Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModStencilsCells.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 to construct cell stencils.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModStencilsCells.F90,v 1.18 2008/12/06 08:44:24 mtcampbe Exp $
34 !
35 ! Copyright: (c) 2005-2006 by the University of Illinois
36 !
37 ! ******************************************************************************
38 
39 MODULE rflu_modstencilscells
40 
41  USE modglobal, ONLY: t_global
42  USE modparameters
43  USE moddatatypes
44  USE moderror
45  USE modbndpatch, ONLY: t_patch
46  USE moddatastruct, ONLY: t_region
47  USE modgrid, ONLY: t_grid
48  USE modstencil, ONLY: t_stencil
49  USE modsortsearch
50  USE modmpi
51 
52  USE rflu_modcellfaceedgeinfo
53  USE rflu_modstencilsutils
54 
55  IMPLICIT NONE
56 
57  PRIVATE
58  PUBLIC :: rflu_buildc2cstencilwrapper, &
59  rflu_buildlistcc2cstencil, &
60  rflu_createc2cstencilwrapper, &
61  rflu_destroyc2cstencilwrapper, &
62  rflu_destroylistcc2cstencil, &
63  rflu_setinfoc2cstencilwrapper
64 
65 
66 ! ******************************************************************************
67 ! Declarations and definitions
68 ! ******************************************************************************
69 
70  CHARACTER(CHRLEN) :: RCSIdentString = &
71  '$RCSfile: RFLU_ModStencilsCells.F90,v $ $Revision: 1.18 $'
72 
73 ! ******************************************************************************
74 ! Routines
75 ! ******************************************************************************
76 
77  CONTAINS
78 
79 
80 
81 
82 
83 
84 ! *******************************************************************************
85 !
86 ! Purpose: Build 1D cell-to-cell stencil.
87 !
88 ! Description: None.
89 !
90 ! Input:
91 ! pRegion Pointer to region
92 ! fnDir Direction of stencil
93 ! icgBeg Beginning global cell index
94 ! icgEnd Ending global cell index
95 !
96 ! Output: None.
97 !
98 ! Notes:
99 ! 1. Restricted to hexahedra.
100 !
101 ! ******************************************************************************
102 
103  SUBROUTINE rflu_buildc2cstencil_1d(pRegion,fnDir,icgBeg,icgEnd)
104 
105  IMPLICIT NONE
106 
107 ! ******************************************************************************
108 ! Declarations and definitions
109 ! ******************************************************************************
110 
111 ! ==============================================================================
112 ! Arguments
113 ! ==============================================================================
114 
115  INTEGER, INTENT(IN) :: fndir,icgbeg,icgend
116  TYPE(t_region), POINTER :: pregion
117 
118 ! ==============================================================================
119 ! Locals
120 ! ==============================================================================
121 
122  INTEGER :: c1,c2,c2cs1dbeg,c2cs1dend,degr,errorflag,icg,icg2, &
123  icl,ict,ifg,ifl,ilayer,iloc,ipatch,isl, &
124  ncellmembsinfomax,ncellmembsinfomaxloc,ncellmembsinfomin, &
125  ncellmembsinfominloc,nfaces,nlayersinfomax,nlayersinfomaxloc, &
126  nlayersinfomin,nlayersinfominloc,nlayersmax,stencilsizemax, &
127  stencilsizemin
128  INTEGER, DIMENSION(:), ALLOCATABLE :: c2cs1d
129  INTEGER, DIMENSION(:,:), ALLOCATABLE :: layerinfo
130  REAL(RFREAL) :: fn
131  TYPE(t_grid), POINTER :: pgrid
132  TYPE(t_patch), POINTER :: ppatch
133  TYPE(t_global), POINTER :: global
134 
135 ! ******************************************************************************
136 ! Start
137 ! ******************************************************************************
138 
139  global => pregion%global
140 
141  CALL registerfunction(global,'RFLU_BuildC2CStencil_1D',&
142  'RFLU_ModStencilsCells.F90')
143 
144  IF ( (global%myProcid == masterproc) .AND. &
145  (global%verbLevel > verbose_none) .AND. &
146  (icgend > icgbeg) ) THEN
147  WRITE(stdout,'(A,1X,A)') solver_name,'Building 1D cell-to-cell stencil...'
148  WRITE(stdout,'(A,3X,A,1X,I2)') solver_name,'Direction:',fndir
149  END IF ! global%myProcid
150 
151 ! ******************************************************************************
152 ! Set grid pointer and check for required arrays
153 ! ******************************************************************************
154 
155  pgrid => pregion%grid
156 
157  IF ( ASSOCIATED(pgrid%hex2f) .EQV. .false. ) THEN
158  CALL errorstop(global,err_associated,__line__,'pGrid%hex2f')
159  END IF ! ASSOCIATED
160 
161 ! ******************************************************************************
162 ! Set variables
163 ! ******************************************************************************
164 
165  nlayersmax = pgrid%c2csInfo%nLayersMax
166  stencilsizemax = pgrid%c2csInfo%nCellMembsMax
167  stencilsizemin = pgrid%c2csInfo%nCellMembsMin
168 
169  ncellmembsinfomax = 0
170  ncellmembsinfomin = huge(1)
171 
172  nlayersinfomax = 0
173  nlayersinfomin = huge(1)
174 
175 ! ******************************************************************************
176 ! Allocate temporary memory
177 ! ******************************************************************************
178 
179  ALLOCATE(c2cs1d(stencilsizemax),stat=errorflag)
180  global%error = errorflag
181  IF ( global%error /= err_none ) THEN
182  CALL errorstop(global,err_allocate,__line__,'c2cs1D')
183  END IF ! global%error
184 
185  ALLOCATE(layerinfo(x2cs_layer_beg:x2cs_layer_end,nlayersmax), &
186  stat=errorflag)
187  global%error = errorflag
188  IF ( global%error /= err_none ) THEN
189  CALL errorstop(global,err_allocate,__line__,'layerInfo')
190  END IF ! global%error
191 
192 ! ******************************************************************************
193 ! Loop over cells
194 ! ******************************************************************************
195 
196  DO icg = icgbeg,icgend
197  ict = pgrid%cellGlob2Loc(1,icg) ! local cell index
198 
199  IF ( ict /= cell_type_hex ) THEN
200  CALL errorstop(global,err_stencilmember_invalid,__line__)
201  END IF ! ict
202 
203  icl = pgrid%cellGlob2Loc(2,icg) ! local cell index
204 
205 ! ==============================================================================
206 ! Initialize variables
207 ! ==============================================================================
208 
209  degr = 0
210 
211  DO isl = 1,stencilsizemax
212  c2cs1d(isl) = 0
213  END DO ! isl
214 
215  DO ilayer = 1,nlayersmax
216  layerinfo(x2cs_layer_beg,ilayer) = 0
217  layerinfo(x2cs_layer_end,ilayer) = 0
218  END DO ! iLayer
219 
220  pgrid%c2cs1D(fndir,icg)%nLayers = 1
221 
222 ! ******************************************************************************
223 ! Select cell type and set pointer to cell-to-face connectivity array
224 ! ******************************************************************************
225 
226  nfaces = SIZE(pgrid%hex2f,2)
227 
228 ! ******************************************************************************
229 ! Loop over faces of cell
230 ! ******************************************************************************
231 
232  DO ifl = 1,nfaces
233  ipatch = pgrid%hex2f(1,ifl,icl)
234  ifg = pgrid%hex2f(2,ifl,icl)
235 
236  IF ( ipatch == 0 ) THEN ! Interior face
237  c1 = pgrid%f2c(1,ifg)
238  c2 = pgrid%f2c(2,ifg)
239 
240  IF ( c1 == icg ) THEN
241  fn = pgrid%fn(fndir,ifg)
242  ELSE IF ( c2 == icg ) THEN
243  fn = -pgrid%fn(fndir,ifg)
244  ELSE ! defensive programming
245  CALL errorstop(global,err_reached_default,__line__)
246  END IF ! c1
247 
248  IF ( abs(fn) >= 0.999_rfreal ) THEN
249  IF ( c1 == icg ) THEN
250  icg2 = c2
251  ELSE IF ( c2 == icg ) THEN
252  icg2 = c1
253  ELSE ! defensive programming
254  CALL errorstop(global,err_reached_default,__line__)
255  END IF ! c1
256 
257  IF ( degr > 0 ) THEN ! Search whether already member
258  CALL binarysearchinteger(c2cs1d(1:degr),degr,icg2,iloc)
259 
260  IF ( iloc == element_not_found ) THEN
261  IF ( degr < stencilsizemax ) THEN
262  degr = degr + 1
263  c2cs1d(degr) = icg2
264  CALL quicksortinteger(c2cs1d(1:degr),degr)
265  END IF ! degr
266  END IF ! iloc
267  ELSE ! First member
268  degr = degr + 1
269  c2cs1d(degr) = icg2
270  END IF ! degr
271  END IF ! ABS(fn)
272  ELSE IF ( ipatch > 0 ) THEN ! Boundary face
273 ! TO DO
274 ! Currently do not add boundary faces for constrained reconstruction
275 ! END TO DO
276  ELSE ! Defensive programming
277  CALL errorstop(global,err_reached_default,__line__)
278  END IF ! iPatch
279  END DO ! ifl
280 
281  layerinfo(x2cs_layer_beg,1) = 1
282  layerinfo(x2cs_layer_end,1) = degr
283 
284 ! ==============================================================================
285 ! Extend basic stencil. NOTE for 1D stencil do not have to check weight
286 ! singularity
287 ! ==============================================================================
288 
289  DO ilayer = 2,nlayersmax
290  IF ( degr < stencilsizemin ) THEN
291  c2cs1dbeg = layerinfo(x2cs_layer_beg,ilayer-1)
292  c2cs1dend = layerinfo(x2cs_layer_end,ilayer-1)
293 
294  CALL rflu_addcelllayer_1d(global,pgrid,stencilsizemax,icg,degr, &
295  c2cs1dbeg,c2cs1dend,c2cs1d,fndir)
296 
297  pgrid%c2cs1D(fndir,icg)%nLayers = pgrid%c2cs1D(fndir,icg)%nLayers + 1
298 
299  layerinfo(x2cs_layer_beg,ilayer) = &
300  layerinfo(x2cs_layer_end,ilayer-1) + 1
301  layerinfo(x2cs_layer_end,ilayer) = degr
302  ELSE
303  EXIT
304  END IF ! degr
305  END DO ! iLayer
306 
307 ! ==============================================================================
308 ! Store stencil
309 ! ==============================================================================
310 
311  pgrid%c2cs1D(fndir,icg)%nCellMembs = degr
312 
313  ALLOCATE(pgrid%c2cs1D(fndir,icg)%cellMembs( &
314  pgrid%c2cs1D(fndir,icg)%nCellMembs),stat=errorflag)
315  global%error = errorflag
316  IF ( global%error /= err_none ) THEN
317  CALL errorstop(global,err_allocate,__line__,'pGrid%c2cs1D%cellMembs')
318  END IF ! global%error
319 
320  DO isl = 1,pgrid%c2cs1D(fndir,icg)%nCellMembs
321  pgrid%c2cs1D(fndir,icg)%cellMembs(isl) = c2cs1d(isl)
322  END DO ! isl
323 
324  ALLOCATE(pgrid%c2cs1D(fndir,icg)%layerInfo(x2cs_layer_beg: &
325  x2cs_layer_end,pgrid%c2cs1D(fndir,icg)%nLayers),stat=errorflag)
326  global%error = errorflag
327  IF ( global%error /= err_none ) THEN
328  CALL errorstop(global,err_allocate,__line__,'pGrid%c2cs1D%layerInfo')
329  END IF ! global%error
330 
331  DO ilayer = 1,pgrid%c2cs1D(fndir,icg)%nLayers
332  pgrid%c2cs1D(fndir,icg)%layerInfo(x2cs_layer_beg,ilayer) = &
333  layerinfo(x2cs_layer_beg,ilayer)
334  pgrid%c2cs1D(fndir,icg)%layerInfo(x2cs_layer_end,ilayer) = &
335  layerinfo(x2cs_layer_end,ilayer)
336  END DO ! iLayer
337 
338 ! ==============================================================================
339 ! Extract information for later printing
340 ! ==============================================================================
341 
342  IF ( pgrid%c2cs1D(fndir,icg)%nLayers < nlayersinfomin ) THEN
343  nlayersinfomin = pgrid%c2cs1D(fndir,icg)%nLayers
344  nlayersinfominloc = icg
345  END IF ! pGrid%c2cs1D(fnDir,icg)%nLayers
346 
347  IF ( pgrid%c2cs1D(fndir,icg)%nLayers > nlayersinfomax ) THEN
348  nlayersinfomax = pgrid%c2cs1D(fndir,icg)%nLayers
349  nlayersinfomaxloc = icg
350  END IF ! pGrid%c2cs1D(fnDir,icg)%nLayers
351 
352  IF ( pgrid%c2cs1D(fndir,icg)%nCellMembs < ncellmembsinfomin ) THEN
353  ncellmembsinfomin = pgrid%c2cs1D(fndir,icg)%nCellMembs
354  ncellmembsinfominloc = icg
355  END IF ! pGrid%c2cs1D(fnDir,icg)%nCellMembs
356 
357  IF ( pgrid%c2cs1D(fndir,icg)%nCellMembs > ncellmembsinfomax ) THEN
358  ncellmembsinfomax = pgrid%c2cs1D(fndir,icg)%nCellMembs
359  ncellmembsinfomaxloc = icg
360  END IF ! pGrid%c2cs1D(fnDir,icg)%nCellMembs
361  END DO ! icg
362 
363 ! ******************************************************************************
364 ! Deallocate temporary memory
365 ! ******************************************************************************
366 
367  DEALLOCATE(c2cs1d,stat=errorflag)
368  global%error = errorflag
369  IF ( global%error /= err_none ) THEN
370  CALL errorstop(global,err_deallocate,__line__,'c2cs1D')
371  END IF ! global%error
372 
373  DEALLOCATE(layerinfo,stat=errorflag)
374  global%error = errorflag
375  IF ( global%error /= err_none ) THEN
376  CALL errorstop(global,err_deallocate,__line__,'layerInfo')
377  END IF ! global%error
378 
379 ! ******************************************************************************
380 ! End
381 ! ******************************************************************************
382 
383  IF ( (global%myProcid == masterproc) .AND. &
384  (global%verbLevel > verbose_none) .AND. &
385  (icgend > icgbeg) ) THEN
386  WRITE(stdout,'(A,1X,A)') solver_name, &
387  'Building 1D cell-to-cell stencil done.'
388  END IF ! global%myProcid
389 
390  CALL deregisterfunction(global)
391 
392  END SUBROUTINE rflu_buildc2cstencil_1d
393 
394 
395 
396 
397 
398 
399 
400 
401 
402 ! *******************************************************************************
403 !
404 ! Purpose: Build cell-to-cell stencil based on geometry.
405 !
406 ! Description: None.
407 !
408 ! Input:
409 ! pRegion Pointer to region
410 ! icgBeg Beginning global cell index
411 ! icgEnd Ending global cell index
412 !
413 ! Output: None.
414 !
415 ! Notes: None.
416 !
417 ! ******************************************************************************
418 
419  SUBROUTINE rflu_buildc2cstencil_1d_g(pRegion,dir,icgBeg,icgEnd)
420 
421  IMPLICIT NONE
422 
423 ! ******************************************************************************
424 ! Declarations and definitions
425 ! ******************************************************************************
426 
427 ! ==============================================================================
428 ! Arguments
429 ! ==============================================================================
430 
431  INTEGER, INTENT(IN) :: dir,icgbeg,icgend
432  TYPE(t_region), POINTER :: pregion
433 
434 ! ==============================================================================
435 ! Locals
436 ! ==============================================================================
437 
438  INTEGER :: c2cs1dbeg,c2cs1dend,degr,errorflag,icg,icg2,icl,ict, &
439  ilayer,iloc,isl,ivg,ivl,iv2c,nbfacemembs,nbfacemembsmax, &
440  nbfacemembsmaxtemp,ncellmembsinfomax,ncellmembsinfomaxloc, &
441  ncellmembsinfomin,ncellmembsinfominloc,nlayersinfomax, &
442  nlayersinfomaxloc,nlayersinfomin,nlayersinfominloc, &
443  nlayersmax,nrows,order,ordernominal,stencilsizemax, &
444  stencilsizemin
445  INTEGER, DIMENSION(:), ALLOCATABLE :: c2cs1d
446  INTEGER, DIMENSION(:,:), ALLOCATABLE :: bfacemembs,layerinfo
447  REAL(RFREAL) :: rc(xcoord:zcoord)
448  TYPE(t_grid), POINTER :: pgrid
449  TYPE(t_global), POINTER :: global
450 
451 ! ******************************************************************************
452 ! Start
453 ! ******************************************************************************
454 
455  global => pregion%global
456 
457  CALL registerfunction(global,'RFLU_BuildC2CStencil_1D_G',&
458  'RFLU_ModStencilsCells.F90')
459 
460  IF ( (global%myProcid == masterproc) .AND. (icgend > icgbeg) ) THEN
461  IF ( global%verbLevel > verbose_none ) THEN
462  WRITE(stdout,'(A,1X,A)') solver_name,'Building cell-to-cell stencil...'
463 
464  IF ( global%verbLevel > verbose_low ) THEN
465  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
466  pregion%iRegionGlobal
467  END IF ! global%verbLevel
468  END IF ! global%verbLevel
469  END IF ! global%myProcid
470 
471 ! ******************************************************************************
472 ! Set grid pointer and set constants
473 ! ******************************************************************************
474 
475  pgrid => pregion%grid
476 
477 ! ******************************************************************************
478 ! Set variables
479 ! ******************************************************************************
480 
481  ordernominal = pgrid%c2csInfo%orderNominal
482  nlayersmax = pgrid%c2csInfo%nLayersMax
483  stencilsizemax = pgrid%c2csInfo%nCellMembsMax
484  stencilsizemin = pgrid%c2csInfo%nCellMembsMin
485 
486  ncellmembsinfomax = 0
487  ncellmembsinfomin = huge(1)
488 
489  nlayersinfomax = 0
490  nlayersinfomin = huge(1)
491 
492 ! ******************************************************************************
493 ! Allocate temporary memory
494 ! ******************************************************************************
495 
496  ALLOCATE(c2cs1d(stencilsizemax),stat=errorflag)
497  global%error = errorflag
498  IF ( global%error /= err_none ) THEN
499  CALL errorstop(global,err_allocate,__line__,'c2cs1D')
500  END IF ! global%error
501 
502  ALLOCATE(layerinfo(x2cs_layer_beg:x2cs_layer_end,nlayersmax), &
503  stat=errorflag)
504  global%error = errorflag
505  IF ( global%error /= err_none ) THEN
506  CALL errorstop(global,err_allocate,__line__,'layerInfo')
507  END IF ! global%error
508 
509 ! ******************************************************************************
510 ! Loop over cells and build stencil
511 ! ******************************************************************************
512 
513  DO icg = icgbeg,icgend
514  ict = rflu_getglobalcelltype(global,pgrid,icg)
515  icl = pgrid%cellGlob2Loc(2,icg)
516 
517  rc(xcoord) = pgrid%cofg(xcoord,icg)
518  rc(ycoord) = pgrid%cofg(ycoord,icg)
519  rc(zcoord) = pgrid%cofg(zcoord,icg)
520 
521 ! ==============================================================================
522 ! Initialize
523 ! ==============================================================================
524 
525  degr = 0
526 
527  DO isl = 1,stencilsizemax
528  c2cs1d(isl) = 0
529  END DO ! isl
530 
531  DO ilayer = 1,nlayersmax
532  layerinfo(x2cs_layer_beg,ilayer) = 0
533  layerinfo(x2cs_layer_end,ilayer) = 0
534  END DO ! iLayer
535 
536  pgrid%c2cs1D(dir,icg)%nLayers = 1
537 
538 ! ==============================================================================
539 ! Build basic stencil
540 ! ==============================================================================
541 
542  CALL rflu_buildc2cstencilbasic_1d(pregion,icg,stencilsizemax,dir,degr, &
543  c2cs1d)
544 
545  layerinfo(x2cs_layer_beg,1) = 1
546  layerinfo(x2cs_layer_end,1) = degr
547 
548 ! ==============================================================================
549 ! Extend basic stencil
550 ! ==============================================================================
551 
552  DO ilayer = 2,nlayersmax
553  order = ordernominal
554 
555  IF ( degr < stencilsizemin ) THEN
556  c2cs1dbeg = layerinfo(x2cs_layer_beg,ilayer-1)
557  c2cs1dend = layerinfo(x2cs_layer_end,ilayer-1)
558 
559  CALL rflu_addcelllayer_1d_g(global,pgrid,stencilsizemax,icg,degr, &
560  c2cs1dbeg,c2cs1dend,c2cs1d,rc,dir)
561 
562  pgrid%c2cs1D(dir,icg)%nLayers = pgrid%c2cs1D(dir,icg)%nLayers + 1
563 
564  layerinfo(x2cs_layer_beg,ilayer) = &
565  layerinfo(x2cs_layer_end,ilayer-1) + 1
566  layerinfo(x2cs_layer_end,ilayer) = degr
567  ELSE
568  EXIT
569  END IF ! sCount
570  END DO ! iLayer
571 
572 ! ==============================================================================
573 ! Store stencil
574 ! ==============================================================================
575 
576  pgrid%c2cs1D(dir,icg)%nCellMembs = degr
577 
578  ALLOCATE(pgrid%c2cs1D(dir,icg)%cellMembs( &
579  pgrid%c2cs1D(dir,icg)%nCellMembs),stat=errorflag)
580  global%error = errorflag
581  IF ( global%error /= err_none ) THEN
582  CALL errorstop(global,err_allocate,__line__,'pGrid%c2cs1D%cellMembs')
583  END IF ! global%error
584 
585  DO isl = 1,pgrid%c2cs1D(dir,icg)%nCellMembs
586  pgrid%c2cs1D(dir,icg)%cellMembs(isl) = c2cs1d(isl)
587  END DO ! isl
588 
589  ALLOCATE(pgrid%c2cs1D(dir,icg)%layerInfo(x2cs_layer_beg:x2cs_layer_end, &
590  pgrid%c2cs1D(dir,icg)%nLayers),stat=errorflag)
591  global%error = errorflag
592  IF ( global%error /= err_none ) THEN
593  CALL errorstop(global,err_allocate,__line__,'pGrid%c2cs1D%layerInfo')
594  END IF ! global%error
595 
596  DO ilayer = 1,pgrid%c2cs1D(dir,icg)%nLayers
597  pgrid%c2cs1D(dir,icg)%layerInfo(x2cs_layer_beg,ilayer) = &
598  layerinfo(x2cs_layer_beg,ilayer)
599  pgrid%c2cs1D(dir,icg)%layerInfo(x2cs_layer_end,ilayer) = &
600  layerinfo(x2cs_layer_end,ilayer)
601  END DO ! iLayer
602 
603 ! ==============================================================================
604 ! Extract information for later printing
605 ! ==============================================================================
606 
607  IF ( pgrid%c2cs1D(dir,icg)%nLayers < nlayersinfomin ) THEN
608  nlayersinfomin = pgrid%c2cs1D(dir,icg)%nLayers
609  nlayersinfominloc = icg
610  END IF ! pGrid%c2cs1D(dir,icg)%nLayers
611 
612  IF ( pgrid%c2cs1D(dir,icg)%nLayers > nlayersinfomax ) THEN
613  nlayersinfomax = pgrid%c2cs1D(dir,icg)%nLayers
614  nlayersinfomaxloc = icg
615  END IF ! pGrid%c2cs1D(dir,icg)%nLayers
616 
617  IF ( pgrid%c2cs1D(dir,icg)%nCellMembs < ncellmembsinfomin ) THEN
618  ncellmembsinfomin = pgrid%c2cs1D(dir,icg)%nCellMembs
619  ncellmembsinfominloc = icg
620  END IF ! pGrid%c2cs1D(dir,icg)%nCellMembs
621 
622  IF ( pgrid%c2cs1D(dir,icg)%nCellMembs > ncellmembsinfomax ) THEN
623  ncellmembsinfomax = pgrid%c2cs1D(dir,icg)%nCellMembs
624  ncellmembsinfomaxloc = icg
625  END IF ! pGrid%c2cs1D(dir,icg)%nCellMembs
626  END DO ! icg
627 
628 ! ******************************************************************************
629 ! Deallocate temporary memory
630 ! ******************************************************************************
631 
632  DEALLOCATE(c2cs1d,stat=errorflag)
633  global%error = errorflag
634  IF ( global%error /= err_none ) THEN
635  CALL errorstop(global,err_deallocate,__line__,'c2cs')
636  END IF ! global%error
637 
638  DEALLOCATE(layerinfo,stat=errorflag)
639  global%error = errorflag
640  IF ( global%error /= err_none ) THEN
641  CALL errorstop(global,err_deallocate,__line__,'layerInfo')
642  END IF ! global%error
643 
644 ! ******************************************************************************
645 ! Write out information on stencils
646 ! ******************************************************************************
647 
648  IF ( (global%myProcid == masterproc) .AND. &
649  (global%verbLevel > verbose_low) .AND. &
650  (icgend > icgbeg) ) THEN
651  WRITE(stdout,'(A,3X,A)') solver_name,'Statistics:'
652  WRITE(stdout,'(A,5X,A,2(1X,I3),2(1X,I9))') solver_name, &
653  'Minimum/maximum number of cell layers: ',nlayersinfomin, &
654  nlayersinfomax,nlayersinfominloc,nlayersinfomaxloc
655  WRITE(stdout,'(A,5X,A,2(1X,I3),2(1X,I9))') solver_name, &
656  'Minimum/maximum number of cell members:',ncellmembsinfomin, &
657  ncellmembsinfomax,ncellmembsinfominloc,ncellmembsinfomaxloc
658  END IF ! global%myProcid
659 
660 #ifdef CHECK_DATASTRUCT
661 ! ******************************************************************************
662 ! Data structure output for checking
663 ! ******************************************************************************
664 
665  WRITE(stdout,'(A)') solver_name
666  WRITE(stdout,'(A,1X,A)') solver_name,'### START CHECK OUTPUT ###'
667  WRITE(stdout,'(A,1X,A)') solver_name,'Cell-to-cell stencils'
668  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Maximum number of layers:', &
669  pgrid%c2csInfo%nLayersMax
670  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Minimum stencil size:', &
671  pgrid%c2csInfo%nCellMembsMin
672 
673  DO icg = 1,pgrid%nCellsTot
674  WRITE(stdout,'(A,1X,I6,2(1X,I3),3X,20(1X,I6))') solver_name,icg, &
675  pgrid%c2cs1D(dir,icg)%nLayers,pgrid%c2cs1D(dir,icg)%nCellMembs, &
676  pgrid%c2cs1D(dir,icg)%cellMembs(1:pgrid%c2cs1D(dir,icg)%nCellMembs)
677  END DO ! icg
678 
679  WRITE(stdout,'(A,1X,A)') solver_name,'### END CHECK OUTPUT ###'
680  WRITE(stdout,'(A)') solver_name
681 #endif
682 
683 ! ******************************************************************************
684 ! End
685 ! ******************************************************************************
686 
687  IF ( (global%myProcid == masterproc) .AND. &
688  (global%verbLevel > verbose_none) .AND. &
689  (icgend > icgbeg) ) THEN
690  WRITE(stdout,'(A,1X,A)') solver_name,'Building cell-to-cell stencil done.'
691  END IF ! global%myProcid
692 
693  CALL deregisterfunction(global)
694 
695  END SUBROUTINE rflu_buildc2cstencil_1d_g
696 
697 
698 
699 
700 
701 
702 
703 
704 ! *******************************************************************************
705 !
706 ! Purpose: Build cell-to-cell stencil.
707 !
708 ! Description: None.
709 !
710 ! Input:
711 ! pRegion Pointer to region
712 ! icgBeg Beginning global cell index
713 ! icgEnd Ending global cell index
714 ! addBFaces Flag indicating whether should add boundary faces
715 !
716 ! Output: None.
717 !
718 ! Notes: None.
719 !
720 ! ******************************************************************************
721 
722  SUBROUTINE rflu_buildc2cstencil(pRegion,icgBeg,icgEnd,addBFaces)
723 
724  USE modinterfaces, ONLY: rflu_invertmatrixsvd
725 
726  IMPLICIT NONE
727 
728 ! ******************************************************************************
729 ! Declarations and definitions
730 ! ******************************************************************************
731 
732 ! ==============================================================================
733 ! Arguments
734 ! ==============================================================================
735 
736  LOGICAL, INTENT(IN) :: addbfaces
737  INTEGER, INTENT(IN) :: icgbeg,icgend
738  TYPE(t_region), POINTER :: pregion
739 
740 ! ==============================================================================
741 ! Locals
742 ! ==============================================================================
743 
744  INTEGER :: c2csbeg,c2csend,degr,errorflag,icg,icg2,icl,ict, &
745  ilayer,iloc,isl,ivg,ivl,iv2c,nbfacemembs,nbfacemembsmax, &
746  nbfacemembsmaxtemp,ncellmembsinfomax,ncellmembsinfomaxloc, &
747  ncellmembsinfomin,ncellmembsinfominloc,nlayersinfomax, &
748  nlayersinfomaxloc,nlayersinfomin,nlayersinfominloc, &
749  nlayersmax,nrows,order,ordernominal,scount,stencilsizemax, &
750  stencilsizemin,ncols,irow,icol
751  INTEGER, DIMENSION(:), ALLOCATABLE :: c2cs,c2cstemp
752  INTEGER, DIMENSION(:,:), ALLOCATABLE :: bfacemembs,layerinfo
753  REAL(RFREAL) :: dx,dy,dz,term
754  REAL(RFREAL) :: colmax(4)
755  REAL(RFREAL), DIMENSION(:,:), ALLOCATABLE :: a,ainv
756  TYPE(t_grid), POINTER :: pgrid
757  TYPE(t_global), POINTER :: global
758 
759 ! ******************************************************************************
760 ! Start
761 ! ******************************************************************************
762 
763  global => pregion%global
764 
765  CALL registerfunction(global,'RFLU_BuildC2CStencil',&
766  'RFLU_ModStencilsCells.F90')
767 
768  IF ( (global%myProcid == masterproc) .AND. (icgend > icgbeg) ) THEN
769  IF ( global%verbLevel > verbose_none ) THEN
770  WRITE(stdout,'(A,1X,A)') solver_name,'Building cell-to-cell stencil...'
771 
772  IF ( global%verbLevel > verbose_low ) THEN
773  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
774  pregion%iRegionGlobal
775  END IF ! global%verbLevel
776  END IF ! global%verbLevel
777  END IF ! global%myProcid
778 
779 ! ******************************************************************************
780 ! Set grid pointer and set constants
781 ! ******************************************************************************
782 
783  pgrid => pregion%grid
784 
785 ! ******************************************************************************
786 ! Set variables
787 ! ******************************************************************************
788 
789  ordernominal = pgrid%c2csInfo%orderNominal
790  nlayersmax = pgrid%c2csInfo%nLayersMax
791  nbfacemembsmax = pgrid%c2csInfo%nBFaceMembsMax
792  stencilsizemax = pgrid%c2csInfo%nCellMembsMax
793  stencilsizemin = pgrid%c2csInfo%nCellMembsMin
794 
795  ncellmembsinfomax = 0
796  ncellmembsinfomin = huge(1)
797 
798  nlayersinfomax = 0
799  nlayersinfomin = huge(1)
800 
801  nbfacemembsmaxtemp = 2*nbfacemembsmax
802 
803 ! ******************************************************************************
804 ! Allocate temporary memory
805 ! ******************************************************************************
806 
807  ALLOCATE(c2cs(stencilsizemax),stat=errorflag)
808  global%error = errorflag
809  IF ( global%error /= err_none ) THEN
810  CALL errorstop(global,err_allocate,__line__,'c2cs')
811  END IF ! global%error
812 
813  ALLOCATE(bfacemembs(2,nbfacemembsmaxtemp),stat=errorflag)
814  global%error = errorflag
815  IF ( global%error /= err_none ) THEN
816  CALL errorstop(global,err_allocate,__line__,'bFaceMembs')
817  END IF ! global%error
818 
819  ALLOCATE(layerinfo(x2cs_layer_beg:x2cs_layer_end,nlayersmax), &
820  stat=errorflag)
821  global%error = errorflag
822  IF ( global%error /= err_none ) THEN
823  CALL errorstop(global,err_allocate,__line__,'layerInfo')
824  END IF ! global%error
825 
826 ! ******************************************************************************
827 ! Loop over cells and build stencil
828 ! ******************************************************************************
829 
830  DO icg = icgbeg,icgend
831  ict = rflu_getglobalcelltype(global,pgrid,icg)
832  icl = pgrid%cellGlob2Loc(2,icg)
833 
834 ! ==============================================================================
835 ! Initialize
836 ! ==============================================================================
837 
838  degr = 0
839 
840  DO isl = 1,stencilsizemax
841  c2cs(isl) = 0
842  END DO ! isl
843 
844  DO ilayer = 1,nlayersmax
845  layerinfo(x2cs_layer_beg,ilayer) = 0
846  layerinfo(x2cs_layer_end,ilayer) = 0
847  END DO ! iLayer
848 
849  pgrid%c2cs(icg)%nLayers = 1
850 
851 ! ==============================================================================
852 ! Build basic stencil
853 ! ==============================================================================
854 
855  CALL rflu_buildc2cstencilbasic(pregion,icg,stencilsizemax,degr,c2cs)
856 
857  layerinfo(x2cs_layer_beg,1) = 1
858  layerinfo(x2cs_layer_end,1) = degr
859 
860 ! ==============================================================================
861 ! Extend basic stencil
862 ! ==============================================================================
863 
864  DO ilayer = 2,nlayersmax
865  order = ordernominal
866  scount = 0
867 
868 ! ------------------------------------------------------------------------------
869 ! Check whether stencil weights are singular
870 ! ------------------------------------------------------------------------------
871 
872  IF ( degr >= stencilsizemin ) THEN
873  nrows = degr
874  ncols = pregion%mixtInput%dimens + 1
875 
876  ALLOCATE(a(nrows,ncols),stat=errorflag)
877  global%error = errorflag
878  IF ( global%error /= err_none ) THEN
879  CALL errorstop(global,err_allocate,__line__,'a')
880  END IF ! global%error
881 
882  ALLOCATE(ainv(nrows,ncols),stat=errorflag)
883  global%error = errorflag
884  IF ( global%error /= err_none ) THEN
885  CALL errorstop(global,err_allocate,__line__,'aInv')
886  END IF ! global%error
887 
888  SELECT CASE ( pregion%mixtInput%dimens )
889  CASE ( 2 )
890  DO isl = 1,degr
891  icg2 = c2cs(isl)
892 
893  dx = pgrid%cofg(xcoord,icg2) - pgrid%cofg(xcoord,icg)
894  dy = pgrid%cofg(ycoord,icg2) - pgrid%cofg(ycoord,icg)
895 
896  term = 1.0_rfreal/sqrt(dx*dx + dy*dy)
897 
898  a(isl,1) = term
899  a(isl,2) = term*dx
900  a(isl,3) = term*dy
901  END DO ! isl
902  CASE ( 3 )
903  DO isl = 1,degr
904  icg2 = c2cs(isl)
905 
906  dx = pgrid%cofg(xcoord,icg2) - pgrid%cofg(xcoord,icg)
907  dy = pgrid%cofg(ycoord,icg2) - pgrid%cofg(ycoord,icg)
908  dz = pgrid%cofg(zcoord,icg2) - pgrid%cofg(zcoord,icg)
909 
910  term = 1.0_rfreal/sqrt(dx*dx + dy*dy + dz*dz)
911 
912  a(isl,1) = term
913  a(isl,2) = term*dx
914  a(isl,3) = term*dy
915  a(isl,4) = term*dz
916  END DO ! isl
917  CASE default
918  CALL errorstop(global,err_reached_default,__line__)
919  END SELECT ! pRegion%mixtInput%dimens
920 
921  DO icol = 1,ncols
922  colmax(icol) = -huge(1.0_rfreal)
923 
924  DO irow = 1,nrows
925  colmax(icol) = max(colmax(icol),abs(a(irow,icol)))
926  END DO ! iRow
927 
928  DO irow = 1,nrows
929  a(irow,icol) = a(irow,icol)/colmax(icol)
930  END DO ! iRow
931  END DO ! iCol
932 
933  CALL rflu_invertmatrixsvd(global,nrows,ncols,a,ainv,scount)
934 
935  DEALLOCATE(a,stat=errorflag)
936  global%error = errorflag
937  IF ( global%error /= err_none ) THEN
938  CALL errorstop(global,err_deallocate,__line__,'a')
939  END IF ! global%error
940 
941  DEALLOCATE(ainv,stat=errorflag)
942  global%error = errorflag
943  IF ( global%error /= err_none ) THEN
944  CALL errorstop(global,err_deallocate,__line__,'aInv')
945  END IF ! global%error
946  END IF ! degr
947 
948 ! ------------------------------------------------------------------------------
949 ! Check whether to reject or accept stencil. If singular or too small,
950 ! add layer of cells.
951 ! ------------------------------------------------------------------------------
952 
953  IF ( scount /= 0 .OR. degr < stencilsizemin ) THEN
954  c2csbeg = layerinfo(x2cs_layer_beg,ilayer-1)
955  c2csend = layerinfo(x2cs_layer_end,ilayer-1)
956 
957  CALL rflu_addcelllayer(global,pgrid,stencilsizemax,icg,degr, &
958  c2csbeg,c2csend,c2cs)
959  pgrid%c2cs(icg)%nLayers = pgrid%c2cs(icg)%nLayers + 1
960 
961  layerinfo(x2cs_layer_beg,ilayer) = &
962  layerinfo(x2cs_layer_end,ilayer-1) + 1
963  layerinfo(x2cs_layer_end,ilayer) = degr
964  ELSE
965  EXIT
966  END IF ! sCount
967  END DO ! iLayer
968 
969 ! ==============================================================================
970 ! Store stencil
971 ! ==============================================================================
972 
973  pgrid%c2cs(icg)%nCellMembs = degr
974 
975  ALLOCATE(pgrid%c2cs(icg)%cellMembs(pgrid%c2cs(icg)%nCellMembs), &
976  stat=errorflag)
977  global%error = errorflag
978  IF ( global%error /= err_none ) THEN
979  CALL errorstop(global,err_allocate,__line__,'pGrid%c2cs%cellMembs')
980  END IF ! global%error
981 
982  DO isl = 1,pgrid%c2cs(icg)%nCellMembs
983  pgrid%c2cs(icg)%cellMembs(isl) = c2cs(isl)
984  END DO ! isl
985 
986  ALLOCATE(pgrid%c2cs(icg)%layerInfo(x2cs_layer_beg:x2cs_layer_end, &
987  pgrid%c2cs(icg)%nLayers),stat=errorflag)
988  global%error = errorflag
989  IF ( global%error /= err_none ) THEN
990  CALL errorstop(global,err_allocate,__line__,'pGrid%c2cs%layerInfo')
991  END IF ! global%error
992 
993  DO ilayer = 1,pgrid%c2cs(icg)%nLayers
994  pgrid%c2cs(icg)%layerInfo(x2cs_layer_beg,ilayer) = &
995  layerinfo(x2cs_layer_beg,ilayer)
996  pgrid%c2cs(icg)%layerInfo(x2cs_layer_end,ilayer) = &
997  layerinfo(x2cs_layer_end,ilayer)
998  END DO ! iLayer
999 
1000 ! ==============================================================================
1001 ! Add boundary faces to stencil. If the stencil contains boundary faces,
1002 ! sort them by distance and pick <nBFaceMembsMax> closest ones. NOTE build
1003 ! temporary c2csTemp array which includes cell icg itself in addition to
1004 ! cells already in stencil. This is done so that boundary face(s) attached
1005 ! to cell icg will also show up in boundary-face stencil.
1006 ! ==============================================================================
1007 
1008  nbfacemembs = 0
1009 
1010  IF ( addbfaces .EQV. .true. ) THEN
1011  ALLOCATE(c2cstemp(pgrid%c2cs(icg)%nCellMembs+1),stat=errorflag)
1012  global%error = errorflag
1013  IF ( global%error /= err_none ) THEN
1014  CALL errorstop(global,err_allocate,__line__,'c2csTemp')
1015  END IF ! global%error
1016 
1017  c2cstemp(1) = icg
1018 
1019  DO isl = 1,pgrid%c2cs(icg)%nCellMembs
1020  c2cstemp(isl+1) = pgrid%c2cs(icg)%cellMembs(isl)
1021  END DO ! isl
1022 
1023  CALL rflu_addbfaces(pregion,nbfacemembsmaxtemp, &
1024  pgrid%c2cs(icg)%nCellMembs+1, &
1025  c2cstemp,nbfacemembs,bfacemembs)
1026 
1027  DEALLOCATE(c2cstemp,stat=errorflag)
1028  global%error = errorflag
1029  IF ( global%error /= err_none ) THEN
1030  CALL errorstop(global,err_deallocate,__line__,'c2csTemp')
1031  END IF ! global%error
1032  END IF ! addBFaces
1033 
1034  IF ( nbfacemembs > 0 ) THEN
1035  CALL rflu_sortbfaces(pregion,pgrid%cofg(xcoord:zcoord,icg), &
1036  nbfacemembs,bfacemembs(1:2,1:nbfacemembs))
1037 
1038  pgrid%c2cs(icg)%nBFaceMembs = min(nbfacemembs,nbfacemembsmax)
1039 
1040  ALLOCATE(pgrid%c2cs(icg)%bFaceMembs(2,pgrid%c2cs(icg)%nBFaceMembs), &
1041  stat=errorflag)
1042  global%error = errorflag
1043  IF ( global%error /= err_none ) THEN
1044  CALL errorstop(global,err_allocate,__line__,'pGrid%c2cs%bFaceMembs')
1045  END IF ! global%error
1046 
1047  DO isl = 1,pgrid%c2cs(icg)%nBFaceMembs
1048  pgrid%c2cs(icg)%bFaceMembs(1,isl) = bfacemembs(1,isl)
1049  pgrid%c2cs(icg)%bFaceMembs(2,isl) = bfacemembs(2,isl)
1050  END DO ! isl
1051  ELSE
1052  pgrid%c2cs(icg)%nBFaceMembs = 0
1053 
1054  nullify(pgrid%c2cs(icg)%bFaceMembs)
1055  END IF ! nBFaceMembs
1056 
1057 ! ==============================================================================
1058 ! Extract information for later printing
1059 ! ==============================================================================
1060 
1061  IF ( pgrid%c2cs(icg)%nLayers < nlayersinfomin ) THEN
1062  nlayersinfomin = pgrid%c2cs(icg)%nLayers
1063  nlayersinfominloc = icg
1064  END IF ! pGrid%c2cs(icg)%nLayers
1065 
1066  IF ( pgrid%c2cs(icg)%nLayers > nlayersinfomax ) THEN
1067  nlayersinfomax = pgrid%c2cs(icg)%nLayers
1068  nlayersinfomaxloc = icg
1069  END IF ! pGrid%c2cs(icg)%nLayers
1070 
1071  IF ( pgrid%c2cs(icg)%nCellMembs < ncellmembsinfomin ) THEN
1072  ncellmembsinfomin = pgrid%c2cs(icg)%nCellMembs
1073  ncellmembsinfominloc = icg
1074  END IF ! pGrid%c2cs(icg)%nCellMembs
1075 
1076  IF ( pgrid%c2cs(icg)%nCellMembs > ncellmembsinfomax ) THEN
1077  ncellmembsinfomax = pgrid%c2cs(icg)%nCellMembs
1078  ncellmembsinfomaxloc = icg
1079  END IF ! pGrid%c2cs(icg)%nCellMembs
1080  END DO ! icg
1081 
1082 ! ******************************************************************************
1083 ! Deallocate temporary memory
1084 ! ******************************************************************************
1085 
1086  DEALLOCATE(c2cs,stat=errorflag)
1087  global%error = errorflag
1088  IF ( global%error /= err_none ) THEN
1089  CALL errorstop(global,err_deallocate,__line__,'c2cs')
1090  END IF ! global%error
1091 
1092  DEALLOCATE(bfacemembs,stat=errorflag)
1093  global%error = errorflag
1094  IF ( global%error /= err_none ) THEN
1095  CALL errorstop(global,err_deallocate,__line__,'bFaceMembs')
1096  END IF ! global%error
1097 
1098  DEALLOCATE(layerinfo,stat=errorflag)
1099  global%error = errorflag
1100  IF ( global%error /= err_none ) THEN
1101  CALL errorstop(global,err_deallocate,__line__,'layerInfo')
1102  END IF ! global%error
1103 
1104 ! ******************************************************************************
1105 ! Write out information on stencils
1106 ! ******************************************************************************
1107 
1108  IF ( (global%myProcid == masterproc) .AND. &
1109  (global%verbLevel > verbose_low) .AND. &
1110  (icgend > icgbeg) ) THEN
1111  WRITE(stdout,'(A,3X,A)') solver_name,'Statistics:'
1112  WRITE(stdout,'(A,5X,A,2(1X,I3),2(1X,I9))') solver_name, &
1113  'Minimum/maximum number of cell layers: ',nlayersinfomin, &
1114  nlayersinfomax,nlayersinfominloc,nlayersinfomaxloc
1115  WRITE(stdout,'(A,5X,A,2(1X,I3),2(1X,I9))') solver_name, &
1116  'Minimum/maximum number of cell members:',ncellmembsinfomin, &
1117  ncellmembsinfomax,ncellmembsinfominloc,ncellmembsinfomaxloc
1118  END IF ! global%myProcid
1119 
1120 #ifdef CHECK_DATASTRUCT
1121 ! ******************************************************************************
1122 ! Data structure output for checking
1123 ! ******************************************************************************
1124 
1125  WRITE(stdout,'(A)') solver_name
1126  WRITE(stdout,'(A,1X,A)') solver_name,'### START CHECK OUTPUT ###'
1127  WRITE(stdout,'(A,1X,A)') solver_name,'Cell-to-cell stencils'
1128  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Maximum number of layers:', &
1129  pgrid%c2csInfo%nLayersMax
1130  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Minimum stencil size:', &
1131  pgrid%c2csInfo%nCellMembsMin
1132 
1133  DO icg = 1,pgrid%nCellsTot
1134  WRITE(stdout,'(A,1X,I6,2(1X,I3),3X,20(1X,I6))') solver_name,icg, &
1135  pgrid%c2cs(icg)%nLayers,pgrid%c2cs(icg)%nCellMembs, &
1136  pgrid%c2cs(icg)%cellMembs(1:pgrid%c2cs(icg)%nCellMembs)
1137  END DO ! icg
1138 
1139  WRITE(stdout,'(A,1X,A)') solver_name,'### END CHECK OUTPUT ###'
1140  WRITE(stdout,'(A)') solver_name
1141 #endif
1142 
1143 ! ******************************************************************************
1144 ! End
1145 ! ******************************************************************************
1146 
1147  IF ( (global%myProcid == masterproc) .AND. &
1148  (global%verbLevel > verbose_none) .AND. &
1149  (icgend > icgbeg) ) THEN
1150  WRITE(stdout,'(A,1X,A)') solver_name,'Building cell-to-cell stencil done.'
1151  END IF ! global%myProcid
1152 
1153  CALL deregisterfunction(global)
1154 
1155  END SUBROUTINE rflu_buildc2cstencil
1156 
1157 
1158 
1159 
1160 
1161 
1162 ! *******************************************************************************
1163 !
1164 ! Purpose: Build basic cell-to-cell stencil.
1165 !
1166 ! Description: None.
1167 !
1168 ! Input:
1169 ! pRegion Pointer to region
1170 ! icgBeg Beginning global cell index
1171 ! icgEnd Ending global cell index
1172 ! addBFaces Flag indicating whether should add boundary faces
1173 !
1174 ! Output: None.
1175 !
1176 ! Notes: None.
1177 !
1178 ! ******************************************************************************
1179 
1180  SUBROUTINE rflu_buildc2cstencilbasic(pRegion,icg,stencilSizeMax,degr,c2cs)
1181 
1182  IMPLICIT NONE
1183 
1184 ! ******************************************************************************
1185 ! Declarations and definitions
1186 ! ******************************************************************************
1187 
1188 ! ==============================================================================
1189 ! Arguments
1190 ! ==============================================================================
1191 
1192  INTEGER, INTENT(IN) :: icg,stencilsizemax
1193  INTEGER, INTENT(OUT) :: degr
1194  INTEGER, INTENT(OUT) :: c2cs(stencilsizemax)
1195  TYPE(t_region), POINTER :: pregion
1196 
1197 ! ==============================================================================
1198 ! Locals
1199 ! ==============================================================================
1200 
1201  INTEGER, PARAMETER :: nvertmax = 8
1202  INTEGER :: errorflag,icg2,icl,icltemp,icl2,ict,ict2,iloc,ivg,ivl,ivl2, &
1203  iv2c,ncells,ncells2,nvert,nvert2,nvert3
1204  INTEGER, DIMENSION(NVERTMAX) :: vtemp,vtemp2,vtemp3
1205  INTEGER, DIMENSION(:), ALLOCATABLE :: icgtemp
1206  INTEGER, DIMENSION(:,:), POINTER :: x2v
1207  REAL(RFREAL) :: invert
1208  REAL(RFREAL), DIMENSION(:), ALLOCATABLE :: nvertsharedfrac
1209  TYPE(t_grid), POINTER :: pgrid
1210  TYPE(t_global), POINTER :: global
1211 
1212 ! ******************************************************************************
1213 ! Start
1214 ! ******************************************************************************
1215 
1216  global => pregion%global
1217 
1218  CALL registerfunction(global,'RFLU_BuildC2CStencilBasic',&
1219  'RFLU_ModStencilsCells.F90')
1220 
1221 ! ******************************************************************************
1222 ! Set grid pointer
1223 ! ******************************************************************************
1224 
1225  pgrid => pregion%grid
1226 
1227 ! ******************************************************************************
1228 ! Build basic stencil
1229 ! ******************************************************************************
1230 
1231  ict = rflu_getglobalcelltype(global,pgrid,icg)
1232  icl = pgrid%cellGlob2Loc(2,icg)
1233 
1234 ! ==============================================================================
1235 ! Build temporary list of cells which are vertex-neighbors of current cell
1236 ! ==============================================================================
1237 
1238  SELECT CASE ( ict )
1239  CASE ( cell_type_tet )
1240  x2v => pgrid%tet2v
1241  CASE ( cell_type_hex )
1242  x2v => pgrid%hex2v
1243  CASE ( cell_type_pri )
1244  x2v => pgrid%pri2v
1245  CASE ( cell_type_pyr )
1246  x2v => pgrid%pyr2v
1247  CASE default
1248  CALL errorstop(global,err_reached_default,__line__)
1249  END SELECT ! ict
1250 
1251  nvert = SIZE(x2v,1)
1252  invert = 1.0_rfreal/REAL(nVert,KIND=RFREAL)
1253 
1254  ncells = 0
1255 
1256  DO ivl = 1,nvert
1257  ivg = x2v(ivl,icl)
1258 
1259  ncells = ncells + pgrid%v2cInfo(v2c_end,ivg) &
1260  - pgrid%v2cInfo(v2c_beg,ivg) &
1261  + 1
1262  END DO ! ivl
1263 
1264  ALLOCATE(icgtemp(ncells),stat=errorflag)
1265  global%error = errorflag
1266  IF ( global%error /= err_none ) THEN
1267  CALL errorstop(global,err_allocate,__line__,'icgTemp')
1268  END IF ! global%error
1269 
1270  ALLOCATE(nvertsharedfrac(ncells),stat=errorflag)
1271  global%error = errorflag
1272  IF ( global%error /= err_none ) THEN
1273  CALL errorstop(global,err_allocate,__line__,'nVertSharedFrac')
1274  END IF ! global%error
1275 
1276  ncells = 0
1277 
1278  DO ivl = 1,nvert
1279  ivg = x2v(ivl,icl)
1280 
1281  DO iv2c = pgrid%v2cInfo(v2c_beg,ivg),pgrid%v2cInfo(v2c_end,ivg)
1282  ncells = ncells + 1
1283 
1284  icgtemp(ncells) = pgrid%v2c(iv2c)
1285  END DO ! iv2c
1286  END DO ! ivl
1287 
1288 ! ==============================================================================
1289 ! Sort temporary list and remove duplicates as well as current cell
1290 ! ==============================================================================
1291 
1292  CALL quicksortinteger(icgtemp(1:ncells),ncells)
1293  CALL simplifysortedintegers(icgtemp(1:ncells),ncells,ncells2)
1294  CALL binarysearchinteger(icgtemp(1:ncells2),ncells2,icg,iloc)
1295 
1296  IF ( iloc /= element_not_found ) THEN
1297  CALL removeinteger(icgtemp(1:ncells2),ncells2,iloc)
1298  ELSE
1299 ! TEMPORARY
1300  WRITE(*,*) 'ERROR! Cell icg not found in own stencil!'
1301  stop
1302 ! END TEMPORARY
1303  END IF ! iLoc
1304 
1305 ! ==============================================================================
1306 ! Determine number of shared vertices between current cell and neighboring
1307 ! cells and store fraction of shared vertices
1308 ! ==============================================================================
1309 
1310  vtemp(1:nvert) = x2v(1:nvert,icl)
1311  CALL quicksortinteger(vtemp(1:nvert),nvert)
1312 
1313  DO icltemp = 1,ncells2
1314  icg2 = icgtemp(icltemp)
1315 
1316  ict2 = rflu_getglobalcelltype(global,pgrid,icg2)
1317  icl2 = pgrid%cellGlob2Loc(2,icg2)
1318 
1319  SELECT CASE ( ict2 )
1320  CASE ( cell_type_tet )
1321  nvert2 = 4
1322  vtemp2(1:4) = pgrid%tet2v(1:4,icl2)
1323  CASE ( cell_type_hex )
1324  nvert2 = 8
1325  vtemp2(1:8) = pgrid%hex2v(1:8,icl2)
1326  CASE ( cell_type_pri )
1327  nvert2 = 6
1328  vtemp2(1:6) = pgrid%pri2v(1:6,icl2)
1329  CASE ( cell_type_pyr )
1330  nvert2 = 5
1331  vtemp2(1:5) = pgrid%pyr2v(1:5,icl2)
1332  CASE default
1333  CALL errorstop(global,err_reached_default,__line__)
1334  END SELECT ! ict2
1335 
1336  CALL quicksortinteger(vtemp2(1:nvert2),nvert2)
1337  CALL findcommonsortedintegers(vtemp(1:nvert),nvert,vtemp2(1:nvert2), &
1338  nvert2,vtemp3,nvertmax,nvert3,errorflag)
1339 ! TEMPORARY
1340  IF ( errorflag /= err_none ) THEN
1341  WRITE(*,*) 'ERROR!',errorflag
1342  END IF ! errorFlag
1343 
1344  IF ( nvert3 == 0 ) THEN
1345  WRITE(*,*) 'ERROR! nVert3 = 0!!!'
1346  END IF ! nVert3
1347 ! END TEMPORARY
1348 
1349  nvertsharedfrac(icltemp) = nvert3*invert
1350  END DO ! iclTemp
1351 
1352 ! ==============================================================================
1353 ! Sort fraction of shared vertices and store as basic stencil
1354 ! ==============================================================================
1355 
1356  CALL quicksortrfrealinteger(nvertsharedfrac(1:ncells2),icgtemp(1:ncells2), &
1357  ncells2)
1358 
1359  degr = 0
1360 
1361  DO icl2 = ncells2,max(ncells2-stencilsizemax+1,1),-1
1362  degr = degr + 1
1363  c2cs(degr) = icgtemp(icl2)
1364  END DO ! icl2
1365 
1366  CALL quicksortinteger(c2cs(1:degr),degr)
1367 
1368 ! ==============================================================================
1369 ! Deallocate temporary lists
1370 ! ==============================================================================
1371 
1372  DEALLOCATE(icgtemp,stat=errorflag)
1373  global%error = errorflag
1374  IF ( global%error /= err_none ) THEN
1375  CALL errorstop(global,err_deallocate,__line__,'icgTemp')
1376  END IF ! global%error
1377 
1378  DEALLOCATE(nvertsharedfrac,stat=errorflag)
1379  global%error = errorflag
1380  IF ( global%error /= err_none ) THEN
1381  CALL errorstop(global,err_deallocate,__line__,'nVertSharedFrac')
1382  END IF ! global%error
1383 
1384 ! ******************************************************************************
1385 ! End
1386 ! ******************************************************************************
1387 
1388  CALL deregisterfunction(global)
1389 
1390  END SUBROUTINE rflu_buildc2cstencilbasic
1391 
1392 
1393 
1394 
1395 
1396 
1397 ! *******************************************************************************
1398 !
1399 ! Purpose: Build basic cell-to-cell stencil.
1400 !
1401 ! Description: None.
1402 !
1403 ! Input:
1404 ! pRegion Pointer to region
1405 ! icg Global cell index
1406 ! stencilSizeMax Maximum allowed stencil size
1407 ! dir Direction in which stencil is to be built
1408 !
1409 ! Output:
1410 ! degr Stencil size
1411 ! c2cs1D Stencil
1412 !
1413 ! Notes: None.
1414 !
1415 ! ******************************************************************************
1416 
1417  SUBROUTINE rflu_buildc2cstencilbasic_1d(pRegion,icg,stencilSizeMax,dir, &
1418  degr,c2cs1d)
1419 
1420  USE rflu_modgeometrytools, ONLY: rflu_testvectorcartaxisaligned
1421 
1422  IMPLICIT NONE
1423 
1424 ! ******************************************************************************
1425 ! Declarations and definitions
1426 ! ******************************************************************************
1427 
1428 ! ==============================================================================
1429 ! Arguments
1430 ! ==============================================================================
1431 
1432  INTEGER, INTENT(IN) :: dir,icg,stencilsizemax
1433  INTEGER, INTENT(OUT) :: degr
1434  INTEGER, INTENT(OUT) :: c2cs1d(stencilsizemax)
1435  TYPE(t_region), POINTER :: pregion
1436 
1437 ! ==============================================================================
1438 ! Locals
1439 ! ==============================================================================
1440 
1441  INTEGER :: errorflag,icg2,icl,ict,iloc,ivg,ivl,iv2c,ncells,ncells2
1442  INTEGER, DIMENSION(:), ALLOCATABLE :: icgtemp
1443  REAL(RFREAL) :: dr(xcoord:zcoord),rc(xcoord:zcoord)
1444  TYPE(t_grid), POINTER :: pgrid
1445  TYPE(t_global), POINTER :: global
1446 
1447 ! ******************************************************************************
1448 ! Start
1449 ! ******************************************************************************
1450 
1451  global => pregion%global
1452 
1453  CALL registerfunction(global,'RFLU_BuildC2CStencilBasic_1D',&
1454  'RFLU_ModStencilsCells.F90')
1455 
1456 ! ******************************************************************************
1457 ! Set grid pointer
1458 ! ******************************************************************************
1459 
1460  pgrid => pregion%grid
1461 
1462 ! ******************************************************************************
1463 ! Build basic stencil
1464 ! ******************************************************************************
1465 
1466  ict = rflu_getglobalcelltype(global,pgrid,icg)
1467  icl = pgrid%cellGlob2Loc(2,icg)
1468 
1469  IF ( ict /= cell_type_hex ) THEN
1470  CALL errorstop(global,err_reached_default,__line__)
1471  END IF ! ict
1472 
1473  IF ( icl /= icg ) THEN
1474 ! TEMPORARY
1475  CALL errorstop(global,err_reached_default,__line__)
1476 ! END TEMPORARY
1477  END IF ! icl
1478 
1479  rc(xcoord) = pgrid%cofg(xcoord,icg)
1480  rc(ycoord) = pgrid%cofg(ycoord,icg)
1481  rc(zcoord) = pgrid%cofg(zcoord,icg)
1482 
1483 ! ==============================================================================
1484 ! Build temporary list of cells which are vertex-neighbors of current cell and
1485 ! aligned with selected direction
1486 ! ==============================================================================
1487 
1488  ncells = 0
1489 
1490  DO ivl = 1,8
1491  ivg = pgrid%hex2v(ivl,icg)
1492 
1493  ncells = ncells + pgrid%v2cInfo(v2c_end,ivg) &
1494  - pgrid%v2cInfo(v2c_beg,ivg) &
1495  + 1
1496  END DO ! ivl
1497 
1498  ALLOCATE(icgtemp(ncells),stat=errorflag)
1499  global%error = errorflag
1500  IF ( global%error /= err_none ) THEN
1501  CALL errorstop(global,err_allocate,__line__,'icgTemp')
1502  END IF ! global%error
1503 
1504  ncells = 0
1505 
1506  DO ivl = 1,8
1507  ivg = pgrid%hex2v(ivl,icl)
1508 
1509  DO iv2c = pgrid%v2cInfo(v2c_beg,ivg),pgrid%v2cInfo(v2c_end,ivg)
1510  icg2 = pgrid%v2c(iv2c)
1511 
1512  dr(xcoord) = pgrid%cofg(xcoord,icg2) - rc(xcoord)
1513  dr(ycoord) = pgrid%cofg(ycoord,icg2) - rc(ycoord)
1514  dr(zcoord) = pgrid%cofg(zcoord,icg2) - rc(zcoord)
1515 
1516  IF ( rflu_testvectorcartaxisaligned(global,dr,dir) .EQV. .true. ) THEN
1517  ncells = ncells + 1
1518 
1519  icgtemp(ncells) = icg2
1520  END IF ! RFLU_TestVectorCartAxisAligned
1521  END DO ! iv2c
1522  END DO ! ivl
1523 
1524 ! ==============================================================================
1525 ! Sort temporary list and remove duplicates as well as current cell
1526 ! ==============================================================================
1527 
1528  CALL quicksortinteger(icgtemp(1:ncells),ncells)
1529  CALL simplifysortedintegers(icgtemp(1:ncells),ncells,ncells2)
1530  CALL binarysearchinteger(icgtemp(1:ncells2),ncells2,icg,iloc)
1531 
1532  IF ( iloc /= element_not_found ) THEN
1533  CALL removeinteger(icgtemp(1:ncells2),ncells2,iloc)
1534  ELSE
1535 ! TEMPORARY
1536  WRITE(*,*) 'ERROR! Cell icg not found in own stencil!'
1537  stop
1538 ! END TEMPORARY
1539  END IF ! iLoc
1540 
1541 ! ==============================================================================
1542 ! Store as basic stencil
1543 ! ==============================================================================
1544 
1545  degr = 0
1546 
1547  DO icl = ncells2,max(ncells2-stencilsizemax+1,1),-1
1548  degr = degr + 1
1549  c2cs1d(degr) = icgtemp(icl)
1550  END DO ! icl
1551 
1552  CALL quicksortinteger(c2cs1d(1:degr),degr)
1553 
1554 ! ==============================================================================
1555 ! Deallocate temporary lists
1556 ! ==============================================================================
1557 
1558  DEALLOCATE(icgtemp,stat=errorflag)
1559  global%error = errorflag
1560  IF ( global%error /= err_none ) THEN
1561  CALL errorstop(global,err_deallocate,__line__,'icgTemp')
1562  END IF ! global%error
1563 
1564 ! ******************************************************************************
1565 ! End
1566 ! ******************************************************************************
1567 
1568  CALL deregisterfunction(global)
1569 
1570  END SUBROUTINE rflu_buildc2cstencilbasic_1d
1571 
1572 
1573 
1574 
1575 
1576 
1577 
1578 
1579 ! *******************************************************************************
1580 !
1581 ! Purpose: Wrapper routine for building cell-to-cell stencils.
1582 !
1583 ! Description: None.
1584 !
1585 ! Input:
1586 ! pRegion Pointer to region
1587 ! icgInput Global cell index
1588 ! constrInput Flag indicating whether have constrained reconstruction
1589 !
1590 ! Output: None.
1591 !
1592 ! Notes: None.
1593 !
1594 ! ******************************************************************************
1595 
1596  SUBROUTINE rflu_buildc2cstencilwrapper(pRegion,icgInput,constrInput)
1597 
1598  IMPLICIT NONE
1599 
1600 ! ******************************************************************************
1601 ! Declarations and definitions
1602 ! ******************************************************************************
1603 
1604 ! ==============================================================================
1605 ! Arguments
1606 ! ==============================================================================
1607 
1608  INTEGER, INTENT(IN), OPTIONAL :: icginput,constrinput
1609  TYPE(t_region), POINTER :: pregion
1610 
1611 ! ==============================================================================
1612 ! Locals
1613 ! ==============================================================================
1614 
1615  LOGICAL :: addbfaces
1616  INTEGER :: icgbeg,icgend
1617  TYPE(t_grid), POINTER :: pgrid
1618  TYPE(t_global), POINTER :: global
1619 
1620 ! ******************************************************************************
1621 ! Start
1622 ! ******************************************************************************
1623 
1624  global => pregion%global
1625 
1626  CALL registerfunction(global,'RFLU_BuildC2CStencilWrapper',&
1627  'RFLU_ModStencilsCells.F90')
1628 
1629 ! ******************************************************************************
1630 ! Set pointers and variables
1631 ! ******************************************************************************
1632 
1633  pgrid => pregion%grid
1634 
1635  IF ( .NOT. present(icginput) ) THEN
1636  icgbeg = 1
1637  icgend = pgrid%nCellsTot
1638  ELSE
1639  icgbeg = icginput
1640  icgend = icginput
1641  END IF ! PRESENT
1642 
1643  IF ( .NOT. present(constrinput) ) THEN
1644  addbfaces = .true.
1645  ELSE
1646  IF ( constrinput == constr_none ) THEN
1647  addbfaces = .false.
1648  ELSE
1649  addbfaces = .true.
1650  END IF ! constrInput
1651  END IF ! PRESENT
1652 
1653 ! ******************************************************************************
1654 ! Call routines to build stencils
1655 ! ******************************************************************************
1656 
1657  SELECT CASE ( pregion%mixtInput%stencilDimensCells )
1658  CASE ( 1 )
1659  CALL rflu_buildc2cstencil_1d_g(pregion,xcoord,icgbeg,icgend)
1660 
1661  IF ( pregion%mixtInput%dimens > 1 ) THEN
1662  CALL rflu_buildc2cstencil_1d_g(pregion,ycoord,icgbeg,icgend)
1663 
1664  IF ( pregion%mixtInput%dimens > 2 ) THEN
1665  CALL rflu_buildc2cstencil_1d_g(pregion,zcoord,icgbeg,icgend)
1666  END IF ! pRegion%mixtInput%dimens
1667  END IF ! pRegion%mixtInput%dimens
1668  CASE ( 2,3 )
1669  CALL rflu_buildc2cstencil(pregion,icgbeg,icgend,addbfaces)
1670  CASE default
1671  CALL errorstop(global,err_reached_default,__line__)
1672  END SELECT ! pRegion%mixtInput%stencilDimensCells
1673 
1674 ! ******************************************************************************
1675 ! End
1676 ! ******************************************************************************
1677 
1678  CALL deregisterfunction(global)
1679 
1680  END SUBROUTINE rflu_buildc2cstencilwrapper
1681 
1682 
1683 
1684 
1685 
1686 
1687 
1688 ! *******************************************************************************
1689 !
1690 ! Purpose: Build list of cell-to-cell stencils which are constrained.
1691 !
1692 ! Description: None.
1693 !
1694 ! Input:
1695 ! pRegion Pointer to region
1696 !
1697 ! Output: None.
1698 !
1699 ! Notes: None.
1700 !
1701 ! ******************************************************************************
1702 
1703  SUBROUTINE rflu_buildlistcc2cstencil(pRegion)
1704 
1705  IMPLICIT NONE
1706 
1707 ! ******************************************************************************
1708 ! Declarations and definitions
1709 ! ******************************************************************************
1710 
1711 ! ==============================================================================
1712 ! Arguments
1713 ! ==============================================================================
1714 
1715  TYPE(t_region), POINTER :: pregion
1716 
1717 ! ==============================================================================
1718 ! Locals
1719 ! ==============================================================================
1720 
1721  INTEGER :: errorflag,icg
1722  TYPE(t_grid), POINTER :: pgrid
1723  TYPE(t_global), POINTER :: global
1724 
1725 ! ******************************************************************************
1726 ! Start
1727 ! ******************************************************************************
1728 
1729  global => pregion%global
1730 
1731  CALL registerfunction(global,'RFLU_BuildListCC2CStencil',&
1732  'RFLU_ModStencilsCells.F90')
1733 
1734  IF ( global%myProcid == masterproc .AND. &
1735  global%verbLevel > verbose_none ) THEN
1736  WRITE(stdout,'(A,1X,A,A)') solver_name,'Building list of constrained ', &
1737  'cell-to-cell stencil...'
1738  END IF ! global%verbLevel
1739 
1740 ! ******************************************************************************
1741 ! Set grid pointer
1742 ! ******************************************************************************
1743 
1744  pgrid => pregion%grid
1745 
1746 ! ******************************************************************************
1747 ! Count and build list of constrained cell-to-cell stencils
1748 ! ******************************************************************************
1749 
1750  pgrid%nCellsConstr = 0
1751 
1752  IF ( pregion%mixtInput%cReconstCells > constr_none ) THEN
1753  DO icg = 1,pgrid%nCellsTot
1754  IF ( pgrid%c2cs(icg)%nBFaceMembs > 0 ) THEN
1755  pgrid%nCellsConstr = pgrid%nCellsConstr + 1
1756  END IF ! pGrid%c2cs(icg)%nBFaceMembs
1757  END DO ! icg
1758 
1759  IF ( pgrid%nCellsConstr > 0 ) THEN
1760  ALLOCATE(pgrid%icgConstr(pgrid%nCellsConstr),stat=errorflag)
1761  global%error = errorflag
1762  IF ( global%error /= err_none ) THEN
1763  CALL errorstop(global,err_allocate,__line__,'pGrid%icgConstr')
1764  END IF ! global%error
1765 
1766  pgrid%nCellsConstr = 0
1767 
1768  DO icg = 1,pgrid%nCellsTot
1769  IF ( pgrid%c2cs(icg)%nBFaceMembs > 0 ) THEN
1770  pgrid%nCellsConstr = pgrid%nCellsConstr + 1
1771 
1772  pgrid%icgConstr(pgrid%nCellsConstr) = icg
1773  END IF ! pGrid%c2cs(icg)%nBFaceMembs
1774  END DO ! icg
1775  ELSE
1776  nullify(pgrid%icgConstr)
1777  END IF ! pGrid%nCellsConstr
1778  ELSE
1779  nullify(pgrid%icgConstr)
1780  END IF ! pRegion%mixtInput%cReconstCells
1781 
1782 ! ******************************************************************************
1783 ! Print info
1784 ! ******************************************************************************
1785 
1786  IF ( global%myProcid == masterproc .AND. &
1787  global%verbLevel > verbose_low ) THEN
1788  WRITE(stdout,'(A,3X,A,A,1X,I5)') solver_name,'Number of constrained ', &
1789  'cell-to-cell stencils:', &
1790  pgrid%nCellsConstr
1791  END IF ! global%verbLevel
1792 
1793 ! ******************************************************************************
1794 ! End
1795 ! ******************************************************************************
1796 
1797  IF ( global%myProcid == masterproc .AND. &
1798  global%verbLevel > verbose_none ) THEN
1799  WRITE(stdout,'(A,1X,A,A)') solver_name,'Building list of constrained ', &
1800  'cell-to-cell stencil done.'
1801  END IF ! global%verbLevel
1802 
1803  CALL deregisterfunction(global)
1804 
1805  END SUBROUTINE rflu_buildlistcc2cstencil
1806 
1807 
1808 
1809 
1810 
1811 
1812 
1813 ! *******************************************************************************
1814 !
1815 ! Purpose: Create 1D cell-to-cell stencil.
1816 !
1817 ! Description: None.
1818 !
1819 ! Input:
1820 ! pRegion Pointer to region
1821 !
1822 ! Output: None.
1823 !
1824 ! Notes: None.
1825 !
1826 ! ******************************************************************************
1827 
1828  SUBROUTINE rflu_createc2cstencil_1d(pRegion)
1829 
1830  IMPLICIT NONE
1831 
1832 ! ******************************************************************************
1833 ! Declarations and definitions
1834 ! ******************************************************************************
1835 
1836 ! ==============================================================================
1837 ! Arguments
1838 ! ==============================================================================
1839 
1840  TYPE(t_region), POINTER :: pregion
1841 
1842 ! ==============================================================================
1843 ! Locals
1844 ! ==============================================================================
1845 
1846  INTEGER :: errorflag,fndir,fndirend,icg
1847  TYPE(t_grid), POINTER :: pgrid
1848  TYPE(t_global), POINTER :: global
1849 
1850 ! ******************************************************************************
1851 ! Start
1852 ! ******************************************************************************
1853 
1854  global => pregion%global
1855 
1856  CALL registerfunction(global,'RFLU_CreateC2CStencil_1D',&
1857  'RFLU_ModStencilsCells.F90')
1858 
1859  IF ( global%myProcid == masterproc .AND. &
1860  global%verbLevel > verbose_none ) THEN
1861  WRITE(stdout,'(A,1X,A)') solver_name,'Creating 1D cell-to-cell stencil...'
1862  END IF ! global%myProcid
1863 
1864 ! ******************************************************************************
1865 ! Nullify memory
1866 ! ******************************************************************************
1867 
1868  CALL rflu_nullifyc2cstencil_1d(pregion)
1869 
1870 ! ******************************************************************************
1871 ! Set grid pointer
1872 ! ******************************************************************************
1873 
1874  pgrid => pregion%grid
1875 
1876 ! ******************************************************************************
1877 ! Allocate memory and initialize
1878 ! ******************************************************************************
1879 
1880  SELECT CASE ( pregion%mixtInput%dimens )
1881  CASE ( 1 )
1882  fndirend = 1
1883  CASE ( 2 )
1884  fndirend = 2
1885  CASE ( 3 )
1886  fndirend = 3
1887  CASE default
1888  CALL errorstop(global,err_reached_default,__line__)
1889  END SELECT ! pRegion%mixtInput%dimens
1890 
1891  ALLOCATE(pgrid%c2cs1D(xcoord:fndirend,pgrid%nCellsTot),stat=errorflag)
1892  global%error = errorflag
1893  IF ( global%error /= err_none ) THEN
1894  CALL errorstop(global,err_allocate,__line__,'pGrid%c2cs1D')
1895  END IF ! global%error
1896 
1897  DO fndir = xcoord,fndirend
1898  DO icg = 1,pgrid%nCellsTot
1899  pgrid%c2cs1D(fndir,icg)%nCellMembs = 0
1900  pgrid%c2cs1D(fndir,icg)%nBFaceMembs = 0
1901  END DO ! icg
1902  END DO ! fnDir
1903 
1904 ! ******************************************************************************
1905 ! End
1906 ! ******************************************************************************
1907 
1908  IF ( global%myProcid == masterproc .AND. &
1909  global%verbLevel > verbose_none ) THEN
1910  WRITE(stdout,'(A,1X,A)') solver_name, &
1911  'Creating 1D cell-to-cell stencil done.'
1912  END IF ! global%myProcid
1913 
1914  CALL deregisterfunction(global)
1915 
1916  END SUBROUTINE rflu_createc2cstencil_1d
1917 
1918 
1919 
1920 
1921 
1922 
1923 
1924 ! *******************************************************************************
1925 !
1926 ! Purpose: Create cell-to-cell stencil.
1927 !
1928 ! Description: None.
1929 !
1930 ! Input:
1931 ! pRegion Pointer to region
1932 !
1933 ! Output: None.
1934 !
1935 ! Notes: None.
1936 !
1937 ! ******************************************************************************
1938 
1939  SUBROUTINE rflu_createc2cstencil(pRegion)
1940 
1941  IMPLICIT NONE
1942 
1943 ! ******************************************************************************
1944 ! Declarations and definitions
1945 ! ******************************************************************************
1946 
1947 ! ==============================================================================
1948 ! Arguments
1949 ! ==============================================================================
1950 
1951  TYPE(t_region), POINTER :: pregion
1952 
1953 ! ==============================================================================
1954 ! Locals
1955 ! ==============================================================================
1956 
1957  INTEGER :: errorflag,icg
1958  TYPE(t_grid), POINTER :: pgrid
1959  TYPE(t_global), POINTER :: global
1960 
1961 ! ******************************************************************************
1962 ! Start
1963 ! ******************************************************************************
1964 
1965  global => pregion%global
1966 
1967  CALL registerfunction(global,'RFLU_CreateC2CStencil',&
1968  'RFLU_ModStencilsCells.F90')
1969 
1970  IF ( global%myProcid == masterproc .AND. &
1971  global%verbLevel > verbose_none ) THEN
1972  WRITE(stdout,'(A,1X,A)') solver_name,'Creating cell-to-cell stencil...'
1973  END IF ! global%verbLevel
1974 
1975 ! ******************************************************************************
1976 ! Nullify memory
1977 ! ******************************************************************************
1978 
1979  CALL rflu_nullifyc2cstencil(pregion)
1980 
1981 ! ******************************************************************************
1982 ! Set grid pointer
1983 ! ******************************************************************************
1984 
1985  pgrid => pregion%grid
1986 
1987 ! ******************************************************************************
1988 ! Allocate memory and initialize
1989 ! ******************************************************************************
1990 
1991  ALLOCATE(pgrid%c2cs(pgrid%nCellsTot),stat=errorflag)
1992  global%error = errorflag
1993  IF ( global%error /= err_none ) THEN
1994  CALL errorstop(global,err_allocate,__line__,'pGrid%c2cs')
1995  END IF ! global%error
1996 
1997  DO icg = 1,pgrid%nCellsTot
1998  pgrid%c2cs(icg)%nCellMembs = 0
1999  pgrid%c2cs(icg)%nBFaceMembs = 0
2000  END DO ! icg
2001 
2002 ! ******************************************************************************
2003 ! End
2004 ! ******************************************************************************
2005 
2006  IF ( global%myProcid == masterproc .AND. &
2007  global%verbLevel > verbose_none ) THEN
2008  WRITE(stdout,'(A,1X,A)') solver_name, &
2009  'Creating cell-to-cell stencil done.'
2010  END IF ! global%verbLevel
2011 
2012  CALL deregisterfunction(global)
2013 
2014  END SUBROUTINE rflu_createc2cstencil
2015 
2016 
2017 
2018 
2019 
2020 
2021 ! *******************************************************************************
2022 !
2023 ! Purpose: Wrapper routine for creating cell-to-cell stencils.
2024 !
2025 ! Description: None.
2026 !
2027 ! Input:
2028 ! pRegion Pointer to region
2029 !
2030 ! Output: None.
2031 !
2032 ! Notes: None.
2033 !
2034 ! ******************************************************************************
2035 
2036  SUBROUTINE rflu_createc2cstencilwrapper(pRegion)
2037 
2038  IMPLICIT NONE
2039 
2040 ! ******************************************************************************
2041 ! Declarations and definitions
2042 ! ******************************************************************************
2043 
2044 ! ==============================================================================
2045 ! Arguments
2046 ! ==============================================================================
2047 
2048  TYPE(t_region), POINTER :: pregion
2049 
2050 ! ==============================================================================
2051 ! Locals
2052 ! ==============================================================================
2053 
2054  TYPE(t_global), POINTER :: global
2055 
2056 ! ******************************************************************************
2057 ! Start
2058 ! ******************************************************************************
2059 
2060  global => pregion%global
2061 
2062  CALL registerfunction(global,'RFLU_CreateC2CStencilWrapper',&
2063  'RFLU_ModStencilsCells.F90')
2064 
2065 ! ******************************************************************************
2066 ! Call routines to create stencils
2067 ! ******************************************************************************
2068 
2069  SELECT CASE ( pregion%mixtInput%stencilDimensCells )
2070  CASE ( 1 )
2071  CALL rflu_createc2cstencil_1d(pregion)
2072  CASE ( 2,3 )
2073  CALL rflu_createc2cstencil(pregion)
2074  CASE default
2075  CALL errorstop(global,err_reached_default,__line__)
2076  END SELECT ! pRegion%mixtInput%stencilDimensCells
2077 
2078 ! ******************************************************************************
2079 ! End
2080 ! ******************************************************************************
2081 
2082  CALL deregisterfunction(global)
2083 
2084  END SUBROUTINE rflu_createc2cstencilwrapper
2085 
2086 
2087 
2088 
2089 
2090 
2091 
2092 
2093 ! *******************************************************************************
2094 !
2095 ! Purpose: Destroy 1D cell-to-cell stencil.
2096 !
2097 ! Description: None.
2098 !
2099 ! Input:
2100 ! pRegion Pointer to region
2101 !
2102 ! Output: None.
2103 !
2104 ! Notes: None.
2105 !
2106 ! ******************************************************************************
2107 
2108  SUBROUTINE rflu_destroyc2cstencil_1d(pRegion)
2109 
2110  IMPLICIT NONE
2111 
2112 ! ******************************************************************************
2113 ! Declarations and definitions
2114 ! ******************************************************************************
2115 
2116 ! ==============================================================================
2117 ! Arguments
2118 ! ==============================================================================
2119 
2120  TYPE(t_region), POINTER :: pregion
2121 
2122 ! ==============================================================================
2123 ! Locals
2124 ! ==============================================================================
2125 
2126  INTEGER :: errorflag,fndir,fndirend,icg
2127  TYPE(t_grid), POINTER :: pgrid
2128  TYPE(t_global), POINTER :: global
2129 
2130 ! ******************************************************************************
2131 ! Start
2132 ! ******************************************************************************
2133 
2134  global => pregion%global
2135 
2136  CALL registerfunction(global,'RFLU_DestroyC2CStencil_1D',&
2137  'RFLU_ModStencilsCells.F90')
2138 
2139  IF ( global%myProcid == masterproc .AND. &
2140  global%verbLevel > verbose_none ) THEN
2141  WRITE(stdout,'(A,1X,A)') solver_name, &
2142  'Destroying 1D cell-to-cell stencil...'
2143  END IF ! global%verbLevel
2144 
2145 ! ******************************************************************************
2146 ! Set grid pointer
2147 ! ******************************************************************************
2148 
2149  pgrid => pregion%grid
2150 
2151 ! ******************************************************************************
2152 ! Deallocate memory
2153 ! ******************************************************************************
2154 
2155  SELECT CASE ( pregion%mixtInput%dimens )
2156  CASE ( 1 )
2157  fndirend = 1
2158  CASE ( 2 )
2159  fndirend = 2
2160  CASE ( 3 )
2161  fndirend = 3
2162  CASE default
2163  CALL errorstop(global,err_reached_default,__line__)
2164  END SELECT ! pRegion%mixtInput%dimens
2165 
2166  DO fndir = xcoord,fndirend
2167  DO icg = 1,pgrid%nCellsTot
2168  IF ( pgrid%c2cs1D(fndir,icg)%nCellMembs > 0 ) THEN
2169  DEALLOCATE(pgrid%c2cs1D(fndir,icg)%cellMembs,stat=errorflag)
2170  global%error = errorflag
2171  IF ( global%error /= err_none ) THEN
2172  CALL errorstop(global,err_deallocate,__line__, &
2173  'pGrid%c2cs1D%cellMembs')
2174  END IF ! global%error
2175 
2176  pgrid%c2cs1D(fndir,icg)%nCellMembs = 0
2177  END IF ! pGrid%c2cs1D%nCellMembs
2178 
2179  IF ( pgrid%c2cs1D(fndir,icg)%nBFaceMembs > 0 ) THEN
2180  DEALLOCATE(pgrid%c2cs1D(fndir,icg)%bFaceMembs,stat=errorflag)
2181  global%error = errorflag
2182  IF ( global%error /= err_none ) THEN
2183  CALL errorstop(global,err_deallocate,__line__, &
2184  'pGrid%c2cs1D%bFaceMembs')
2185  END IF ! global%error
2186 
2187  pgrid%c2cs1D(fndir,icg)%nBFaceMembs = 0
2188  END IF ! pGrid%c2cs1D%nBFaceMembs
2189  END DO ! icg
2190  END DO ! fnDir
2191 
2192  DEALLOCATE(pgrid%c2cs1D,stat=errorflag)
2193  global%error = errorflag
2194  IF ( global%error /= err_none ) THEN
2195  CALL errorstop(global,err_deallocate,__line__,'pGrid%c2cs1D')
2196  END IF ! global%error
2197 
2198 ! ******************************************************************************
2199 ! Nullify memory
2200 ! ******************************************************************************
2201 
2202  CALL rflu_nullifyc2cstencil_1d(pregion)
2203 
2204 ! ******************************************************************************
2205 ! End
2206 ! ******************************************************************************
2207 
2208  IF ( global%myProcid == masterproc .AND. &
2209  global%verbLevel > verbose_none ) THEN
2210  WRITE(stdout,'(A,1X,A)') solver_name, &
2211  'Destroying 1D cell-to-cell stencil done.'
2212  END IF ! global%verbLevel
2213 
2214  CALL deregisterfunction(global)
2215 
2216  END SUBROUTINE rflu_destroyc2cstencil_1d
2217 
2218 
2219 
2220 
2221 
2222 
2223 
2224 
2225 ! *******************************************************************************
2226 !
2227 ! Purpose: Destroy cell-to-cell stencil.
2228 !
2229 ! Description: None.
2230 !
2231 ! Input:
2232 ! pRegion Pointer to region
2233 !
2234 ! Output: None.
2235 !
2236 ! Notes: None.
2237 !
2238 ! ******************************************************************************
2239 
2240  SUBROUTINE rflu_destroyc2cstencil(pRegion)
2241 
2242  IMPLICIT NONE
2243 
2244 ! ******************************************************************************
2245 ! Declarations and definitions
2246 ! ******************************************************************************
2247 
2248 ! ==============================================================================
2249 ! Arguments
2250 ! ==============================================================================
2251 
2252  TYPE(t_region), POINTER :: pregion
2253 
2254 ! ==============================================================================
2255 ! Locals
2256 ! ==============================================================================
2257 
2258  INTEGER :: errorflag,icg
2259  TYPE(t_grid), POINTER :: pgrid
2260  TYPE(t_global), POINTER :: global
2261 
2262 ! ******************************************************************************
2263 ! Start
2264 ! ******************************************************************************
2265 
2266  global => pregion%global
2267 
2268  CALL registerfunction(global,'RFLU_DestroyC2CStencil',&
2269  'RFLU_ModStencilsCells.F90')
2270 
2271  IF ( global%myProcid == masterproc .AND. &
2272  global%verbLevel > verbose_none ) THEN
2273  WRITE(stdout,'(A,1X,A)') solver_name, &
2274  'Destroying cell-to-cell stencil...'
2275  END IF ! global%verbLevel
2276 
2277 ! ******************************************************************************
2278 ! Set grid pointer
2279 ! ******************************************************************************
2280 
2281  pgrid => pregion%grid
2282 
2283 ! ******************************************************************************
2284 ! Deallocate memory
2285 ! ******************************************************************************
2286 
2287  DO icg = 1,pgrid%nCellsTot
2288  IF ( pgrid%c2cs(icg)%nCellMembs > 0 ) THEN
2289  DEALLOCATE(pgrid%c2cs(icg)%cellMembs,stat=errorflag)
2290  global%error = errorflag
2291  IF ( global%error /= err_none ) THEN
2292  CALL errorstop(global,err_deallocate,__line__,'pGrid%c2cs%cellMembs')
2293  END IF ! global%error
2294 
2295  pgrid%c2cs(icg)%nCellMembs = 0
2296  END IF ! pGrid%c2cs%nCellMembs
2297 
2298  IF ( pgrid%c2cs(icg)%nBFaceMembs > 0 ) THEN
2299  DEALLOCATE(pgrid%c2cs(icg)%bFaceMembs,stat=errorflag)
2300  global%error = errorflag
2301  IF ( global%error /= err_none ) THEN
2302  CALL errorstop(global,err_deallocate,__line__,'pGrid%c2cs%bFaceMembs')
2303  END IF ! global%error
2304 
2305  pgrid%c2cs(icg)%nBFaceMembs = 0
2306  END IF ! pGrid%c2cs%nBFaceMembs
2307  END DO ! icg
2308 
2309  DEALLOCATE(pgrid%c2cs,stat=errorflag)
2310  global%error = errorflag
2311  IF ( global%error /= err_none ) THEN
2312  CALL errorstop(global,err_deallocate,__line__,'pGrid%c2cs')
2313  END IF ! global%error
2314 
2315 ! ******************************************************************************
2316 ! Nullify memory
2317 ! ******************************************************************************
2318 
2319  CALL rflu_nullifyc2cstencil(pregion)
2320 
2321 ! ******************************************************************************
2322 ! End
2323 ! ******************************************************************************
2324 
2325  IF ( global%myProcid == masterproc .AND. &
2326  global%verbLevel > verbose_none ) THEN
2327  WRITE(stdout,'(A,1X,A)') solver_name, &
2328  'Destroying cell-to-cell stencil done.'
2329  END IF ! global%verbLevel
2330 
2331  CALL deregisterfunction(global)
2332 
2333  END SUBROUTINE rflu_destroyc2cstencil
2334 
2335 
2336 
2337 
2338 
2339 
2340 
2341 ! *******************************************************************************
2342 !
2343 ! Purpose: Wrapper routine for destroying cell-to-cell stencils.
2344 !
2345 ! Description: None.
2346 !
2347 ! Input:
2348 ! pRegion Pointer to region
2349 !
2350 ! Output: None.
2351 !
2352 ! Notes: None.
2353 !
2354 ! ******************************************************************************
2355 
2356  SUBROUTINE rflu_destroyc2cstencilwrapper(pRegion)
2357 
2358  IMPLICIT NONE
2359 
2360 ! ******************************************************************************
2361 ! Declarations and definitions
2362 ! ******************************************************************************
2363 
2364 ! ==============================================================================
2365 ! Arguments
2366 ! ==============================================================================
2367 
2368  TYPE(t_region), POINTER :: pregion
2369 
2370 ! ==============================================================================
2371 ! Locals
2372 ! ==============================================================================
2373 
2374  TYPE(t_global), POINTER :: global
2375 
2376 ! ******************************************************************************
2377 ! Start
2378 ! ******************************************************************************
2379 
2380  global => pregion%global
2381 
2382  CALL registerfunction(global,'RFLU_DestroyC2CStencilWrapper',&
2383  'RFLU_ModStencilsCells.F90')
2384 
2385 ! ******************************************************************************
2386 ! Call routines to destroy stencils
2387 ! ******************************************************************************
2388 
2389  SELECT CASE ( pregion%mixtInput%stencilDimensCells )
2390  CASE ( 1 )
2391  CALL rflu_destroyc2cstencil_1d(pregion)
2392  CASE ( 2,3 )
2393  CALL rflu_destroyc2cstencil(pregion)
2394  CASE default
2395  CALL errorstop(global,err_reached_default,__line__)
2396  END SELECT ! pRegion%mixtInput%stencilDimensCells
2397 
2398 ! ******************************************************************************
2399 ! End
2400 ! ******************************************************************************
2401 
2402  CALL deregisterfunction(global)
2403 
2404  END SUBROUTINE rflu_destroyc2cstencilwrapper
2405 
2406 
2407 
2408 
2409 
2410 
2411 
2412 ! *******************************************************************************
2413 !
2414 ! Purpose: Destroy list of cell-to-cell stencils which are constrained.
2415 !
2416 ! Description: None.
2417 !
2418 ! Input:
2419 ! pRegion Pointer to region
2420 !
2421 ! Output: None.
2422 !
2423 ! Notes: None.
2424 !
2425 ! ******************************************************************************
2426 
2427  SUBROUTINE rflu_destroylistcc2cstencil(pRegion)
2428 
2429  IMPLICIT NONE
2430 
2431 ! ******************************************************************************
2432 ! Declarations and definitions
2433 ! ******************************************************************************
2434 
2435 ! ==============================================================================
2436 ! Arguments
2437 ! ==============================================================================
2438 
2439  TYPE(t_region), POINTER :: pregion
2440 
2441 ! ==============================================================================
2442 ! Locals
2443 ! ==============================================================================
2444 
2445  INTEGER :: errorflag
2446  TYPE(t_grid), POINTER :: pgrid
2447  TYPE(t_global), POINTER :: global
2448 
2449 ! ******************************************************************************
2450 ! Start
2451 ! ******************************************************************************
2452 
2453  global => pregion%global
2454 
2455  CALL registerfunction(global,'RFLU_DestroyListCC2CStencil',&
2456  'RFLU_ModStencilsCells.F90')
2457 
2458  IF ( global%myProcid == masterproc .AND. &
2459  global%verbLevel > verbose_none ) THEN
2460  WRITE(stdout,'(A,1X,A,A)') solver_name,'Destroying list of ', &
2461  'constrained cell-to-cell stencil...'
2462  END IF ! global%verbLevel
2463 
2464 ! ******************************************************************************
2465 ! Set grid pointer
2466 ! ******************************************************************************
2467 
2468  pgrid => pregion%grid
2469 
2470 ! ******************************************************************************
2471 ! Destroy list of constrained cell-to-cell stencils
2472 ! ******************************************************************************
2473 
2474  IF ( pregion%mixtInput%cReconstCells > constr_none ) THEN
2475  IF ( pgrid%nCellsConstr > 0 ) THEN
2476  DEALLOCATE(pgrid%icgConstr,stat=errorflag)
2477  global%error = errorflag
2478  IF ( global%error /= err_none ) THEN
2479  CALL errorstop(global,err_deallocate,__line__,'pGrid%icgConstr')
2480  END IF ! global%error
2481 
2482  pgrid%nCellsConstr = 0
2483  END IF ! pGrid%nCellsConstr
2484  END IF ! pRegion%mixtInput%cReconstCells
2485 
2486 ! ******************************************************************************
2487 ! End
2488 ! ******************************************************************************
2489 
2490  IF ( global%myProcid == masterproc .AND. &
2491  global%verbLevel > verbose_none ) THEN
2492  WRITE(stdout,'(A,1X,A,A)') solver_name,'Destroying list of ', &
2493  'constrained cell-to-cell stencil done.'
2494  END IF ! global%verbLevel
2495 
2496  CALL deregisterfunction(global)
2497 
2498  END SUBROUTINE rflu_destroylistcc2cstencil
2499 
2500 
2501 
2502 
2503 
2504 
2505 ! *******************************************************************************
2506 !
2507 ! Purpose: Nullify 1D cell-to-cell stencil.
2508 !
2509 ! Description: None.
2510 !
2511 ! Input:
2512 ! pRegion Pointer to region
2513 !
2514 ! Output: None.
2515 !
2516 ! Notes: None.
2517 !
2518 ! ******************************************************************************
2519 
2520  SUBROUTINE rflu_nullifyc2cstencil_1d(pRegion)
2521 
2522  IMPLICIT NONE
2523 
2524 ! ******************************************************************************
2525 ! Declarations and definitions
2526 ! ******************************************************************************
2527 
2528 ! ==============================================================================
2529 ! Arguments
2530 ! ==============================================================================
2531 
2532  TYPE(t_region), POINTER :: pregion
2533 
2534 ! ==============================================================================
2535 ! Locals
2536 ! ==============================================================================
2537 
2538  TYPE(t_grid), POINTER :: pgrid
2539  TYPE(t_global), POINTER :: global
2540 
2541 ! ******************************************************************************
2542 ! Start
2543 ! ******************************************************************************
2544 
2545  global => pregion%global
2546 
2547  CALL registerfunction(global,'RFLU_NullifyC2CStencil_1D',&
2548  'RFLU_ModStencilsCells.F90')
2549 
2550  IF ( global%myProcid == masterproc .AND. &
2551  global%verbLevel > verbose_none ) THEN
2552  WRITE(stdout,'(A,1X,A)') solver_name, &
2553  'Nullifying 1D cell-to-cell stencil...'
2554  END IF ! global%verbLevel
2555 
2556 ! ******************************************************************************
2557 ! Set grid pointer
2558 ! ******************************************************************************
2559 
2560  pgrid => pregion%grid
2561 
2562 ! ******************************************************************************
2563 ! Nullify memory
2564 ! ******************************************************************************
2565 
2566  nullify(pgrid%c2cs1D)
2567 
2568 ! ******************************************************************************
2569 ! End
2570 ! ******************************************************************************
2571 
2572  IF ( global%myProcid == masterproc .AND. &
2573  global%verbLevel > verbose_none ) THEN
2574  WRITE(stdout,'(A,1X,A)') solver_name, &
2575  'Nullifying 1D cell-to-cell stencil done.'
2576  END IF ! global%verbLevel
2577 
2578  CALL deregisterfunction(global)
2579 
2580  END SUBROUTINE rflu_nullifyc2cstencil_1d
2581 
2582 
2583 
2584 
2585 
2586 
2587 
2588 
2589 ! *******************************************************************************
2590 !
2591 ! Purpose: Nullify cell-to-cell stencil.
2592 !
2593 ! Description: None.
2594 !
2595 ! Input:
2596 ! pRegion Pointer to region
2597 !
2598 ! Output: None.
2599 !
2600 ! Notes: None.
2601 !
2602 ! ******************************************************************************
2603 
2604  SUBROUTINE rflu_nullifyc2cstencil(pRegion)
2605 
2606  IMPLICIT NONE
2607 
2608 ! ******************************************************************************
2609 ! Declarations and definitions
2610 ! ******************************************************************************
2611 
2612 ! ==============================================================================
2613 ! Arguments
2614 ! ==============================================================================
2615 
2616  TYPE(t_region), POINTER :: pregion
2617 
2618 ! ==============================================================================
2619 ! Locals
2620 ! ==============================================================================
2621 
2622  TYPE(t_grid), POINTER :: pgrid
2623  TYPE(t_global), POINTER :: global
2624 
2625 ! ******************************************************************************
2626 ! Start
2627 ! ******************************************************************************
2628 
2629  global => pregion%global
2630 
2631  CALL registerfunction(global,'RFLU_NullifyC2CStencil',&
2632  'RFLU_ModStencilsCells.F90')
2633 
2634  IF ( global%myProcid == masterproc .AND. &
2635  global%verbLevel > verbose_none ) THEN
2636  WRITE(stdout,'(A,1X,A)') solver_name, &
2637  'Nullifying cell-to-cell stencil...'
2638  END IF ! global%verbLevel
2639 
2640 ! ******************************************************************************
2641 ! Set grid pointer
2642 ! ******************************************************************************
2643 
2644  pgrid => pregion%grid
2645 
2646 ! ******************************************************************************
2647 ! Nullify memory
2648 ! ******************************************************************************
2649 
2650  nullify(pgrid%c2cs)
2651 
2652 ! ******************************************************************************
2653 ! End
2654 ! ******************************************************************************
2655 
2656  IF ( global%myProcid == masterproc .AND. &
2657  global%verbLevel > verbose_none ) THEN
2658  WRITE(stdout,'(A,1X,A)') solver_name, &
2659  'Nullifying cell-to-cell stencil done.'
2660  END IF ! global%verbLevel
2661 
2662  CALL deregisterfunction(global)
2663 
2664  END SUBROUTINE rflu_nullifyc2cstencil
2665 
2666 
2667 
2668 
2669 
2670 
2671 
2672 ! *******************************************************************************
2673 !
2674 ! Purpose: Set 1D cell-to-cell stencil information.
2675 !
2676 ! Description: None.
2677 !
2678 ! Input:
2679 ! pRegion Pointer to region
2680 ! orderNominal Nominal order of accuracy
2681 !
2682 ! Output: None.
2683 !
2684 ! Notes:
2685 ! 1. VERY IMPORTANT: orderNominal is the polynomial order, i.e., the order
2686 ! of the polynomial which is represented exactly. So orderNominal=1 really
2687 ! means a second-order accurate representation.
2688 !
2689 ! ******************************************************************************
2690 
2691  SUBROUTINE rflu_setinfoc2cstencil_1d(pRegion,orderNominal)
2692 
2693  IMPLICIT NONE
2694 
2695 ! ******************************************************************************
2696 ! Declarations and definitions
2697 ! ******************************************************************************
2698 
2699 ! ==============================================================================
2700 ! Arguments
2701 ! ==============================================================================
2702 
2703  INTEGER, INTENT(IN) :: ordernominal
2704  TYPE(t_region), POINTER :: pregion
2705 
2706 ! ==============================================================================
2707 ! Locals
2708 ! ==============================================================================
2709 
2710  INTEGER :: nbfacemembsmax,nlayersmax,stencilsizemax,stencilsizemin
2711  TYPE(t_grid), POINTER :: pgrid
2712  TYPE(t_global), POINTER :: global
2713 
2714 ! ******************************************************************************
2715 ! Start
2716 ! ******************************************************************************
2717 
2718  global => pregion%global
2719 
2720  CALL registerfunction(global,'RFLU_SetInfoC2CStencil_1D',&
2721  'RFLU_ModStencilsCells.F90')
2722 
2723  IF ( global%myProcid == masterproc .AND. &
2724  global%verbLevel > verbose_none ) THEN
2725  WRITE(stdout,'(A,1X,A)') solver_name, &
2726  'Setting 1D cell-to-cell stencil information...'
2727  END IF ! global%verbLevel
2728 
2729 ! ******************************************************************************
2730 ! Set grid pointer
2731 ! ******************************************************************************
2732 
2733  pgrid => pregion%grid
2734 
2735 ! ******************************************************************************
2736 ! Set stencil information
2737 ! ******************************************************************************
2738 
2739  nlayersmax = ordernominal+1
2740  nbfacemembsmax = 0 ! TEMPORARY
2741  stencilsizemin = ordernominal+1 ! No difference between min and max value
2742  stencilsizemax = ordernominal+1
2743 
2744  pgrid%c2csInfo%orderNominal = ordernominal
2745  pgrid%c2csInfo%nLayersMax = nlayersmax
2746  pgrid%c2csInfo%nBFaceMembsMax = nbfacemembsmax
2747  pgrid%c2csInfo%nCellMembsMax = stencilsizemax
2748  pgrid%c2csInfo%nCellMembsMin = stencilsizemin
2749 
2750 ! ******************************************************************************
2751 ! Print stencil information
2752 ! ******************************************************************************
2753 
2754  IF ( global%myProcid == masterproc .AND. &
2755  global%verbLevel > verbose_low ) THEN
2756  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name, &
2757  'Maximum allowed number of cell layers in 1D stencil: ', &
2758  nlayersmax
2759  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name, &
2760  'Minimum required number of cell members in 1D stencil:', &
2761  stencilsizemin
2762  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name, &
2763  'Maximum allowed number of cell members in 1D stencil: ', &
2764  stencilsizemax
2765  END IF ! global%myProcid
2766 
2767 ! ******************************************************************************
2768 ! End
2769 ! ******************************************************************************
2770 
2771  IF ( global%myProcid == masterproc .AND. &
2772  global%verbLevel > verbose_none ) THEN
2773  WRITE(stdout,'(A,1X,A)') solver_name, &
2774  'Setting 1D cell-to-cell stencil information done.'
2775  END IF ! global%verbLevel
2776 
2777  CALL deregisterfunction(global)
2778 
2779  END SUBROUTINE rflu_setinfoc2cstencil_1d
2780 
2781 
2782 
2783 
2784 
2785 
2786 
2787 ! *******************************************************************************
2788 !
2789 ! Purpose: Set cell-to-cell stencil information.
2790 !
2791 ! Description: None.
2792 !
2793 ! Input:
2794 ! pRegion Pointer to region
2795 ! orderNominal Nominal order of accuracy
2796 !
2797 ! Output: None.
2798 !
2799 ! Notes: None.
2800 !
2801 ! ******************************************************************************
2802 
2803  SUBROUTINE rflu_setinfoc2cstencil(pRegion,orderNominal)
2804 
2805  IMPLICIT NONE
2806 
2807 ! ******************************************************************************
2808 ! Declarations and definitions
2809 ! ******************************************************************************
2810 
2811 ! ==============================================================================
2812 ! Arguments
2813 ! ==============================================================================
2814 
2815  INTEGER, INTENT(IN) :: ordernominal
2816  TYPE(t_region), POINTER :: pregion
2817 
2818 ! ==============================================================================
2819 ! Locals
2820 ! ==============================================================================
2821 
2822  INTEGER :: nbfacemembsmax,nlayersmax,stencilsizemax,stencilsizemin
2823  TYPE(t_grid), POINTER :: pgrid
2824  TYPE(t_global), POINTER :: global
2825 
2826 ! ******************************************************************************
2827 ! Start
2828 ! ******************************************************************************
2829 
2830  global => pregion%global
2831 
2832  CALL registerfunction(global,'RFLU_SetInfoC2CStencil',&
2833  'RFLU_ModStencilsCells.F90')
2834 
2835  IF ( global%myProcid == masterproc .AND. &
2836  global%verbLevel > verbose_none ) THEN
2837  WRITE(stdout,'(A,1X,A)') solver_name, &
2838  'Setting cell-to-cell stencil information...'
2839  END IF ! global%verbLevel
2840 
2841 ! ******************************************************************************
2842 ! Set grid pointer
2843 ! ******************************************************************************
2844 
2845  pgrid => pregion%grid
2846 
2847 ! ******************************************************************************
2848 ! Set stencil information. NOTE nBFaceMembsMax must be one less than the
2849 ! number of unknowns (columns), otherwise LAPACK routine used for constrained
2850 ! least-squares problem always gives trivial solution.
2851 ! ******************************************************************************
2852 
2853  nlayersmax = 6
2854 ! TEMPORARY
2855 ! nBFaceMembsMax = RFLU_ComputeStencilSize(global,pRegion%mixtInput%dimens, &
2856 ! 1,orderNominal) - 1
2857  nbfacemembsmax = 9
2858 ! END TEMPORARY
2859  stencilsizemin = rflu_computestencilsize(global,pregion%mixtInput%dimens, &
2860  1,ordernominal)
2861  stencilsizemax = 10*stencilsizemin
2862 
2863  pgrid%c2csInfo%orderNominal = ordernominal
2864  pgrid%c2csInfo%nLayersMax = nlayersmax
2865  pgrid%c2csInfo%nBFaceMembsMax = nbfacemembsmax
2866  pgrid%c2csInfo%nCellMembsMax = stencilsizemax
2867  pgrid%c2csInfo%nCellMembsMin = stencilsizemin
2868 
2869 ! ******************************************************************************
2870 ! Print stencil information
2871 ! ******************************************************************************
2872 
2873  IF ( global%myProcid == masterproc .AND. &
2874  global%verbLevel > verbose_low ) THEN
2875  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name, &
2876  'Maximum allowed number of cell layers: ',nlayersmax
2877  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name, &
2878  'Minimum required number of cell members: ',stencilsizemin
2879  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name, &
2880  'Maximum allowed number of cell members: ',stencilsizemax
2881  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name, &
2882  'Maximum allowed number of boundary face members: ',nbfacemembsmax
2883  END IF ! global%myProcid
2884 
2885 ! ******************************************************************************
2886 ! End
2887 ! ******************************************************************************
2888 
2889  IF ( global%myProcid == masterproc .AND. &
2890  global%verbLevel > verbose_none ) THEN
2891  WRITE(stdout,'(A,1X,A)') solver_name, &
2892  'Setting cell-to-cell stencil information done.'
2893  END IF ! global%verbLevel
2894 
2895  CALL deregisterfunction(global)
2896 
2897  END SUBROUTINE rflu_setinfoc2cstencil
2898 
2899 
2900 
2901 
2902 
2903 
2904 
2905 ! *******************************************************************************
2906 !
2907 ! Purpose: Wrapper routine for setting info for cell-to-cell stencils.
2908 !
2909 ! Description: None.
2910 !
2911 ! Input:
2912 ! pRegion Pointer to region
2913 ! orderNominal Nominal order of accuracy
2914 !
2915 ! Output: None.
2916 !
2917 ! Notes: None.
2918 !
2919 ! ******************************************************************************
2920 
2921  SUBROUTINE rflu_setinfoc2cstencilwrapper(pRegion,orderNominal)
2922 
2923  IMPLICIT NONE
2924 
2925 ! ******************************************************************************
2926 ! Declarations and definitions
2927 ! ******************************************************************************
2928 
2929 ! ==============================================================================
2930 ! Arguments
2931 ! ==============================================================================
2932 
2933  INTEGER, INTENT(IN) :: ordernominal
2934  TYPE(t_region), POINTER :: pregion
2935 
2936 ! ==============================================================================
2937 ! Locals
2938 ! ==============================================================================
2939 
2940  TYPE(t_global), POINTER :: global
2941 
2942 ! ******************************************************************************
2943 ! Start
2944 ! ******************************************************************************
2945 
2946  global => pregion%global
2947 
2948  CALL registerfunction(global,'RFLU_SetInfoC2CStencilWrapper',&
2949  'RFLU_ModStencilsCells.F90')
2950 
2951 ! ******************************************************************************
2952 ! Call routines to set info for stencils
2953 ! ******************************************************************************
2954 
2955  SELECT CASE ( pregion%mixtInput%stencilDimensCells )
2956  CASE ( 1 )
2957  CALL rflu_setinfoc2cstencil_1d(pregion,ordernominal)
2958  CASE ( 2,3 )
2959  CALL rflu_setinfoc2cstencil(pregion,ordernominal)
2960  CASE default
2961  CALL errorstop(global,err_reached_default,__line__)
2962  END SELECT ! pRegion%mixtInput%stencilDimensCells
2963 
2964 ! ******************************************************************************
2965 ! End
2966 ! ******************************************************************************
2967 
2968  CALL deregisterfunction(global)
2969 
2970  END SUBROUTINE rflu_setinfoc2cstencilwrapper
2971 
2972 
2973 
2974 
2975 
2976 
2977 ! ******************************************************************************
2978 ! End
2979 ! ******************************************************************************
2980 
2981 END MODULE rflu_modstencilscells
2982 
2983 
2984 ! ******************************************************************************
2985 !
2986 ! RCS Revision history:
2987 !
2988 ! $Log: RFLU_ModStencilsCells.F90,v $
2989 ! Revision 1.18 2008/12/06 08:44:24 mtcampbe
2990 ! Updated license.
2991 !
2992 ! Revision 1.17 2008/11/19 22:17:35 mtcampbe
2993 ! Added Illinois Open Source License/Copyright
2994 !
2995 ! Revision 1.16 2007/07/08 21:45:03 gzheng
2996 ! changed the PRESENT is used for PGI compiler
2997 !
2998 ! Revision 1.15 2007/03/28 18:17:49 haselbac
2999 ! Bug fix: Incorrect format statement, too many close parentheses
3000 !
3001 ! Revision 1.14 2007/03/06 18:07:56 haselbac
3002 ! Added capability to build 1D stencils based on geometry (not on hex2f)
3003 !
3004 ! Revision 1.13 2007/02/27 13:07:06 haselbac
3005 ! Enabled 1d computations
3006 !
3007 ! Revision 1.12 2006/12/15 13:26:36 haselbac
3008 ! Fixed bug in format statement, found by ifort
3009 !
3010 ! Revision 1.11 2006/04/07 15:19:20 haselbac
3011 ! Removed tabs
3012 !
3013 ! Revision 1.10 2006/04/07 14:51:21 haselbac
3014 ! Adapted to new stencilDimens param
3015 !
3016 ! Revision 1.9 2006/04/01 16:41:05 haselbac
3017 ! Cosmetics only
3018 !
3019 ! Revision 1.8 2006/04/01 15:56:52 haselbac
3020 ! Cosmetics only
3021 !
3022 ! Revision 1.7 2006/03/20 13:55:37 haselbac
3023 ! Completely redone building of basic stencil (see notes)
3024 !
3025 ! Revision 1.6 2006/03/09 15:04:40 haselbac
3026 ! Bug fix and put routines in right order
3027 !
3028 ! Revision 1.5 2006/03/09 14:08:23 haselbac
3029 ! Cosmetics, removed CC2C list routines to prevent huge output from rflupart
3030 !
3031 ! Revision 1.4 2006/01/06 22:13:43 haselbac
3032 ! Renamed routines with shorter names bcos of new 1D routines
3033 !
3034 ! Revision 1.3 2005/12/25 15:33:22 haselbac
3035 ! Added cell-specific constraint flag
3036 !
3037 ! Revision 1.2 2005/10/27 19:19:36 haselbac
3038 ! Changed names, clean-up
3039 !
3040 ! Revision 1.1 2005/10/05 14:33:44 haselbac
3041 ! Initial revision
3042 !
3043 ! ******************************************************************************
3044 
3045 
3046 
3047 
3048 
3049 
3050 
3051 
3052 
3053 
3054 
3055 
3056 
3057 
3058 
3059 
3060 
3061 
3062 
3063 
3064 
3065 
3066 
3067 
3068 
modsortsearch::findcommonsortedintegers
subroutine findcommonsortedintegers(a, na, b, nb, c, ncMax, nc, errorFlag)
Definition: ModSortSearch.F90:261
rflu_modstencilscells::rflu_createc2cstencilwrapper
subroutine, public rflu_createc2cstencilwrapper(pRegion)
Definition: RFLU_ModStencilsCells.F90:2036
rflu_modstencilscells
Definition: RFLU_ModStencilsCells.F90:39
modsortsearch::removeinteger
subroutine removeinteger(a, na, iLoc)
Definition: ModSortSearch.F90:1131
rflu_modstencilsutils::rflu_addcelllayer
subroutine, public rflu_addcelllayer(global, pGrid, stencilSizeMax, ixg, degr, x2csBeg, x2csEnd, x2cs)
Definition: RFLU_ModStencilsUtils.F90:669
rflu_modstencilscells::rflu_setinfoc2cstencil_1d
subroutine rflu_setinfoc2cstencil_1d(pRegion, orderNominal)
Definition: RFLU_ModStencilsCells.F90:2691
invert
subroutine invert(a, nrow, det)
Definition: v3d8_me.f90:1392
modstencil::t_stencil
Definition: ModStencil.F90:46
dx
NT dx
Definition: rational_rotation.h:81
rflu_modstencilsutils::rflu_addcelllayer_1d
subroutine, public rflu_addcelllayer_1d(global, pGrid, stencilSizeMax, ixg, degr, x2csBeg, x2csEnd, x2cs, fnDir)
Definition: RFLU_ModStencilsUtils.F90:306
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
ainv
subroutine ainv(ajac, ajacin, det, ndim)
Definition: ainv.f90:53
Generic_element_2::order
Size order() const
Degree of the element. 1 for linear and 2 for quadratic.
Definition: Generic_element_2.h:117
rflu_invertmatrixsvd
subroutine rflu_invertmatrixsvd(global, nRows, nCols, a, aInv, sCount)
Definition: RFLU_InvertMatrixSVD.F90:50
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
rflu_modstencilscells::rflu_destroylistcc2cstencil
subroutine, public rflu_destroylistcc2cstencil(pRegion)
Definition: RFLU_ModStencilsCells.F90:2427
rflu_modstencilscells::rflu_buildlistcc2cstencil
subroutine, public rflu_buildlistcc2cstencil(pRegion)
Definition: RFLU_ModStencilsCells.F90:1703
modgrid::t_grid
Definition: ModGrid.F90:56
sqrt
double sqrt(double d)
Definition: double.h:73
modsortsearch::simplifysortedintegers
subroutine simplifysortedintegers(a, na, nb)
Definition: ModSortSearch.F90:1197
rflu_modstencilscells::rflu_createc2cstencil_1d
subroutine rflu_createc2cstencil_1d(pRegion)
Definition: RFLU_ModStencilsCells.F90:1828
modsortsearch::quicksortinteger
subroutine quicksortinteger(a, n)
Definition: ModSortSearch.F90:482
modsortsearch::binarysearchinteger
subroutine binarysearchinteger(a, n, v, i, j)
Definition: ModSortSearch.F90:98
rflu_modgeometrytools
Definition: RFLU_ModGeometryTools.F90:39
rflu_modgeometrytools::rflu_testvectorcartaxisaligned
LOGICAL function, public rflu_testvectorcartaxisaligned(global, dr, dir)
Definition: RFLU_ModGeometryTools.F90:746
rflu_modstencilscells::rflu_setinfoc2cstencil
subroutine rflu_setinfoc2cstencil(pRegion, orderNominal)
Definition: RFLU_ModStencilsCells.F90:2803
rflu_modstencilsutils::rflu_addbfaces
subroutine, public rflu_addbfaces(pRegion, nBFaceMembsMaxTemp, nCellMembs, cellMembs, nBFaceMembs, bFaceMembs)
Definition: RFLU_ModStencilsUtils.F90:104
rflu_modstencilscells::rflu_destroyc2cstencilwrapper
subroutine, public rflu_destroyc2cstencilwrapper(pRegion)
Definition: RFLU_ModStencilsCells.F90:2356
Mesh::GenericElement::nfaces
IndexType nfaces() const
Definition: Mesh.H:641
rflu_modstencilscells::rflu_buildc2cstencilbasic
subroutine rflu_buildc2cstencilbasic(pRegion, icg, stencilSizeMax, degr, c2cs)
Definition: RFLU_ModStencilsCells.F90:1180
rflu_computestencilsize
INTEGER function rflu_computestencilsize(global, factor, order)
Definition: RFLU_ComputeStencilSize.F90:50
rflu_modstencilscells::rflu_nullifyc2cstencil_1d
subroutine rflu_nullifyc2cstencil_1d(pRegion)
Definition: RFLU_ModStencilsCells.F90:2520
rflu_modstencilscells::rflu_buildc2cstencilbasic_1d
subroutine rflu_buildc2cstencilbasic_1d(pRegion, icg, stencilSizeMax, dir, degr, c2cs1D)
Definition: RFLU_ModStencilsCells.F90:1417
rflu_modstencilsutils
Definition: RFLU_ModStencilsUtils.F90:39
rflu_modstencilscells::rflu_buildc2cstencil_1d_g
subroutine rflu_buildc2cstencil_1d_g(pRegion, dir, icgBeg, icgEnd)
Definition: RFLU_ModStencilsCells.F90:419
rflu_modstencilscells::rflu_createc2cstencil
subroutine rflu_createc2cstencil(pRegion)
Definition: RFLU_ModStencilsCells.F90:1939
rflu_modstencilscells::rflu_buildc2cstencil
subroutine rflu_buildc2cstencil(pRegion, icgBeg, icgEnd, addBFaces)
Definition: RFLU_ModStencilsCells.F90:722
rflu_modstencilscells::rflu_destroyc2cstencil_1d
subroutine rflu_destroyc2cstencil_1d(pRegion)
Definition: RFLU_ModStencilsCells.F90:2108
rflu_modstencilscells::rflu_setinfoc2cstencilwrapper
subroutine, public rflu_setinfoc2cstencilwrapper(pRegion, orderNominal)
Definition: RFLU_ModStencilsCells.F90:2921
modsortsearch::quicksortrfrealinteger
subroutine quicksortrfrealinteger(a, b, n)
Definition: ModSortSearch.F90:840
rflu_modstencilsutils::rflu_addcelllayer_1d_g
subroutine, public rflu_addcelllayer_1d_g(global, pGrid, stencilSizeMax, ixg, degr, x2csBeg, x2csEnd, x2cs, rc, dir)
Definition: RFLU_ModStencilsUtils.F90:485
Direction_3::dz
RT dz() const
Definition: Direction_3.h:133
rflu_modstencilscells::rflu_buildc2cstencilwrapper
subroutine, public rflu_buildc2cstencilwrapper(pRegion, icgInput, constrInput)
Definition: RFLU_ModStencilsCells.F90:1596
min
Vector_n min(const Array_n_const &v1, const Array_n_const &v2)
Definition: Vector_n.h:346
rflu_modstencilsutils::rflu_sortbfaces
subroutine, public rflu_sortbfaces(pRegion, xyz, nBFaceMembs, bFaceMembs)
Definition: RFLU_ModStencilsUtils.F90:1484
dy
NT dy
Definition: rational_rotation.h:82
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
vector3d::dir
vector3d dir(void) const
Definition: vector3d.h:144
rflu_modcellfaceedgeinfo
Definition: RFLU_ModCellFaceEdgeInfo.F90:40
rflu_modstencilscells::rflu_nullifyc2cstencil
subroutine rflu_nullifyc2cstencil(pRegion)
Definition: RFLU_ModStencilsCells.F90:2604
rflu_modstencilscells::rflu_destroyc2cstencil
subroutine rflu_destroyc2cstencil(pRegion)
Definition: RFLU_ModStencilsCells.F90:2240
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
rflu_modstencilscells::rflu_buildc2cstencil_1d
subroutine rflu_buildc2cstencil_1d(pRegion, fnDir, icgBeg, icgEnd)
Definition: RFLU_ModStencilsCells.F90:103
rflu_modcellfaceedgeinfo::rflu_getglobalcelltype
INTEGER function, public rflu_getglobalcelltype(global, pGrid, icg)
Definition: RFLU_ModCellFaceEdgeInfo.F90:96
Line_2::a
RT a() const
Definition: Line_2.h:140
Mesh::GenericCell_2::nvert
IndexType nvert() const
Definition: Mesh.H:565
modbndpatch::t_patch
Definition: ModBndPatch.F90:91