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