Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModWENO.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 WENO method.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModWENO.F90,v 1.4 2008/12/06 08:44:25 mtcampbe Exp $
34 !
35 ! Copyright: (c) 2006 by the University of Illinois
36 !
37 ! ******************************************************************************
38 
39 MODULE rflu_modweno
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_wenogradcellswrapper, &
54  rflu_wenogradcellsxyzwrapper
55 
56 ! ******************************************************************************
57 ! Declarations and definitions
58 ! ******************************************************************************
59 
60  CHARACTER(CHRLEN) :: RCSIdentString = &
61  '$RCSfile: RFLU_ModWENO.F90,v $ $Revision: 1.4 $'
62 
63 ! ******************************************************************************
64 ! Routines
65 ! ******************************************************************************
66 
67  CONTAINS
68 
69 
70 
71 
72 
73 
74 
75 
76 
77 
78 ! ******************************************************************************
79 !
80 ! Purpose: Compute 2d WENO gradients of any vector or scalar at cell centers.
81 !
82 ! Description: None.
83 !
84 ! Input:
85 ! pRegion Pointer to region data
86 ! iBegGrad Beginning index of data in grad
87 ! iEndGrad Ending index of data in grad
88 !
89 ! Output:
90 ! grad Gradients of variables at cell centers
91 !
92 ! Notes: None.
93 !
94 ! ******************************************************************************
95 
96  SUBROUTINE rflu_wenogradcells_2d(pRegion,iBegGrad,iEndGrad,grad)
97 
98  IMPLICIT NONE
99 
100 ! ******************************************************************************
101 ! Definitions and declarations
102 ! ******************************************************************************
103 
104 ! ==============================================================================
105 ! Arguments
106 ! ==============================================================================
107 
108  INTEGER :: ibeggrad,iendgrad
109  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
110  TYPE(t_region), POINTER :: pregion
111 
112 ! ==============================================================================
113 ! Locals
114 ! ==============================================================================
115 
116  INTEGER :: errorflag,icg,icg2,igrad,isl
117  REAL(RFREAL) :: smooindsum,term
118  REAL(RFREAL) :: gradlocal(xcoord:ycoord)
119  REAL(RFREAL), DIMENSION(:), ALLOCATABLE :: smooind
120  REAL(RFREAL), DIMENSION(:,:,:), ALLOCATABLE :: gradeno
121  TYPE(t_global), POINTER :: global
122  TYPE(t_grid), POINTER :: pgrid
123 
124 ! ******************************************************************************
125 ! Start
126 ! ******************************************************************************
127 
128  global => pregion%global
129 
130  CALL registerfunction(global,'RFLU_WENOGradCells_2D',&
131  'RFLU_ModWENO.F90' )
132 
133 #ifdef ROCPROF
134  CALL fprofiler_begins("RFLU::WENOGradCells_2D")
135 #endif
136 
137 ! ******************************************************************************
138 ! Set pointers and variables
139 ! ******************************************************************************
140 
141  pgrid => pregion%grid
142 
143 ! ******************************************************************************
144 ! Compute ENO gradients
145 ! ******************************************************************************
146 
147 ! ==============================================================================
148 ! Allocate memory
149 ! ==============================================================================
150 
151  ALLOCATE(gradeno(xcoord:ycoord,ibeggrad:iendgrad,pgrid%nCellsTot), &
152  stat=errorflag)
153  global%error = errorflag
154  IF ( global%error /= err_none ) THEN
155  CALL errorstop(global,err_allocate,__line__,'gradENO')
156  END IF ! global%error
157 
158  ALLOCATE(smooind(0:pgrid%c2csInfo%nCellMembsMax),stat=errorflag)
159  global%error = errorflag
160  IF ( global%error /= err_none ) THEN
161  CALL errorstop(global,err_allocate,__line__,'smooInd')
162  END IF ! global%error
163 
164 ! ==============================================================================
165 ! Loop over cells
166 ! ==============================================================================
167 
168  DO icg = 1,pgrid%nCellsTot
169 
170 ! ------------------------------------------------------------------------------
171 ! Compute weighted gradient based on smoothness indicator
172 ! ------------------------------------------------------------------------------
173 
174  DO igrad = ibeggrad,iendgrad
175 
176 ! ----- Compute smoothness indicator -------------------------------------------
177 
178  term = abs(grad(xcoord,igrad,icg)) + abs(grad(ycoord,igrad,icg))
179 
180  smooind(0) = 1.0_rfreal/(term*term + 1.0e-15_rfreal)
181  smooindsum = smooind(0)
182 
183  DO isl = 1,pgrid%c2cs(icg)%nCellMembs
184  icg2 = pgrid%c2cs(icg)%cellMembs(isl)
185 
186  term = abs(grad(xcoord,igrad,icg2)) + abs(grad(ycoord,igrad,icg2))
187 
188  smooind(isl) = 1.0_rfreal/(term*term + 1.0e-15_rfreal)
189  smooindsum = smooindsum + smooind(isl)
190  END DO ! isl
191 
192 ! ----- Compute weighted gradient ----------------------------------------------
193 
194  term = smooind(0)/smooindsum
195 
196  gradlocal(xcoord) = term*grad(xcoord,igrad,icg)
197  gradlocal(ycoord) = term*grad(ycoord,igrad,icg)
198 
199  DO isl = 1,pgrid%c2cs(icg)%nCellMembs
200  icg2 = pgrid%c2cs(icg)%cellMembs(isl)
201  term = smooind(isl)/smooindsum
202 
203  gradlocal(xcoord) = gradlocal(xcoord) + term*grad(xcoord,igrad,icg2)
204  gradlocal(ycoord) = gradlocal(ycoord) + term*grad(ycoord,igrad,icg2)
205  END DO ! isl
206 
207  gradeno(xcoord,igrad,icg) = gradlocal(xcoord)
208  gradeno(ycoord,igrad,icg) = gradlocal(ycoord)
209  END DO ! iGrad
210  END DO ! icg
211 
212 ! ==============================================================================
213 ! Reassign gradients
214 ! ==============================================================================
215 
216  DO icg = 1,pgrid%nCellsTot
217  DO igrad = ibeggrad,iendgrad
218  grad(xcoord,igrad,icg) = gradeno(xcoord,igrad,icg)
219  grad(ycoord,igrad,icg) = gradeno(ycoord,igrad,icg)
220  END DO ! iGrad
221  END DO ! icg
222 
223 ! ==============================================================================
224 ! Deallocate memory
225 ! ==============================================================================
226 
227  DEALLOCATE(smooind,stat=errorflag)
228  global%error = errorflag
229  IF ( global%error /= err_none ) THEN
230  CALL errorstop(global,err_deallocate,__line__,'smooInd')
231  END IF ! global%error
232 
233  DEALLOCATE(gradeno,stat=errorflag)
234  global%error = errorflag
235  IF ( global%error /= err_none ) THEN
236  CALL errorstop(global,err_deallocate,__line__,'gradENO')
237  END IF ! global%error
238 
239 ! ******************************************************************************
240 ! End
241 ! ******************************************************************************
242 
243 #ifdef ROCPROF
244  CALL fprofiler_ends("RFLU::WENOGradCells_2D")
245 #endif
246 
247  CALL deregisterfunction(global)
248 
249  END SUBROUTINE rflu_wenogradcells_2d
250 
251 
252 
253 
254 
255 
256 
257 ! ******************************************************************************
258 !
259 ! Purpose: Compute 3d WENO gradients of any vector or scalar at cell centers.
260 !
261 ! Description: None.
262 !
263 ! Input:
264 ! pRegion Pointer to region data
265 ! iBegGrad Beginning index of data in grad
266 ! iEndGrad Ending index of data in grad
267 !
268 ! Output:
269 ! grad Gradients of variables at cell centers
270 !
271 ! Notes: None.
272 !
273 ! ******************************************************************************
274 
275  SUBROUTINE rflu_wenogradcells_3d(pRegion,iBegGrad,iEndGrad,grad)
276 
277  IMPLICIT NONE
278 
279 ! ******************************************************************************
280 ! Definitions and declarations
281 ! ******************************************************************************
282 
283 ! ==============================================================================
284 ! Arguments
285 ! ==============================================================================
286 
287  INTEGER :: ibeggrad,iendgrad
288  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
289  TYPE(t_region), POINTER :: pregion
290 
291 ! ==============================================================================
292 ! Locals
293 ! ==============================================================================
294 
295  INTEGER :: errorflag,icg,icg2,igrad,isl
296  REAL(RFREAL) :: smooindsum,term
297  REAL(RFREAL) :: gradlocal(xcoord:zcoord)
298  REAL(RFREAL), DIMENSION(:), ALLOCATABLE :: smooind
299  REAL(RFREAL), DIMENSION(:,:,:), ALLOCATABLE :: gradeno
300  TYPE(t_global), POINTER :: global
301  TYPE(t_grid), POINTER :: pgrid
302 
303 ! ******************************************************************************
304 ! Start
305 ! ******************************************************************************
306 
307  global => pregion%global
308 
309  CALL registerfunction(global,'RFLU_WENOGradCells_3D',&
310  'RFLU_ModWENO.F90' )
311 
312 #ifdef ROCPROF
313  CALL fprofiler_begins("RFLU::WENOGradCells_3D")
314 #endif
315 
316 ! ******************************************************************************
317 ! Set pointers and variables
318 ! ******************************************************************************
319 
320  pgrid => pregion%grid
321 
322 ! ******************************************************************************
323 ! Compute ENO gradients
324 ! ******************************************************************************
325 
326 ! ==============================================================================
327 ! Allocate memory
328 ! ==============================================================================
329 
330  ALLOCATE(gradeno(xcoord:zcoord,ibeggrad:iendgrad,pgrid%nCellsTot), &
331  stat=errorflag)
332  global%error = errorflag
333  IF ( global%error /= err_none ) THEN
334  CALL errorstop(global,err_allocate,__line__,'gradENO')
335  END IF ! global%error
336 
337  ALLOCATE(smooind(0:pgrid%c2csInfo%nCellMembsMax),stat=errorflag)
338  global%error = errorflag
339  IF ( global%error /= err_none ) THEN
340  CALL errorstop(global,err_allocate,__line__,'smooInd')
341  END IF ! global%error
342 
343 ! ==============================================================================
344 ! Loop over cells
345 ! ==============================================================================
346 
347  DO icg = 1,pgrid%nCellsTot
348 
349 ! ------------------------------------------------------------------------------
350 ! Compute weighted gradient based on smoothness indicator
351 ! ------------------------------------------------------------------------------
352 
353  DO igrad = ibeggrad,iendgrad
354 
355 ! ----- Compute smoothness indicator -------------------------------------------
356 
357  term = abs(grad(xcoord,igrad,icg)) &
358  + abs(grad(ycoord,igrad,icg)) &
359  + abs(grad(zcoord,igrad,icg))
360 
361  smooind(0) = 1.0_rfreal/(term*term + 1.0e-15_rfreal)
362  smooindsum = smooind(0)
363 
364  DO isl = 1,pgrid%c2cs(icg)%nCellMembs
365  icg2 = pgrid%c2cs(icg)%cellMembs(isl)
366 
367  term = abs(grad(xcoord,igrad,icg2)) &
368  + abs(grad(ycoord,igrad,icg2)) &
369  + abs(grad(zcoord,igrad,icg2))
370 
371  smooind(isl) = 1.0_rfreal/(term*term + 1.0e-15_rfreal)
372  smooindsum = smooindsum + smooind(isl)
373  END DO ! isl
374 
375 ! ----- Compute weighted gradient ----------------------------------------------
376 
377  term = smooind(0)/smooindsum
378 
379  gradlocal(xcoord) = term*grad(xcoord,igrad,icg)
380  gradlocal(ycoord) = term*grad(ycoord,igrad,icg)
381  gradlocal(zcoord) = term*grad(zcoord,igrad,icg)
382 
383  DO isl = 1,pgrid%c2cs(icg)%nCellMembs
384  icg2 = pgrid%c2cs(icg)%cellMembs(isl)
385  term = smooind(isl)/smooindsum
386 
387  gradlocal(xcoord) = gradlocal(xcoord) + term*grad(xcoord,igrad,icg2)
388  gradlocal(ycoord) = gradlocal(ycoord) + term*grad(ycoord,igrad,icg2)
389  gradlocal(zcoord) = gradlocal(zcoord) + term*grad(zcoord,igrad,icg2)
390  END DO ! isl
391 
392  gradeno(xcoord,igrad,icg) = gradlocal(xcoord)
393  gradeno(ycoord,igrad,icg) = gradlocal(ycoord)
394  gradeno(zcoord,igrad,icg) = gradlocal(zcoord)
395  END DO ! iGrad
396  END DO ! icg
397 
398 ! ==============================================================================
399 ! Reassign gradients
400 ! ==============================================================================
401 
402  DO icg = 1,pgrid%nCellsTot
403  DO igrad = ibeggrad,iendgrad
404  grad(xcoord,igrad,icg) = gradeno(xcoord,igrad,icg)
405  grad(ycoord,igrad,icg) = gradeno(ycoord,igrad,icg)
406  grad(zcoord,igrad,icg) = gradeno(zcoord,igrad,icg)
407  END DO ! iGrad
408  END DO ! icg
409 
410 ! ==============================================================================
411 ! Deallocate memory
412 ! ==============================================================================
413 
414  DEALLOCATE(smooind,stat=errorflag)
415  global%error = errorflag
416  IF ( global%error /= err_none ) THEN
417  CALL errorstop(global,err_deallocate,__line__,'smooInd')
418  END IF ! global%error
419 
420  DEALLOCATE(gradeno,stat=errorflag)
421  global%error = errorflag
422  IF ( global%error /= err_none ) THEN
423  CALL errorstop(global,err_deallocate,__line__,'gradENO')
424  END IF ! global%error
425 
426 ! ******************************************************************************
427 ! End
428 ! ******************************************************************************
429 
430 #ifdef ROCPROF
431  CALL fprofiler_ends("RFLU::WENOGradCells_3D")
432 #endif
433 
434  CALL deregisterfunction(global)
435 
436  END SUBROUTINE rflu_wenogradcells_3d
437 
438 
439 
440 
441 
442 
443 ! ******************************************************************************
444 !
445 ! Purpose: Compute WENO gradients of any vector or scalar at cell centers.
446 !
447 ! Description: None.
448 !
449 ! Input:
450 ! pRegion Pointer to region data
451 ! iBegGrad Beginning index of data in grad
452 ! iEndGrad Ending index of data in grad
453 ! grad Gradients of variables at cell centers
454 !
455 ! Output:
456 ! grad Weighted gradients of variables at cell centers
457 !
458 ! Notes:
459 ! 1. If stencil dimension is 1, calling xyz routine, anything else does not
460 ! make sense.
461 !
462 ! ******************************************************************************
463 
464  SUBROUTINE rflu_wenogradcellswrapper(pRegion,iBegGrad,iEndGrad,grad)
465 
466  IMPLICIT NONE
467 
468 ! ******************************************************************************
469 ! Definitions and declarations
470 ! ******************************************************************************
471 
472 ! ==============================================================================
473 ! Arguments
474 ! ==============================================================================
475 
476  INTEGER, INTENT(IN) :: ibeggrad,iendgrad
477  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
478  TYPE(t_region), POINTER :: pregion
479 
480 ! ==============================================================================
481 ! Locals
482 ! ==============================================================================
483 
484  TYPE(t_global), POINTER :: global
485 
486 ! *****************************************************************************
487 ! Start
488 ! *****************************************************************************
489 
490  global => pregion%global
491 
492  CALL registerfunction(global,'RFLU_WENOGradCellsWrapper',&
493  'RFLU_ModWENO.F90' )
494 
495 ! ******************************************************************************
496 ! Call weighting routines
497 ! ******************************************************************************
498 
499  SELECT CASE ( pregion%mixtInput%stencilDimensCells )
500  CASE ( 1 ) ! NOTE calling xyz routine, anything else does not make sense
501  CALL rflu_wenogradcellsxyz_1d(pregion,ibeggrad,iendgrad,grad)
502  CASE ( 2 )
503  CALL rflu_wenogradcells_2d(pregion,ibeggrad,iendgrad,grad)
504  CASE ( 3 )
505  CALL rflu_wenogradcells_3d(pregion,ibeggrad,iendgrad,grad)
506  CASE default
507  CALL errorstop(global,err_reached_default,__line__)
508  END SELECT ! pMixtInput%stencilDimensCells
509 
510 ! ******************************************************************************
511 ! End
512 ! ******************************************************************************
513 
514  CALL deregisterfunction(global)
515 
516  END SUBROUTINE rflu_wenogradcellswrapper
517 
518 
519 
520 
521 
522 
523 ! ******************************************************************************
524 !
525 ! Purpose: Compute 1d WENO gradients of any vector or scalar at cell centers
526 ! component-wise.
527 !
528 ! Description: None.
529 !
530 ! Input:
531 ! pRegion Pointer to region data
532 ! iBegGrad Beginning index of data in grad
533 ! iEndGrad Ending index of data in grad
534 !
535 ! Output:
536 ! grad Gradients of variables at cell centers
537 !
538 ! Notes: None.
539 !
540 ! ******************************************************************************
541 
542  SUBROUTINE rflu_wenogradcellsxyz_1d(pRegion,iBegGrad,iEndGrad,grad)
543 
544  IMPLICIT NONE
545 
546 ! ******************************************************************************
547 ! Definitions and declarations
548 ! ******************************************************************************
549 
550 ! ==============================================================================
551 ! Arguments
552 ! ==============================================================================
553 
554  INTEGER :: ibeggrad,iendgrad
555  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
556  TYPE(t_region), POINTER :: pregion
557 
558 ! ==============================================================================
559 ! Locals
560 ! ==============================================================================
561 
562  INTEGER :: errorflag,icg,icg2,idir,idirend,igrad,isl
563  REAL(RFREAL) :: smooindsum,term
564  REAL(RFREAL), DIMENSION(XCOORD:ZCOORD) :: gradlocal
565  REAL(RFREAL), DIMENSION(:), ALLOCATABLE :: smooind
566  REAL(RFREAL), DIMENSION(:,:,:), ALLOCATABLE :: gradeno
567  TYPE(t_global), POINTER :: global
568  TYPE(t_grid), POINTER :: pgrid
569 
570 ! ******************************************************************************
571 ! Start
572 ! ******************************************************************************
573 
574  global => pregion%global
575 
576  CALL registerfunction(global,'RFLU_WENOGradCellsXYZ_1D',&
577  'RFLU_ModWENO.F90' )
578 
579 #ifdef ROCPROF
580  CALL fprofiler_begins("RFLU::WENOGradCellsXYZ_1D")
581 #endif
582 
583 ! ******************************************************************************
584 ! Set pointers and variables
585 ! ******************************************************************************
586 
587  pgrid => pregion%grid
588 
589  SELECT CASE ( pregion%mixtInput%dimens )
590  CASE ( 1 )
591  idirend = xcoord
592  CASE ( 2 )
593  idirend = ycoord
594  CASE ( 3 )
595  idirend = zcoord
596  CASE default
597  CALL errorstop(global,err_reached_default,__line__)
598  END SELECT ! pRegion%mixtInput%dimens
599 
600 ! ******************************************************************************
601 ! Compute ENO gradients
602 ! ******************************************************************************
603 
604 ! ==============================================================================
605 ! Allocate memory
606 ! ==============================================================================
607 
608  ALLOCATE(gradeno(xcoord:idirend,ibeggrad:iendgrad,pgrid%nCellsTot), &
609  stat=errorflag)
610  global%error = errorflag
611  IF ( global%error /= err_none ) THEN
612  CALL errorstop(global,err_allocate,__line__,'gradENO')
613  END IF ! global%error
614 
615  ALLOCATE(smooind(0:pgrid%c2csInfo%nCellMembsMax),stat=errorflag)
616  global%error = errorflag
617  IF ( global%error /= err_none ) THEN
618  CALL errorstop(global,err_allocate,__line__,'smooInd')
619  END IF ! global%error
620 
621 ! ==============================================================================
622 ! Loop over cells
623 ! ==============================================================================
624 
625  DO icg = 1,pgrid%nCellsTot
626 
627 ! ------------------------------------------------------------------------------
628 ! Compute weighted gradient based on smoothness indicator
629 ! ------------------------------------------------------------------------------
630 
631  DO igrad = ibeggrad,iendgrad
632 
633 ! ----- Loop over directions ---------------------------------------------------
634 
635  DO idir = xcoord,idirend
636 
637 ! ------- Compute smoothness indicator
638 
639  term = grad(idir,igrad,icg)
640 
641  smooind(0) = 1.0_rfreal/(term*term + 1.0e-15_rfreal)
642  smooindsum = smooind(0)
643 
644  DO isl = 1,pgrid%c2cs1D(idir,icg)%nCellMembs
645  icg2 = pgrid%c2cs1D(idir,icg)%cellMembs(isl)
646 
647  term = grad(idir,igrad,icg2)
648 
649  smooind(isl) = 1.0_rfreal/(term*term + 1.0e-15_rfreal)
650  smooindsum = smooindsum + smooind(isl)
651  END DO ! isl
652 
653 ! ------- Compute weighted gradient
654 
655  term = smooind(0)/smooindsum
656 
657  gradlocal(idir) = term*grad(idir,igrad,icg)
658 
659  DO isl = 1,pgrid%c2cs1D(idir,icg)%nCellMembs
660  icg2 = pgrid%c2cs1D(idir,icg)%cellMembs(isl)
661 
662  term = smooind(isl)/smooindsum
663 
664  gradlocal(idir) = gradlocal(idir) + term*grad(idir,igrad,icg2)
665  END DO ! isl
666 
667  gradeno(idir,igrad,icg) = gradlocal(idir)
668  END DO ! iDir
669  END DO ! iGrad
670  END DO ! icg
671 
672 ! ==============================================================================
673 ! Reassign gradients
674 ! ==============================================================================
675 
676  SELECT CASE ( pregion%mixtInput%dimens )
677  CASE ( 1 )
678  DO icg = 1,pgrid%nCellsTot
679  DO igrad = ibeggrad,iendgrad
680  grad(xcoord,igrad,icg) = gradeno(xcoord,igrad,icg)
681  grad(ycoord,igrad,icg) = 0.0_rfreal
682  grad(zcoord,igrad,icg) = 0.0_rfreal
683  END DO ! iGrad
684  END DO ! icg
685  CASE ( 2 )
686  DO icg = 1,pgrid%nCellsTot
687  DO igrad = ibeggrad,iendgrad
688  grad(xcoord,igrad,icg) = gradeno(xcoord,igrad,icg)
689  grad(ycoord,igrad,icg) = gradeno(ycoord,igrad,icg)
690  grad(zcoord,igrad,icg) = 0.0_rfreal
691  END DO ! iGrad
692  END DO ! icg
693  CASE ( 3 )
694  DO icg = 1,pgrid%nCellsTot
695  DO igrad = ibeggrad,iendgrad
696  grad(xcoord,igrad,icg) = gradeno(xcoord,igrad,icg)
697  grad(ycoord,igrad,icg) = gradeno(ycoord,igrad,icg)
698  grad(zcoord,igrad,icg) = gradeno(zcoord,igrad,icg)
699  END DO ! iGrad
700  END DO ! icg
701  CASE default
702  CALL errorstop(global,err_reached_default,__line__)
703  END SELECT ! pRegion%mixtInput%dimens
704 
705 ! ==============================================================================
706 ! Deallocate memory
707 ! ==============================================================================
708 
709  DEALLOCATE(smooind,stat=errorflag)
710  global%error = errorflag
711  IF ( global%error /= err_none ) THEN
712  CALL errorstop(global,err_deallocate,__line__,'smooInd')
713  END IF ! global%error
714 
715  DEALLOCATE(gradeno,stat=errorflag)
716  global%error = errorflag
717  IF ( global%error /= err_none ) THEN
718  CALL errorstop(global,err_deallocate,__line__,'gradENO')
719  END IF ! global%error
720 
721 ! ******************************************************************************
722 ! End
723 ! ******************************************************************************
724 
725 #ifdef ROCPROF
726  CALL fprofiler_ends("RFLU::WENOGradCellsXYZ_1D")
727 #endif
728 
729  CALL deregisterfunction(global)
730 
731  END SUBROUTINE rflu_wenogradcellsxyz_1d
732 
733 
734 
735 
736 
737 
738 ! ******************************************************************************
739 !
740 ! Purpose: Compute 2d WENO gradients of any vector or scalar at cell centers
741 ! component-wise.
742 !
743 ! Description: None.
744 !
745 ! Input:
746 ! pRegion Pointer to region data
747 ! iBegGrad Beginning index of data in grad
748 ! iEndGrad Ending index of data in grad
749 !
750 ! Output:
751 ! grad Gradients of variables at cell centers
752 !
753 ! Notes: None.
754 !
755 ! ******************************************************************************
756 
757  SUBROUTINE rflu_wenogradcellsxyz_2d(pRegion,iBegGrad,iEndGrad,grad)
758 
759  IMPLICIT NONE
760 
761 ! ******************************************************************************
762 ! Definitions and declarations
763 ! ******************************************************************************
764 
765 ! ==============================================================================
766 ! Arguments
767 ! ==============================================================================
768 
769  INTEGER :: ibeggrad,iendgrad
770  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
771  TYPE(t_region), POINTER :: pregion
772 
773 ! ==============================================================================
774 ! Locals
775 ! ==============================================================================
776 
777  INTEGER :: errorflag,icg,icg2,igrad,isl
778  REAL(RFREAL) :: termx,termy
779  REAL(RFREAL), DIMENSION(XCOORD:YCOORD) :: gradlocal,smooindsum
780  REAL(RFREAL), DIMENSION(:,:), ALLOCATABLE :: smooind
781  REAL(RFREAL), DIMENSION(:,:,:), ALLOCATABLE :: gradeno
782  TYPE(t_global), POINTER :: global
783  TYPE(t_grid), POINTER :: pgrid
784 
785 ! ******************************************************************************
786 ! Start
787 ! ******************************************************************************
788 
789  global => pregion%global
790 
791  CALL registerfunction(global,'RFLU_WENOGradCellsXYZ_2D',&
792  'RFLU_ModWENO.F90' )
793 
794 #ifdef ROCPROF
795  CALL fprofiler_begins("RFLU::WENOGradCellsXYZ_2D")
796 #endif
797 
798 ! ******************************************************************************
799 ! Set pointers and variables
800 ! ******************************************************************************
801 
802  pgrid => pregion%grid
803 
804 ! ******************************************************************************
805 ! Compute ENO gradients
806 ! ******************************************************************************
807 
808 ! ==============================================================================
809 ! Allocate memory
810 ! ==============================================================================
811 
812  ALLOCATE(gradeno(xcoord:ycoord,ibeggrad:iendgrad,pgrid%nCellsTot), &
813  stat=errorflag)
814  global%error = errorflag
815  IF ( global%error /= err_none ) THEN
816  CALL errorstop(global,err_allocate,__line__,'gradENO')
817  END IF ! global%error
818 
819  ALLOCATE(smooind(xcoord:ycoord,0:pgrid%c2csInfo%nCellMembsMax), &
820  stat=errorflag)
821  global%error = errorflag
822  IF ( global%error /= err_none ) THEN
823  CALL errorstop(global,err_allocate,__line__,'smooInd')
824  END IF ! global%error
825 
826 ! ==============================================================================
827 ! Loop over cells
828 ! ==============================================================================
829 
830  DO icg = 1,pgrid%nCellsTot
831 
832 ! ------------------------------------------------------------------------------
833 ! Compute weighted gradient based on smoothness indicator
834 ! ------------------------------------------------------------------------------
835 
836  DO igrad = ibeggrad,iendgrad
837 
838 ! ----- Compute smoothness indicator -------------------------------------------
839 
840  termx = grad(xcoord,igrad,icg)
841  termy = grad(ycoord,igrad,icg)
842 
843  smooind(xcoord,0) = 1.0_rfreal/(termx*termx + 1.0e-15_rfreal)
844  smooind(ycoord,0) = 1.0_rfreal/(termy*termy + 1.0e-15_rfreal)
845 
846  smooindsum(xcoord) = smooind(xcoord,0)
847  smooindsum(ycoord) = smooind(ycoord,0)
848 
849  DO isl = 1,pgrid%c2cs(icg)%nCellMembs
850  icg2 = pgrid%c2cs(icg)%cellMembs(isl)
851 
852  termx = grad(xcoord,igrad,icg2)
853  termy = grad(ycoord,igrad,icg2)
854 
855  smooind(xcoord,isl) = 1.0_rfreal/(termx*termx + 1.0e-15_rfreal)
856  smooind(ycoord,isl) = 1.0_rfreal/(termy*termy + 1.0e-15_rfreal)
857 
858  smooindsum(xcoord) = smooindsum(xcoord) + smooind(xcoord,isl)
859  smooindsum(ycoord) = smooindsum(ycoord) + smooind(ycoord,isl)
860  END DO ! isl
861 
862 ! ----- Compute weighted gradient ----------------------------------------------
863 
864  termx = smooind(xcoord,0)/smooindsum(xcoord)
865  termy = smooind(ycoord,0)/smooindsum(ycoord)
866 
867  gradlocal(xcoord) = termx*grad(xcoord,igrad,icg)
868  gradlocal(ycoord) = termy*grad(ycoord,igrad,icg)
869 
870  DO isl = 1,pgrid%c2cs(icg)%nCellMembs
871  icg2 = pgrid%c2cs(icg)%cellMembs(isl)
872 
873  termx = smooind(xcoord,isl)/smooindsum(xcoord)
874  termy = smooind(ycoord,isl)/smooindsum(ycoord)
875 
876  gradlocal(xcoord) = gradlocal(xcoord) + termx*grad(xcoord,igrad,icg2)
877  gradlocal(ycoord) = gradlocal(ycoord) + termy*grad(ycoord,igrad,icg2)
878  END DO ! isl
879 
880  gradeno(xcoord,igrad,icg) = gradlocal(xcoord)
881  gradeno(ycoord,igrad,icg) = gradlocal(ycoord)
882  END DO ! iGrad
883  END DO ! icg
884 
885 ! ==============================================================================
886 ! Reassign gradients
887 ! ==============================================================================
888 
889  DO icg = 1,pgrid%nCellsTot
890  DO igrad = ibeggrad,iendgrad
891  grad(xcoord,igrad,icg) = gradeno(xcoord,igrad,icg)
892  grad(ycoord,igrad,icg) = gradeno(ycoord,igrad,icg)
893  END DO ! iGrad
894  END DO ! icg
895 
896 ! DEBUG
897 ! DO iGrad = iBegGrad,iEndGrad
898 ! WRITE(*,*) iGrad,MINVAL(grad(XCOORD,iGrad,1:pGrid%nCellsTot)), &
899 ! MINVAL(grad(YCOORD,iGrad,1:pGrid%nCellsTot)), &
900 ! MAXVAL(grad(XCOORD,iGrad,1:pGrid%nCellsTot)), &
901 ! MAXVAL(grad(YCOORD,iGrad,1:pGrid%nCellsTot))
902 ! END DO ! iGrad
903 !
904 ! STOP
905 ! END DEBUG
906 
907 ! ==============================================================================
908 ! Deallocate memory
909 ! ==============================================================================
910 
911  DEALLOCATE(smooind,stat=errorflag)
912  global%error = errorflag
913  IF ( global%error /= err_none ) THEN
914  CALL errorstop(global,err_deallocate,__line__,'smooInd')
915  END IF ! global%error
916 
917  DEALLOCATE(gradeno,stat=errorflag)
918  global%error = errorflag
919  IF ( global%error /= err_none ) THEN
920  CALL errorstop(global,err_deallocate,__line__,'gradENO')
921  END IF ! global%error
922 
923 ! ******************************************************************************
924 ! End
925 ! ******************************************************************************
926 
927 #ifdef ROCPROF
928  CALL fprofiler_ends("RFLU::WENOGradCellsXYZ_2D")
929 #endif
930 
931  CALL deregisterfunction(global)
932 
933  END SUBROUTINE rflu_wenogradcellsxyz_2d
934 
935 
936 
937 
938 
939 
940 
941 
942 ! ******************************************************************************
943 !
944 ! Purpose: Compute 3d WENO gradients of any vector or scalar at cell centers
945 ! component-wise.
946 !
947 ! Description: None.
948 !
949 ! Input:
950 ! pRegion Pointer to region data
951 ! iBegGrad Beginning index of data in grad
952 ! iEndGrad Ending index of data in grad
953 !
954 ! Output:
955 ! grad Gradients of variables at cell centers
956 !
957 ! Notes: None.
958 !
959 ! ******************************************************************************
960 
961  SUBROUTINE rflu_wenogradcellsxyz_3d(pRegion,iBegGrad,iEndGrad,grad)
962 
963  IMPLICIT NONE
964 
965 ! ******************************************************************************
966 ! Definitions and declarations
967 ! ******************************************************************************
968 
969 ! ==============================================================================
970 ! Arguments
971 ! ==============================================================================
972 
973  INTEGER :: ibeggrad,iendgrad
974  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
975  TYPE(t_region), POINTER :: pregion
976 
977 ! ==============================================================================
978 ! Locals
979 ! ==============================================================================
980 
981  INTEGER :: errorflag,icg,icg2,igrad,isl
982  REAL(RFREAL) :: termx,termy,termz
983  REAL(RFREAL), DIMENSION(XCOORD:ZCOORD) :: gradlocal,smooindsum
984  REAL(RFREAL), DIMENSION(:,:), ALLOCATABLE :: smooind
985  REAL(RFREAL), DIMENSION(:,:,:), ALLOCATABLE :: gradeno
986  TYPE(t_global), POINTER :: global
987  TYPE(t_grid), POINTER :: pgrid
988 
989 ! ******************************************************************************
990 ! Start
991 ! ******************************************************************************
992 
993  global => pregion%global
994 
995  CALL registerfunction(global,'RFLU_WENOGradCellsXYZ_3D',&
996  'RFLU_ModWENO.F90' )
997 
998 #ifdef ROCPROF
999  CALL fprofiler_begins("RFLU::WENOGradCellsXYZ_3D")
1000 #endif
1001 
1002 ! ******************************************************************************
1003 ! Set pointers and variables
1004 ! ******************************************************************************
1005 
1006  pgrid => pregion%grid
1007 
1008 ! ******************************************************************************
1009 ! Compute ENO gradients
1010 ! ******************************************************************************
1011 
1012 ! ==============================================================================
1013 ! Allocate memory
1014 ! ==============================================================================
1015 
1016  ALLOCATE(gradeno(xcoord:zcoord,ibeggrad:iendgrad,pgrid%nCellsTot), &
1017  stat=errorflag)
1018  global%error = errorflag
1019  IF ( global%error /= err_none ) THEN
1020  CALL errorstop(global,err_allocate,__line__,'gradENO')
1021  END IF ! global%error
1022 
1023  ALLOCATE(smooind(xcoord:zcoord,0:pgrid%c2csInfo%nCellMembsMax), &
1024  stat=errorflag)
1025  global%error = errorflag
1026  IF ( global%error /= err_none ) THEN
1027  CALL errorstop(global,err_allocate,__line__,'smooInd')
1028  END IF ! global%error
1029 
1030 ! ==============================================================================
1031 ! Loop over cells
1032 ! ==============================================================================
1033 
1034  DO icg = 1,pgrid%nCellsTot
1035 
1036 ! ------------------------------------------------------------------------------
1037 ! Compute weighted gradient based on smoothness indicator
1038 ! ------------------------------------------------------------------------------
1039 
1040  DO igrad = ibeggrad,iendgrad
1041 
1042 ! ----- Compute smoothness indicator -------------------------------------------
1043 
1044  termx = grad(xcoord,igrad,icg)
1045  termy = grad(ycoord,igrad,icg)
1046  termz = grad(zcoord,igrad,icg)
1047 
1048  smooind(xcoord,0) = 1.0_rfreal/(termx*termx + 1.0e-15_rfreal)
1049  smooind(ycoord,0) = 1.0_rfreal/(termy*termy + 1.0e-15_rfreal)
1050  smooind(zcoord,0) = 1.0_rfreal/(termz*termz + 1.0e-15_rfreal)
1051 
1052  smooindsum(xcoord) = smooind(xcoord,0)
1053  smooindsum(ycoord) = smooind(ycoord,0)
1054  smooindsum(zcoord) = smooind(zcoord,0)
1055 
1056  DO isl = 1,pgrid%c2cs(icg)%nCellMembs
1057  icg2 = pgrid%c2cs(icg)%cellMembs(isl)
1058 
1059  termx = grad(xcoord,igrad,icg2)
1060  termy = grad(ycoord,igrad,icg2)
1061  termz = grad(zcoord,igrad,icg2)
1062 
1063  smooind(xcoord,isl) = 1.0_rfreal/(termx*termx + 1.0e-15_rfreal)
1064  smooind(ycoord,isl) = 1.0_rfreal/(termy*termy + 1.0e-15_rfreal)
1065  smooind(zcoord,isl) = 1.0_rfreal/(termz*termz + 1.0e-15_rfreal)
1066 
1067  smooindsum(xcoord) = smooindsum(xcoord) + smooind(xcoord,isl)
1068  smooindsum(ycoord) = smooindsum(ycoord) + smooind(ycoord,isl)
1069  smooindsum(zcoord) = smooindsum(zcoord) + smooind(zcoord,isl)
1070  END DO ! isl
1071 
1072 ! ----- Compute weighted gradient ----------------------------------------------
1073 
1074  termx = smooind(xcoord,0)/smooindsum(xcoord)
1075  termy = smooind(ycoord,0)/smooindsum(ycoord)
1076  termz = smooind(zcoord,0)/smooindsum(zcoord)
1077 
1078  gradlocal(xcoord) = termx*grad(xcoord,igrad,icg)
1079  gradlocal(ycoord) = termy*grad(ycoord,igrad,icg)
1080  gradlocal(zcoord) = termz*grad(zcoord,igrad,icg)
1081 
1082  DO isl = 1,pgrid%c2cs(icg)%nCellMembs
1083  icg2 = pgrid%c2cs(icg)%cellMembs(isl)
1084 
1085  termx = smooind(xcoord,isl)/smooindsum(xcoord)
1086  termy = smooind(ycoord,isl)/smooindsum(ycoord)
1087  termz = smooind(zcoord,isl)/smooindsum(zcoord)
1088 
1089  gradlocal(xcoord) = gradlocal(xcoord) + termx*grad(xcoord,igrad,icg2)
1090  gradlocal(ycoord) = gradlocal(ycoord) + termy*grad(ycoord,igrad,icg2)
1091  gradlocal(zcoord) = gradlocal(zcoord) + termz*grad(zcoord,igrad,icg2)
1092  END DO ! isl
1093 
1094  gradeno(xcoord,igrad,icg) = gradlocal(xcoord)
1095  gradeno(ycoord,igrad,icg) = gradlocal(ycoord)
1096  gradeno(zcoord,igrad,icg) = gradlocal(zcoord)
1097  END DO ! iGrad
1098  END DO ! icg
1099 
1100 ! ==============================================================================
1101 ! Reassign gradients
1102 ! ==============================================================================
1103 
1104  DO icg = 1,pgrid%nCellsTot
1105  DO igrad = ibeggrad,iendgrad
1106  grad(xcoord,igrad,icg) = gradeno(xcoord,igrad,icg)
1107  grad(ycoord,igrad,icg) = gradeno(ycoord,igrad,icg)
1108  grad(zcoord,igrad,icg) = gradeno(zcoord,igrad,icg)
1109  END DO ! iGrad
1110  END DO ! icg
1111 
1112 ! DEBUG
1113 ! DO iGrad = iBegGrad,iEndGrad
1114 ! WRITE(*,*) iGrad,MINVAL(grad(XCOORD,iGrad,1:pGrid%nCellsTot)), &
1115 ! MINVAL(grad(YCOORD,iGrad,1:pGrid%nCellsTot)), &
1116 ! MINVAL(grad(ZCOORD,iGrad,1:pGrid%nCellsTot)), &
1117 ! MAXVAL(grad(XCOORD,iGrad,1:pGrid%nCellsTot)), &
1118 ! MAXVAL(grad(YCOORD,iGrad,1:pGrid%nCellsTot)), &
1119 ! MAXVAL(grad(ZCOORD,iGrad,1:pGrid%nCellsTot))
1120 ! END DO ! iGrad
1121 !
1122 ! STOP
1123 ! END DEBUG
1124 
1125 ! ==============================================================================
1126 ! Deallocate memory
1127 ! ==============================================================================
1128 
1129  DEALLOCATE(smooind,stat=errorflag)
1130  global%error = errorflag
1131  IF ( global%error /= err_none ) THEN
1132  CALL errorstop(global,err_deallocate,__line__,'smooInd')
1133  END IF ! global%error
1134 
1135  DEALLOCATE(gradeno,stat=errorflag)
1136  global%error = errorflag
1137  IF ( global%error /= err_none ) THEN
1138  CALL errorstop(global,err_deallocate,__line__,'gradENO')
1139  END IF ! global%error
1140 
1141 ! ******************************************************************************
1142 ! End
1143 ! ******************************************************************************
1144 
1145 #ifdef ROCPROF
1146  CALL fprofiler_ends("RFLU::WENOGradCellsXYZ_3D")
1147 #endif
1148 
1149  CALL deregisterfunction(global)
1150 
1151  END SUBROUTINE rflu_wenogradcellsxyz_3d
1152 
1153 
1154 
1155 
1156 
1157 
1158 
1159 
1160 ! ******************************************************************************
1161 !
1162 ! Purpose: Compute 2d ENO gradients of any vector or scalar at cell centers
1163 ! component wise.
1164 !
1165 ! Description: None.
1166 !
1167 ! Input:
1168 ! pRegion Pointer to region data
1169 ! iBegGrad Beginning index of data in grad
1170 ! iEndGrad Ending index of data in grad
1171 !
1172 ! Output:
1173 ! grad Gradients of variables at cell centers
1174 !
1175 ! Notes:
1176 ! 1. Optimized by Adam Moody and Charles Shereda, LLNL.
1177 !
1178 ! ******************************************************************************
1179 
1180  SUBROUTINE rflu_wenogradcellsxyzfast_2d(pRegion,iBegGrad,iEndGrad,grad)
1181 
1182  IMPLICIT NONE
1183 
1184 ! ******************************************************************************
1185 ! Definitions and declarations
1186 ! ******************************************************************************
1187 
1188 ! ==============================================================================
1189 ! Arguments
1190 ! ==============================================================================
1191 
1192  INTEGER :: ibeggrad,iendgrad
1193  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
1194  TYPE(t_region), POINTER :: pregion
1195 
1196 ! ==============================================================================
1197 ! Locals
1198 ! ==============================================================================
1199 
1200  INTEGER :: errorflag,icg,icg2,igrad,isl,ncellmembs
1201  INTEGER, DIMENSION(:), ALLOCATABLE :: icg_ary
1202  REAL(RFREAL) :: gradlocalx,gradlocaly,nextx,nextx2,nexty,nexty2, &
1203  smooindsumx,smooindx,smooindsumy,smooindy,termx,termy
1204  REAL(RFREAL), DIMENSION(XCOORD:YCOORD) :: gradlocal,smooindsum
1205  REAL(RFREAL), DIMENSION(:,:), ALLOCATABLE :: smooind
1206  REAL(RFREAL), DIMENSION(:,:,:), ALLOCATABLE :: gradeno
1207  TYPE(t_global), POINTER :: global
1208  TYPE(t_grid), POINTER :: pgrid
1209 
1210 ! ******************************************************************************
1211 ! Start
1212 ! ******************************************************************************
1213 
1214  global => pregion%global
1215 
1216  CALL registerfunction(global,'RFLU_WENOGradCellsXYZFast_2D',&
1217  'RFLU_ModWENO.F90' )
1218 
1219 #ifdef ROCPROF
1220  CALL fprofiler_begins("RFLU::WENOGradCellsXYZFast_2D")
1221 #endif
1222 
1223 ! ******************************************************************************
1224 ! Set pointers and variables
1225 ! ******************************************************************************
1226 
1227  pgrid => pregion%grid
1228 
1229 ! ******************************************************************************
1230 ! Compute ENO gradients
1231 ! ******************************************************************************
1232 
1233 ! ==============================================================================
1234 ! Allocate memory
1235 ! ==============================================================================
1236 
1237  ALLOCATE(gradeno(xcoord:ycoord,ibeggrad:iendgrad,pgrid%nCellsTot), &
1238  stat=errorflag)
1239  global%error = errorflag
1240  IF ( global%error /= err_none ) THEN
1241  CALL errorstop(global,err_allocate,__line__,'gradENO')
1242  END IF ! global%error
1243 
1244  ALLOCATE(icg_ary(0:pgrid%c2csInfo%nCellMembsMax+2),stat=errorflag )
1245  global%error = errorflag
1246  IF ( global%error /= err_none ) THEN
1247  CALL errorstop(global,err_allocate,__line__,'icg_ary')
1248  END IF ! global%error
1249 
1250 ! ==============================================================================
1251 ! Loop over cells
1252 ! ==============================================================================
1253 
1254  DO icg = 1,pgrid%nCellsTot
1255  ncellmembs = pgrid%c2cs(icg)%nCellMembs
1256 
1257  DO isl = 1,ncellmembs
1258  icg_ary(isl) = pgrid%c2cs(icg)%cellMembs(isl)
1259  END DO ! isl
1260 
1261  icg_ary(ncellmembs+1) = icg
1262  icg_ary(ncellmembs+2) = icg
1263 
1264  DO igrad = ibeggrad,iendgrad
1265  termx = grad(xcoord,igrad,icg)
1266  termy = grad(ycoord,igrad,icg)
1267 
1268  nextx = grad(xcoord,igrad,icg_ary(1))
1269  nexty = grad(ycoord,igrad,icg_ary(1))
1270 
1271  nextx2 = grad(xcoord,igrad,icg_ary(2))
1272  nexty2 = grad(ycoord,igrad,icg_ary(2))
1273 
1274  smooindsumx = 1.0_rfreal/(termx*termx + 1.0e-15_rfreal)
1275  smooindsumy = 1.0_rfreal/(termy*termy + 1.0e-15_rfreal)
1276 
1277  gradlocalx = smooindsumx*termx
1278  gradlocaly = smooindsumy*termy
1279 
1280  DO isl = 1,ncellmembs
1281  icg2 = icg_ary(isl+2)
1282 
1283  termx = nextx
1284  termy = nexty
1285 
1286  nextx = nextx2
1287  nexty = nexty2
1288 
1289  nextx2 = grad(xcoord,igrad,icg2)
1290  nexty2 = grad(ycoord,igrad,icg2)
1291 
1292  smooindx = 1.0_rfreal/(termx*termx + 1.0e-15_rfreal)
1293  smooindy = 1.0_rfreal/(termy*termy + 1.0e-15_rfreal)
1294 
1295  smooindsumx = smooindsumx + smooindx
1296  smooindsumy = smooindsumy + smooindy
1297 
1298  gradlocalx = gradlocalx + smooindx*termx
1299  gradlocaly = gradlocaly + smooindy*termy
1300  END DO ! isl
1301 
1302  gradeno(xcoord,igrad,icg) = gradlocalx/smooindsumx
1303  gradeno(ycoord,igrad,icg) = gradlocaly/smooindsumy
1304  END DO ! iGrad
1305  END DO ! icg
1306 
1307  DO icg = 1,pgrid%nCellsTot
1308  DO igrad = ibeggrad,iendgrad
1309  grad(xcoord,igrad,icg) = gradeno(xcoord,igrad,icg)
1310  grad(ycoord,igrad,icg) = gradeno(ycoord,igrad,icg)
1311  END DO ! iGrad
1312  END DO ! icg
1313 
1314 ! DEBUG
1315 ! DO iGrad = iBegGrad,iEndGrad
1316 ! WRITE(*,*) iGrad,MINVAL(grad(XCOORD,iGrad,1:pGrid%nCellsTot)), &
1317 ! MINVAL(grad(YCOORD,iGrad,1:pGrid%nCellsTot)), &
1318 ! MAXVAL(grad(XCOORD,iGrad,1:pGrid%nCellsTot)), &
1319 ! MAXVAL(grad(YCOORD,iGrad,1:pGrid%nCellsTot))
1320 ! END DO ! iGrad
1321 !
1322 ! STOP
1323 ! END DEBUG
1324 
1325 ! ==============================================================================
1326 ! Deallocate memory
1327 ! ==============================================================================
1328 
1329  DEALLOCATE(icg_ary,stat=errorflag)
1330  global%error = errorflag
1331  IF ( global%error /= err_none ) THEN
1332  CALL errorstop(global,err_deallocate,__line__,'smooInd')
1333  END IF ! global%error
1334 
1335  DEALLOCATE(gradeno,stat=errorflag)
1336  global%error = errorflag
1337  IF ( global%error /= err_none ) THEN
1338  CALL errorstop(global,err_deallocate,__line__,'gradENO')
1339  END IF ! global%error
1340 
1341 ! ******************************************************************************
1342 ! End
1343 ! ******************************************************************************
1344 
1345 #ifdef ROCPROF
1346  CALL fprofiler_ends("RFLU::WENOGradCellsXYZFast_2D")
1347 #endif
1348 
1349  CALL deregisterfunction(global)
1350 
1351  END SUBROUTINE rflu_wenogradcellsxyzfast_2d
1352 
1353 
1354 
1355 
1356 
1357 
1358 
1359 ! ******************************************************************************
1360 !
1361 ! Purpose: Compute 3d ENO gradients of any vector or scalar at cell centers
1362 ! component wise.
1363 !
1364 ! Description: None.
1365 !
1366 ! Input:
1367 ! pRegion Pointer to region data
1368 ! iBegGrad Beginning index of data in grad
1369 ! iEndGrad Ending index of data in grad
1370 !
1371 ! Output:
1372 ! grad Gradients of variables at cell centers
1373 !
1374 ! Notes:
1375 ! 1. Optimized by Adam Moody and Charles Shereda, LLNL.
1376 !
1377 ! ******************************************************************************
1378 
1379  SUBROUTINE rflu_wenogradcellsxyzfast_3d(pRegion,iBegGrad,iEndGrad,grad)
1380 
1381  IMPLICIT NONE
1382 
1383 ! ******************************************************************************
1384 ! Definitions and declarations
1385 ! ******************************************************************************
1386 
1387 ! ==============================================================================
1388 ! Arguments
1389 ! ==============================================================================
1390 
1391  INTEGER :: ibeggrad,iendgrad
1392  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
1393  TYPE(t_region), POINTER :: pregion
1394 
1395 ! ==============================================================================
1396 ! Locals
1397 ! ==============================================================================
1398 
1399  INTEGER :: errorflag,icg,icg2,igrad,isl,ncellmembs
1400  INTEGER, DIMENSION(:), ALLOCATABLE :: icg_ary
1401  REAL(RFREAL) :: gradlocalx,gradlocaly,gradlocalz,nextx,nextx2,nexty, &
1402  nexty2,nextz,nextz2,smooindsumx,smooindx,smooindsumy, &
1403  smooindy,smooindsumz,smooindz,termx,termy,termz
1404  REAL(RFREAL), DIMENSION(XCOORD:ZCOORD) :: gradlocal,smooindsum
1405  REAL(RFREAL), DIMENSION(:,:), ALLOCATABLE :: smooind
1406  REAL(RFREAL), DIMENSION(:,:,:), ALLOCATABLE :: gradeno
1407  TYPE(t_global), POINTER :: global
1408  TYPE(t_grid), POINTER :: pgrid
1409 
1410 ! ******************************************************************************
1411 ! Start
1412 ! ******************************************************************************
1413 
1414  global => pregion%global
1415 
1416  CALL registerfunction(global,'RFLU_WENOGradCellsXYZFast_3D',&
1417  'RFLU_ModWENO.F90' )
1418 
1419 #ifdef ROCPROF
1420  CALL fprofiler_begins("RFLU::WENOGradCellsXYZFast_3D")
1421 #endif
1422 
1423 ! ******************************************************************************
1424 ! Set pointers and variables
1425 ! ******************************************************************************
1426 
1427  pgrid => pregion%grid
1428 
1429 ! ******************************************************************************
1430 ! Compute ENO gradients
1431 ! ******************************************************************************
1432 
1433 ! ==============================================================================
1434 ! Allocate memory
1435 ! ==============================================================================
1436 
1437  ALLOCATE(gradeno(xcoord:zcoord,ibeggrad:iendgrad,pgrid%nCellsTot), &
1438  stat=errorflag)
1439  global%error = errorflag
1440  IF ( global%error /= err_none ) THEN
1441  CALL errorstop(global,err_allocate,__line__,'gradENO')
1442  END IF ! global%error
1443 
1444  ALLOCATE(icg_ary(0:pgrid%c2csInfo%nCellMembsMax+2),stat=errorflag )
1445  global%error = errorflag
1446  IF ( global%error /= err_none ) THEN
1447  CALL errorstop(global,err_allocate,__line__,'icg_ary')
1448  END IF ! global%error
1449 
1450 ! ==============================================================================
1451 ! Loop over cells
1452 ! ==============================================================================
1453 
1454  DO icg = 1,pgrid%nCellsTot
1455  ncellmembs = pgrid%c2cs(icg)%nCellMembs
1456 
1457  DO isl = 1,ncellmembs
1458  icg_ary(isl) = pgrid%c2cs(icg)%cellMembs(isl)
1459  END DO ! isl
1460 
1461  icg_ary(ncellmembs+1) = icg
1462  icg_ary(ncellmembs+2) = icg
1463 
1464  DO igrad = ibeggrad,iendgrad
1465  termx = grad(xcoord,igrad,icg)
1466  termy = grad(ycoord,igrad,icg)
1467  termz = grad(zcoord,igrad,icg)
1468 
1469  nextx = grad(xcoord,igrad,icg_ary(1))
1470  nexty = grad(ycoord,igrad,icg_ary(1))
1471  nextz = grad(zcoord,igrad,icg_ary(1))
1472 
1473  nextx2 = grad(xcoord,igrad,icg_ary(2))
1474  nexty2 = grad(ycoord,igrad,icg_ary(2))
1475  nextz2 = grad(zcoord,igrad,icg_ary(2))
1476 
1477  smooindsumx = 1.0_rfreal/(termx*termx + 1.0e-15_rfreal)
1478  smooindsumy = 1.0_rfreal/(termy*termy + 1.0e-15_rfreal)
1479  smooindsumz = 1.0_rfreal/(termz*termz + 1.0e-15_rfreal)
1480 
1481  gradlocalx = smooindsumx*termx
1482  gradlocaly = smooindsumy*termy
1483  gradlocalz = smooindsumz*termz
1484 
1485  DO isl = 1,ncellmembs
1486  icg2 = icg_ary(isl+2)
1487 
1488  termx = nextx
1489  termy = nexty
1490  termz = nextz
1491 
1492  nextx = nextx2
1493  nexty = nexty2
1494  nextz = nextz2
1495 
1496  nextx2 = grad(xcoord,igrad,icg2)
1497  nexty2 = grad(ycoord,igrad,icg2)
1498  nextz2 = grad(zcoord,igrad,icg2)
1499 
1500  smooindx = 1.0_rfreal/(termx*termx + 1.0e-15_rfreal)
1501  smooindy = 1.0_rfreal/(termy*termy + 1.0e-15_rfreal)
1502  smooindz = 1.0_rfreal/(termz*termz + 1.0e-15_rfreal)
1503 
1504  smooindsumx = smooindsumx + smooindx
1505  smooindsumy = smooindsumy + smooindy
1506  smooindsumz = smooindsumz + smooindz
1507 
1508  gradlocalx = gradlocalx + smooindx*termx
1509  gradlocaly = gradlocaly + smooindy*termy
1510  gradlocalz = gradlocalz + smooindz*termz
1511  END DO ! isl
1512 
1513  gradeno(xcoord,igrad,icg) = gradlocalx/smooindsumx
1514  gradeno(ycoord,igrad,icg) = gradlocaly/smooindsumy
1515  gradeno(zcoord,igrad,icg) = gradlocalz/smooindsumz
1516  END DO ! iGrad
1517  END DO ! icg
1518 
1519  DO icg = 1,pgrid%nCellsTot
1520  DO igrad = ibeggrad,iendgrad
1521  grad(xcoord,igrad,icg) = gradeno(xcoord,igrad,icg)
1522  grad(ycoord,igrad,icg) = gradeno(ycoord,igrad,icg)
1523  grad(zcoord,igrad,icg) = gradeno(zcoord,igrad,icg)
1524  END DO ! iGrad
1525  END DO ! icg
1526 
1527 ! DEBUG
1528 ! DO iGrad = iBegGrad,iEndGrad
1529 ! WRITE(*,*) iGrad,MINVAL(grad(XCOORD,iGrad,1:pGrid%nCellsTot)), &
1530 ! MINVAL(grad(YCOORD,iGrad,1:pGrid%nCellsTot)), &
1531 ! MINVAL(grad(ZCOORD,iGrad,1:pGrid%nCellsTot)), &
1532 ! MAXVAL(grad(XCOORD,iGrad,1:pGrid%nCellsTot)), &
1533 ! MAXVAL(grad(YCOORD,iGrad,1:pGrid%nCellsTot)), &
1534 ! MAXVAL(grad(ZCOORD,iGrad,1:pGrid%nCellsTot))
1535 ! END DO ! iGrad
1536 !
1537 ! STOP
1538 ! END DEBUG
1539 
1540 ! ==============================================================================
1541 ! Deallocate memory
1542 ! ==============================================================================
1543 
1544  DEALLOCATE(icg_ary,stat=errorflag)
1545  global%error = errorflag
1546  IF ( global%error /= err_none ) THEN
1547  CALL errorstop(global,err_deallocate,__line__,'smooInd')
1548  END IF ! global%error
1549 
1550  DEALLOCATE(gradeno,stat=errorflag)
1551  global%error = errorflag
1552  IF ( global%error /= err_none ) THEN
1553  CALL errorstop(global,err_deallocate,__line__,'gradENO')
1554  END IF ! global%error
1555 
1556 ! ******************************************************************************
1557 ! End
1558 ! ******************************************************************************
1559 
1560 #ifdef ROCPROF
1561  CALL fprofiler_ends("RFLU::WENOGradCellsXYZFast_3D")
1562 #endif
1563 
1564  CALL deregisterfunction(global)
1565 
1566  END SUBROUTINE rflu_wenogradcellsxyzfast_3d
1567 
1568 
1569 
1570 
1571 
1572 
1573 ! ******************************************************************************
1574 !
1575 ! Purpose: Compute WENO-gradients of any vector or scalar at cell centers
1576 ! component-wise.
1577 !
1578 ! Description: None.
1579 !
1580 ! Input:
1581 ! pRegion Pointer to region data
1582 ! iBegGrad Beginning index of data in grad
1583 ! iEndGrad Ending index of data in grad
1584 ! grad Gradients of variables at cell centers
1585 !
1586 ! Output:
1587 ! grad Weighted gradients of variables at cell centers
1588 !
1589 ! Notes: None.
1590 !
1591 ! ******************************************************************************
1592 
1593  SUBROUTINE rflu_wenogradcellsxyzwrapper(pRegion,iBegGrad,iEndGrad,grad)
1594 
1595  IMPLICIT NONE
1596 
1597 ! ******************************************************************************
1598 ! Definitions and declarations
1599 ! ******************************************************************************
1600 
1601 ! ==============================================================================
1602 ! Arguments
1603 ! ==============================================================================
1604 
1605  INTEGER, INTENT(IN) :: ibeggrad,iendgrad
1606  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
1607  TYPE(t_region), POINTER :: pregion
1608 
1609 ! ==============================================================================
1610 ! Locals
1611 ! ==============================================================================
1612 
1613  TYPE(t_global), POINTER :: global
1614 
1615 ! *****************************************************************************
1616 ! Start
1617 ! *****************************************************************************
1618 
1619  global => pregion%global
1620 
1621  CALL registerfunction(global,'RFLU_WENOGradCellsXYZWrapper',&
1622  'RFLU_ModWENO.F90' )
1623 
1624 ! ******************************************************************************
1625 ! Call weighting routines
1626 ! ******************************************************************************
1627 
1628  SELECT CASE ( pregion%mixtInput%stencilDimensCells )
1629  CASE ( 1 )
1630  CALL rflu_wenogradcellsxyz_1d(pregion,ibeggrad,iendgrad,grad)
1631  CASE ( 2 )
1632 ! CALL RFLU_WENOGradCellsXYZ_2D(pRegion,iBegGrad,iEndGrad,grad)
1633  CALL rflu_wenogradcellsxyzfast_2d(pregion,ibeggrad,iendgrad,grad)
1634  CASE ( 3 )
1635 ! CALL RFLU_WENOGradCellsXYZ_3D(pRegion,iBegGrad,iEndGrad,grad)
1636  CALL rflu_wenogradcellsxyzfast_3d(pregion,ibeggrad,iendgrad,grad)
1637  CASE default
1638  CALL errorstop(global,err_reached_default,__line__)
1639  END SELECT ! pMixtInput%stencilDimensCells
1640 
1641 ! ******************************************************************************
1642 ! End
1643 ! ******************************************************************************
1644 
1645  CALL deregisterfunction(global)
1646 
1647  END SUBROUTINE rflu_wenogradcellsxyzwrapper
1648 
1649 
1650 
1651 
1652 
1653 ! ******************************************************************************
1654 ! End
1655 ! ******************************************************************************
1656 
1657 END MODULE rflu_modweno
1658 
1659 
1660 ! ******************************************************************************
1661 !
1662 ! RCS Revision history:
1663 !
1664 ! $Log: RFLU_ModWENO.F90,v $
1665 ! Revision 1.4 2008/12/06 08:44:25 mtcampbe
1666 ! Updated license.
1667 !
1668 ! Revision 1.3 2008/11/19 22:17:36 mtcampbe
1669 ! Added Illinois Open Source License/Copyright
1670 !
1671 ! Revision 1.2 2006/04/19 19:43:17 haselbac
1672 ! Added tuned routines
1673 !
1674 ! Revision 1.1 2006/04/07 14:36:19 haselbac
1675 ! Initial revision
1676 !
1677 ! ******************************************************************************
1678 
1679 
1680 
1681 
1682 
1683 
1684 
1685 
1686 
1687 
1688 
1689 
1690 
1691 
1692 
rflu_modweno::rflu_wenogradcellsxyzfast_3d
subroutine rflu_wenogradcellsxyzfast_3d(pRegion, iBegGrad, iEndGrad, grad)
Definition: RFLU_ModWENO.F90:1379
Kdtree_d::ExtPoint::term
void term()
Definition: kdtree_d.h:237
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
rflu_modweno::rflu_wenogradcellsxyz_1d
subroutine rflu_wenogradcellsxyz_1d(pRegion, iBegGrad, iEndGrad, grad)
Definition: RFLU_ModWENO.F90:542
modgrid::t_grid
Definition: ModGrid.F90:56
rflu_modweno
Definition: RFLU_ModWENO.F90:39
rflu_modweno::rflu_wenogradcells_3d
subroutine rflu_wenogradcells_3d(pRegion, iBegGrad, iEndGrad, grad)
Definition: RFLU_ModWENO.F90:275
rflu_modweno::rflu_wenogradcellsxyz_3d
subroutine rflu_wenogradcellsxyz_3d(pRegion, iBegGrad, iEndGrad, grad)
Definition: RFLU_ModWENO.F90:961
rflu_modweno::rflu_wenogradcells_2d
subroutine rflu_wenogradcells_2d(pRegion, iBegGrad, iEndGrad, grad)
Definition: RFLU_ModWENO.F90:96
rflu_modweno::rflu_wenogradcellsxyz_2d
subroutine rflu_wenogradcellsxyz_2d(pRegion, iBegGrad, iEndGrad, grad)
Definition: RFLU_ModWENO.F90:757
rflu_modweno::rflu_wenogradcellswrapper
subroutine, public rflu_wenogradcellswrapper(pRegion, iBegGrad, iEndGrad, grad)
Definition: RFLU_ModWENO.F90:464
idir
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com WITHOUT WARRANTY OF ANY **EXPRESS OR INCLUDING BUT NOT LIMITED TO THE WARRANTIES **OF FITNESS FOR A PARTICULAR PURPOSE AND **NONINFRINGEMENT IN NO EVENT SHALL THE CONTRIBUTORS OR **COPYRIGHT HOLDERS BE LIABLE FOR ANY DAMAGES OR OTHER WHETHER IN AN ACTION OF TORT OR **Arising OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE **USE OR OTHER DEALINGS WITH THE SOFTWARE **********************************************************************INTERFACE SUBROUTINE idir
Definition: RFLO_CalcGradDummyConn.h:30
rflu_modweno::rflu_wenogradcellsxyzfast_2d
subroutine rflu_wenogradcellsxyzfast_2d(pRegion, iBegGrad, iEndGrad, grad)
Definition: RFLU_ModWENO.F90:1180
rflu_modweno::rflu_wenogradcellsxyzwrapper
subroutine, public rflu_wenogradcellsxyzwrapper(pRegion, iBegGrad, iEndGrad, grad)
Definition: RFLU_ModWENO.F90:1593
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
modbndpatch::t_patch
Definition: ModBndPatch.F90:91