Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModStencilsFaces.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 face stencils.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModStencilsFaces.F90,v 1.11 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_modstencilsfaces
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_buildlistcf2cstencil, &
59  rflu_buildf2cstencilwrapper, &
60  rflu_createf2cstencilwrapper, &
61  rflu_destroyf2cstencilwrapper, &
62  rflu_destroylistcf2cstencil, &
63  rflu_setinfof2cstencilwrapper
64 
65 
66 ! ******************************************************************************
67 ! Declarations and definitions
68 ! ******************************************************************************
69 
70  CHARACTER(CHRLEN) :: RCSIdentString = &
71  '$RCSfile: RFLU_ModStencilsFaces.F90,v $ $Revision: 1.11 $'
72 
73 ! ******************************************************************************
74 ! Routines
75 ! ******************************************************************************
76 
77  CONTAINS
78 
79 
80 
81 
82 
83 
84 
85 
86 ! *******************************************************************************
87 !
88 ! Purpose: Build 1D face-to-cell stencil.
89 !
90 ! Description: None.
91 !
92 ! Input:
93 ! pRegion Pointer to region
94 !
95 ! Output: None.
96 !
97 ! Notes:
98 ! 1. Restricted to hexahedra.
99 !
100 ! ******************************************************************************
101 
102  SUBROUTINE rflu_buildf2cstencil_1d(pRegion)
103 
104  USE modtools, ONLY: floatequal
105 
106  IMPLICIT NONE
107 
108 ! ******************************************************************************
109 ! Declarations and definitions
110 ! ******************************************************************************
111 
112 ! ==============================================================================
113 ! Arguments
114 ! ==============================================================================
115 
116  TYPE(t_region), POINTER :: pregion
117 
118 ! ==============================================================================
119 ! Locals
120 ! ==============================================================================
121 
122  INTEGER :: fndir,f2cs1dbeg,f2cs1dend,degr,errorflag,ifg,ilayer,iloc,ipatch,isl, &
123  ncellmembsinfomax,ncellmembsinfomaxloc,ncellmembsinfomin, &
124  ncellmembsinfominloc,nfaces,nlayersinfomax,nlayersinfomaxloc, &
125  nlayersinfomin,nlayersinfominloc,nlayersmax,stencilsizemax, &
126  stencilsizemin
127  INTEGER, DIMENSION(:), ALLOCATABLE :: f2cs1d
128  INTEGER, DIMENSION(:,:), ALLOCATABLE :: layerinfo
129  REAL(RFREAL) :: nx,ny,nz,nm
130  TYPE(t_grid), POINTER :: pgrid
131  TYPE(t_patch), POINTER :: ppatch
132  TYPE(t_global), POINTER :: global
133 
134 ! ******************************************************************************
135 ! Start
136 ! ******************************************************************************
137 
138  global => pregion%global
139 
140  CALL registerfunction(global,'RFLU_BuildF2CStencil_1D',&
141  'RFLU_ModStencilsFaces.F90')
142 
143  IF ( (global%myProcid == masterproc) .AND. &
144  (global%verbLevel > verbose_none) ) THEN
145  WRITE(stdout,'(A,1X,A)') solver_name,'Building 1D face-to-cell stencil...'
146  END IF ! global%myProcid
147 
148 ! ******************************************************************************
149 ! Set grid pointer and check for required arrays
150 ! ******************************************************************************
151 
152  pgrid => pregion%grid
153 
154  IF ( ASSOCIATED(pgrid%hex2f) .EQV. .false. ) THEN
155  CALL errorstop(global,err_associated,__line__,'pGrid%hex2f')
156  END IF ! ASSOCIATED
157 
158 ! ******************************************************************************
159 ! Set variables
160 ! ******************************************************************************
161 
162  nlayersmax = pgrid%f2csInfo%nLayersMax
163  stencilsizemax = pgrid%f2csInfo%nCellMembsMax
164  stencilsizemin = pgrid%f2csInfo%nCellMembsMin
165 
166  ncellmembsinfomax = 0
167  ncellmembsinfomin = huge(1)
168 
169  nlayersinfomax = 0
170  nlayersinfomin = huge(1)
171 
172 ! ******************************************************************************
173 ! Allocate temporary memory
174 ! ******************************************************************************
175 
176  ALLOCATE(f2cs1d(stencilsizemax),stat=errorflag)
177  global%error = errorflag
178  IF ( global%error /= err_none ) THEN
179  CALL errorstop(global,err_allocate,__line__,'f2cs1D')
180  END IF ! global%error
181 
182  ALLOCATE(layerinfo(x2cs_layer_beg:x2cs_layer_end,nlayersmax), &
183  stat=errorflag)
184  global%error = errorflag
185  IF ( global%error /= err_none ) THEN
186  CALL errorstop(global,err_allocate,__line__,'layerInfo')
187  END IF ! global%error
188 
189 ! ******************************************************************************
190 ! Loop over cells
191 ! ******************************************************************************
192 
193  DO ifg = 1,pgrid%nFaces
194 
195 ! ==============================================================================
196 ! Initialize variables
197 ! ==============================================================================
198 
199  nx = abs(pgrid%fn(xcoord,ifg))
200  ny = abs(pgrid%fn(ycoord,ifg))
201  nz = abs(pgrid%fn(zcoord,ifg))
202 
203  nm = max(nx,ny,nz)
204 
205  IF ( floatequal(nm,1.0_rfreal,1.0e-6_rfreal) .EQV. .true. ) THEN
206  IF ( nx > ny .AND. nx > nz ) THEN
207  fndir = xcoord
208  ELSE IF ( ny > nx .AND. ny > nz ) THEN
209  fndir = ycoord
210  ELSE IF ( nz > nx .AND. nz > ny ) THEN
211  fndir = zcoord
212  END IF ! nx
213  ELSE
214 ! TEMPORARY
215  WRITE(*,*) 'ERROR - Face not aligned with coordinate axes!'
216  stop
217 ! END TEMPORARY
218  END IF ! FloatEqual
219 
220  degr = 0
221 
222  DO isl = 1,stencilsizemax
223  f2cs1d(isl) = 0
224  END DO ! isl
225 
226  DO ilayer = 1,nlayersmax
227  layerinfo(x2cs_layer_beg,ilayer) = 0
228  layerinfo(x2cs_layer_end,ilayer) = 0
229  END DO ! iLayer
230 
231 ! ==============================================================================
232 ! Build basic stencil consisting of cells meeting at vertices of face
233 ! ==============================================================================
234 
235  degr = 2
236 
237  f2cs1d(1) = pgrid%f2c(1,ifg)
238  f2cs1d(2) = pgrid%f2c(2,ifg)
239 
240  pgrid%f2cs1D(ifg)%nLayers = 1
241 
242  layerinfo(x2cs_layer_beg,1) = 1
243  layerinfo(x2cs_layer_end,1) = degr
244 
245 ! ==============================================================================
246 ! Extend basic stencil. NOTE for 1D stencil do not have to check weight
247 ! singularity
248 ! ==============================================================================
249 
250  DO ilayer = 2,nlayersmax
251  IF ( degr < stencilsizemin ) THEN
252  f2cs1dbeg = layerinfo(x2cs_layer_beg,ilayer-1)
253  f2cs1dend = layerinfo(x2cs_layer_end,ilayer-1)
254 
255  CALL rflu_addcelllayer_1d(global,pgrid,stencilsizemax,0,degr, &
256  f2cs1dbeg,f2cs1dend,f2cs1d,fndir)
257 
258  pgrid%f2cs1D(ifg)%nLayers = pgrid%f2cs1D(ifg)%nLayers + 1
259 
260  layerinfo(x2cs_layer_beg,ilayer) = &
261  layerinfo(x2cs_layer_end,ilayer-1) + 1
262  layerinfo(x2cs_layer_end,ilayer) = degr
263  ELSE
264  EXIT
265  END IF ! degr
266  END DO ! iLayer
267 
268 ! ==============================================================================
269 ! Store stencil and layer info
270 ! ==============================================================================
271 
272  pgrid%f2cs1D(ifg)%nCellMembs = degr
273 
274  ALLOCATE(pgrid%f2cs1D(ifg)%cellMembs(degr),stat=errorflag)
275  global%error = errorflag
276  IF ( global%error /= err_none ) THEN
277  CALL errorstop(global,err_allocate,__line__,'pGrid%f2cs1D%cellMembs')
278  END IF ! global%error
279 
280  DO isl = 1,degr
281  pgrid%f2cs1D(ifg)%cellMembs(isl) = f2cs1d(isl)
282  END DO ! isl
283 
284  ALLOCATE(pgrid%f2cs1D(ifg)%layerInfo(x2cs_layer_beg:x2cs_layer_end, &
285  pgrid%f2cs1D(ifg)%nLayers),stat=errorflag)
286  global%error = errorflag
287  IF ( global%error /= err_none ) THEN
288  CALL errorstop(global,err_allocate,__line__,'pGrid%f2cs1D%layerInfo')
289  END IF ! global%error
290 
291  DO ilayer = 1,pgrid%f2cs1D(ifg)%nLayers
292  pgrid%f2cs1D(ifg)%layerInfo(x2cs_layer_beg,ilayer) = &
293  layerinfo(x2cs_layer_beg,ilayer)
294  pgrid%f2cs1D(ifg)%layerInfo(x2cs_layer_end,ilayer) = &
295  layerinfo(x2cs_layer_end,ilayer)
296  END DO ! iLayer
297 
298 ! ==============================================================================
299 ! Extract information for later printing
300 ! ==============================================================================
301 
302  IF ( pgrid%f2cs1D(ifg)%nLayers < nlayersinfomin ) THEN
303  nlayersinfomin = pgrid%f2cs1D(ifg)%nLayers
304  nlayersinfominloc = ifg
305  END IF ! pGrid%f2cs(ifg)%nLayers
306 
307  IF ( pgrid%f2cs1D(ifg)%nLayers > nlayersinfomax ) THEN
308  nlayersinfomax = pgrid%f2cs1D(ifg)%nLayers
309  nlayersinfomaxloc = ifg
310  END IF ! pGrid%f2cs(ifg)%nLayers
311 
312  IF ( pgrid%f2cs1D(ifg)%nCellMembs < ncellmembsinfomin ) THEN
313  ncellmembsinfomin = pgrid%f2cs1D(ifg)%nCellMembs
314  ncellmembsinfominloc = ifg
315  END IF ! pGrid%f2cs(ifg)%nCellMembs
316 
317  IF ( pgrid%f2cs1D(ifg)%nCellMembs > ncellmembsinfomax ) THEN
318  ncellmembsinfomax = pgrid%f2cs1D(ifg)%nCellMembs
319  ncellmembsinfomaxloc = ifg
320  END IF ! pGrid%f2cs1D(ifg)%nCellMembs
321  END DO ! ifg
322 
323 ! ******************************************************************************
324 ! Write out information on stencils
325 ! ******************************************************************************
326 
327  IF ( global%myProcid == masterproc .AND. &
328  global%verbLevel > verbose_low ) THEN
329  WRITE(stdout,'(A,3X,A)') solver_name,'Statistics:'
330  WRITE(stdout,'(A,5X,A,2(1X,I3),2(1X,I9))') solver_name, &
331  'Minimum/maximum number of cell layers: ',nlayersinfomin, &
332  nlayersinfomax,nlayersinfominloc,nlayersinfomaxloc
333  WRITE(stdout,'(A,5X,A,2(1X,I3),2(1X,I9))') solver_name, &
334  'Minimum/maximum number of cell members:',ncellmembsinfomin, &
335  ncellmembsinfomax,ncellmembsinfominloc,ncellmembsinfomaxloc
336  END IF ! global%myProcid
337 
338 ! ******************************************************************************
339 ! Deallocate temporary memory
340 ! ******************************************************************************
341 
342  DEALLOCATE(f2cs1d,stat=errorflag)
343  global%error = errorflag
344  IF ( global%error /= err_none ) THEN
345  CALL errorstop(global,err_deallocate,__line__,'c2cs1D')
346  END IF ! global%error
347 
348  DEALLOCATE(layerinfo,stat=errorflag)
349  global%error = errorflag
350  IF ( global%error /= err_none ) THEN
351  CALL errorstop(global,err_deallocate,__line__,'layerInfo')
352  END IF ! global%error
353 
354 ! ******************************************************************************
355 ! End
356 ! ******************************************************************************
357 
358  IF ( (global%myProcid == masterproc) .AND. &
359  (global%verbLevel > verbose_none) ) THEN
360  WRITE(stdout,'(A,1X,A)') solver_name, &
361  'Building 1D face-to-cell stencil done.'
362  END IF ! global%myProcid
363 
364  CALL deregisterfunction(global)
365 
366  END SUBROUTINE rflu_buildf2cstencil_1d
367 
368 
369 
370 
371 
372 
373 
374 ! *******************************************************************************
375 !
376 ! Purpose: Build face-to-cell stencil.
377 !
378 ! Description: None.
379 !
380 ! Input:
381 ! pRegion Pointer to region
382 ! addBFaces Flag indicating whether should add boundary faces
383 !
384 ! Output: None.
385 !
386 ! Notes: None.
387 !
388 ! ******************************************************************************
389 
390  SUBROUTINE rflu_buildf2cstencil(pRegion,addBFaces)
391 
392  USE rflu_modfacelist, ONLY: rflu_getopposingfaces
393 
394  USE modinterfaces, ONLY: rflu_invertmatrixsvd
395 
396  IMPLICIT NONE
397 
398 ! ******************************************************************************
399 ! Declarations and definitions
400 ! ******************************************************************************
401 
402 ! ==============================================================================
403 ! Arguments
404 ! ==============================================================================
405 
406  LOGICAL, INTENT(IN) :: addbfaces
407  TYPE(t_region), POINTER :: pregion
408 
409 ! ==============================================================================
410 ! Locals
411 ! ==============================================================================
412 
413  INTEGER :: degr,errorflag,f2csbeg,f2csend,icg,ifg,ifg2,ifl,ilayer,iloc, &
414  ipatch,isl,ivl,iv2c,nbfacemembs,nbfacemembsmax, &
415  nbfacemembsmaxtemp,ncellmembsinfomax,ncellmembsinfomaxloc, &
416  ncellmembsinfomin,ncellmembsinfominloc,nfacesopp, &
417  nlayersinfomax,nlayersinfomaxloc,nlayersinfomin, &
418  nlayersinfominloc,nlayersmax,nrows,order,ordernominal,scount, &
419  stencilsizemax,stencilsizemin,ncols,irow,icol
420  INTEGER :: bf2v(4)
421  INTEGER :: faceoppinfo(2,2)
422  INTEGER, DIMENSION(:), ALLOCATABLE :: f2cs
423  INTEGER, DIMENSION(:,:), ALLOCATABLE :: bfacemembs,layerinfo
424  REAL(RFREAL) :: dx,dy,dz,term
425  REAL(RFREAL) :: colmax(4)
426  REAL(RFREAL), DIMENSION(:,:), ALLOCATABLE :: a,ainv
427  TYPE(t_grid), POINTER :: pgrid
428  TYPE(t_patch), POINTER :: ppatch
429  TYPE(t_global), POINTER :: global
430 
431 ! ******************************************************************************
432 ! Start
433 ! ******************************************************************************
434 
435  global => pregion%global
436 
437  CALL registerfunction(global,'RFLU_BuildF2CStencil',&
438  'RFLU_ModStencilsFaces.F90')
439 
440  IF ( global%myProcid == masterproc .AND. &
441  global%verbLevel > verbose_none ) THEN
442  WRITE(stdout,'(A,1X,A)') solver_name,'Building face-to-cell stencil...'
443  END IF ! global%verbLevel
444 
445 ! ******************************************************************************
446 ! Set grid pointer
447 ! ******************************************************************************
448 
449  pgrid => pregion%grid
450 
451 ! ******************************************************************************
452 ! Get variables
453 ! ******************************************************************************
454 
455  ordernominal = pgrid%f2csInfo%orderNominal
456  nlayersmax = pgrid%f2csInfo%nLayersMax
457  nbfacemembsmax = pgrid%f2csInfo%nBFaceMembsMax
458  stencilsizemax = pgrid%f2csInfo%nCellMembsMax
459  stencilsizemin = pgrid%f2csInfo%nCellMembsMin
460 
461  ncellmembsinfomax = 0
462  ncellmembsinfomin = huge(1)
463 
464  nlayersinfomax = 0
465  nlayersinfomin = huge(1)
466 
467  nbfacemembsmaxtemp = 2*nbfacemembsmax
468 
469  IF ( (global%myProcid == masterproc) .AND. &
470  (global%verbLevel > verbose_low) ) THEN
471  WRITE(stdout,'(A,3X,A,1X,L1)') solver_name,'Adding boundary faces:', &
472  addbfaces
473  END IF ! global%verbLevel
474 
475 ! ******************************************************************************
476 ! Allocate temporary memory
477 ! ******************************************************************************
478 
479  ALLOCATE(f2cs(stencilsizemax),stat=errorflag)
480  global%error = errorflag
481  IF ( global%error /= err_none ) THEN
482  CALL errorstop(global,err_allocate,__line__,'f2cs')
483  END IF ! global%error
484 
485  ALLOCATE(bfacemembs(2,nbfacemembsmaxtemp),stat=errorflag)
486  global%error = errorflag
487  IF ( global%error /= err_none ) THEN
488  CALL errorstop(global,err_allocate,__line__,'bFaceMembs')
489  END IF ! global%error
490 
491  ALLOCATE(layerinfo(x2cs_layer_beg:x2cs_layer_end,nlayersmax), &
492  stat=errorflag)
493  global%error = errorflag
494  IF ( global%error /= err_none ) THEN
495  CALL errorstop(global,err_allocate,__line__,'layerInfo')
496  END IF ! global%error
497 
498 ! ******************************************************************************
499 ! Loop over interior faces
500 ! ******************************************************************************
501 
502  DO ifg = 1,pgrid%nFaces
503 
504 ! ==============================================================================
505 ! Initialize
506 ! ==============================================================================
507 
508  DO isl = 1,stencilsizemax
509  f2cs(isl) = 0
510  END DO ! isl
511 
512  DO ilayer = 1,nlayersmax
513  layerinfo(x2cs_layer_beg,ilayer) = 0
514  layerinfo(x2cs_layer_end,ilayer) = 0
515  END DO ! iLayer
516 
517 ! ==============================================================================
518 ! Build basic stencil consisting of cells meeting at vertices of face
519 ! ==============================================================================
520 
521  degr = 0
522 
523  CALL rflu_addfacevertneighbs(global,pgrid,stencilsizemax, &
524  pgrid%f2v(1:4,ifg),degr,f2cs)
525 
526  pgrid%f2cs(ifg)%nLayers = 1
527 
528  layerinfo(x2cs_layer_beg,1) = 1
529  layerinfo(x2cs_layer_end,1) = degr
530 
531 ! ==============================================================================
532 ! Extend basic stencil
533 ! ==============================================================================
534 
535  DO ilayer = 2,nlayersmax
536  order = ordernominal
537  scount = 0
538 
539 ! ------------------------------------------------------------------------------
540 ! Check whether stencil weights are singular
541 ! ------------------------------------------------------------------------------
542 
543  IF ( degr >= stencilsizemin ) THEN
544  nrows = degr
545  ncols = pregion%mixtInput%dimens + 1
546 
547  ALLOCATE(a(nrows,ncols),stat=errorflag)
548  global%error = errorflag
549  IF ( global%error /= err_none ) THEN
550  CALL errorstop(global,err_allocate,__line__,'a')
551  END IF ! global%error
552 
553  ALLOCATE(ainv(nrows,ncols),stat=errorflag)
554  global%error = errorflag
555  IF ( global%error /= err_none ) THEN
556  CALL errorstop(global,err_allocate,__line__,'aInv')
557  END IF ! global%error
558 
559  SELECT CASE ( pregion%mixtInput%dimens )
560  CASE ( 2 )
561  DO isl = 1,degr
562  icg = f2cs(isl)
563 
564  dx = pgrid%cofg(xcoord,icg) - pgrid%fc(xcoord,ifg)
565  dy = pgrid%cofg(ycoord,icg) - pgrid%fc(ycoord,ifg)
566 
567  term = 1.0_rfreal/sqrt(dx*dx + dy*dy)
568 
569  a(isl,1) = term
570  a(isl,2) = term*dx
571  a(isl,3) = term*dy
572  END DO ! isl
573  CASE ( 3 )
574  DO isl = 1,degr
575  icg = f2cs(isl)
576 
577  dx = pgrid%cofg(xcoord,icg) - pgrid%fc(xcoord,ifg)
578  dy = pgrid%cofg(ycoord,icg) - pgrid%fc(ycoord,ifg)
579  dz = pgrid%cofg(zcoord,icg) - pgrid%fc(zcoord,ifg)
580 
581  term = 1.0_rfreal/sqrt(dx*dx + dy*dy + dz*dz)
582 
583  a(isl,1) = term
584  a(isl,2) = term*dx
585  a(isl,3) = term*dy
586  a(isl,4) = term*dz
587  END DO ! isl
588  CASE default
589  CALL errorstop(global,err_reached_default,__line__)
590  END SELECT ! pRegion%mixtInput%dimens
591 
592  DO icol = 1,ncols
593  colmax(icol) = -huge(1.0_rfreal)
594 
595  DO irow = 1,nrows
596  colmax(icol) = max(colmax(icol),abs(a(irow,icol)))
597  END DO ! iRow
598 
599  DO irow = 1,nrows
600  a(irow,icol) = a(irow,icol)/colmax(icol)
601  END DO ! iRow
602  END DO ! iCol
603 
604  CALL rflu_invertmatrixsvd(global,nrows,ncols,a,ainv,scount)
605 
606  DEALLOCATE(a,stat=errorflag)
607  global%error = errorflag
608  IF ( global%error /= err_none ) THEN
609  CALL errorstop(global,err_deallocate,__line__,'a')
610  END IF ! global%error
611 
612  DEALLOCATE(ainv,stat=errorflag)
613  global%error = errorflag
614  IF ( global%error /= err_none ) THEN
615  CALL errorstop(global,err_deallocate,__line__,'aInv')
616  END IF ! global%error
617  END IF ! degr
618 
619 ! ------------------------------------------------------------------------------
620 ! Check whether to reject or accept stencil. If singular or too small,
621 ! add layer of cells. Pass 0 instead of ifg because want to prevent
622 ! present cell from being added, not present face. If pass present
623 ! face, could actually prevent a proper cell from being added in
624 ! rare cases...
625 ! ------------------------------------------------------------------------------
626 
627  IF ( scount /= 0 .OR. degr < stencilsizemin ) THEN
628  f2csbeg = layerinfo(x2cs_layer_beg,ilayer-1)
629  f2csend = layerinfo(x2cs_layer_end,ilayer-1)
630 
631  CALL rflu_addcelllayer(global,pgrid,stencilsizemax,0,degr, &
632  f2csbeg,f2csend,f2cs)
633 
634  pgrid%f2cs(ifg)%nLayers = pgrid%f2cs(ifg)%nLayers + 1
635 
636  layerinfo(x2cs_layer_beg,ilayer) = &
637  layerinfo(x2cs_layer_end,ilayer-1) + 1
638  layerinfo(x2cs_layer_end,ilayer) = degr
639  ELSE
640  EXIT
641  END IF ! sCount
642  END DO ! iLayer
643 
644 ! ==============================================================================
645 ! Store stencil and layer info
646 ! ==============================================================================
647 
648  pgrid%f2cs(ifg)%nCellMembs = degr
649 
650  ALLOCATE(pgrid%f2cs(ifg)%cellMembs(degr),stat=errorflag)
651  global%error = errorflag
652  IF ( global%error /= err_none ) THEN
653  CALL errorstop(global,err_allocate,__line__,'pGrid%f2cs%cellMembs')
654  END IF ! global%error
655 
656  DO isl = 1,degr
657  pgrid%f2cs(ifg)%cellMembs(isl) = f2cs(isl)
658  END DO ! isl
659 
660  ALLOCATE(pgrid%f2cs(ifg)%layerInfo(x2cs_layer_beg:x2cs_layer_end, &
661  pgrid%f2cs(ifg)%nLayers),stat=errorflag)
662  global%error = errorflag
663  IF ( global%error /= err_none ) THEN
664  CALL errorstop(global,err_allocate,__line__,'pGrid%f2cs%layerInfo')
665  END IF ! global%error
666 
667  DO ilayer = 1,pgrid%f2cs(ifg)%nLayers
668  pgrid%f2cs(ifg)%layerInfo(x2cs_layer_beg,ilayer) = &
669  layerinfo(x2cs_layer_beg,ilayer)
670  pgrid%f2cs(ifg)%layerInfo(x2cs_layer_end,ilayer) = &
671  layerinfo(x2cs_layer_end,ilayer)
672  END DO ! iLayer
673 
674 ! ==============================================================================
675 ! Add boundary faces to stencil. If the stencil contains boundary faces,
676 ! sort them by distance and pick <nBFaceMembsMax> closest ones.
677 ! ==============================================================================
678 
679  nbfacemembs = 0
680 
681  IF ( addbfaces .EQV. .true. ) THEN
682  CALL rflu_addbfaces(pregion,nbfacemembsmaxtemp, &
683  pgrid%f2cs(ifg)%nCellMembs, &
684  pgrid%f2cs(ifg)%cellMembs(1:pgrid%f2cs(ifg)%nCellMembs), &
685  nbfacemembs,bfacemembs)
686  END IF ! addBFaces
687 
688  IF ( nbfacemembs > 0 ) THEN
689  CALL rflu_sortbfaces(pregion,pgrid%fc(xcoord:zcoord,icg), &
690  nbfacemembs,bfacemembs(1:2,1:nbfacemembs))
691 
692  pgrid%f2cs(ifg)%nBFaceMembs = min(nbfacemembs,nbfacemembsmax)
693 
694  ALLOCATE(pgrid%f2cs(ifg)%bFaceMembs(2,pgrid%f2cs(ifg)%nBFaceMembs), &
695  stat=errorflag)
696  global%error = errorflag
697  IF ( global%error /= err_none ) THEN
698  CALL errorstop(global,err_allocate,__line__,'pGrid%f2cs%bFaceMembs')
699  END IF ! global%error
700 
701  DO isl = 1,pgrid%f2cs(ifg)%nBFaceMembs
702  pgrid%f2cs(ifg)%bFaceMembs(1,isl) = bfacemembs(1,isl)
703  pgrid%f2cs(ifg)%bFaceMembs(2,isl) = bfacemembs(2,isl)
704  END DO ! isl
705  ELSE
706  pgrid%f2cs(ifg)%nBFaceMembs = 0
707 
708  nullify(pgrid%f2cs(ifg)%bFaceMembs)
709  END IF ! nBFaceMembs
710 
711 ! ==============================================================================
712 ! Extract information for later printing
713 ! ==============================================================================
714 
715  IF ( pgrid%f2cs(ifg)%nLayers < nlayersinfomin ) THEN
716  nlayersinfomin = pgrid%f2cs(ifg)%nLayers
717  nlayersinfominloc = ifg
718  END IF ! pGrid%f2cs(ifg)%nLayers
719 
720  IF ( pgrid%f2cs(ifg)%nLayers > nlayersinfomax ) THEN
721  nlayersinfomax = pgrid%f2cs(ifg)%nLayers
722  nlayersinfomaxloc = ifg
723  END IF ! pGrid%f2cs(ifg)%nLayers
724 
725  IF ( pgrid%f2cs(ifg)%nCellMembs < ncellmembsinfomin ) THEN
726  ncellmembsinfomin = pgrid%f2cs(ifg)%nCellMembs
727  ncellmembsinfominloc = ifg
728  END IF ! pGrid%f2cs(ifg)%nCellMembs
729 
730  IF ( pgrid%f2cs(ifg)%nCellMembs > ncellmembsinfomax ) THEN
731  ncellmembsinfomax = pgrid%f2cs(ifg)%nCellMembs
732  ncellmembsinfomaxloc = ifg
733  END IF ! pGrid%f2cs(ifg)%nCellMembs
734  END DO ! ifg
735 
736 ! ******************************************************************************
737 ! Write out information on stencils
738 ! ******************************************************************************
739 
740  IF ( global%myProcid == masterproc .AND. &
741  global%verbLevel > verbose_low ) THEN
742  WRITE(stdout,'(A,3X,A)') solver_name,'Statistics:'
743  WRITE(stdout,'(A,5X,A,2(1X,I3),2(1X,I9))') solver_name, &
744  'Minimum/maximum number of cell layers: ',nlayersinfomin, &
745  nlayersinfomax,nlayersinfominloc,nlayersinfomaxloc
746  WRITE(stdout,'(A,5X,A,2(1X,I3),2(1X,I9))') solver_name, &
747  'Minimum/maximum number of cell members:',ncellmembsinfomin, &
748  ncellmembsinfomax,ncellmembsinfominloc,ncellmembsinfomaxloc
749  END IF ! global%myProcid
750 
751 #ifdef CHECK_DATASTRUCT
752 ! ******************************************************************************
753 ! Data structure output for checking
754 ! ******************************************************************************
755 
756  WRITE(stdout,'(A)') solver_name
757  WRITE(stdout,'(A,1X,A)') solver_name,'### START CHECK OUTPUT ###'
758  WRITE(stdout,'(A,1X,A)') solver_name,'Face-to-cell stencils'
759  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Maximum number of layers:', &
760  pgrid%f2csInfo%nLayersMax
761  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Minimum stencil size:', &
762  pgrid%f2csInfo%nCellMembsMin
763  DO ifg = 1,pgrid%nFaces
764  WRITE(stdout,'(A,1X,I6,2(1X,I3),3X,20(1X,I6))') solver_name,ifg, &
765  pgrid%f2cs(ifg)%nLayers,pgrid%f2cs(ifg)%nCellMembs, &
766  pgrid%f2cs(ifg)%cellMembs(1:pgrid%f2cs(ifg)%nCellMembs)
767  END DO ! ifg
768 
769  WRITE(stdout,'(A,1X,A)') solver_name,'### END CHECK OUTPUT ###'
770  WRITE(stdout,'(A)') solver_name
771 #endif
772 
773 ! ******************************************************************************
774 ! Deallocate temporary memory
775 ! ******************************************************************************
776 
777  DEALLOCATE(f2cs,stat=errorflag)
778  global%error = errorflag
779  IF ( global%error /= err_none ) THEN
780  CALL errorstop(global,err_deallocate,__line__,'f2cs')
781  END IF ! global%error
782 
783  DEALLOCATE(bfacemembs,stat=errorflag)
784  global%error = errorflag
785  IF ( global%error /= err_none ) THEN
786  CALL errorstop(global,err_deallocate,__line__,'bFaceMembs')
787  END IF ! global%error
788 
789  DEALLOCATE(layerinfo,stat=errorflag)
790  global%error = errorflag
791  IF ( global%error /= err_none ) THEN
792  CALL errorstop(global,err_deallocate,__line__,'layerInfo')
793  END IF ! global%error
794 
795 ! ******************************************************************************
796 ! End
797 ! ******************************************************************************
798 
799  IF ( global%myProcid == masterproc .AND. &
800  global%verbLevel > verbose_none ) THEN
801  WRITE(stdout,'(A,1X,A)') solver_name,'Building face-to-cell stencil done.'
802  END IF ! global%verbLevel
803 
804  CALL deregisterfunction(global)
805 
806  END SUBROUTINE rflu_buildf2cstencil
807 
808 
809 
810 
811 
812 
813 ! *******************************************************************************
814 !
815 ! Purpose: Wrapper for building face-to-cell stencil.
816 !
817 ! Description: None.
818 !
819 ! Input:
820 ! pRegion Pointer to region
821 ! constrInput Flag indicating whether have constrained reconstruction
822 !
823 ! Output: None.
824 !
825 ! Notes: None.
826 !
827 ! ******************************************************************************
828 
829  SUBROUTINE rflu_buildf2cstencilwrapper(pRegion,constrInput)
830 
831  IMPLICIT NONE
832 
833 ! ******************************************************************************
834 ! Declarations and definitions
835 ! ******************************************************************************
836 
837 ! ==============================================================================
838 ! Arguments
839 ! ==============================================================================
840 
841  INTEGER, INTENT(IN), OPTIONAL :: constrinput
842  TYPE(t_region), POINTER :: pregion
843 
844 ! ==============================================================================
845 ! Locals
846 ! ==============================================================================
847 
848  LOGICAL :: addbfaces
849  TYPE(t_grid), POINTER :: pgrid
850  TYPE(t_global), POINTER :: global
851 
852 ! ******************************************************************************
853 ! Start
854 ! ******************************************************************************
855 
856  global => pregion%global
857 
858  CALL registerfunction(global,'RFLU_BuildF2CStencilWrapper',&
859  'RFLU_ModStencilsFaces.F90')
860 
861 ! ******************************************************************************
862 ! Set pointers and variables
863 ! ******************************************************************************
864 
865  pgrid => pregion%grid
866 
867  IF ( .NOT. present(constrinput) ) THEN
868  addbfaces = .true.
869  ELSE
870  IF ( constrinput == constr_none ) THEN
871  addbfaces = .false.
872  ELSE
873  addbfaces = .true.
874  END IF ! constrInput
875  END IF ! PRESENT
876 
877 ! ******************************************************************************
878 ! Call routines to build stencils
879 ! ******************************************************************************
880 
881  SELECT CASE ( pregion%mixtInput%stencilDimensFaces )
882  CASE ( 1 )
883  CALL rflu_buildf2cstencil_1d(pregion)
884  CASE ( 2,3 )
885  CALL rflu_buildf2cstencil(pregion,addbfaces)
886  CASE default
887  CALL errorstop(global,err_reached_default,__line__)
888  END SELECT ! pRegion%mixtInput%stencilDimensFaces
889 
890 
891 ! ******************************************************************************
892 ! End
893 ! ******************************************************************************
894 
895  CALL deregisterfunction(global)
896 
897  END SUBROUTINE rflu_buildf2cstencilwrapper
898 
899 
900 
901 
902 
903 
904 ! *******************************************************************************
905 !
906 ! Purpose: Build list of face-to-cell stencils which are constrained.
907 !
908 ! Description: None.
909 !
910 ! Input:
911 ! pRegion Pointer to region
912 !
913 ! Output: None.
914 !
915 ! Notes: None.
916 !
917 ! ******************************************************************************
918 
919  SUBROUTINE rflu_buildlistcf2cstencil(pRegion)
920 
921  IMPLICIT NONE
922 
923 ! ******************************************************************************
924 ! Declarations and definitions
925 ! ******************************************************************************
926 
927 ! ==============================================================================
928 ! Arguments
929 ! ==============================================================================
930 
931  TYPE(t_region), POINTER :: pregion
932 
933 ! ==============================================================================
934 ! Locals
935 ! ==============================================================================
936 
937  INTEGER :: errorflag,ifg
938  TYPE(t_grid), POINTER :: pgrid
939  TYPE(t_global), POINTER :: global
940 
941 ! ******************************************************************************
942 ! Start
943 ! ******************************************************************************
944 
945  global => pregion%global
946 
947  CALL registerfunction(global,'RFLU_BuildListCF2CStencil',&
948  'RFLU_ModStencilsFaces.F90')
949 
950  IF ( global%myProcid == masterproc .AND. &
951  global%verbLevel > verbose_none ) THEN
952  WRITE(stdout,'(A,1X,A,A)') solver_name,'Building list of constrained ', &
953  'face-to-cell stencil...'
954  END IF ! global%verbLevel
955 
956 ! ******************************************************************************
957 ! Set grid pointer
958 ! ******************************************************************************
959 
960  pgrid => pregion%grid
961 
962 ! ******************************************************************************
963 ! Count and build list of constrained cell-to-cell stencils
964 ! ******************************************************************************
965 
966  pgrid%nFacesConstr = 0
967 
968  IF ( pregion%mixtInput%cReconstFaces > constr_none ) THEN
969  DO ifg = 1,pgrid%nFaces
970  IF ( pgrid%f2cs(ifg)%nBFaceMembs > 0 ) THEN
971  pgrid%nFacesConstr = pgrid%nFacesConstr + 1
972  END IF ! pGrid%f2cs(ifg)%nBFaceMembs
973  END DO ! ifg
974 
975  IF ( pgrid%nFacesConstr > 0 ) THEN
976  ALLOCATE(pgrid%ifgConstr(pgrid%nFacesConstr),stat=errorflag)
977  global%error = errorflag
978  IF ( global%error /= err_none ) THEN
979  CALL errorstop(global,err_allocate,__line__,'pGrid%ifgConstr')
980  END IF ! global%error
981 
982  pgrid%nFacesConstr = 0
983 
984  DO ifg = 1,pgrid%nFaces
985  IF ( pgrid%f2cs(ifg)%nBFaceMembs > 0 ) THEN
986  pgrid%nFacesConstr = pgrid%nFacesConstr + 1
987 
988  pgrid%ifgConstr(pgrid%nFacesConstr) = ifg
989  END IF ! pGrid%f2cs(ifg)%nBFaceMembs
990  END DO ! ifg
991  ELSE
992  nullify(pgrid%ifgConstr)
993  END IF ! pGrid%nFacesConstr
994  ELSE
995  nullify(pgrid%ifgConstr)
996  END IF ! pRegion%mixtInput%cReconstFaces
997 
998 ! ******************************************************************************
999 ! Print info
1000 ! ******************************************************************************
1001 
1002  IF ( global%myProcid == masterproc .AND. &
1003  global%verbLevel > verbose_low ) THEN
1004  WRITE(stdout,'(A,3X,A,A,1X,I5)') solver_name,'Number of constrained ', &
1005  'face-to-cell stencils:', &
1006  pgrid%nFacesConstr
1007  END IF ! global%verbLevel
1008 
1009 ! ******************************************************************************
1010 ! End
1011 ! ******************************************************************************
1012 
1013  IF ( global%myProcid == masterproc .AND. &
1014  global%verbLevel > verbose_none ) THEN
1015  WRITE(stdout,'(A,1X,A,A)') solver_name,'Building list of constrained ', &
1016  'face-to-cell stencil done.'
1017  END IF ! global%verbLevel
1018 
1019  CALL deregisterfunction(global)
1020 
1021  END SUBROUTINE rflu_buildlistcf2cstencil
1022 
1023 
1024 
1025 
1026 
1027 
1028 ! *******************************************************************************
1029 !
1030 ! Purpose: Create 1D face-to-cell stencil.
1031 !
1032 ! Description: None.
1033 !
1034 ! Input:
1035 ! pRegion Pointer to region
1036 !
1037 ! Output: None.
1038 !
1039 ! Notes: None.
1040 !
1041 ! ******************************************************************************
1042 
1043  SUBROUTINE rflu_createf2cstencil_1d(pRegion)
1044 
1045  IMPLICIT NONE
1046 
1047 ! ******************************************************************************
1048 ! Declarations and definitions
1049 ! ******************************************************************************
1050 
1051 ! ==============================================================================
1052 ! Arguments
1053 ! ==============================================================================
1054 
1055  TYPE(t_region), POINTER :: pregion
1056 
1057 ! ==============================================================================
1058 ! Locals
1059 ! ==============================================================================
1060 
1061  INTEGER :: errorflag,ifg
1062  TYPE(t_grid), POINTER :: pgrid
1063  TYPE(t_global), POINTER :: global
1064 
1065 ! ******************************************************************************
1066 ! Start
1067 ! ******************************************************************************
1068 
1069  global => pregion%global
1070 
1071  CALL registerfunction(global,'RFLU_CreateF2CStencil_1D',&
1072  'RFLU_ModStencilsFaces.F90')
1073 
1074  IF ( global%myProcid == masterproc .AND. &
1075  global%verbLevel > verbose_none ) THEN
1076  WRITE(stdout,'(A,1X,A)') solver_name,'Creating 1D face-to-cell stencil...'
1077  END IF ! global%verbLevel
1078 
1079 ! ******************************************************************************
1080 ! Nullify memory
1081 ! ******************************************************************************
1082 
1083  CALL rflu_nullifyf2cstencil_1d(pregion)
1084 
1085 ! ******************************************************************************
1086 ! Set grid pointer
1087 ! ******************************************************************************
1088 
1089  pgrid => pregion%grid
1090 
1091 ! ******************************************************************************
1092 ! Allocate memory and initialize
1093 ! ******************************************************************************
1094 
1095  ALLOCATE(pgrid%f2cs1D(pgrid%nFaces),stat=errorflag)
1096  global%error = errorflag
1097  IF ( global%error /= err_none ) THEN
1098  CALL errorstop(global,err_allocate,__line__,'pGrid%f2cs1D')
1099  END IF ! global%error
1100 
1101  DO ifg = 1,pgrid%nFaces
1102  pgrid%f2cs1D(ifg)%nCellMembs = 0
1103  pgrid%f2cs1D(ifg)%nBFaceMembs = 0
1104  END DO ! ifg
1105 
1106 ! ******************************************************************************
1107 ! End
1108 ! ******************************************************************************
1109 
1110  IF ( global%myProcid == masterproc .AND. &
1111  global%verbLevel > verbose_none ) THEN
1112  WRITE(stdout,'(A,1X,A)') solver_name, &
1113  'Creating 1D face-to-cell stencil done.'
1114  END IF ! global%verbLevel
1115 
1116  CALL deregisterfunction(global)
1117 
1118  END SUBROUTINE rflu_createf2cstencil_1d
1119 
1120 
1121 
1122 
1123 
1124 
1125 
1126 
1127 ! *******************************************************************************
1128 !
1129 ! Purpose: Create face-to-cell stencil.
1130 !
1131 ! Description: None.
1132 !
1133 ! Input:
1134 ! pRegion Pointer to region
1135 !
1136 ! Output: None.
1137 !
1138 ! Notes: None.
1139 !
1140 ! ******************************************************************************
1141 
1142  SUBROUTINE rflu_createf2cstencil(pRegion)
1143 
1144  IMPLICIT NONE
1145 
1146 ! ******************************************************************************
1147 ! Declarations and definitions
1148 ! ******************************************************************************
1149 
1150 ! ==============================================================================
1151 ! Arguments
1152 ! ==============================================================================
1153 
1154  TYPE(t_region), POINTER :: pregion
1155 
1156 ! ==============================================================================
1157 ! Locals
1158 ! ==============================================================================
1159 
1160  INTEGER :: errorflag,ifg
1161  TYPE(t_grid), POINTER :: pgrid
1162  TYPE(t_global), POINTER :: global
1163 
1164 ! ******************************************************************************
1165 ! Start
1166 ! ******************************************************************************
1167 
1168  global => pregion%global
1169 
1170  CALL registerfunction(global,'RFLU_CreateF2CStencil',&
1171  'RFLU_ModStencilsFaces.F90')
1172 
1173  IF ( global%myProcid == masterproc .AND. &
1174  global%verbLevel > verbose_none ) THEN
1175  WRITE(stdout,'(A,1X,A)') solver_name,'Creating face-to-cell stencil...'
1176  END IF ! global%verbLevel
1177 
1178 ! ******************************************************************************
1179 ! Nullify memory
1180 ! ******************************************************************************
1181 
1182  CALL rflu_nullifyf2cstencil(pregion)
1183 
1184 ! ******************************************************************************
1185 ! Set grid pointer
1186 ! ******************************************************************************
1187 
1188  pgrid => pregion%grid
1189 
1190 ! ******************************************************************************
1191 ! Allocate memory and initialize
1192 ! ******************************************************************************
1193 
1194  ALLOCATE(pgrid%f2cs(pgrid%nFaces),stat=errorflag)
1195  global%error = errorflag
1196  IF ( global%error /= err_none ) THEN
1197  CALL errorstop(global,err_allocate,__line__,'pGrid%f2cs')
1198  END IF ! global%error
1199 
1200  DO ifg = 1,pgrid%nFaces
1201  pgrid%f2cs(ifg)%nCellMembs = 0
1202  pgrid%f2cs(ifg)%nBFaceMembs = 0
1203  END DO ! ifg
1204 
1205 ! ******************************************************************************
1206 ! End
1207 ! ******************************************************************************
1208 
1209  IF ( global%myProcid == masterproc .AND. &
1210  global%verbLevel > verbose_none ) THEN
1211  WRITE(stdout,'(A,1X,A)') solver_name, &
1212  'Creating face-to-cell stencil done.'
1213  END IF ! global%verbLevel
1214 
1215  CALL deregisterfunction(global)
1216 
1217  END SUBROUTINE rflu_createf2cstencil
1218 
1219 
1220 
1221 
1222 
1223 
1224 
1225 ! *******************************************************************************
1226 !
1227 ! Purpose: Wrapper routine for creating face-to-cell stencils.
1228 !
1229 ! Description: None.
1230 !
1231 ! Input:
1232 ! pRegion Pointer to region
1233 !
1234 ! Output: None.
1235 !
1236 ! Notes: None.
1237 !
1238 ! ******************************************************************************
1239 
1240  SUBROUTINE rflu_createf2cstencilwrapper(pRegion)
1241 
1242  IMPLICIT NONE
1243 
1244 ! ******************************************************************************
1245 ! Declarations and definitions
1246 ! ******************************************************************************
1247 
1248 ! ==============================================================================
1249 ! Arguments
1250 ! ==============================================================================
1251 
1252  TYPE(t_region), POINTER :: pregion
1253 
1254 ! ==============================================================================
1255 ! Locals
1256 ! ==============================================================================
1257 
1258  TYPE(t_global), POINTER :: global
1259 
1260 ! ******************************************************************************
1261 ! Start
1262 ! ******************************************************************************
1263 
1264  global => pregion%global
1265 
1266  CALL registerfunction(global,'RFLU_CreateF2CStencilWrapper',&
1267  'RFLU_ModStencilsFaces.F90')
1268 
1269 ! ******************************************************************************
1270 ! Call routines to create stencils
1271 ! ******************************************************************************
1272 
1273  SELECT CASE ( pregion%mixtInput%stencilDimensFaces )
1274  CASE ( 1 )
1275  CALL rflu_createf2cstencil_1d(pregion)
1276  CASE ( 2,3 )
1277  CALL rflu_createf2cstencil(pregion)
1278  CASE default
1279  CALL errorstop(global,err_reached_default,__line__)
1280  END SELECT ! pRegion%mixtInput%stencilDimensFaces
1281 
1282 ! ******************************************************************************
1283 ! End
1284 ! ******************************************************************************
1285 
1286  CALL deregisterfunction(global)
1287 
1288  END SUBROUTINE rflu_createf2cstencilwrapper
1289 
1290 
1291 
1292 
1293 
1294 
1295 
1296 
1297 ! *******************************************************************************
1298 !
1299 ! Purpose: Destroy 1D face-to-cell stencil.
1300 !
1301 ! Description: None.
1302 !
1303 ! Input:
1304 ! pRegion Pointer to region
1305 !
1306 ! Output: None.
1307 !
1308 ! Notes: None.
1309 !
1310 ! ******************************************************************************
1311 
1312  SUBROUTINE rflu_destroyf2cstencil_1d(pRegion)
1313 
1314  IMPLICIT NONE
1315 
1316 ! ******************************************************************************
1317 ! Declarations and definitions
1318 ! ******************************************************************************
1319 
1320 ! ==============================================================================
1321 ! Arguments
1322 ! ==============================================================================
1323 
1324  TYPE(t_region), POINTER :: pregion
1325 
1326 ! ==============================================================================
1327 ! Locals
1328 ! ==============================================================================
1329 
1330  INTEGER :: errorflag,ifg
1331  TYPE(t_grid), POINTER :: pgrid
1332  TYPE(t_global), POINTER :: global
1333 
1334 ! ******************************************************************************
1335 ! Start
1336 ! ******************************************************************************
1337 
1338  global => pregion%global
1339 
1340  CALL registerfunction(global,'RFLU_DestroyF2CStencil_1D',&
1341  'RFLU_ModStencilsFaces.F90')
1342 
1343  IF ( global%myProcid == masterproc .AND. &
1344  global%verbLevel > verbose_none ) THEN
1345  WRITE(stdout,'(A,1X,A)') solver_name, &
1346  'Destroying 1D face-to-cell stencil...'
1347  END IF ! global%verbLevel
1348 
1349 ! ******************************************************************************
1350 ! Set grid pointer
1351 ! ******************************************************************************
1352 
1353  pgrid => pregion%grid
1354 
1355 ! ******************************************************************************
1356 ! Deallocate memory
1357 ! ******************************************************************************
1358 
1359  DO ifg = 1,pgrid%nFaces
1360  DEALLOCATE(pgrid%f2cs1D(ifg)%cellMembs,stat=errorflag)
1361  global%error = errorflag
1362  IF ( global%error /= err_none ) THEN
1363  CALL errorstop(global,err_deallocate,__line__,'pGrid%f2cs1D%cellMembs')
1364  END IF ! global%error
1365 
1366  IF ( pgrid%f2cs1D(ifg)%nBFaceMembs > 0 ) THEN
1367  DEALLOCATE(pgrid%f2cs1D(ifg)%bFaceMembs,stat=errorflag)
1368  global%error = errorflag
1369  IF ( global%error /= err_none ) THEN
1370  CALL errorstop(global,err_deallocate,__line__, &
1371  'pGrid%f2cs1D%bFaceMembs')
1372  END IF ! global%error
1373  END IF ! pGrid%f2cs1D%nBFaceMembs
1374  END DO ! ifg
1375 
1376  DEALLOCATE(pgrid%f2cs1D,stat=errorflag)
1377  global%error = errorflag
1378  IF ( global%error /= err_none ) THEN
1379  CALL errorstop(global,err_deallocate,__line__,'pGrid%f2cs1D')
1380  END IF ! global%error
1381 
1382 ! ******************************************************************************
1383 ! Nullify memory
1384 ! ******************************************************************************
1385 
1386  CALL rflu_nullifyf2cstencil_1d(pregion)
1387 
1388 ! ******************************************************************************
1389 ! End
1390 ! ******************************************************************************
1391 
1392  IF ( global%myProcid == masterproc .AND. &
1393  global%verbLevel > verbose_none ) THEN
1394  WRITE(stdout,'(A,1X,A)') solver_name, &
1395  'Destroying 1D face-to-cell stencil done.'
1396  END IF ! global%verbLevel
1397 
1398  CALL deregisterfunction(global)
1399 
1400  END SUBROUTINE rflu_destroyf2cstencil_1d
1401 
1402 
1403 
1404 
1405 
1406 
1407 ! *******************************************************************************
1408 !
1409 ! Purpose: Destroy face-to-cell stencil.
1410 !
1411 ! Description: None.
1412 !
1413 ! Input:
1414 ! pRegion Pointer to region
1415 !
1416 ! Output: None.
1417 !
1418 ! Notes: None.
1419 !
1420 ! ******************************************************************************
1421 
1422  SUBROUTINE rflu_destroyf2cstencil(pRegion)
1423 
1424  IMPLICIT NONE
1425 
1426 ! ******************************************************************************
1427 ! Declarations and definitions
1428 ! ******************************************************************************
1429 
1430 ! ==============================================================================
1431 ! Arguments
1432 ! ==============================================================================
1433 
1434  TYPE(t_region), POINTER :: pregion
1435 
1436 ! ==============================================================================
1437 ! Locals
1438 ! ==============================================================================
1439 
1440  INTEGER :: errorflag,ifg
1441  TYPE(t_grid), POINTER :: pgrid
1442  TYPE(t_global), POINTER :: global
1443 
1444 ! ******************************************************************************
1445 ! Start
1446 ! ******************************************************************************
1447 
1448  global => pregion%global
1449 
1450  CALL registerfunction(global,'RFLU_DestroyF2CStencil',&
1451  'RFLU_ModStencilsFaces.F90')
1452 
1453  IF ( global%myProcid == masterproc .AND. &
1454  global%verbLevel > verbose_none ) THEN
1455  WRITE(stdout,'(A,1X,A)') solver_name, &
1456  'Destroying face-to-cell stencil...'
1457  END IF ! global%verbLevel
1458 
1459 ! ******************************************************************************
1460 ! Set grid pointer
1461 ! ******************************************************************************
1462 
1463  pgrid => pregion%grid
1464 
1465 ! ******************************************************************************
1466 ! Deallocate memory
1467 ! ******************************************************************************
1468 
1469  DO ifg = 1,pgrid%nFaces
1470  DEALLOCATE(pgrid%f2cs(ifg)%cellMembs,stat=errorflag)
1471  global%error = errorflag
1472  IF ( global%error /= err_none ) THEN
1473  CALL errorstop(global,err_deallocate,__line__,'pGrid%f2cs%cellMembs')
1474  END IF ! global%error
1475 
1476  IF ( pgrid%f2cs(ifg)%nBFaceMembs > 0 ) THEN
1477  DEALLOCATE(pgrid%f2cs(ifg)%bFaceMembs,stat=errorflag)
1478  global%error = errorflag
1479  IF ( global%error /= err_none ) THEN
1480  CALL errorstop(global,err_deallocate,__line__, &
1481  'pGrid%f2cs%bFaceMembs')
1482  END IF ! global%error
1483  END IF ! pGrid%f2cs%nBFaceMembs
1484  END DO ! ifg
1485 
1486  DEALLOCATE(pgrid%f2cs,stat=errorflag)
1487  global%error = errorflag
1488  IF ( global%error /= err_none ) THEN
1489  CALL errorstop(global,err_deallocate,__line__,'pGrid%f2cs')
1490  END IF ! global%error
1491 
1492 ! ******************************************************************************
1493 ! Nullify memory
1494 ! ******************************************************************************
1495 
1496  CALL rflu_nullifyf2cstencil(pregion)
1497 
1498 ! ******************************************************************************
1499 ! End
1500 ! ******************************************************************************
1501 
1502  IF ( global%myProcid == masterproc .AND. &
1503  global%verbLevel > verbose_none ) THEN
1504  WRITE(stdout,'(A,1X,A)') solver_name, &
1505  'Destroying face-to-cell stencil done.'
1506  END IF ! global%verbLevel
1507 
1508  CALL deregisterfunction(global)
1509 
1510  END SUBROUTINE rflu_destroyf2cstencil
1511 
1512 
1513 
1514 
1515 
1516 
1517 
1518 ! *******************************************************************************
1519 !
1520 ! Purpose: Wrapper routine for destroying face-to-cell stencils.
1521 !
1522 ! Description: None.
1523 !
1524 ! Input:
1525 ! pRegion Pointer to region
1526 !
1527 ! Output: None.
1528 !
1529 ! Notes: None.
1530 !
1531 ! ******************************************************************************
1532 
1533  SUBROUTINE rflu_destroyf2cstencilwrapper(pRegion)
1534 
1535  IMPLICIT NONE
1536 
1537 ! ******************************************************************************
1538 ! Declarations and definitions
1539 ! ******************************************************************************
1540 
1541 ! ==============================================================================
1542 ! Arguments
1543 ! ==============================================================================
1544 
1545  TYPE(t_region), POINTER :: pregion
1546 
1547 ! ==============================================================================
1548 ! Locals
1549 ! ==============================================================================
1550 
1551  TYPE(t_global), POINTER :: global
1552 
1553 ! ******************************************************************************
1554 ! Start
1555 ! ******************************************************************************
1556 
1557  global => pregion%global
1558 
1559  CALL registerfunction(global,'RFLU_DestroyF2CStencilWrapper',&
1560  'RFLU_ModStencilsFaces.F90')
1561 
1562 ! ******************************************************************************
1563 ! Call routines to destroy stencils
1564 ! ******************************************************************************
1565 
1566  SELECT CASE ( pregion%mixtInput%stencilDimensFaces )
1567  CASE ( 1 )
1568  CALL rflu_destroyf2cstencil_1d(pregion)
1569  CASE ( 2,3 )
1570  CALL rflu_destroyf2cstencil(pregion)
1571  CASE default
1572  CALL errorstop(global,err_reached_default,__line__)
1573  END SELECT ! pRegion%mixtInput%stencilDimensFaces
1574 
1575 ! ******************************************************************************
1576 ! End
1577 ! ******************************************************************************
1578 
1579  CALL deregisterfunction(global)
1580 
1581  END SUBROUTINE rflu_destroyf2cstencilwrapper
1582 
1583 
1584 
1585 
1586 
1587 
1588 ! *******************************************************************************
1589 !
1590 ! Purpose: Destroy list of face-to-cell stencils which are constrained.
1591 !
1592 ! Description: None.
1593 !
1594 ! Input:
1595 ! pRegion Pointer to region
1596 !
1597 ! Output: None.
1598 !
1599 ! Notes: None.
1600 !
1601 ! ******************************************************************************
1602 
1603  SUBROUTINE rflu_destroylistcf2cstencil(pRegion)
1604 
1605  IMPLICIT NONE
1606 
1607 ! ******************************************************************************
1608 ! Declarations and definitions
1609 ! ******************************************************************************
1610 
1611 ! ==============================================================================
1612 ! Arguments
1613 ! ==============================================================================
1614 
1615  TYPE(t_region), POINTER :: pregion
1616 
1617 ! ==============================================================================
1618 ! Locals
1619 ! ==============================================================================
1620 
1621  INTEGER :: errorflag
1622  TYPE(t_grid), POINTER :: pgrid
1623  TYPE(t_global), POINTER :: global
1624 
1625 ! ******************************************************************************
1626 ! Start
1627 ! ******************************************************************************
1628 
1629  global => pregion%global
1630 
1631  CALL registerfunction(global,'RFLU_DestroyListCF2CStencil',&
1632  'RFLU_ModStencilsFaces.F90')
1633 
1634  IF ( global%myProcid == masterproc .AND. &
1635  global%verbLevel > verbose_none ) THEN
1636  WRITE(stdout,'(A,1X,A,A)') solver_name,'Destroying list of ', &
1637  'constrained face-to-cell stencil...'
1638  END IF ! global%verbLevel
1639 
1640 ! ******************************************************************************
1641 ! Set grid pointer
1642 ! ******************************************************************************
1643 
1644  pgrid => pregion%grid
1645 
1646 ! ******************************************************************************
1647 ! Destroy list of constrained cell-to-cell stencils
1648 ! ******************************************************************************
1649 
1650  IF ( pregion%mixtInput%cReconstFaces > constr_none ) THEN
1651  IF ( pgrid%nFacesConstr > 0 ) THEN
1652  DEALLOCATE(pgrid%ifgConstr,stat=errorflag)
1653  global%error = errorflag
1654  IF ( global%error /= err_none ) THEN
1655  CALL errorstop(global,err_deallocate,__line__,'pGrid%ifgConstr')
1656  END IF ! global%error
1657 
1658  pgrid%nFacesConstr = 0
1659  END IF ! pGrid%nFacesConstr
1660  END IF ! pRegion%mixtInput%cReconstFaces
1661 
1662 ! ******************************************************************************
1663 ! End
1664 ! ******************************************************************************
1665 
1666  IF ( global%myProcid == masterproc .AND. &
1667  global%verbLevel > verbose_none ) THEN
1668  WRITE(stdout,'(A,1X,A,A)') solver_name,'Destroying list of ', &
1669  'constrained face-to-cell stencil done.'
1670  END IF ! global%verbLevel
1671 
1672  CALL deregisterfunction(global)
1673 
1674  END SUBROUTINE rflu_destroylistcf2cstencil
1675 
1676 
1677 
1678 
1679 
1680 ! *******************************************************************************
1681 !
1682 ! Purpose: Nullify face-to-cell stencil.
1683 !
1684 ! Description: None.
1685 !
1686 ! Input:
1687 ! pRegion Pointer to region
1688 !
1689 ! Output: None.
1690 !
1691 ! Notes: None.
1692 !
1693 ! ******************************************************************************
1694 
1695  SUBROUTINE rflu_nullifyf2cstencil_1d(pRegion)
1696 
1697  IMPLICIT NONE
1698 
1699 ! ******************************************************************************
1700 ! Declarations and definitions
1701 ! ******************************************************************************
1702 
1703 ! ==============================================================================
1704 ! Arguments
1705 ! ==============================================================================
1706 
1707  TYPE(t_region), POINTER :: pregion
1708 
1709 ! ==============================================================================
1710 ! Locals
1711 ! ==============================================================================
1712 
1713  INTEGER :: ipatch
1714  TYPE(t_grid), POINTER :: pgrid
1715  TYPE(t_patch), POINTER :: ppatch
1716  TYPE(t_global), POINTER :: global
1717 
1718 ! ******************************************************************************
1719 ! Start
1720 ! ******************************************************************************
1721 
1722  global => pregion%global
1723 
1724  CALL registerfunction(global,'RFLU_NullifyF2CStencil_1D',&
1725  'RFLU_ModStencilsFaces.F90')
1726 
1727  IF ( global%myProcid == masterproc .AND. &
1728  global%verbLevel > verbose_none ) THEN
1729  WRITE(stdout,'(A,1X,A)') solver_name, &
1730  'Nullifying 1D face-to-cell stencil...'
1731  END IF ! global%verbLevel
1732 
1733 ! ******************************************************************************
1734 ! Set grid pointer
1735 ! ******************************************************************************
1736 
1737  pgrid => pregion%grid
1738 
1739 ! ******************************************************************************
1740 ! Nullify memory
1741 ! ******************************************************************************
1742 
1743  nullify(pgrid%f2cs1D)
1744 
1745 ! ******************************************************************************
1746 ! End
1747 ! ******************************************************************************
1748 
1749  IF ( global%myProcid == masterproc .AND. &
1750  global%verbLevel > verbose_none ) THEN
1751  WRITE(stdout,'(A,1X,A)') solver_name, &
1752  'Nullifying 1D face-to-cell stencil done.'
1753  END IF ! global%verbLevel
1754 
1755  CALL deregisterfunction(global)
1756 
1757  END SUBROUTINE rflu_nullifyf2cstencil_1d
1758 
1759 
1760 
1761 
1762 
1763 ! *******************************************************************************
1764 !
1765 ! Purpose: Nullify face-to-cell stencil.
1766 !
1767 ! Description: None.
1768 !
1769 ! Input:
1770 ! pRegion Pointer to region
1771 !
1772 ! Output: None.
1773 !
1774 ! Notes: None.
1775 !
1776 ! ******************************************************************************
1777 
1778  SUBROUTINE rflu_nullifyf2cstencil(pRegion)
1779 
1780  IMPLICIT NONE
1781 
1782 ! ******************************************************************************
1783 ! Declarations and definitions
1784 ! ******************************************************************************
1785 
1786 ! ==============================================================================
1787 ! Arguments
1788 ! ==============================================================================
1789 
1790  TYPE(t_region), POINTER :: pregion
1791 
1792 ! ==============================================================================
1793 ! Locals
1794 ! ==============================================================================
1795 
1796  INTEGER :: ipatch
1797  TYPE(t_grid), POINTER :: pgrid
1798  TYPE(t_patch), POINTER :: ppatch
1799  TYPE(t_global), POINTER :: global
1800 
1801 ! ******************************************************************************
1802 ! Start
1803 ! ******************************************************************************
1804 
1805  global => pregion%global
1806 
1807  CALL registerfunction(global,'RFLU_NullifyF2CStencil',&
1808  'RFLU_ModStencilsFaces.F90')
1809 
1810  IF ( global%myProcid == masterproc .AND. &
1811  global%verbLevel > verbose_none ) THEN
1812  WRITE(stdout,'(A,1X,A)') solver_name, &
1813  'Nullifying face-to-cell stencil...'
1814  END IF ! global%verbLevel
1815 
1816 ! ******************************************************************************
1817 ! Set grid pointer
1818 ! ******************************************************************************
1819 
1820  pgrid => pregion%grid
1821 
1822 ! ******************************************************************************
1823 ! Nullify memory
1824 ! ******************************************************************************
1825 
1826  nullify(pgrid%f2cs)
1827 
1828 ! ******************************************************************************
1829 ! End
1830 ! ******************************************************************************
1831 
1832  IF ( global%myProcid == masterproc .AND. &
1833  global%verbLevel > verbose_none ) THEN
1834  WRITE(stdout,'(A,1X,A)') solver_name, &
1835  'Nullifying face-to-cell stencil done.'
1836  END IF ! global%verbLevel
1837 
1838  CALL deregisterfunction(global)
1839 
1840  END SUBROUTINE rflu_nullifyf2cstencil
1841 
1842 
1843 
1844 
1845 
1846 
1847 
1848 ! *******************************************************************************
1849 !
1850 ! Purpose: Set 1D face-to-cell stencil information.
1851 !
1852 ! Description: None.
1853 !
1854 ! Input:
1855 ! pRegion Pointer to region
1856 ! orderNominalInput Nominal order of accuracy
1857 !
1858 ! Output: None.
1859 !
1860 ! Notes:
1861 ! 1. NOTE need to guard against orderInput being zero if running with
1862 ! first-order scheme.
1863 !
1864 ! ******************************************************************************
1865 
1866  SUBROUTINE rflu_setinfof2cstencil_1d(pRegion,orderNominalInput)
1867 
1868  IMPLICIT NONE
1869 
1870 ! ******************************************************************************
1871 ! Declarations and definitions
1872 ! ******************************************************************************
1873 
1874 ! ==============================================================================
1875 ! Arguments
1876 ! ==============================================================================
1877 
1878  INTEGER, INTENT(IN) :: ordernominalinput
1879  TYPE(t_region), POINTER :: pregion
1880 
1881 ! ==============================================================================
1882 ! Locals
1883 ! ==============================================================================
1884 
1885  INTEGER :: nbfacemembsmax,nlayersmax,ordernominal,stencilsizemax, &
1886  stencilsizemin
1887  TYPE(t_grid), POINTER :: pgrid
1888  TYPE(t_global), POINTER :: global
1889 
1890 ! ******************************************************************************
1891 ! Start
1892 ! ******************************************************************************
1893 
1894  global => pregion%global
1895 
1896  CALL registerfunction(global,'RFLU_SetInfoF2CStencil_1D',&
1897  'RFLU_ModStencilsFaces.F90')
1898 
1899  IF ( global%myProcid == masterproc .AND. &
1900  global%verbLevel > verbose_none ) THEN
1901  WRITE(stdout,'(A,1X,A)') solver_name, &
1902  'Setting 1D face-to-cell stencil information...'
1903  END IF ! global%verbLevel
1904 
1905 ! ******************************************************************************
1906 ! Set grid pointer
1907 ! ******************************************************************************
1908 
1909  pgrid => pregion%grid
1910 
1911 ! ******************************************************************************
1912 ! Set stencil information. NOTE nBFaceMembsMax must be one less than the
1913 ! number of unknowns (or columns). NOTE orderNominal must be at least 2
1914 ! so can get stencil of at least 2 cells.
1915 ! ******************************************************************************
1916 
1917  ordernominal = max(ordernominalinput,2)
1918 
1919  nlayersmax = ordernominal
1920  nbfacemembsmax = 0 ! TEMPORARY
1921  stencilsizemin = ordernominal ! No difference between min and max value
1922  stencilsizemax = ordernominal
1923 
1924  pgrid%f2csInfo%orderNominal = ordernominal
1925  pgrid%f2csInfo%nLayersMax = nlayersmax
1926  pgrid%f2csInfo%nBFaceMembsMax = nbfacemembsmax
1927  pgrid%f2csInfo%nCellMembsMax = stencilsizemax
1928  pgrid%f2csInfo%nCellMembsMin = stencilsizemin
1929 
1930 ! ******************************************************************************
1931 ! Print stencil information
1932 ! ******************************************************************************
1933 
1934  IF ( global%myProcid == masterproc .AND. &
1935  global%verbLevel > verbose_low ) THEN
1936  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name, &
1937  'Maximum allowed number of cell layers: ',nlayersmax
1938  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name, &
1939  'Minimum required number of cell members:',stencilsizemin
1940  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name, &
1941  'Maximum allowed number of cell members: ',stencilsizemax
1942  END IF ! global%myProcid
1943 
1944 ! ******************************************************************************
1945 ! End
1946 ! ******************************************************************************
1947 
1948  IF ( global%myProcid == masterproc .AND. &
1949  global%verbLevel > verbose_none ) THEN
1950  WRITE(stdout,'(A,1X,A)') solver_name, &
1951  'Setting 1D face-to-cell stencil information done.'
1952  END IF ! global%verbLevel
1953 
1954  CALL deregisterfunction(global)
1955 
1956  END SUBROUTINE rflu_setinfof2cstencil_1d
1957 
1958 
1959 
1960 
1961 
1962 
1963 ! *******************************************************************************
1964 !
1965 ! Purpose: Set face-to-cell stencil information.
1966 !
1967 ! Description: None.
1968 !
1969 ! Input:
1970 ! pRegion Pointer to region
1971 ! orderNominalInput Nominal order of accuracy
1972 !
1973 ! Output: None.
1974 !
1975 ! Notes:
1976 ! 1. NOTE need to guard against orderInput being zero if running with
1977 ! first-order scheme.
1978 !
1979 ! ******************************************************************************
1980 
1981  SUBROUTINE rflu_setinfof2cstencil(pRegion,orderNominalInput)
1982 
1983  IMPLICIT NONE
1984 
1985 ! ******************************************************************************
1986 ! Declarations and definitions
1987 ! ******************************************************************************
1988 
1989 ! ==============================================================================
1990 ! Arguments
1991 ! ==============================================================================
1992 
1993  INTEGER, INTENT(IN) :: ordernominalinput
1994  TYPE(t_region), POINTER :: pregion
1995 
1996 ! ==============================================================================
1997 ! Locals
1998 ! ==============================================================================
1999 
2000  INTEGER :: nbfacemembsmax,nlayersmax,ordernominal,stencilsizemax, &
2001  stencilsizemin
2002  TYPE(t_grid), POINTER :: pgrid
2003  TYPE(t_global), POINTER :: global
2004 
2005 ! ******************************************************************************
2006 ! Start
2007 ! ******************************************************************************
2008 
2009  global => pregion%global
2010 
2011  CALL registerfunction(global,'RFLU_SetInfoF2CStencil',&
2012  'RFLU_ModStencilsFaces.F90')
2013 
2014  IF ( global%myProcid == masterproc .AND. &
2015  global%verbLevel > verbose_none ) THEN
2016  WRITE(stdout,'(A,1X,A)') solver_name, &
2017  'Setting face-to-cell stencil information...'
2018  END IF ! global%verbLevel
2019 
2020 ! ******************************************************************************
2021 ! Set grid pointer
2022 ! ******************************************************************************
2023 
2024  pgrid => pregion%grid
2025 
2026 ! ******************************************************************************
2027 ! Set stencil information. NOTE nBFaceMembsMax must be one less than the
2028 ! number of unknowns (or columns), otherwise LAPACK routine used for
2029 ! constrained least-squares problem always gives trivial solution.
2030 ! ******************************************************************************
2031 
2032  ordernominal = max(ordernominalinput,1)
2033 
2034  nlayersmax = 6
2035 ! nBFaceMembsMax = RFLU_ComputeStencilSize(global,pRegion%mixtInput%dimens, &
2036 ! 1,orderNominal) - 1
2037  nbfacemembsmax = 3
2038  stencilsizemin = rflu_computestencilsize(global,pregion%mixtInput%dimens, &
2039  1,ordernominal)
2040  stencilsizemax = 10*stencilsizemin
2041 
2042  pgrid%f2csInfo%orderNominal = ordernominal
2043  pgrid%f2csInfo%nLayersMax = nlayersmax
2044  pgrid%f2csInfo%nBFaceMembsMax = nbfacemembsmax
2045  pgrid%f2csInfo%nCellMembsMax = stencilsizemax
2046  pgrid%f2csInfo%nCellMembsMin = stencilsizemin
2047 
2048 ! ******************************************************************************
2049 ! Print stencil information
2050 ! ******************************************************************************
2051 
2052  IF ( global%myProcid == masterproc .AND. &
2053  global%verbLevel > verbose_low ) THEN
2054  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name, &
2055  'Maximum allowed number of cell layers: ',nlayersmax
2056  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name, &
2057  'Minimum required number of cell members:',stencilsizemin
2058  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name, &
2059  'Maximum allowed number of cell members: ',stencilsizemax
2060  END IF ! global%myProcid
2061 
2062 ! ******************************************************************************
2063 ! End
2064 ! ******************************************************************************
2065 
2066  IF ( global%myProcid == masterproc .AND. &
2067  global%verbLevel > verbose_none ) THEN
2068  WRITE(stdout,'(A,1X,A)') solver_name, &
2069  'Setting face-to-cell stencil information done.'
2070  END IF ! global%verbLevel
2071 
2072  CALL deregisterfunction(global)
2073 
2074  END SUBROUTINE rflu_setinfof2cstencil
2075 
2076 
2077 
2078 
2079 
2080 
2081 
2082 ! *******************************************************************************
2083 !
2084 ! Purpose: Wrapper routine for setting info for face-to-cell stencils.
2085 !
2086 ! Description: None.
2087 !
2088 ! Input:
2089 ! pRegion Pointer to region
2090 ! orderNominal Nominal order of accuracy
2091 !
2092 ! Output: None.
2093 !
2094 ! Notes: None.
2095 !
2096 ! ******************************************************************************
2097 
2098  SUBROUTINE rflu_setinfof2cstencilwrapper(pRegion,orderNominal)
2099 
2100  IMPLICIT NONE
2101 
2102 ! ******************************************************************************
2103 ! Declarations and definitions
2104 ! ******************************************************************************
2105 
2106 ! ==============================================================================
2107 ! Arguments
2108 ! ==============================================================================
2109 
2110  INTEGER, INTENT(IN) :: ordernominal
2111  TYPE(t_region), POINTER :: pregion
2112 
2113 ! ==============================================================================
2114 ! Locals
2115 ! ==============================================================================
2116 
2117  TYPE(t_global), POINTER :: global
2118 
2119 ! ******************************************************************************
2120 ! Start
2121 ! ******************************************************************************
2122 
2123  global => pregion%global
2124 
2125  CALL registerfunction(global,'RFLU_SetInfoF2CStencilWrapper',&
2126  'RFLU_ModStencilsFaces.F90')
2127 
2128 ! ******************************************************************************
2129 ! Call routines to set info for stencils
2130 ! ******************************************************************************
2131 
2132  SELECT CASE ( pregion%mixtInput%stencilDimensFaces )
2133  CASE ( 1 )
2134  CALL rflu_setinfof2cstencil_1d(pregion,ordernominal)
2135  CASE ( 2,3 )
2136  CALL rflu_setinfof2cstencil(pregion,ordernominal)
2137  CASE default
2138  CALL errorstop(global,err_reached_default,__line__)
2139  END SELECT ! pRegion%mixtInput%stencilDimensFaces
2140 
2141 ! ******************************************************************************
2142 ! End
2143 ! ******************************************************************************
2144 
2145  CALL deregisterfunction(global)
2146 
2147  END SUBROUTINE rflu_setinfof2cstencilwrapper
2148 
2149 
2150 
2151 
2152 
2153 
2154 ! ******************************************************************************
2155 ! End
2156 ! ******************************************************************************
2157 
2158 END MODULE rflu_modstencilsfaces
2159 
2160 
2161 ! ******************************************************************************
2162 !
2163 ! RCS Revision history:
2164 !
2165 ! $Log: RFLU_ModStencilsFaces.F90,v $
2166 ! Revision 1.11 2008/12/06 08:44:24 mtcampbe
2167 ! Updated license.
2168 !
2169 ! Revision 1.10 2008/11/19 22:17:35 mtcampbe
2170 ! Added Illinois Open Source License/Copyright
2171 !
2172 ! Revision 1.9 2007/07/08 21:45:03 gzheng
2173 ! changed the PRESENT is used for PGI compiler
2174 !
2175 ! Revision 1.8 2006/12/15 13:26:36 haselbac
2176 ! Fixed bug in format statement, found by ifort
2177 !
2178 ! Revision 1.7 2006/04/07 15:19:20 haselbac
2179 ! Removed tabs
2180 !
2181 ! Revision 1.6 2006/04/07 14:52:04 haselbac
2182 ! Adapted to new stencilDimens param, bug fixes for 1D stencils
2183 !
2184 ! Revision 1.5 2006/03/09 15:04:51 haselbac
2185 ! Bug fix and put routines in right order
2186 !
2187 ! Revision 1.4 2006/03/09 14:08:59 haselbac
2188 ! Wrapperified module bcos of 1D routines, removed CF2C list routines
2189 !
2190 ! Revision 1.3 2005/12/25 15:33:58 haselbac
2191 ! Added face-specific constraint flag
2192 !
2193 ! Revision 1.2 2005/10/27 19:19:36 haselbac
2194 ! Changed names, clean-up
2195 !
2196 ! Revision 1.1 2005/10/05 14:33:44 haselbac
2197 ! Initial revision
2198 !
2199 ! ******************************************************************************
2200 
2201 
2202 
2203 
2204 
2205 
2206 
2207 
2208 
2209 
2210 
2211 
2212 
2213 
2214 
2215 
2216 
2217 
2218 
2219 
2220 
2221 
rflu_modstencilsutils::rflu_addcelllayer
subroutine, public rflu_addcelllayer(global, pGrid, stencilSizeMax, ixg, degr, x2csBeg, x2csEnd, x2cs)
Definition: RFLU_ModStencilsUtils.F90:669
rflu_modstencilsfaces::rflu_buildf2cstencil_1d
subroutine rflu_buildf2cstencil_1d(pRegion)
Definition: RFLU_ModStencilsFaces.F90:102
modstencil::t_stencil
Definition: ModStencil.F90:46
dx
NT dx
Definition: rational_rotation.h:81
rflu_modstencilsfaces::rflu_buildf2cstencilwrapper
subroutine, public rflu_buildf2cstencilwrapper(pRegion, constrInput)
Definition: RFLU_ModStencilsFaces.F90:829
rflu_modstencilsfaces::rflu_setinfof2cstencilwrapper
subroutine, public rflu_setinfof2cstencilwrapper(pRegion, orderNominal)
Definition: RFLU_ModStencilsFaces.F90:2098
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
rflu_modstencilsfaces::rflu_setinfof2cstencil
subroutine rflu_setinfof2cstencil(pRegion, orderNominalInput)
Definition: RFLU_ModStencilsFaces.F90:1981
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_modstencilsfaces::rflu_destroylistcf2cstencil
subroutine, public rflu_destroylistcf2cstencil(pRegion)
Definition: RFLU_ModStencilsFaces.F90:1603
modgrid::t_grid
Definition: ModGrid.F90:56
sqrt
double sqrt(double d)
Definition: double.h:73
rflu_modstencilsfaces::rflu_destroyf2cstencil
subroutine rflu_destroyf2cstencil(pRegion)
Definition: RFLU_ModStencilsFaces.F90:1422
rflu_modstencilsfaces::rflu_buildf2cstencil
subroutine rflu_buildf2cstencil(pRegion, addBFaces)
Definition: RFLU_ModStencilsFaces.F90:390
rflu_modstencilsfaces::rflu_createf2cstencil_1d
subroutine rflu_createf2cstencil_1d(pRegion)
Definition: RFLU_ModStencilsFaces.F90:1043
rflu_modstencilsutils::rflu_addfacevertneighbs
subroutine, public rflu_addfacevertneighbs(global, pGrid, stencilSizeMax, f2v, degr, x2cs)
Definition: RFLU_ModStencilsUtils.F90:953
rflu_modfacelist
Definition: RFLU_ModFaceList.F90:39
rflu_modstencilsfaces::rflu_destroyf2cstencilwrapper
subroutine, public rflu_destroyf2cstencilwrapper(pRegion)
Definition: RFLU_ModStencilsFaces.F90:1533
rflu_modstencilsutils::rflu_addbfaces
subroutine, public rflu_addbfaces(pRegion, nBFaceMembsMaxTemp, nCellMembs, cellMembs, nBFaceMembs, bFaceMembs)
Definition: RFLU_ModStencilsUtils.F90:104
Mesh::GenericElement::nfaces
IndexType nfaces() const
Definition: Mesh.H:641
rflu_computestencilsize
INTEGER function rflu_computestencilsize(global, factor, order)
Definition: RFLU_ComputeStencilSize.F90:50
rflu_modstencilsfaces::rflu_createf2cstencil
subroutine rflu_createf2cstencil(pRegion)
Definition: RFLU_ModStencilsFaces.F90:1142
rflu_modstencilsutils
Definition: RFLU_ModStencilsUtils.F90:39
rflu_modstencilsfaces::rflu_buildlistcf2cstencil
subroutine, public rflu_buildlistcf2cstencil(pRegion)
Definition: RFLU_ModStencilsFaces.F90:919
rflu_modstencilsfaces::rflu_destroyf2cstencil_1d
subroutine rflu_destroyf2cstencil_1d(pRegion)
Definition: RFLU_ModStencilsFaces.F90:1312
rflu_modstencilsfaces::rflu_nullifyf2cstencil
subroutine rflu_nullifyf2cstencil(pRegion)
Definition: RFLU_ModStencilsFaces.F90:1778
Direction_3::dz
RT dz() const
Definition: Direction_3.h:133
min
Vector_n min(const Array_n_const &v1, const Array_n_const &v2)
Definition: Vector_n.h:346
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
rflu_modfacelist::rflu_getopposingfaces
subroutine, public rflu_getopposingfaces(pRegion, iPatch, ifg, nFacesOpp, faceOppInfo)
Definition: RFLU_ModFaceList.F90:2499
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
rflu_modstencilsfaces
Definition: RFLU_ModStencilsFaces.F90:39
rflu_modcellfaceedgeinfo
Definition: RFLU_ModCellFaceEdgeInfo.F90:40
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
rflu_modstencilsfaces::rflu_nullifyf2cstencil_1d
subroutine rflu_nullifyf2cstencil_1d(pRegion)
Definition: RFLU_ModStencilsFaces.F90:1695
rflu_modstencilsfaces::rflu_createf2cstencilwrapper
subroutine, public rflu_createf2cstencilwrapper(pRegion)
Definition: RFLU_ModStencilsFaces.F90:1240
modtools::floatequal
LOGICAL function floatequal(a, b, tolIn)
Definition: ModTools.F90:99
Line_2::a
RT a() const
Definition: Line_2.h:140
modbndpatch::t_patch
Definition: ModBndPatch.F90:91
rflu_modstencilsfaces::rflu_setinfof2cstencil_1d
subroutine rflu_setinfof2cstencil_1d(pRegion, orderNominalInput)
Definition: RFLU_ModStencilsFaces.F90:1866