Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModLimiters.F90
Go to the documentation of this file.
1 ! *********************************************************************
2 ! * Rocstar Simulation Suite *
3 ! * Copyright@2015, Illinois Rocstar LLC. All rights reserved. *
4 ! * *
5 ! * Illinois Rocstar LLC *
6 ! * Champaign, IL *
7 ! * www.illinoisrocstar.com *
8 ! * sales@illinoisrocstar.com *
9 ! * *
10 ! * License: See LICENSE file in top level of distribution package or *
11 ! * http://opensource.org/licenses/NCSA *
12 ! *********************************************************************
13 ! *********************************************************************
14 ! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *
15 ! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *
16 ! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *
17 ! * NONINFRINGEMENT. IN NO EVENT SHALL THE CONTRIBUTORS OR *
18 ! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
19 ! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, *
20 ! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE *
21 ! * USE OR OTHER DEALINGS WITH THE SOFTWARE. *
22 ! *********************************************************************
23 ! ******************************************************************************
24 !
25 ! Purpose: Suite of routines related to limiter functions.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModLimiters.F90,v 1.5 2008/12/06 08:44:22 mtcampbe Exp $
34 !
35 ! Copyright: (c) 2002-2006 by the University of Illinois
36 !
37 ! ******************************************************************************
38 
39 MODULE rflu_modlimiters
40 
41  USE modglobal, ONLY: t_global
42  USE modparameters
43  USE moddatatypes
44  USE moderror
45  USE moddatastruct, ONLY: t_region
46  USE modgrid, ONLY: t_grid
47  USE modbndpatch, ONLY: t_patch
48  USE modmpi
49 
50  IMPLICIT NONE
51 
52  PRIVATE
53  PUBLIC :: rflu_computelimiterbarthjesp, &
54  rflu_computelimitervenkat, &
55  rflu_createlimiter, &
56  rflu_destroylimiter, &
57  rflu_limitgradcells, &
58  rflu_limitgradcellssimple
59 
60 
61 ! ******************************************************************************
62 ! Declarations and definitions
63 ! ******************************************************************************
64 
65  CHARACTER(CHRLEN) :: RCSIdentString = &
66  '$RCSfile: RFLU_ModLimiters.F90,v $ $Revision: 1.5 $'
67 
68 ! ******************************************************************************
69 ! Routines
70 ! ******************************************************************************
71 
72  CONTAINS
73 
74 
75 
76 
77 
78 ! ******************************************************************************
79 !
80 ! Purpose: Compute limiters for gradients at cell centers using Barth-
81 ! Jespersen limiter function.
82 !
83 ! Description: None.
84 !
85 ! Input:
86 ! pRegion Pointer to region data
87 ! iBegVar Beginning index in var array
88 ! iEndVar Beginning index in var array
89 ! iBegGrad Beginning index in grad array
90 ! iEndGrad Beginning index in grad array
91 ! var Variables to be limited
92 ! grad Gradients of variables
93 !
94 ! Output:
95 ! lim Limiter
96 !
97 ! Notes: None.
98 !
99 ! ******************************************************************************
100 
101 SUBROUTINE rflu_computelimiterbarthjesp(pRegion,iBegVar,iEndVar,iBegGrad, &
102  iendgrad,var,grad,lim)
103 
104  IMPLICIT NONE
105 
106 ! ******************************************************************************
107 ! Definitions and declarations
108 ! ******************************************************************************
109 
110 ! ==============================================================================
111 ! Arguments
112 ! ==============================================================================
113 
114  INTEGER :: ibeggrad,ibegvar,iendgrad,iendvar
115  REAL(RFREAL), DIMENSION(:,:), POINTER :: lim,var
116  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
117  TYPE(t_region), POINTER :: pregion
118 
119 ! ==============================================================================
120 ! Locals
121 ! ==============================================================================
122 
123  INTEGER :: c1,c2,errorflag,icg,ifg,igrad,ivar
124  REAL(RFREAL) :: dx1,dx2,dy1,dy2,dz1,dz2,d1max1,d1max2,d1min1,d1min2,d21, &
125  d22,term,var1,var2,xc,yc,zc
126  REAL(RFREAL), DIMENSION(:,:), POINTER :: varmax,varmin
127  TYPE(t_global), POINTER :: global
128  TYPE(t_grid), POINTER :: pgrid
129 
130 ! *****************************************************************************
131 ! Start
132 ! *****************************************************************************
133 
134  global => pregion%global
135 
136  CALL registerfunction(global,'RFLU_ComputeLimiterBarthJesp',&
137  'RFLU_ModLimiters.F90' )
138 
139  IF ( (iendvar - ibegvar) /= (iendgrad - ibeggrad) ) THEN
140  CALL errorstop(global,err_grad_mismatch,__line__)
141  END IF ! iEndVar
142 
143 ! ******************************************************************************
144 ! Set pointers and variables
145 ! ******************************************************************************
146 
147  pgrid => pregion%grid
148 
149 ! ******************************************************************************
150 ! Allocate temporary memory
151 ! ******************************************************************************
152 
153  ALLOCATE(varmin(ibegvar:iendvar,pgrid%nCellsTot),stat=errorflag)
154  global%error = errorflag
155  IF ( global%error /= err_none ) THEN
156  CALL errorstop(global,err_allocate,__line__,'varMin')
157  END IF ! global%error
158 
159  ALLOCATE(varmax(ibegvar:iendvar,pgrid%nCellsTot),stat=errorflag)
160  global%error = errorflag
161  IF ( global%error /= err_none ) THEN
162  CALL errorstop(global,err_allocate,__line__,'varMax')
163  END IF ! global%error
164 
165 ! ******************************************************************************
166 ! Initialize
167 ! ******************************************************************************
168 
169  DO icg = 1,pgrid%nCellsTot
170  DO ivar = ibegvar,iendvar
171  varmax(ivar,icg) = var(ivar,icg)
172  varmin(ivar,icg) = var(ivar,icg)
173  END DO ! iVar
174 
175  DO igrad = ibeggrad,iendgrad
176  lim(igrad,icg) = 1.0_rfreal
177  END DO ! iGrad
178  END DO ! icg
179 
180 ! ******************************************************************************
181 ! Compute varMax and varMin
182 ! ******************************************************************************
183 
184  DO ifg = 1,pgrid%nFaces
185  c1 = pgrid%f2c(1,ifg)
186  c2 = pgrid%f2c(2,ifg)
187 
188  DO ivar = ibegvar,iendvar
189  var1 = var(ivar,c1)
190  var2 = var(ivar,c2)
191 
192  varmin(ivar,c1) = min(varmin(ivar,c1),var2)
193  varmin(ivar,c2) = min(varmin(ivar,c2),var1)
194  varmax(ivar,c1) = max(varmax(ivar,c1),var2)
195  varmax(ivar,c2) = max(varmax(ivar,c2),var1)
196  END DO ! iVar
197  END DO ! ifg
198 
199 ! ******************************************************************************
200 ! Loop over faces and compute limiter
201 ! ******************************************************************************
202 
203  DO ifg = 1,pgrid%nFaces
204  c1 = pgrid%f2c(1,ifg)
205  c2 = pgrid%f2c(2,ifg)
206 
207  xc = pgrid%fc(xcoord,ifg)
208  yc = pgrid%fc(ycoord,ifg)
209  zc = pgrid%fc(zcoord,ifg)
210 
211  dx1 = pgrid%cofg(xcoord,c1) - xc
212  dy1 = pgrid%cofg(ycoord,c1) - yc
213  dz1 = pgrid%cofg(zcoord,c1) - zc
214 
215  dx2 = pgrid%cofg(xcoord,c2) - xc
216  dy2 = pgrid%cofg(ycoord,c2) - yc
217  dz2 = pgrid%cofg(zcoord,c2) - zc
218 
219  igrad = ibeggrad
220 
221  DO ivar = ibegvar,iendvar
222  var1 = var(ivar,c1)
223  var2 = var(ivar,c2)
224 
225  d1min1 = varmin(ivar,c1) - var1
226  d1max1 = varmax(ivar,c1) - var1
227  d1min2 = varmin(ivar,c2) - var2
228  d1max2 = varmax(ivar,c2) - var2
229 
230  d21 = grad(xcoord,igrad,c1)*dx1 &
231  + grad(ycoord,igrad,c1)*dy1 &
232  + grad(zcoord,igrad,c1)*dz1
233  d22 = grad(xcoord,igrad,c2)*dx2 &
234  + grad(ycoord,igrad,c2)*dy2 &
235  + grad(zcoord,igrad,c2)*dz2
236 
237  IF ( d21 > 0.0_rfreal ) THEN
238  term = min(1.0_rfreal,d1max1/d21)
239  lim(igrad,c1) = min(term,lim(igrad,c1))
240  ELSEIF ( d21 < 0.0_rfreal ) THEN
241  term = min(1.0_rfreal,d1min1/d21)
242  lim(igrad,c1) = min(term,lim(igrad,c1))
243  END IF ! d21
244 
245  IF ( d22 > 0.0_rfreal ) THEN
246  term = min(1.0_rfreal,d1max2/d22)
247  lim(igrad,c2) = min(term,lim(igrad,c2))
248  ELSEIF ( d22 < 0.0_rfreal ) THEN
249  term = min(1.0_rfreal,d1min2/d22)
250  lim(igrad,c2) = min(term,lim(igrad,c2))
251  END IF ! d22
252 
253  igrad = igrad + 1
254  END DO ! iVar
255  END DO ! ifg
256 
257 ! ******************************************************************************
258 ! Deallocate temporary memory
259 ! ******************************************************************************
260 
261  DEALLOCATE(varmin,stat=errorflag)
262  global%error = errorflag
263  IF ( global%error /= err_none ) THEN
264  CALL errorstop(global,err_deallocate,__line__,'varMin')
265  END IF ! global%error
266 
267  DEALLOCATE(varmax,stat=errorflag)
268  global%error = errorflag
269  IF ( global%error /= err_none ) THEN
270  CALL errorstop(global,err_deallocate,__line__,'varMax')
271  END IF ! global%error
272 
273 ! ******************************************************************************
274 ! End
275 ! ******************************************************************************
276 
277  CALL deregisterfunction(global)
278 
279  END SUBROUTINE rflu_computelimiterbarthjesp
280 
281 
282 
283 
284 
285 
286 
287 ! ******************************************************************************
288 !
289 ! Purpose: Compute limiters for gradients at cell centers using Venkatakrishnan
290 ! limiter function.
291 !
292 ! Description: None.
293 !
294 ! Input:
295 ! pRegion Pointer to region data
296 ! iBegVar Beginning index in var array
297 ! iEndVar Beginning index in var array
298 ! iBegGrad Beginning index in grad array
299 ! iEndGrad Beginning index in grad array
300 ! var Variables to be limited
301 ! grad Gradients of variables
302 !
303 ! Output:
304 ! lim Limiter
305 !
306 ! Notes: None.
307 !
308 ! ******************************************************************************
309 
310 SUBROUTINE rflu_computelimitervenkat(pRegion,iBegVar,iEndVar,iBegGrad, &
311  iendgrad,var,grad,lim)
312 
313  IMPLICIT NONE
314 
315 ! ******************************************************************************
316 ! Definitions and declarations
317 ! ******************************************************************************
318 
319 ! ==============================================================================
320 ! Arguments
321 ! ==============================================================================
322 
323  INTEGER :: ibeggrad,ibegvar,iendgrad,iendvar
324  REAL(RFREAL), DIMENSION(:,:), POINTER :: lim,var
325  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
326  TYPE(t_region), POINTER :: pregion
327 
328 ! ==============================================================================
329 ! Locals
330 ! ==============================================================================
331 
332  INTEGER :: c1,c2,errorflag,icg,ifg,igrad,ivar
333  REAL(RFREAL), PARAMETER :: thrd = 1.0_rfreal/3.0_rfreal
334  REAL(RFREAL), PARAMETER :: tiny = 1.0e-12_rfreal
335  REAL(RFREAL) :: denom,ds1,ds2,dx1,dx2,dy1,dy2,dz1,dz2,d1max1,d1max2,d1min1, &
336  d1min2,d21,d22,epsq1,epsq2,numer,term,var1,var2,venkatlimk, &
337  xc,yc,zc
338  REAL(RFREAL), DIMENSION(:,:), POINTER :: varmax,varmin
339  TYPE(t_global), POINTER :: global
340  TYPE(t_grid), POINTER :: pgrid
341 
342 ! *****************************************************************************
343 ! Start
344 ! *****************************************************************************
345 
346  global => pregion%global
347 
348  CALL registerfunction(global,'RFLU_ComputeLimiterVenkat',&
349  'RFLU_ModLimiters.F90' )
350 
351 ! ******************************************************************************
352 ! Set pointers and variables
353 ! ******************************************************************************
354 
355  pgrid => pregion%grid
356 
357 ! TEMPORARY
358  venkatlimk = 1.0_rfreal
359 ! END TEMPORARY
360 
361 ! ******************************************************************************
362 ! Allocate temporary memory
363 ! ******************************************************************************
364 
365  ALLOCATE(varmin(ibegvar:iendvar,pgrid%nCellsTot),stat=errorflag)
366  global%error = errorflag
367  IF ( global%error /= err_none ) THEN
368  CALL errorstop(global,err_allocate,__line__,'varMin')
369  END IF ! global%error
370 
371  ALLOCATE(varmax(ibegvar:iendvar,pgrid%nCellsTot),stat=errorflag)
372  global%error = errorflag
373  IF ( global%error /= err_none ) THEN
374  CALL errorstop(global,err_allocate,__line__,'varMax')
375  END IF ! global%error
376 
377 ! ******************************************************************************
378 ! Initialize
379 ! ******************************************************************************
380 
381  DO icg = 1,pgrid%nCellsTot
382  DO ivar = ibegvar,iendvar
383  varmax(ivar,icg) = var(ivar,icg)
384  varmin(ivar,icg) = var(ivar,icg)
385  END DO ! iVar
386 
387  DO igrad = ibeggrad,iendgrad
388  lim(igrad,icg) = 1.0_rfreal
389  END DO ! iGrad
390  END DO ! icg
391 
392 ! ******************************************************************************
393 ! Compute varMax and varMin
394 ! ******************************************************************************
395 
396  DO ifg = 1,pgrid%nFaces
397  c1 = pgrid%f2c(1,ifg)
398  c2 = pgrid%f2c(2,ifg)
399 
400  DO ivar = ibegvar,iendvar
401  var1 = var(ivar,c1)
402  var2 = var(ivar,c2)
403 
404  varmin(ivar,c1) = min(varmin(ivar,c1),var2)
405  varmin(ivar,c2) = min(varmin(ivar,c2),var1)
406  varmax(ivar,c1) = max(varmax(ivar,c1),var2)
407  varmax(ivar,c2) = max(varmax(ivar,c2),var1)
408  END DO ! iVar
409  END DO ! ifg
410 
411 ! ******************************************************************************
412 ! Loop over faces and compute limiter
413 ! ******************************************************************************
414 
415  DO ifg = 1,pgrid%nFaces
416  c1 = pgrid%f2c(1,ifg)
417  c2 = pgrid%f2c(2,ifg)
418 
419  xc = pgrid%fc(xcoord,ifg)
420  yc = pgrid%fc(ycoord,ifg)
421  zc = pgrid%fc(zcoord,ifg)
422 
423  dx1 = pgrid%cofg(xcoord,c1) - xc
424  dy1 = pgrid%cofg(ycoord,c1) - yc
425  dz1 = pgrid%cofg(zcoord,c1) - zc
426 
427  dx2 = pgrid%cofg(xcoord,c2) - xc
428  dy2 = pgrid%cofg(ycoord,c2) - yc
429  dz2 = pgrid%cofg(zcoord,c2) - zc
430 
431  ds1 = pgrid%vol(c1)**thrd
432  ds2 = pgrid%vol(c2)**thrd
433  epsq1 = (venkatlimk*ds1)*(venkatlimk*ds1)*(venkatlimk*ds1)
434  epsq2 = (venkatlimk*ds2)*(venkatlimk*ds2)*(venkatlimk*ds2)
435 
436  igrad = ibeggrad
437 
438  DO ivar = ibegvar,iendvar
439  var1 = var(ivar,c1)
440  var2 = var(ivar,c2)
441 
442  d1min1 = varmin(ivar,c1) - var1
443  d1max1 = varmax(ivar,c1) - var1
444  d1min2 = varmin(ivar,c2) - var2
445  d1max2 = varmax(ivar,c2) - var2
446 
447  d21 = grad(xcoord,igrad,c1)*dx1 &
448  + grad(ycoord,igrad,c1)*dy1 &
449  + grad(zcoord,igrad,c1)*dz1
450  d22 = grad(xcoord,igrad,c2)*dx2 &
451  + grad(ycoord,igrad,c2)*dy2 &
452  + grad(zcoord,igrad,c2)*dz2
453 
454  IF ( d21 > 0.0_rfreal ) THEN
455  numer = (d1max1*d1max1+epsq1)*d21 + 2*d21*d21*d1max1
456  denom = d21*(d1max1*d1max1 + 2*d21*d21 + d1max1*d21 + epsq1)
457  term = numer/(denom+tiny)
458  lim(igrad,c1) = min(term,lim(igrad,c1))
459  ELSEIF ( d21 < 0.0_rfreal ) THEN
460  numer = (d1min1*d1min1+epsq1)*d21 + 2*d21*d21*d1min1
461  denom = d21*(d1min1*d1min1 + 2*d21*d21 + d1min1*d21 + epsq1)
462  term = numer/(denom+tiny)
463  lim(igrad,c1) = min(term,lim(igrad,c1))
464  ENDIF ! d21
465 
466  IF ( d22 > 0.0_rfreal ) THEN
467  numer = (d1max2*d1max2+epsq2)*d22 + 2*d22*d22*d1max2
468  denom = d22*(d1max2*d1max2 + 2*d22*d22 + d1max2*d22 + epsq2)
469  term = numer/(denom+tiny)
470  lim(igrad,c2) = min(term,lim(igrad,c2))
471  ELSEIF ( d22 < 0.0_rfreal ) THEN
472  numer = (d1min2*d1min2+epsq2)*d22 + 2*d22*d22*d1min2
473  denom = d22*(d1min2*d1min2 + 2*d22*d22 + d1min2*d22 + epsq2)
474  term = numer/(denom+tiny)
475  lim(igrad,c2) = min(term,lim(igrad,c2))
476  ENDIF ! d22
477 
478  igrad = igrad + 1
479  END DO ! iVar
480  END DO ! ifg
481 
482 ! ******************************************************************************
483 ! Deallocate temporary memory
484 ! ******************************************************************************
485 
486  DEALLOCATE(varmin,stat=errorflag)
487  global%error = errorflag
488  IF ( global%error /= err_none ) THEN
489  CALL errorstop(global,err_deallocate,__line__,'varMin')
490  END IF ! global%error
491 
492  DEALLOCATE(varmax,stat=errorflag)
493  global%error = errorflag
494  IF ( global%error /= err_none ) THEN
495  CALL errorstop(global,err_deallocate,__line__,'varMax')
496  END IF ! global%error
497 
498 ! ******************************************************************************
499 ! End
500 ! ******************************************************************************
501 
502  CALL deregisterfunction(global)
503 
504  END SUBROUTINE rflu_computelimitervenkat
505 
506 
507 
508 
509 
510 
511 
512 
513 ! ******************************************************************************
514 !
515 ! Purpose: Create limiter.
516 !
517 ! Description: None.
518 !
519 ! Input:
520 ! pRegion Pointer to region
521 ! iBegGrad Beginning index of gradient array
522 ! iEndGrad Ending index of gradient array
523 !
524 ! Output:
525 ! lim Limiter
526 !
527 ! Notes: None.
528 !
529 ! ******************************************************************************
530 
531 SUBROUTINE rflu_createlimiter(pRegion,iBegGrad,iEndGrad,lim)
532 
533  IMPLICIT NONE
534 
535 ! ******************************************************************************
536 ! Declarations and definitions
537 ! ******************************************************************************
538 
539 ! ==============================================================================
540 ! Arguments
541 ! ==============================================================================
542 
543  INTEGER, INTENT(IN) :: ibeggrad,iendgrad
544  REAL(RFREAL), DIMENSION(:,:), POINTER :: lim
545  TYPE(t_region), POINTER :: pregion
546 
547 ! ==============================================================================
548 ! Locals
549 ! ==============================================================================
550 
551  INTEGER :: errorflag
552  TYPE(t_global), POINTER :: global
553  TYPE(t_grid), POINTER :: pgrid
554 
555 ! ******************************************************************************
556 ! Start
557 ! ******************************************************************************
558 
559  global => pregion%global
560  pgrid => pregion%grid
561 
562  CALL registerfunction(global,'RFLU_CreateLimiter', &
563  'RFLU_ModLimiters.F90')
564 
565 ! ******************************************************************************
566 ! Create limiter
567 ! ******************************************************************************
568 
569  ALLOCATE(lim(ibeggrad:iendgrad,pgrid%nCellsTot),stat=errorflag)
570  global%error = errorflag
571  IF ( global%error /= err_none ) THEN
572  CALL errorstop(global,err_allocate,__line__,'lim')
573  END IF ! global%error
574 
575 ! ******************************************************************************
576 ! End
577 ! ******************************************************************************
578 
579  CALL deregisterfunction(global)
580 
581 END SUBROUTINE rflu_createlimiter
582 
583 
584 
585 
586 
587 
588 
589 ! ******************************************************************************
590 !
591 ! Purpose: Destroy limiter.
592 !
593 ! Description: None.
594 !
595 ! Input:
596 ! pRegion Pointer to region
597 !
598 ! Output: None.
599 !
600 ! Notes: None.
601 !
602 ! ******************************************************************************
603 
604 SUBROUTINE rflu_destroylimiter(pRegion,lim)
605 
606  IMPLICIT NONE
607 
608 ! ******************************************************************************
609 ! Declarations and definitions
610 ! ******************************************************************************
611 
612 ! ==============================================================================
613 ! Arguments
614 ! ==============================================================================
615 
616  REAL(RFREAL), DIMENSION(:,:), POINTER :: lim
617  TYPE(t_region), POINTER :: pregion
618 
619 ! ==============================================================================
620 ! Locals
621 ! ==============================================================================
622 
623  INTEGER :: errorflag
624  TYPE(t_global), POINTER :: global
625 
626 ! ******************************************************************************
627 ! Start
628 ! ******************************************************************************
629 
630  global => pregion%global
631 
632  CALL registerfunction(global,'RFLU_DestroyLimiter', &
633  'RFLU_ModLimiters.F90')
634 
635 ! ******************************************************************************
636 ! Destroy limiter
637 ! ******************************************************************************
638 
639  DEALLOCATE(lim,stat=errorflag)
640  global%error = errorflag
641  IF ( global%error /= err_none ) THEN
642  CALL errorstop(global,err_deallocate,__line__,'lim')
643  END IF ! global%error
644 
645 ! ******************************************************************************
646 ! End
647 ! ******************************************************************************
648 
649  CALL deregisterfunction(global)
650 
651 END SUBROUTINE rflu_destroylimiter
652 
653 
654 
655 
656 
657 
658 
659 ! ******************************************************************************
660 !
661 ! Purpose: Apply limiter to gradient.
662 !
663 ! Description: None.
664 !
665 ! Input:
666 ! pRegion Pointer to region
667 ! iBegGrad Beginning index of grad array
668 ! iEndGrad Ending index of grad array
669 ! grad Gradient array
670 ! lim Limiter
671 !
672 ! Output:
673 ! grad Limited gradient array
674 !
675 ! Notes: None.
676 !
677 ! ******************************************************************************
678 
679 SUBROUTINE rflu_limitgradcells(pRegion,iBegGrad,iEndGrad,grad,lim)
680 
681  IMPLICIT NONE
682 
683 ! ******************************************************************************
684 ! Declarations and definitions
685 ! ******************************************************************************
686 
687 ! ==============================================================================
688 ! Arguments
689 ! ==============================================================================
690 
691  INTEGER, INTENT(IN) :: ibeggrad,iendgrad
692  REAL(RFREAL), DIMENSION(:,:), POINTER :: lim
693  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
694  TYPE(t_region), POINTER :: pregion
695 
696 ! ==============================================================================
697 ! Locals
698 ! ==============================================================================
699 
700  INTEGER :: icg,igrad
701  TYPE(t_global), POINTER :: global
702  TYPE(t_grid), POINTER :: pgrid
703 
704 ! ******************************************************************************
705 ! Start
706 ! ******************************************************************************
707 
708  global => pregion%global
709  pgrid => pregion%grid
710 
711  CALL registerfunction(global,'RFLU_LimitGradCells', &
712  'RFLU_ModLimiters.F90')
713 
714 ! ******************************************************************************
715 ! Apply limiter
716 ! ******************************************************************************
717 
718  DO icg = 1,pgrid%nCellsTot
719  DO igrad = ibeggrad,iendgrad
720  grad(xcoord,igrad,icg) = lim(igrad,icg)*grad(xcoord,igrad,icg)
721  grad(ycoord,igrad,icg) = lim(igrad,icg)*grad(ycoord,igrad,icg)
722  grad(zcoord,igrad,icg) = lim(igrad,icg)*grad(zcoord,igrad,icg)
723  END DO ! iVar
724  END DO ! icg
725 
726 ! ******************************************************************************
727 ! End
728 ! ******************************************************************************
729 
730  CALL deregisterfunction(global)
731 
732 END SUBROUTINE rflu_limitgradcells
733 
734 
735 
736 
737 
738 
739 
740 
741 ! ******************************************************************************
742 !
743 ! Purpose: Limit gradients of any vector or scalar at cell centers
744 ! to ensure positive face quantities.
745 !
746 ! Description: None.
747 !
748 ! Input:
749 ! pRegion Pointer to region data
750 ! iBegVar Beginning index of data in var
751 ! iEndVar Ending index of data in var
752 ! iBegGrad Beginning index of data in grad
753 ! iEndGrad Ending index of data in grad
754 ! var Variables
755 ! varInfo Information on variables
756 ! grad Gradients of variables at cell centers
757 !
758 ! Output:
759 ! grad Gradients of variables at cell centers
760 !
761 ! Notes: None.
762 !
763 ! ******************************************************************************
764 
765 SUBROUTINE rflu_limitgradcellssimple(pRegion,iBegVar,iEndVar,iBegGrad, &
766  iendgrad,var,varinfo,grad)
767 
768  IMPLICIT NONE
769 
770 ! ******************************************************************************
771 ! Definitions and declarations
772 ! ******************************************************************************
773 
774 ! ==============================================================================
775 ! Arguments
776 ! ==============================================================================
777 
778  INTEGER, INTENT(IN) :: ibegvar,iendvar,ibeggrad,iendgrad
779  INTEGER, DIMENSION(:), POINTER :: varinfo
780  REAL(RFREAL), DIMENSION(:,:), POINTER :: var
781  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
782  TYPE(t_region), POINTER :: pregion
783 
784 ! ==============================================================================
785 ! Locals
786 ! ==============================================================================
787 
788  INTEGER :: errorflag,icg,icl,ict,ifg,ifl,igrad,ipatch,ivar,nfacespercell
789  INTEGER, DIMENSION(:,:,:), POINTER :: pc2f
790  REAL(RFREAL) :: dx,dy,dz,varc,varf,xc,yc,zc,xfc,yfc,zfc
791  TYPE(t_global), POINTER :: global
792  TYPE(t_grid), POINTER :: pgrid
793  TYPE(t_patch), POINTER :: ppatch
794 
795 ! ******************************************************************************
796 ! Start
797 ! ******************************************************************************
798 
799  global => pregion%global
800 
801  CALL registerfunction(global,'RFLU_LimitGradCellsSimple',&
802  'RFLU_ModLimiters.F90' )
803 
804  IF ( (iendvar - ibegvar) /= (iendgrad - ibeggrad) ) THEN
805  CALL errorstop(global,err_grad_mismatch,__line__)
806  END IF ! iEndVar
807 
808 ! ******************************************************************************
809 ! Set pointers and variables
810 ! ******************************************************************************
811 
812  pgrid => pregion%grid
813 
814 ! ******************************************************************************
815 ! Loop over cells
816 ! ******************************************************************************
817 
818  DO icg = 1,pgrid%nCellsTot
819  ict = pgrid%cellGlob2Loc(1,icg) ! cell type
820  icl = pgrid%cellGlob2Loc(2,icg) ! local cell index
821 
822  SELECT CASE ( ict )
823  CASE ( cell_type_tet )
824  nfacespercell = 4
825  pc2f => pgrid%tet2f
826  CASE ( cell_type_hex )
827  nfacespercell = 6
828  pc2f => pgrid%hex2f
829  CASE ( cell_type_pri )
830  nfacespercell = 5
831  pc2f => pgrid%pri2f
832  CASE ( cell_type_pyr )
833  nfacespercell = 5
834  pc2f => pgrid%pyr2f
835  CASE default
836  CALL errorstop(global,err_reached_default,__line__)
837  END SELECT ! ict
838 
839  xc = pgrid%cofg(xcoord,icg)
840  yc = pgrid%cofg(ycoord,icg)
841  zc = pgrid%cofg(zcoord,icg)
842 
843 ! ==============================================================================
844 ! Loop over positive-definite variables
845 ! ==============================================================================
846 
847  igrad = ibeggrad
848 
849  DO ivar = ibegvar,iendvar
850  IF ( varinfo(ivar) == var_info_pos ) THEN
851  varc = var(ivar,icg)
852 
853  faceloop: DO ifl = 1,nfacespercell
854  ipatch = pc2f(1,ifl,icl)
855  ifg = pc2f(2,ifl,icl)
856 
857  IF ( ipatch == 0 ) THEN ! Interior face
858  dx = pgrid%fc(xcoord,ifg) - xc
859  dy = pgrid%fc(ycoord,ifg) - yc
860  dz = pgrid%fc(zcoord,ifg) - zc
861  ELSE ! Boundary face
862  ppatch => pregion%patches(ipatch)
863 
864  dx = ppatch%fc(xcoord,ifg) - xc
865  dy = ppatch%fc(ycoord,ifg) - yc
866  dz = ppatch%fc(zcoord,ifg) - zc
867  END IF ! pC2f
868 
869  varf = varc + grad(xcoord,igrad,icg)*dx &
870  + grad(ycoord,igrad,icg)*dy &
871  + grad(zcoord,igrad,icg)*dz
872 
873  IF ( varf <= 0.0_rfreal ) THEN
874  grad(xcoord,igrad,icg) = 0.0_rfreal
875  grad(ycoord,igrad,icg) = 0.0_rfreal
876  grad(zcoord,igrad,icg) = 0.0_rfreal
877 
878  EXIT faceloop
879  END IF ! varf
880 
881  END DO faceloop
882  END IF ! iVar
883 
884  igrad = igrad + 1
885  END DO ! iVar
886  END DO ! icg
887 
888 ! ******************************************************************************
889 ! End
890 ! ******************************************************************************
891 
892  CALL deregisterfunction(global)
893 
894 END SUBROUTINE rflu_limitgradcellssimple
895 
896 
897 
898 
899 
900 ! ******************************************************************************
901 ! End
902 ! ******************************************************************************
903 
904 END MODULE rflu_modlimiters
905 
906 ! ******************************************************************************
907 !
908 ! RCS Revision history:
909 !
910 ! $Log: RFLU_ModLimiters.F90,v $
911 ! Revision 1.5 2008/12/06 08:44:22 mtcampbe
912 ! Updated license.
913 !
914 ! Revision 1.4 2008/11/19 22:17:33 mtcampbe
915 ! Added Illinois Open Source License/Copyright
916 !
917 ! Revision 1.3 2006/04/27 15:10:55 haselbac
918 ! Many bug fixes and clean-up
919 !
920 ! Revision 1.2 2006/04/07 15:19:19 haselbac
921 ! Removed tabs
922 !
923 ! Revision 1.1 2005/07/11 19:33:47 mparmar
924 ! Initial revision
925 !
926 ! ******************************************************************************
927 
928 
929 
930 
931 
932 
933 
934 
935 
936 
937 
938 
rflu_modlimiters::rflu_destroylimiter
subroutine, public rflu_destroylimiter(pRegion, lim)
Definition: RFLU_ModLimiters.F90:604
rflu_modlimiters::rflu_computelimitervenkat
subroutine, public rflu_computelimitervenkat(pRegion, iBegVar, iEndVar, iBegGrad, iEndGrad, var, grad, lim)
Definition: RFLU_ModLimiters.F90:310
rflu_modlimiters::rflu_computelimiterbarthjesp
subroutine, public rflu_computelimiterbarthjesp(pRegion, iBegVar, iEndVar, iBegGrad, iEndGrad, var, grad, lim)
Definition: RFLU_ModLimiters.F90:101
rflu_modlimiters::rflu_createlimiter
subroutine, public rflu_createlimiter(pRegion, iBegGrad, iEndGrad, lim)
Definition: RFLU_ModLimiters.F90:531
dx
NT dx
Definition: rational_rotation.h:81
Kdtree_d::ExtPoint::term
void term()
Definition: kdtree_d.h:237
max
Vector_n max(const Array_n_const &v1, const Array_n_const &v2)
Definition: Vector_n.h:354
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
modgrid::t_grid
Definition: ModGrid.F90:56
rflu_modlimiters::rflu_limitgradcells
subroutine, public rflu_limitgradcells(pRegion, iBegGrad, iEndGrad, grad, lim)
Definition: RFLU_ModLimiters.F90:679
rflu_modlimiters::rflu_limitgradcellssimple
subroutine, public rflu_limitgradcellssimple(pRegion, iBegVar, iEndVar, iBegGrad, iEndGrad, var, varInfo, grad)
Definition: RFLU_ModLimiters.F90:765
Direction_3::dz
RT dz() const
Definition: Direction_3.h:133
min
Vector_n min(const Array_n_const &v1, const Array_n_const &v2)
Definition: Vector_n.h:346
dy
NT dy
Definition: rational_rotation.h:82
rflu_modlimiters
Definition: RFLU_ModLimiters.F90:39
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
denom
CGAL_BEGIN_NAMESPACE void const NT NT NT NT & denom
Definition: rational_rotation.h:61
modbndpatch::t_patch
Definition: ModBndPatch.F90:91