Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModGeometry.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 compute geometry.
26 !
27 ! Description: None.
28 !
29 ! Notes:
30 ! 1. Need special destruction modes because cofg needed for interpolation from
31 ! cell centers to vertices, so once have the entire geometry constructed,
32 ! can deallocate everything except cofg.
33 ! 2. Initialize geometry also in creation routine, because cofg is used in
34 ! RFLU_PrintLocInfo, and although it is allocated before being used, the
35 ! fact that it is not initialized appears to cause a floating-point
36 ! exception (INVALID) on modi4.
37 !
38 ! ******************************************************************************
39 !
40 ! $Id: RFLU_ModGeometry.F90,v 1.35 2008/12/06 08:44:22 mtcampbe Exp $
41 !
42 ! Copyright: (c) 2002-2004 by the University of Illinois
43 !
44 ! ******************************************************************************
45 
46 MODULE rflu_modgeometry
47 
48  USE modglobal, ONLY: t_global
49  USE modparameters
50  USE moddatatypes
51  USE moderror
52  USE modbndpatch, ONLY: t_patch
53  USE moddatastruct, ONLY: t_region
54  USE modgrid, ONLY: t_grid
55  USE modmpi
56 
57  IMPLICIT NONE
58 
59  PRIVATE
60  PUBLIC :: rflu_buildbvertexnormals, &
61  rflu_buildgeometry, &
62  rflu_computeapproxcentroids, &
63  rflu_computefacedist, &
64  rflu_createapproxcentroids, &
65  rflu_createfacedist, &
66  rflu_creategeometry, &
67  rflu_destroyapproxcentroids, &
68  rflu_destroyfacedist, &
69  rflu_destroygeometry, &
70  rflu_nullifyapproxcentroids, &
71  rflu_nullifygeometry
72 
73  SAVE
74 
75 ! ******************************************************************************
76 ! Declarations and definitions
77 ! ******************************************************************************
78 
79  CHARACTER(CHRLEN) :: &
80  RCSIdentString = '$RCSfile: RFLU_ModGeometry.F90,v $ $Revision: 1.35 $'
81 
82 ! ******************************************************************************
83 ! Routines
84 ! ******************************************************************************
85 
86  CONTAINS
87 
88 
89 
90 
91 
92 
93 
94 
95 ! ******************************************************************************
96 !
97 ! Purpose: Build boundary-vertex normals list
98 !
99 ! Description: None.
100 !
101 ! Input:
102 ! pRegion Pointer to region
103 !
104 ! Output: None.
105 !
106 ! Notes: None.
107 !
108 ! ******************************************************************************
109 
110  SUBROUTINE rflu_buildbvertexnormals(pRegion)
111 
112  IMPLICIT NONE
113 
114 ! ******************************************************************************
115 ! Declarations and definitions
116 ! ******************************************************************************
117 
118 ! ==============================================================================
119 ! Parameters
120 ! ==============================================================================
121  TYPE(t_region), POINTER :: pregion
122 
123 ! ==============================================================================
124 ! Locals
125 ! ==============================================================================
126 
127  INTEGER :: errorflag,ibv,ic,ifc,ipatch
128  REAL(RFREAL) :: term
129  REAL(RFREAL), DIMENSION(:,:), POINTER :: pbvn
130  TYPE(t_global), POINTER :: global
131  TYPE(t_grid), POINTER :: pgrid
132  TYPE(t_patch), POINTER :: ppatch
133 
134 ! ******************************************************************************
135 ! Start
136 ! ******************************************************************************
137 
138  global => pregion%global
139 
140  CALL registerfunction(global,'RFLU_BuildBVertexNormals',&
141  'RFLU_ModGeometry.F90')
142 
143  IF ( global%myProcid == masterproc .AND. &
144  global%verbLevel >= verbose_high ) THEN
145  WRITE(stdout,'(A,1X,A)') solver_name
146  WRITE(stdout,'(A,1X,A)') solver_name,'Building boundary-vertex '// &
147  'normals...'
148  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
149  pregion%iRegionGlobal
150  END IF ! global%verbLevel
151 
152  pgrid => pregion%grid
153 
154 ! ******************************************************************************
155 ! Build list of boundary vertex normals for each patch
156 ! ******************************************************************************
157 
158  DO ipatch = 1,pgrid%nPatches
159  ppatch => pregion%patches(ipatch)
160  pbvn => ppatch%bvn
161 
162 ! ==============================================================================
163 ! Accumulate face normals to vertices
164 ! ==============================================================================
165 
166  DO ifc = 1,ppatch%nBFacesTot
167  DO ic = 1,4
168  ibv = ppatch%bf2v(ic,ifc)
169 
170  IF ( ibv /= vert_none ) THEN
171  pbvn(xcoord,ibv) = pbvn(xcoord,ibv) + ppatch%fn(xcoord,ifc)
172  pbvn(ycoord,ibv) = pbvn(ycoord,ibv) + ppatch%fn(ycoord,ifc)
173  pbvn(zcoord,ibv) = pbvn(zcoord,ibv) + ppatch%fn(zcoord,ifc)
174  END IF ! ibv
175  END DO ! ic
176  END DO ! ifc
177 
178 ! ==============================================================================
179 ! Normalize accumulated face normals
180 ! ==============================================================================
181 
182  DO ibv = 1,ppatch%nBVertTot
183  term = 1.0_rfreal/(sqrt(pbvn(xcoord,ibv)*pbvn(xcoord,ibv) &
184  + pbvn(ycoord,ibv)*pbvn(ycoord,ibv) &
185  + pbvn(zcoord,ibv)*pbvn(zcoord,ibv)))
186 
187  pbvn(xcoord,ibv) = term*pbvn(xcoord,ibv)
188  pbvn(ycoord,ibv) = term*pbvn(ycoord,ibv)
189  pbvn(zcoord,ibv) = term*pbvn(zcoord,ibv)
190  END DO ! ibv
191 
192  IF ( global%myProcid == masterproc .AND. &
193  global%verbLevel >= verbose_high ) THEN
194  IF ( ppatch%nBVert > 0 ) THEN
195  WRITE(stdout,'(A,3X,A)') solver_name,'Normal component extrema:'
196  WRITE(stdout,'(A,5X,A,1X,I3)') solver_name,'Patch:',ipatch
197  WRITE(stdout,'(A,7X,A,2(1X,E23.16))') solver_name,'x-direction:', &
198  minval(pbvn(xcoord,1:ppatch%nBVert)), &
199  maxval(pbvn(xcoord,1:ppatch%nBVert))
200  WRITE(stdout,'(A,7X,A,2(1X,E23.16))') solver_name,'y-direction:', &
201  minval(pbvn(ycoord,1:ppatch%nBVert)), &
202  maxval(pbvn(ycoord,1:ppatch%nBVert))
203  WRITE(stdout,'(A,7X,A,2(1X,E23.16))') solver_name,'z-direction:', &
204  minval(pbvn(zcoord,1:ppatch%nBVert)), &
205  maxval(pbvn(zcoord,1:ppatch%nBVert))
206  END IF ! pPatch%nBVert
207  END IF ! global%verbLevel
208  END DO ! iPatch
209 
210 #ifdef CHECK_DATASTRUCT
211 ! ==============================================================================
212 ! Data structure output for checking
213 ! ==============================================================================
214 
215  IF ( pgrid%nPatches > 0 ) THEN
216  WRITE(stdout,'(A)') solver_name
217  WRITE(stdout,'(A,1X,A)') solver_name,'### START CHECK OUTPUT ###'
218  WRITE(stdout,'(A,1X,A)') solver_name,'Boundary vertex normals:'
219 
220  DO ipatch = 1,pgrid%nPatches
221  ppatch => pregion%patches(ipatch)
222  WRITE(stdout,'(A,1X,A,1X,I3,3X,A)') solver_name,'Patch:', &
223  ipatch,ppatch%bcName
224  WRITE(stdout,'(A,1X,A,1X,A,1X,I7))') solver_name,'Number of actual', &
225  'vertices:',ppatch%nBVert
226  WRITE(stdout,'(A,1X,A,1X,A,1X,I7))') solver_name,'Number of total', &
227  'vertices:',ppatch%nBVertTot
228 
229  DO ibv = 1,ppatch%nBVertTot
230  WRITE(stdout,'(A,1X,I7,3(1X,E18.9))') solver_name,ibv, &
231  ppatch%bvn(xcoord:zcoord,ibv)
232  END DO ! ibv
233 
234  END DO ! iPatch
235  WRITE(stdout,'(A,1X,A)') solver_name,'### END CHECK OUTPUT ###'
236  WRITE(stdout,'(A)') solver_name
237  END IF ! pGrid%nPatches
238 #endif
239 
240 ! ******************************************************************************
241 ! End
242 ! ******************************************************************************
243 
244  IF ( global%myProcid == masterproc .AND. &
245  global%verbLevel >= verbose_high ) THEN
246  WRITE(stdout,'(A,1X,A)') solver_name,'Building boundary-vertex '// &
247  'normals done.'
248  WRITE(stdout,'(A,1X,A)') solver_name
249  END IF ! global%verbLevel
250 
251  CALL deregisterfunction(global)
252 
253  END SUBROUTINE rflu_buildbvertexnormals
254 
255 
256 
257 
258 
259 
260 
261 
262 ! ******************************************************************************
263 !
264 ! Purpose: Build geometry - compute face areas and centroids and cell volumes.
265 !
266 ! Description: None.
267 !
268 ! Input:
269 ! pRegion Pointer to region
270 ! sypeFaceFlag Flag indicating whether faces on symmetry and periodic
271 ! patches should contribute to computation of volumes
272 ! of cells adjacent to patches
273 !
274 ! Output: None.
275 !
276 ! Notes: None.
277 !
278 ! ******************************************************************************
279 
280  SUBROUTINE rflu_buildgeometry(pRegion,sypeFaceFlag)
281 
282  USE modsortsearch
283 
284  USE rflu_modcellfaceedgeinfo
285 
286  USE modinterfaces, ONLY: facecentroidquad, &
287  facecentroidtria, &
288  facevectorquad, &
289  facevectortria, &
290  rflu_printlocinfo
291 
292  IMPLICIT NONE
293 
294 ! ******************************************************************************
295 ! Declarations and definitions
296 ! ******************************************************************************
297 
298 ! ==============================================================================
299 ! Parameters
300 ! ==============================================================================
301 
302  LOGICAL, OPTIONAL :: sypefaceflag
303  TYPE (t_region), POINTER :: pregion
304 
305 ! ==============================================================================
306 ! Locals
307 ! ==============================================================================
308 
309  LOGICAL :: ignoresypefaces
310  CHARACTER(CHRLEN) :: errorstring
311  INTEGER :: c1,c1k,c1t,c2,c2k,c2t,errorflag,ibv,ic,icl,icg,ifc,ifk, &
312  ipatch,iv,v1,v2,v3,v4
313  INTEGER, DIMENSION(:) :: dummyloc(1),volloc(2,min_val:max_val)
314  REAL(RFREAL) :: facesummax,fcenx,fceny,fcenz,fsumlimit,fvecm,fvecmsum, &
315  fvecx,fvecy,fvecz,patchfacesum,term,volerr,volsum1,volsum2
316  REAL(RFREAL), PARAMETER :: thrd = 1.0_rfreal/3.0_rfreal, &
317  vol_err_limit = 1.0e-10_rfreal
318  REAL(RFREAL), DIMENSION(:), ALLOCATABLE :: fndummy,voldummy
319  REAL(RFREAL), DIMENSION(:,:), ALLOCATABLE :: facesum
320  REAL(RFREAL) :: xyzavg(xcoord:zcoord),xyznodes(xcoord:zcoord,4)
321  TYPE(t_grid), POINTER :: pgrid,pgridold
322  TYPE(t_patch), POINTER :: ppatch
323  TYPE(t_global), POINTER :: global
324 
325 ! ******************************************************************************
326 ! Start
327 ! ******************************************************************************
328 
329  global => pregion%global
330 
331  CALL registerfunction(global,'RFLU_BuildGeometry',&
332  'RFLU_ModGeometry.F90')
333 
334  IF ( global%myProcid == masterproc .AND. &
335  global%verbLevel >= verbose_high ) THEN
336  WRITE(stdout,'(A,1X,A)') solver_name,'Building geometry...'
337  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
338  pregion%iRegionGlobal
339  END IF ! global%verbLevel
340 
341  pgrid => pregion%grid
342 
343  IF ( .NOT. present(sypefaceflag) ) THEN
344  ignoresypefaces = .true.
345  ELSE
346  ignoresypefaces = sypefaceflag
347  END IF ! PRESENT(ignoreSypeFaces)
348 
349 ! ******************************************************************************
350 ! Initialize geometry - do here because of mesh motion
351 ! ******************************************************************************
352 
353  DO ic = 1,pgrid%nCellsTot ! Explicit loop because of ASCI White problem
354  pgrid%vol(ic) = 0.0_rfreal
355  pgrid%cofg(xcoord,ic) = 0.0_rfreal
356  pgrid%cofg(ycoord,ic) = 0.0_rfreal
357  pgrid%cofg(zcoord,ic) = 0.0_rfreal
358  END DO ! ic
359 
360  DO ifc = 1,pgrid%nFacesTot
361  pgrid%fn(xcoord,ifc) = 0.0_rfreal
362  pgrid%fn(ycoord,ifc) = 0.0_rfreal
363  pgrid%fn(zcoord,ifc) = 0.0_rfreal
364  pgrid%fn(xyzmag,ifc) = 0.0_rfreal
365  pgrid%fc(xcoord,ifc) = 0.0_rfreal
366  pgrid%fc(ycoord,ifc) = 0.0_rfreal
367  pgrid%fc(zcoord,ifc) = 0.0_rfreal
368  END DO ! ifc
369 
370  DO ipatch = 1,pgrid%nPatches
371  ppatch => pregion%patches(ipatch)
372 
373  ppatch%pc(xcoord) = 0.0_rfreal
374  ppatch%pc(ycoord) = 0.0_rfreal
375  ppatch%pc(zcoord) = 0.0_rfreal
376 
377  DO ifc = 1,ppatch%nBFacesTot
378  ppatch%fn(xcoord,ifc) = 0.0_rfreal
379  ppatch%fn(ycoord,ifc) = 0.0_rfreal
380  ppatch%fn(zcoord,ifc) = 0.0_rfreal
381  ppatch%fn(xyzmag,ifc) = 0.0_rfreal
382 
383  ppatch%fc(xcoord,ifc) = 0.0_rfreal
384  ppatch%fc(ycoord,ifc) = 0.0_rfreal
385  ppatch%fc(zcoord,ifc) = 0.0_rfreal
386  END DO ! ifc
387 
388  IF ( pregion%mixtInput%moveGrid .EQV. .true. ) THEN
389  DO ibv = 1,ppatch%nBVertTot
390  ppatch%bvn(xcoord,ibv) = 0.0_rfreal
391  ppatch%bvn(ycoord,ibv) = 0.0_rfreal
392  ppatch%bvn(zcoord,ibv) = 0.0_rfreal
393  END DO ! ibv
394  END IF ! pRegion%mixtInput
395  END DO ! iPatch
396 
397 ! ******************************************************************************
398 ! Create and build approximate cell centroids (for later use)
399 ! ******************************************************************************
400 
401  CALL rflu_createapproxcentroids(pregion)
402  CALL rflu_computeapproxcentroids(pregion)
403 
404 ! ******************************************************************************
405 ! Interior faces
406 ! ******************************************************************************
407 
408  IF ( global%myProcid == masterproc .AND. &
409  global%verbLevel >= verbose_high ) THEN
410  WRITE(stdout,'(A,3X,A)') solver_name,'Non-boundary faces...'
411  END IF ! global%verbLevel
412 
413  DO ifc = 1,pgrid%nFacesTot
414  v1 = pgrid%f2v(1,ifc)
415  v2 = pgrid%f2v(2,ifc)
416  v3 = pgrid%f2v(3,ifc)
417 
418  c1 = pgrid%f2c(1,ifc)
419  c2 = pgrid%f2c(2,ifc)
420 
421 ! ==============================================================================
422 ! Compute face vector and centroid
423 ! ==============================================================================
424 
425  IF ( pgrid%f2v(4,ifc) == vert_none ) THEN ! triangular face
426  xyznodes(xcoord:zcoord,1) = pgrid%xyz(xcoord:zcoord,v1)
427  xyznodes(xcoord:zcoord,2) = pgrid%xyz(xcoord:zcoord,v2)
428  xyznodes(xcoord:zcoord,3) = pgrid%xyz(xcoord:zcoord,v3)
429 
430  CALL facevectortria(xyznodes(xcoord:zcoord,1:3),fvecx,fvecy,fvecz)
431  CALL facecentroidtria(xyznodes(xcoord:zcoord,1:3),fcenx,fceny,fcenz)
432  ELSE ! quadrilateral face
433  v4 = pgrid%f2v(4,ifc)
434 
435  xyznodes(xcoord:zcoord,1) = pgrid%xyz(xcoord:zcoord,v1)
436  xyznodes(xcoord:zcoord,2) = pgrid%xyz(xcoord:zcoord,v2)
437  xyznodes(xcoord:zcoord,3) = pgrid%xyz(xcoord:zcoord,v3)
438  xyznodes(xcoord:zcoord,4) = pgrid%xyz(xcoord:zcoord,v4)
439 
440  CALL facevectorquad(xyznodes(xcoord:zcoord,1:4),fvecx,fvecy,fvecz)
441  CALL facecentroidquad(xyznodes(xcoord:zcoord,1:4),fcenx,fceny,fcenz)
442  END IF ! quadFaces
443 
444  fvecm = sqrt(fvecx*fvecx + fvecy*fvecy + fvecz*fvecz)
445  term = 1.0_rfreal/fvecm
446 
447  pgrid%fn(xcoord,ifc) = fvecx*term
448  pgrid%fn(ycoord,ifc) = fvecy*term
449  pgrid%fn(zcoord,ifc) = fvecz*term
450  pgrid%fn(xyzmag,ifc) = fvecm
451 
452  pgrid%fc(xcoord,ifc) = fcenx
453  pgrid%fc(ycoord,ifc) = fceny
454  pgrid%fc(zcoord,ifc) = fcenz
455 
456 ! ==============================================================================
457 ! Compute contribution to volumes and centroids
458 ! ==============================================================================
459 
460  IF ( c1 /= cell_type_ext .AND. c1 /= cell_type_bnd ) THEN
461  term = (fcenx - pgrid%cofgApp(xcoord,c1))*fvecx &
462  + (fceny - pgrid%cofgApp(ycoord,c1))*fvecy &
463  + (fcenz - pgrid%cofgApp(zcoord,c1))*fvecz
464 
465  pgrid%vol(c1) = pgrid%vol(c1) + term
466 
467  term = fcenx*fvecx + fceny*fvecy + fcenz*fvecz
468 
469  pgrid%cofg(xcoord,c1) = pgrid%cofg(xcoord,c1) + term*fcenx
470  pgrid%cofg(ycoord,c1) = pgrid%cofg(ycoord,c1) + term*fceny
471  pgrid%cofg(zcoord,c1) = pgrid%cofg(zcoord,c1) + term*fcenz
472  END IF ! c1
473 
474  IF ( c2 /= cell_type_ext .AND. c2 /= cell_type_bnd ) THEN
475  term = (fcenx - pgrid%cofgApp(xcoord,c2))*fvecx &
476  + (fceny - pgrid%cofgApp(ycoord,c2))*fvecy &
477  + (fcenz - pgrid%cofgApp(zcoord,c2))*fvecz
478 
479  pgrid%vol(c2) = pgrid%vol(c2) - term
480 
481  term = fcenx*fvecx + fceny*fvecy + fcenz*fvecz
482 
483  pgrid%cofg(xcoord,c2) = pgrid%cofg(xcoord,c2) - term*fcenx
484  pgrid%cofg(ycoord,c2) = pgrid%cofg(ycoord,c2) - term*fceny
485  pgrid%cofg(zcoord,c2) = pgrid%cofg(zcoord,c2) - term*fcenz
486  END IF ! c2
487  END DO ! ifc
488 
489 ! ******************************************************************************
490 ! Boundary faces, loop over patches
491 ! ******************************************************************************
492 
493  IF ( global%myProcid == masterproc .AND. &
494  global%verbLevel >= verbose_high ) THEN
495  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary faces...'
496  END IF ! global%verbLevel
497 
498  DO ipatch = 1,pgrid%nPatches
499  ppatch => pregion%patches(ipatch)
500 
501  IF ( global%myProcid == masterproc .AND. &
502  global%verbLevel >= verbose_high ) THEN
503  WRITE(stdout,'(A,5X,A,I3)') solver_name,'Patch: ',ipatch
504  END IF ! global%verbLevel
505 
506  fvecmsum = 0.0_rfreal
507 
508 ! ==============================================================================
509 ! Loop over faces
510 ! ==============================================================================
511 
512  DO ifc = 1,ppatch%nBFacesTot
513  v1 = ppatch%bv(ppatch%bf2v(1,ifc))
514  v2 = ppatch%bv(ppatch%bf2v(2,ifc))
515  v3 = ppatch%bv(ppatch%bf2v(3,ifc))
516 
517  c1 = ppatch%bf2c(ifc)
518 
519 ! ------------------------------------------------------------------------------
520 ! Compute face vector and centroid
521 ! ------------------------------------------------------------------------------
522 
523  IF ( ppatch%bf2v(4,ifc) == vert_none ) THEN ! triangular face
524  xyznodes(xcoord:zcoord,1) = pgrid%xyz(xcoord:zcoord,v1)
525  xyznodes(xcoord:zcoord,2) = pgrid%xyz(xcoord:zcoord,v2)
526  xyznodes(xcoord:zcoord,3) = pgrid%xyz(xcoord:zcoord,v3)
527 
528  CALL facevectortria(xyznodes(xcoord:zcoord,1:3),fvecx,fvecy,fvecz)
529  CALL facecentroidtria(xyznodes(xcoord:zcoord,1:3),fcenx,fceny,fcenz)
530  ELSE ! quadrilateral face
531  v4 = ppatch%bv(ppatch%bf2v(4,ifc))
532 
533  xyznodes(xcoord:zcoord,1) = pgrid%xyz(xcoord:zcoord,v1)
534  xyznodes(xcoord:zcoord,2) = pgrid%xyz(xcoord:zcoord,v2)
535  xyznodes(xcoord:zcoord,3) = pgrid%xyz(xcoord:zcoord,v3)
536  xyznodes(xcoord:zcoord,4) = pgrid%xyz(xcoord:zcoord,v4)
537 
538  CALL facevectorquad(xyznodes(xcoord:zcoord,1:4),fvecx,fvecy,fvecz)
539  CALL facecentroidquad(xyznodes(xcoord:zcoord,1:4),fcenx,fceny,fcenz)
540  END IF ! quadFaces
541 
542  fvecm = sqrt(fvecx*fvecx + fvecy*fvecy + fvecz*fvecz)
543  term = 1.0_rfreal/fvecm
544 
545  ppatch%fn(xcoord,ifc) = fvecx*term
546  ppatch%fn(ycoord,ifc) = fvecy*term
547  ppatch%fn(zcoord,ifc) = fvecz*term
548  ppatch%fn(xyzmag,ifc) = fvecm
549 
550  ppatch%fc(xcoord,ifc) = fcenx
551  ppatch%fc(ycoord,ifc) = fceny
552  ppatch%fc(zcoord,ifc) = fcenz
553 
554 ! ------------------------------------------------------------------------------
555 ! Accumulate patch centroid
556 ! ------------------------------------------------------------------------------
557 
558  fvecmsum = fvecmsum + fvecm
559 
560  ppatch%pc(xcoord) = ppatch%pc(xcoord) + fcenx*fvecm
561  ppatch%pc(ycoord) = ppatch%pc(ycoord) + fceny*fvecm
562  ppatch%pc(zcoord) = ppatch%pc(zcoord) + fcenz*fvecm
563 
564 ! ------------------------------------------------------------------------------
565 ! Add contribution to volume and centroids. NOTE add contribution only if
566 ! face is not on symmetry or periodic patch.
567 ! ------------------------------------------------------------------------------
568 
569  IF ( ignoresypefaces .EQV. .true. ) THEN
570  IF ( ppatch%bcType /= bc_symmetry .AND. &
571  ppatch%bcType /= bc_periodic ) THEN
572  term = (fcenx - pgrid%cofgApp(xcoord,c1))*fvecx &
573  + (fceny - pgrid%cofgApp(ycoord,c1))*fvecy &
574  + (fcenz - pgrid%cofgApp(zcoord,c1))*fvecz
575 
576  pgrid%vol(c1) = pgrid%vol(c1) + term
577 
578  term = fcenx*fvecx + fceny*fvecy + fcenz*fvecz
579 
580  pgrid%cofg(xcoord,c1) = pgrid%cofg(xcoord,c1) + term*fcenx
581  pgrid%cofg(ycoord,c1) = pgrid%cofg(ycoord,c1) + term*fceny
582  pgrid%cofg(zcoord,c1) = pgrid%cofg(zcoord,c1) + term*fcenz
583  END IF ! pPatch%bcType
584  ELSE
585  term = (fcenx - pgrid%cofgApp(xcoord,c1))*fvecx &
586  + (fceny - pgrid%cofgApp(ycoord,c1))*fvecy &
587  + (fcenz - pgrid%cofgApp(zcoord,c1))*fvecz
588 
589  pgrid%vol(c1) = pgrid%vol(c1) + term
590 
591  term = fcenx*fvecx + fceny*fvecy + fcenz*fvecz
592 
593  pgrid%cofg(xcoord,c1) = pgrid%cofg(xcoord,c1) + term*fcenx
594  pgrid%cofg(ycoord,c1) = pgrid%cofg(ycoord,c1) + term*fceny
595  pgrid%cofg(zcoord,c1) = pgrid%cofg(zcoord,c1) + term*fcenz
596  END IF ! ignoreSypeFaces
597  END DO ! ifc
598 
599 ! =============================================================================
600 ! Finalize patch centroid
601 ! =============================================================================
602 
603  term = 1.0_rfreal/fvecmsum
604 
605  ppatch%pc(xcoord) = term*ppatch%pc(xcoord)
606  ppatch%pc(ycoord) = term*ppatch%pc(ycoord)
607  ppatch%pc(zcoord) = term*ppatch%pc(zcoord)
608  END DO ! iPatch
609 
610 ! ******************************************************************************
611 ! Finalize volumes and cell centroids
612 ! ******************************************************************************
613 
614  DO ic = 1,pgrid%nCellsTot
615  pgrid%vol(ic) = thrd*pgrid%vol(ic)
616 
617  term = 1.0_rfreal/(4.0_rfreal*pgrid%vol(ic))
618 
619  pgrid%cofg(xcoord,ic) = term*pgrid%cofg(xcoord,ic)
620  pgrid%cofg(ycoord,ic) = term*pgrid%cofg(ycoord,ic)
621  pgrid%cofg(zcoord,ic) = term*pgrid%cofg(zcoord,ic)
622  END DO ! ic
623 
624 ! ******************************************************************************
625 ! Destroy approximate cell centroids
626 ! ******************************************************************************
627 
628  CALL rflu_destroyapproxcentroids(pregion)
629 
630 ! ******************************************************************************
631 ! Print out some information for diagnostic purposes
632 ! ******************************************************************************
633 
634 ! ==============================================================================
635 ! Volume information
636 ! ==============================================================================
637 
638  IF ( global%myProcid == masterproc .AND. &
639  global%verbLevel >= verbose_high ) THEN
640  dummyloc = minloc(pgrid%vol(1:pgrid%nCells))
641  volloc(1,min_val) = dummyloc(1)
642  volloc(1,max_val) = dummyloc(1)
643 
644  dummyloc = maxloc(pgrid%vol(1:pgrid%nCells))
645  volloc(2,min_val) = dummyloc(1)
646  volloc(2,max_val) = dummyloc(1)
647 
648  WRITE(stdout,'(A,3X,A)') solver_name,'Statistics (actual cells only):'
649  WRITE(stdout,'(A,5X,A,7X,E23.16,1X,I8)') solver_name, &
650  'Minimum volume:',minval(pgrid%vol(1:pgrid%nCells)),volloc(1,min_val)
651  WRITE(stdout,'(A,5X,A,7X,E23.16,1X,I8)') solver_name, &
652  'Maximum volume:',maxval(pgrid%vol(1:pgrid%nCells)),volloc(2,max_val)
653 
654  CALL rflu_printlocinfo(pregion,volloc,2,locinfo_mode_verbose, &
655  output_mode_master_only)
656  END IF ! global%verbLevel
657 
658  IF ( minval(pgrid%vol(1:pgrid%nCells)) <= 0.0_rfreal ) THEN
659  CALL errorstop(global,err_volume_negative,__line__)
660  END IF ! MINVAL
661 
662  IF ( global%myProcid == masterproc .AND. &
663  global%verbLevel >= verbose_high ) THEN
664  IF ( ASSOCIATED(pregion%gridOld%vol) .EQV. .true. ) THEN
665  IF ( minval(pregion%gridOld%vol(1:pgrid%nCells)) > 0.0_rfreal ) THEN
666  pgridold => pregion%gridOld
667 
668  WRITE(stdout,'(A,5X,A,1X,E23.16,2(1X,I8))') solver_name, &
669  'Minimum volume ratio:', &
670  minval(pgrid%vol(1:pgrid%nCells))/ &
671  minval(pgridold%vol(1:pgrid%nCells)), &
672  minloc(pgrid%vol(1:pgrid%nCells)), &
673  minloc(pgridold%vol(1:pgrid%nCells))
674  WRITE(stdout,'(A,5X,A,1X,E23.16,2(1X,I8))') solver_name, &
675  'Maximum volume ratio:',&
676  maxval(pgrid%vol(1:pgrid%nCells))/ &
677  maxval(pgridold%vol(1:pgrid%nCells)), &
678  maxloc(pgrid%vol(1:pgrid%nCells)), &
679  maxloc(pgridold%vol(1:pgrid%nCells))
680  END IF ! MINVAL
681  END IF ! ASSOCIATED
682  END IF ! global%myProcid
683 
684 ! ==============================================================================
685 ! Patch areas (only actual ones - because of parallel runs)
686 ! ==============================================================================
687 
688  IF ( global%myProcid == masterproc .AND. &
689  global%verbLevel >= verbose_high ) THEN
690  WRITE(stdout,'(A,5X,A,1X,A)') solver_name,'Boundary patch areas', &
691  '(actual faces only):'
692 
693  DO ipatch = 1,pgrid%nPatches
694  ppatch => pregion%patches(ipatch)
695 
696  ALLOCATE(fndummy(ppatch%nBFaces),stat=errorflag)
697  global%error = errorflag
698  IF ( global%error /= err_none ) THEN
699  CALL errorstop(global,err_allocate,__line__,'fnDummy')
700  END IF ! global%error
701 
702  DO ifc = 1,ppatch%nBFaces
703  fndummy(ifc) = ppatch%fn(xyzmag,ifc)
704  END DO ! ifc
705 
706  IF ( ppatch%nBFaces > 0 ) THEN ! Might have 0 actual faces...
707  CALL quicksortrfreal(fndummy,ppatch%nBFaces) ! Put in ascending order
708  END IF ! pPatch%nBFaces
709 
710  patchfacesum = 0.0_rfreal
711 
712  DO ifc = 1,ppatch%nBFaces
713  patchfacesum = patchfacesum + fndummy(ifc)
714  END DO ! ifc
715 
716  DEALLOCATE(fndummy,stat=errorflag)
717  global%error = errorflag
718  IF ( global%error /= err_none ) THEN
719  CALL errorstop(global,err_deallocate,__line__,'fnDummy')
720  END IF ! global%error
721 
722  WRITE(stdout,'(A,7X,A,1X,I3,3X,E23.16)') solver_name,'Patch:', &
723  ipatch,patchfacesum
724  END DO ! iPatch
725  END IF ! global%myProcid
726 
727 ! ******************************************************************************
728 ! Check volume computation: total volume
729 ! ******************************************************************************
730 
731  IF ( global%checkLevel > check_none ) THEN
732  IF ( global%myProcid == masterproc .AND. &
733  global%verbLevel >= verbose_high ) THEN
734  WRITE(stdout,'(A,3X,A,1X,A)') solver_name,'Check total volume', &
735  '(actual cells only):'
736  END IF ! global%verbLevel
737 
738 ! ==============================================================================
739 ! Part 1: Sum individual volumes. NOTE want only sum interior volumes, so
740 ! need to be careful with summation because sorting means that interior
741 ! and dummy cells are jumbled up. Therefore copy only interior cells into
742 ! volDummy array and then sort
743 ! ==============================================================================
744 
745  volsum1 = 0.0_rfreal
746 
747  ALLOCATE(voldummy(pgrid%nCells),stat=errorflag)
748  global%error = errorflag
749  IF ( global%error /= err_none ) THEN
750  CALL errorstop(global,err_allocate,__line__,'volDummy')
751  END IF ! global%error
752 
753  IF ( pgrid%nTets > 0 ) THEN
754  DO icl = 1,pgrid%nTets
755  icg = pgrid%tet2CellGlob(icl)
756  voldummy(icg) = pgrid%vol(icg)
757  END DO ! icl
758  END IF ! pGrid%nTets
759 
760  IF ( pgrid%nHexs > 0 ) THEN
761  DO icl = 1,pgrid%nHexs
762  icg = pgrid%hex2CellGlob(icl)
763  voldummy(icg) = pgrid%vol(icg)
764  END DO ! icl
765  END IF ! pGrid%nHexs
766 
767  IF ( pgrid%nPris > 0 ) THEN
768  DO icl = 1,pgrid%nPris
769  icg = pgrid%pri2CellGlob(icl)
770  voldummy(icg) = pgrid%vol(icg)
771  END DO ! icl
772  END IF ! pGrid%nPris
773 
774  IF ( pgrid%nPyrs > 0 ) THEN
775  DO icl = 1,pgrid%nPyrs
776  icg = pgrid%pyr2CellGlob(icl)
777  voldummy(icg) = pgrid%vol(icg)
778  END DO ! icl
779  END IF ! pGrid%nPyrs
780 
781  CALL quicksortrfreal(voldummy,pgrid%nCells) ! Put in ascending order
782 
783  DO ic = 1,pgrid%nCells
784  volsum1 = volsum1 + voldummy(ic)
785  END DO ! ic
786 
787  IF ( global%myProcid == masterproc .AND. &
788  global%verbLevel >= verbose_high ) THEN
789  WRITE(stdout,'(A,5X,A,1X,E23.16)') solver_name,&
790  'Total volume from sum of control volumes:',volsum1
791  END IF ! global%verbLevel
792 
793  DEALLOCATE(voldummy,stat=errorflag)
794  global%error = errorflag
795  IF ( global%error /= err_none ) THEN
796  CALL errorstop(global,err_deallocate,__line__,'volDummy')
797  END IF ! global%error
798 
799 ! ==============================================================================
800 ! Part 2: Compute total volume from boundary faces
801 ! ==============================================================================
802 
803 ! ------------------------------------------------------------------------------
804 ! Compute approximate centroid for region
805 ! ------------------------------------------------------------------------------
806 
807  xyzavg(xcoord) = 0.0_rfreal
808  xyzavg(ycoord) = 0.0_rfreal
809  xyzavg(zcoord) = 0.0_rfreal
810 
811  DO iv = 1,pgrid%nVertTot
812  xyzavg(xcoord) = xyzavg(xcoord) + pgrid%xyz(xcoord,iv)
813  xyzavg(ycoord) = xyzavg(ycoord) + pgrid%xyz(ycoord,iv)
814  xyzavg(zcoord) = xyzavg(zcoord) + pgrid%xyz(zcoord,iv)
815  END DO ! iv
816 
817  term = 1.0_rfreal/REAL(pgrid%nverttot,kind=rfreal)
818 
819  xyzavg(xcoord) = term*xyzavg(xcoord)
820  xyzavg(ycoord) = term*xyzavg(ycoord)
821  xyzavg(zcoord) = term*xyzavg(zcoord)
822 
823 ! ------------------------------------------------------------------------------
824 ! Compute volume. NOTE need to leave out faces on symmetry and periodic
825 ! patches because taken into account through interpartition faces below.
826 ! ------------------------------------------------------------------------------
827 
828  volsum2 = 0.0_rfreal
829 
830  DO ipatch = 1,pgrid%nPatches
831  ppatch => pregion%patches(ipatch)
832 
833  IF ( ignoresypefaces .EQV. .true. ) THEN
834  IF ( ppatch%bcType /= bc_symmetry .AND. &
835  ppatch%bcType /= bc_periodic ) THEN
836  DO ifc = 1,ppatch%nBFaces
837  fvecx = ppatch%fn(xcoord,ifc)
838  fvecy = ppatch%fn(ycoord,ifc)
839  fvecz = ppatch%fn(zcoord,ifc)
840  fvecm = ppatch%fn(xyzmag,ifc)
841 
842  fcenx = ppatch%fc(xcoord,ifc)
843  fceny = ppatch%fc(ycoord,ifc)
844  fcenz = ppatch%fc(zcoord,ifc)
845 
846  volsum2 = volsum2 + ((fcenx - xyzavg(xcoord))*fvecx &
847  + (fceny - xyzavg(ycoord))*fvecy &
848  + (fcenz - xyzavg(zcoord))*fvecz)*fvecm
849  END DO ! ifc
850  END IF ! pPatch%bcType
851  ELSE
852  DO ifc = 1,ppatch%nBFaces
853  fvecx = ppatch%fn(xcoord,ifc)
854  fvecy = ppatch%fn(ycoord,ifc)
855  fvecz = ppatch%fn(zcoord,ifc)
856  fvecm = ppatch%fn(xyzmag,ifc)
857 
858  fcenx = ppatch%fc(xcoord,ifc)
859  fceny = ppatch%fc(ycoord,ifc)
860  fcenz = ppatch%fc(zcoord,ifc)
861 
862  volsum2 = volsum2 + ((fcenx - xyzavg(xcoord))*fvecx &
863  + (fceny - xyzavg(ycoord))*fvecy &
864  + (fcenz - xyzavg(zcoord))*fvecz)*fvecm
865  END DO ! ifc
866  END IF ! ignoreSypefaces
867  END DO ! iPatch
868 
869 ! ==============================================================================
870 ! Part 3: Include contribution of interpartition faces. NOTE need to take
871 ! into account direction of face. NOTE the second comparison in the if
872 ! statement (ifk == FACE_KIND_AB) is retained so that should no dummy
873 ! cells be included in a debugging run, one still gets the correct
874 ! computation of the total volume. In normal runs, where dummy cells
875 ! exist, this statement should never be active
876 ! ==============================================================================
877 
878  DO ifc = 1,pgrid%nFacesTot
879  c1 = pgrid%f2c(1,ifc)
880  c2 = pgrid%f2c(2,ifc)
881 
882  c1k = rflu_getglobalcellkind(global,pgrid,c1)
883  c2k = rflu_getglobalcellkind(global,pgrid,c2)
884  ifk = rflu_getfacekind(global,c1k,c2k)
885 
886  IF ( (ifk == face_kind_av) .OR. (ifk == face_kind_ab) ) THEN
887  fvecx = pgrid%fn(xcoord,ifc)
888  fvecy = pgrid%fn(ycoord,ifc)
889  fvecz = pgrid%fn(zcoord,ifc)
890  fvecm = pgrid%fn(xyzmag,ifc)
891 
892  fcenx = pgrid%fc(xcoord,ifc)
893  fceny = pgrid%fc(ycoord,ifc)
894  fcenz = pgrid%fc(zcoord,ifc)
895 
896  term = ((fcenx - xyzavg(xcoord))*fvecx &
897  + (fceny - xyzavg(ycoord))*fvecy &
898  + (fcenz - xyzavg(zcoord))*fvecz)*fvecm
899 
900  IF ( c1k == cell_kind_actual ) THEN
901  volsum2 = volsum2 + term
902  ELSE
903  volsum2 = volsum2 - term
904  END IF ! c1k
905  END IF ! ifk
906  END DO ! ifc
907 
908  volsum2 = thrd*volsum2
909  volerr = (volsum2-volsum1)/(0.5_rfreal*(volsum1+volsum2)*100.0_rfreal)
910 
911  IF ( global%myProcid == masterproc .AND. &
912  global%verbLevel >= verbose_high ) THEN
913  WRITE(stdout,'(A,5X,A,4X,E23.16)') solver_name,&
914  'Total volume from boundary polyhedron:',volsum2
915  WRITE(stdout,'(A,5X,A,4X,E23.16)') solver_name,&
916  'Error (in % of average total volume): ',volerr
917  END IF ! global%verbLevel
918 
919  IF ( abs(volerr) > vol_err_limit ) THEN
920  WRITE(errorstring,'(A,1X,E13.6)') 'Error:',volerr
921  CALL errorstop(global,err_volume_diff,__line__,trim(errorstring))
922  END IF ! volErr
923  END IF ! global%checkLevel
924 
925 ! ******************************************************************************
926 ! Check volume computation: closed-ness of control volumes. NOTE need to
927 ! check this for ALL volumes so that can make sure that geometry is computed
928 ! correctly for virtual cells.
929 ! ******************************************************************************
930 
931  IF ( global%checkLevel > check_none ) THEN
932  IF ( global%myProcid == masterproc .AND. &
933  global%verbLevel >= verbose_high ) THEN
934  WRITE(stdout,'(A,3X,A)') solver_name,'Check closedness of '// &
935  'control volumes (all cells):'
936  END IF ! global%verbLevel
937 
938  ALLOCATE(facesum(xcoord:zcoord,pgrid%nCellsTot),stat=errorflag)
939  global%error = errorflag
940  IF ( global%error /= err_none ) THEN
941  CALL errorstop(global,err_allocate,__line__,'faceSum')
942  END IF ! global%error
943 
944  DO ic = 1,pgrid%nCellsTot
945  facesum(xcoord,ic) = 0.0_rfreal
946  facesum(ycoord,ic) = 0.0_rfreal
947  facesum(zcoord,ic) = 0.0_rfreal
948  END DO ! ic
949 
950 ! ==============================================================================
951 ! Part 1: Contribution from interior faces
952 ! ==============================================================================
953 
954  DO ifc = 1,pgrid%nFacesTot
955  c1 = pgrid%f2c(1,ifc)
956  c2 = pgrid%f2c(2,ifc)
957 
958  fvecx = pgrid%fn(xcoord,ifc)
959  fvecy = pgrid%fn(ycoord,ifc)
960  fvecz = pgrid%fn(zcoord,ifc)
961  fvecm = pgrid%fn(xyzmag,ifc)
962 
963  IF ( c1 /= cell_type_ext .AND. c1 /= cell_type_bnd ) THEN
964  facesum(xcoord,c1) = facesum(xcoord,c1) + fvecx*fvecm
965  facesum(ycoord,c1) = facesum(ycoord,c1) + fvecy*fvecm
966  facesum(zcoord,c1) = facesum(zcoord,c1) + fvecz*fvecm
967  END IF ! c1
968 
969  IF ( c2 /= cell_type_ext .AND. c2 /= cell_type_bnd ) THEN
970  facesum(xcoord,c2) = facesum(xcoord,c2) - fvecx*fvecm
971  facesum(ycoord,c2) = facesum(ycoord,c2) - fvecy*fvecm
972  facesum(zcoord,c2) = facesum(zcoord,c2) - fvecz*fvecm
973  END IF ! c2
974  END DO ! ifc
975 
976 ! ==============================================================================
977 ! Part 2: Contribution from boundary faces
978 ! ==============================================================================
979 
980  DO ipatch = 1,pgrid%nPatches
981  ppatch => pregion%patches(ipatch)
982 
983  IF ( ignoresypefaces .EQV. .true. ) THEN
984  IF ( ppatch%bcType /= bc_symmetry .AND. &
985  ppatch%bcType /= bc_periodic ) THEN
986  DO ifc = 1,ppatch%nBFacesTot
987  c1 = ppatch%bf2c(ifc)
988 
989  fvecx = ppatch%fn(xcoord,ifc)
990  fvecy = ppatch%fn(ycoord,ifc)
991  fvecz = ppatch%fn(zcoord,ifc)
992  fvecm = ppatch%fn(xyzmag,ifc)
993 
994  facesum(xcoord,c1) = facesum(xcoord,c1) + fvecx*fvecm
995  facesum(ycoord,c1) = facesum(ycoord,c1) + fvecy*fvecm
996  facesum(zcoord,c1) = facesum(zcoord,c1) + fvecz*fvecm
997  END DO ! ifc
998  END IF ! pPatch%bcType
999  ELSE
1000  DO ifc = 1,ppatch%nBFacesTot
1001  c1 = ppatch%bf2c(ifc)
1002 
1003  fvecx = ppatch%fn(xcoord,ifc)
1004  fvecy = ppatch%fn(ycoord,ifc)
1005  fvecz = ppatch%fn(zcoord,ifc)
1006  fvecm = ppatch%fn(xyzmag,ifc)
1007 
1008  facesum(xcoord,c1) = facesum(xcoord,c1) + fvecx*fvecm
1009  facesum(ycoord,c1) = facesum(ycoord,c1) + fvecy*fvecm
1010  facesum(zcoord,c1) = facesum(zcoord,c1) + fvecz*fvecm
1011  END DO ! ifc
1012  END IF ! ignoreSypeFaces
1013  END DO ! iPatch
1014 
1015  IF ( global%myProcid == masterproc .AND. &
1016  global%verbLevel >= verbose_high ) THEN
1017  WRITE(stdout,'(A,5X,A)') solver_name,'Minimum/maximum value of '// &
1018  'sum of face vectors:'
1019  WRITE(stdout,'(A,7X,A,2(1X,E23.16),2(1X,I8))') solver_name, &
1020  'x-direction:', &
1021  minval(facesum(xcoord,1:pgrid%nCellsTot)), &
1022  maxval(facesum(xcoord,1:pgrid%nCellsTot)), &
1023  minloc(facesum(xcoord,1:pgrid%nCellsTot)), &
1024  maxloc(facesum(xcoord,1:pgrid%nCellsTot))
1025  WRITE(stdout,'(A,7X,A,2(1X,E23.16),2(1X,I8))') solver_name, &
1026  'y-direction:', &
1027  minval(facesum(ycoord,1:pgrid%nCellsTot)), &
1028  maxval(facesum(ycoord,1:pgrid%nCellsTot)), &
1029  minloc(facesum(ycoord,1:pgrid%nCellsTot)), &
1030  maxloc(facesum(ycoord,1:pgrid%nCellsTot))
1031  WRITE(stdout,'(A,7X,A,2(1X,E23.16),2(1X,I8))') solver_name, &
1032  'z-direction:', &
1033  minval(facesum(zcoord,1:pgrid%nCellsTot)), &
1034  maxval(facesum(zcoord,1:pgrid%nCellsTot)), &
1035  minloc(facesum(zcoord,1:pgrid%nCellsTot)), &
1036  maxloc(facesum(zcoord,1:pgrid%nCellsTot))
1037  END IF ! global%verbLevel
1038 
1039  facesummax = max(abs(minval(facesum(xcoord,1:pgrid%nCellsTot))), &
1040  abs(maxval(facesum(xcoord,1:pgrid%nCellsTot))), &
1041  abs(minval(facesum(ycoord,1:pgrid%nCellsTot))), &
1042  abs(maxval(facesum(ycoord,1:pgrid%nCellsTot))), &
1043  abs(minval(facesum(zcoord,1:pgrid%nCellsTot))), &
1044  abs(maxval(facesum(zcoord,1:pgrid%nCellsTot))))
1045 
1046  IF ( facesummax > minval(pgrid%fn(xyzmag,1:pgrid%nFacesTot)) ) THEN
1047  WRITE(errorstring,'(A,1X,E13.6)') 'Error:',facesummax
1048  CALL errorstop(global,err_facesum,__line__,trim(errorstring))
1049  END IF ! faceSumMax
1050 
1051  DEALLOCATE(facesum,stat=errorflag)
1052  global%error = errorflag
1053  IF ( global%error /= err_none ) THEN
1054  CALL errorstop(global,err_deallocate,__line__,'faceSum')
1055  END IF ! global%error
1056  END IF ! global%checkLevel
1057 
1058 #ifdef CHECK_DATASTRUCT
1059 ! ******************************************************************************
1060 ! Data structure output for checking
1061 ! ******************************************************************************
1062 
1063  WRITE(stdout,'(A)') solver_name
1064  WRITE(stdout,'(A,1X,A)') solver_name,'### START CHECK OUTPUT ###'
1065  WRITE(stdout,'(A,1X,A)') solver_name,'Cell centroid locations'
1066  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Number of actual cells: ', &
1067  pgrid%nCells
1068  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Number of virtual cells:', &
1069  pgrid%nCellsTot-pgrid%nCells
1070 
1071  DO ic = 1,pgrid%nCellsTot
1072  WRITE(stdout,'(A,1X,I6,3(1X,E18.9))') solver_name,ic, &
1073  pgrid%cofg(xcoord,ic), &
1074  pgrid%cofg(ycoord,ic), &
1075  pgrid%cofg(zcoord,ic)
1076  END DO ! ic
1077 
1078  WRITE(stdout,'(A,1X,A)') solver_name,'### END CHECK OUTPUT ###'
1079  WRITE(stdout,'(A)') solver_name
1080  WRITE(stdout,'(A,1X,A)') solver_name,'### START CHECK OUTPUT ###'
1081  WRITE(stdout,'(A,1X,A)') solver_name,'Cell volumes'
1082  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Number of actual cells: ', &
1083  pgrid%nCells
1084  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Number of virtual cells:', &
1085  pgrid%nCellsTot-pgrid%nCells
1086 
1087  DO ic = 1,pgrid%nCellsTot
1088  WRITE(stdout,'(A,1X,I6,1X,E18.9)') solver_name,ic,pgrid%vol(ic)
1089  END DO ! ic
1090 
1091  WRITE(stdout,'(A,1X,A)') solver_name,'### END CHECK OUTPUT ###'
1092  WRITE(stdout,'(A)') solver_name
1093  WRITE(stdout,'(A,1X,A)') solver_name,'### START CHECK OUTPUT ###'
1094  WRITE(stdout,'(A,1X,A)') solver_name,'Face centroid locations'
1095 
1096  DO ifc = 1,pgrid%nFacesTot
1097  WRITE(stdout,'(A,1X,I6,3(1X,E18.9))') solver_name,ifc, &
1098  pgrid%fc(xcoord,ifc), &
1099  pgrid%fc(ycoord,ifc), &
1100  pgrid%fc(zcoord,ifc)
1101  END DO ! ifc
1102 
1103  WRITE(stdout,'(A,1X,A)') solver_name,'### END CHECK OUTPUT ###'
1104  WRITE(stdout,'(A)') solver_name
1105  WRITE(stdout,'(A,1X,A)') solver_name,'### START CHECK OUTPUT ###'
1106  WRITE(stdout,'(A,1X,A)') solver_name,'Face normals'
1107 
1108  DO ifc = 1,pgrid%nFacesTot
1109  WRITE(stdout,'(A,1X,I6,3(1X,E18.9))') solver_name,ifc, &
1110  pgrid%fn(xcoord,ifc), &
1111  pgrid%fn(ycoord,ifc), &
1112  pgrid%fn(zcoord,ifc)
1113  END DO ! ifc
1114 
1115  WRITE(stdout,'(A,1X,A)') solver_name,'### END CHECK OUTPUT ###'
1116  WRITE(stdout,'(A)') solver_name
1117  WRITE(stdout,'(A,1X,A)') solver_name,'### START CHECK OUTPUT ###'
1118  WRITE(stdout,'(A,1X,A)') solver_name,'Boundary face centroid locations'
1119 
1120  DO ipatch = 1,pgrid%nPatches
1121  ppatch => pregion%patches(ipatch)
1122  WRITE(stdout,'(A,3X,A,1X,I7)') solver_name,'Patch:',ipatch
1123  WRITE(stdout,'(A,3X,A,1X,I7)') solver_name, &
1124  'Actual number of faces:', &
1125  ppatch%nBFaces
1126  WRITE(stdout,'(A,3X,A,1X,I7)') solver_name, &
1127  'Total number of faces: ', &
1128  ppatch%nBFacesTot
1129 
1130  DO ifc = 1,ppatch%nBFacesTot
1131  WRITE(stdout,'(A,1X,I6,3(1X,E18.9))') solver_name,ifc, &
1132  ppatch%fc(xcoord,ifc), &
1133  ppatch%fc(ycoord,ifc), &
1134  ppatch%fc(zcoord,ifc)
1135  END DO ! ifc
1136  END DO ! iPatch
1137 
1138  WRITE(stdout,'(A,1X,A)') solver_name,'### END CHECK OUTPUT ###'
1139  WRITE(stdout,'(A)') solver_name
1140  WRITE(stdout,'(A,1X,A)') solver_name,'### START CHECK OUTPUT ###'
1141  WRITE(stdout,'(A,1X,A)') solver_name,'Boundary face normals'
1142 
1143  DO ipatch = 1,pgrid%nPatches
1144  ppatch => pregion%patches(ipatch)
1145  WRITE(stdout,'(A,3X,A,1X,I7)') solver_name,'Patch:',ipatch
1146  WRITE(stdout,'(A,3X,A,1X,I7)') solver_name, &
1147  'Actual number of faces:', &
1148  ppatch%nBFaces
1149  WRITE(stdout,'(A,3X,A,1X,I7)') solver_name, &
1150  'Total number of faces: ', &
1151  ppatch%nBFacesTot
1152 
1153  DO ifc = 1,ppatch%nBFacesTot
1154  WRITE(stdout,'(A,1X,I6,3(1X,E18.9))') solver_name,ifc, &
1155  ppatch%fn(xcoord,ifc), &
1156  ppatch%fn(ycoord,ifc), &
1157  ppatch%fn(zcoord,ifc)
1158  END DO ! ifc
1159  END DO ! iPatch
1160 
1161  WRITE(stdout,'(A,1X,A)') solver_name,'### END CHECK OUTPUT ###'
1162  WRITE(stdout,'(A)') solver_name
1163 #endif
1164 
1165 ! ******************************************************************************
1166 ! Compute boundary vertex normals for moving grids
1167 ! ******************************************************************************
1168 
1169  IF ( pregion%mixtInput%moveGrid .EQV. .true. ) THEN
1170  CALL rflu_buildbvertexnormals(pregion)
1171  END IF ! pRegion%mixtInput
1172 
1173 ! ******************************************************************************
1174 ! End
1175 ! ******************************************************************************
1176 
1177  IF ( global%myProcid == masterproc .AND. &
1178  global%verbLevel >= verbose_high ) THEN
1179  WRITE(stdout,'(A,1X,A)') solver_name,'Building geometry done.'
1180  END IF ! global%verbLevel
1181 
1182  CALL deregisterfunction(global)
1183 
1184  END SUBROUTINE rflu_buildgeometry
1185 
1186 
1187 
1188 
1189 
1190 
1191 
1192 ! ******************************************************************************
1193 !
1194 ! Purpose: Compute approximate cell centroids from simple vertex-coordinate
1195 ! averages
1196 !
1197 ! Description: None.
1198 !
1199 ! Input:
1200 ! pRegion Pointer to region
1201 !
1202 ! Output: None.
1203 !
1204 ! Notes: None.
1205 !
1206 ! ******************************************************************************
1207 
1208  SUBROUTINE rflu_computeapproxcentroids(pRegion)
1209 
1210 ! ******************************************************************************
1211 ! Declarations and definitions
1212 ! ******************************************************************************
1213 
1214 ! ==============================================================================
1215 ! Parameters
1216 ! ==============================================================================
1217 
1218  TYPE(t_region), POINTER :: pregion
1219 
1220 ! ==============================================================================
1221 ! Locals
1222 ! ==============================================================================
1223 
1224  INTEGER :: icl,icg,v1,v2,v3,v4,v5,v6,v7,v8
1225  REAL(RFREAL) :: term,x1,x2,x3,x4,x5,x6,x7,x8,y1,y2,y3,y4,y5,y6,y7,y8, &
1226  z1,z2,z3,z4,z5,z6,z7,z8
1227  TYPE(t_grid), POINTER :: pgrid
1228  TYPE(t_global), POINTER :: global
1229 
1230 ! ******************************************************************************
1231 ! Start
1232 ! ******************************************************************************
1233 
1234  global => pregion%global
1235 
1236  CALL registerfunction(global,'RFLU_ComputeApproxCentroids',&
1237  'RFLU_ModGeometry.F90')
1238 
1239  IF ( global%myProcid == masterproc .AND. &
1240  global%verbLevel >= verbose_high ) THEN
1241  WRITE(stdout,'(A,1X,A,A)') solver_name,'Computing approximate ', &
1242  'centroids...'
1243  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1244  pregion%iRegionGlobal
1245  END IF ! global%verbLevel
1246 
1247  pgrid => pregion%grid
1248 
1249 ! ******************************************************************************
1250 ! Loop over cell types and compute approximate centroids
1251 ! ******************************************************************************
1252 
1253 ! ==============================================================================
1254 ! Tetrahedra
1255 ! ==============================================================================
1256 
1257  term = 1.0_rfreal/4.0_rfreal
1258 
1259  DO icl = 1,pgrid%nTetsTot
1260  v1 = pgrid%tet2v(1,icl)
1261  v2 = pgrid%tet2v(2,icl)
1262  v3 = pgrid%tet2v(3,icl)
1263  v4 = pgrid%tet2v(4,icl)
1264 
1265  x1 = pgrid%xyz(xcoord,v1)
1266  x2 = pgrid%xyz(xcoord,v2)
1267  x3 = pgrid%xyz(xcoord,v3)
1268  x4 = pgrid%xyz(xcoord,v4)
1269 
1270  y1 = pgrid%xyz(ycoord,v1)
1271  y2 = pgrid%xyz(ycoord,v2)
1272  y3 = pgrid%xyz(ycoord,v3)
1273  y4 = pgrid%xyz(ycoord,v4)
1274 
1275  z1 = pgrid%xyz(zcoord,v1)
1276  z2 = pgrid%xyz(zcoord,v2)
1277  z3 = pgrid%xyz(zcoord,v3)
1278  z4 = pgrid%xyz(zcoord,v4)
1279 
1280  icg = pgrid%tet2CellGlob(icl)
1281 
1282  pgrid%cofgApp(xcoord,icg) = term*(x1 + x2 + x3 + x4)
1283  pgrid%cofgApp(ycoord,icg) = term*(y1 + y2 + y3 + y4)
1284  pgrid%cofgApp(zcoord,icg) = term*(z1 + z2 + z3 + z4)
1285  END DO ! icl
1286 
1287 ! ==============================================================================
1288 ! Hexahedra
1289 ! ==============================================================================
1290 
1291  term = 1.0_rfreal/8.0_rfreal
1292 
1293  DO icl = 1,pgrid%nHexsTot
1294  v1 = pgrid%hex2v(1,icl)
1295  v2 = pgrid%hex2v(2,icl)
1296  v3 = pgrid%hex2v(3,icl)
1297  v4 = pgrid%hex2v(4,icl)
1298  v5 = pgrid%hex2v(5,icl)
1299  v6 = pgrid%hex2v(6,icl)
1300  v7 = pgrid%hex2v(7,icl)
1301  v8 = pgrid%hex2v(8,icl)
1302 
1303  x1 = pgrid%xyz(xcoord,v1)
1304  x2 = pgrid%xyz(xcoord,v2)
1305  x3 = pgrid%xyz(xcoord,v3)
1306  x4 = pgrid%xyz(xcoord,v4)
1307  x5 = pgrid%xyz(xcoord,v5)
1308  x6 = pgrid%xyz(xcoord,v6)
1309  x7 = pgrid%xyz(xcoord,v7)
1310  x8 = pgrid%xyz(xcoord,v8)
1311 
1312  y1 = pgrid%xyz(ycoord,v1)
1313  y2 = pgrid%xyz(ycoord,v2)
1314  y3 = pgrid%xyz(ycoord,v3)
1315  y4 = pgrid%xyz(ycoord,v4)
1316  y5 = pgrid%xyz(ycoord,v5)
1317  y6 = pgrid%xyz(ycoord,v6)
1318  y7 = pgrid%xyz(ycoord,v7)
1319  y8 = pgrid%xyz(ycoord,v8)
1320 
1321  z1 = pgrid%xyz(zcoord,v1)
1322  z2 = pgrid%xyz(zcoord,v2)
1323  z3 = pgrid%xyz(zcoord,v3)
1324  z4 = pgrid%xyz(zcoord,v4)
1325  z5 = pgrid%xyz(zcoord,v5)
1326  z6 = pgrid%xyz(zcoord,v6)
1327  z7 = pgrid%xyz(zcoord,v7)
1328  z8 = pgrid%xyz(zcoord,v8)
1329 
1330  icg = pgrid%hex2CellGlob(icl)
1331 
1332  pgrid%cofgApp(xcoord,icg) = term*(x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8)
1333  pgrid%cofgApp(ycoord,icg) = term*(y1 + y2 + y3 + y4 + y5 + y6 + y7 + y8)
1334  pgrid%cofgApp(zcoord,icg) = term*(z1 + z2 + z3 + z4 + z5 + z6 + z7 + z8)
1335  END DO ! icl
1336 
1337 ! ==============================================================================
1338 ! Prisms
1339 ! ==============================================================================
1340 
1341  term = 1.0_rfreal/6.0_rfreal
1342 
1343  DO icl = 1,pgrid%nPrisTot
1344  v1 = pgrid%pri2v(1,icl)
1345  v2 = pgrid%pri2v(2,icl)
1346  v3 = pgrid%pri2v(3,icl)
1347  v4 = pgrid%pri2v(4,icl)
1348  v5 = pgrid%pri2v(5,icl)
1349  v6 = pgrid%pri2v(6,icl)
1350 
1351  x1 = pgrid%xyz(xcoord,v1)
1352  x2 = pgrid%xyz(xcoord,v2)
1353  x3 = pgrid%xyz(xcoord,v3)
1354  x4 = pgrid%xyz(xcoord,v4)
1355  x5 = pgrid%xyz(xcoord,v5)
1356  x6 = pgrid%xyz(xcoord,v6)
1357 
1358  y1 = pgrid%xyz(ycoord,v1)
1359  y2 = pgrid%xyz(ycoord,v2)
1360  y3 = pgrid%xyz(ycoord,v3)
1361  y4 = pgrid%xyz(ycoord,v4)
1362  y5 = pgrid%xyz(ycoord,v5)
1363  y6 = pgrid%xyz(ycoord,v6)
1364 
1365  z1 = pgrid%xyz(zcoord,v1)
1366  z2 = pgrid%xyz(zcoord,v2)
1367  z3 = pgrid%xyz(zcoord,v3)
1368  z4 = pgrid%xyz(zcoord,v4)
1369  z5 = pgrid%xyz(zcoord,v5)
1370  z6 = pgrid%xyz(zcoord,v6)
1371 
1372  icg = pgrid%pri2CellGlob(icl)
1373 
1374  pgrid%cofgApp(xcoord,icg) = term*(x1 + x2 + x3 + x4 + x5 + x6)
1375  pgrid%cofgApp(ycoord,icg) = term*(y1 + y2 + y3 + y4 + y5 + y6)
1376  pgrid%cofgApp(zcoord,icg) = term*(z1 + z2 + z3 + z4 + z5 + z6)
1377  END DO ! icl
1378 
1379 ! ==============================================================================
1380 ! Pyramids
1381 ! ==============================================================================
1382 
1383  term = 1.0_rfreal/5.0_rfreal
1384 
1385  DO icl = 1,pgrid%nPyrsTot
1386  v1 = pgrid%pyr2v(1,icl)
1387  v2 = pgrid%pyr2v(2,icl)
1388  v3 = pgrid%pyr2v(3,icl)
1389  v4 = pgrid%pyr2v(4,icl)
1390  v5 = pgrid%pyr2v(5,icl)
1391 
1392  x1 = pgrid%xyz(xcoord,v1)
1393  x2 = pgrid%xyz(xcoord,v2)
1394  x3 = pgrid%xyz(xcoord,v3)
1395  x4 = pgrid%xyz(xcoord,v4)
1396  x5 = pgrid%xyz(xcoord,v5)
1397 
1398  y1 = pgrid%xyz(ycoord,v1)
1399  y2 = pgrid%xyz(ycoord,v2)
1400  y3 = pgrid%xyz(ycoord,v3)
1401  y4 = pgrid%xyz(ycoord,v4)
1402  y5 = pgrid%xyz(ycoord,v5)
1403 
1404  z1 = pgrid%xyz(zcoord,v1)
1405  z2 = pgrid%xyz(zcoord,v2)
1406  z3 = pgrid%xyz(zcoord,v3)
1407  z4 = pgrid%xyz(zcoord,v4)
1408  z5 = pgrid%xyz(zcoord,v5)
1409 
1410  icg = pgrid%pyr2CellGlob(icl)
1411 
1412  pgrid%cofgApp(xcoord,icg) = term*(x1 + x2 + x3 + x4 + x5)
1413  pgrid%cofgApp(ycoord,icg) = term*(y1 + y2 + y3 + y4 + y5)
1414  pgrid%cofgApp(zcoord,icg) = term*(z1 + z2 + z3 + z4 + z5)
1415  END DO ! icl
1416 
1417 ! ******************************************************************************
1418 ! End
1419 ! ******************************************************************************
1420 
1421  IF ( global%myProcid == masterproc .AND. &
1422  global%verbLevel >= verbose_high ) THEN
1423  WRITE(stdout,'(A,1X,A,A)') solver_name,'Computing approximate '// &
1424  'centroids done.'
1425  END IF ! global%verbLevel
1426 
1427  CALL deregisterfunction(global)
1428 
1429  END SUBROUTINE rflu_computeapproxcentroids
1430 
1431 
1432 
1433 
1434 
1435 
1436 ! ******************************************************************************
1437 !
1438 ! Purpose: Compute distance from face to cell centroids.
1439 !
1440 ! Description: None.
1441 !
1442 ! Input:
1443 ! pRegion Pointer to region
1444 !
1445 ! Output: None.
1446 !
1447 ! Notes: None.
1448 !
1449 ! ******************************************************************************
1450 
1451  SUBROUTINE rflu_computefacedist(pRegion)
1452 
1453  IMPLICIT NONE
1454 
1455 ! ******************************************************************************
1456 ! Declarations and definitions
1457 ! ******************************************************************************
1458 
1459 ! ==============================================================================
1460 ! Parameters
1461 ! ==============================================================================
1462 
1463  TYPE(t_region), POINTER :: pregion
1464 
1465 ! ==============================================================================
1466 ! Locals
1467 ! ==============================================================================
1468 
1469  INTEGER :: c1,c2,errorflag,ifc,ipatch
1470  TYPE(t_global), POINTER :: global
1471  TYPE(t_grid), POINTER :: pgrid
1472  TYPE(t_patch), POINTER :: ppatch
1473 
1474 ! ******************************************************************************
1475 ! Start
1476 ! ******************************************************************************
1477 
1478  global => pregion%global
1479 
1480  CALL registerfunction(global,'RFLU_ComputeFaceDist',&
1481  'RFLU_ModGeometry.F90')
1482 
1483  IF ( global%myProcid == masterproc .AND. &
1484  global%verbLevel >= verbose_high ) THEN
1485  WRITE(stdout,'(A,1X,A)') solver_name,'Computing face distance...'
1486  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1487  pregion%iRegionGlobal
1488  END IF ! global%verbLevel
1489 
1490  pgrid => pregion%grid
1491 
1492 ! ******************************************************************************
1493 ! Compute distances
1494 ! ******************************************************************************
1495 
1496 ! ==============================================================================
1497 ! Interior faces
1498 ! ==============================================================================
1499 
1500  DO ifc = 1,pgrid%nFaces
1501  c1 = pgrid%f2c(1,ifc)
1502  c2 = pgrid%f2c(2,ifc)
1503 
1504  pgrid%cofgDist(1,ifc) = dot_product(pgrid%fc(:,ifc)-pgrid%cofg(:,c1), &
1505  pgrid%fn(1:3,ifc))
1506  pgrid%cofgDist(2,ifc) = dot_product(pgrid%cofg(:,c2)-pgrid%fc(:,ifc), &
1507  pgrid%fn(1:3,ifc))
1508  END DO ! ifc
1509 
1510 ! ==============================================================================
1511 ! Boundary faces
1512 ! ==============================================================================
1513 
1514  DO ipatch = 1,pgrid%nPatches
1515  ppatch => pregion%patches(ipatch)
1516 
1517  DO ifc = 1,ppatch%nBFaces
1518  c1 = ppatch%bf2c(ifc)
1519 
1520  ppatch%cofgDist(ifc) = dot_product(ppatch%fc(:,ifc)-pgrid%cofg(:,c1), &
1521  ppatch%fn(1:3,ifc))
1522  END DO ! ifc
1523  END DO ! iPatch
1524 
1525 ! ******************************************************************************
1526 ! End
1527 ! ******************************************************************************
1528 
1529  IF ( global%myProcid == masterproc .AND. &
1530  global%verbLevel >= verbose_high ) THEN
1531  WRITE(stdout,'(A,1X,A)') solver_name,'Computing face distance done.'
1532  END IF ! global%verbLevel
1533 
1534  CALL deregisterfunction(global)
1535 
1536  END SUBROUTINE rflu_computefacedist
1537 
1538 
1539 
1540 
1541 
1542 
1543 ! ******************************************************************************
1544 !
1545 ! Purpose: Create approximate cell centroids.
1546 !
1547 ! Description: None.
1548 !
1549 ! Input:
1550 ! pRegion Pointer to region
1551 !
1552 ! Output: None.
1553 !
1554 ! Notes: None.
1555 !
1556 ! ******************************************************************************
1557 
1558  SUBROUTINE rflu_createapproxcentroids(pRegion)
1559 
1560  IMPLICIT NONE
1561 
1562 ! ******************************************************************************
1563 ! Declarations and definitions
1564 ! ******************************************************************************
1565 
1566 ! ==============================================================================
1567 ! Parameters
1568 ! ==============================================================================
1569 
1570  TYPE(t_region), POINTER :: pregion
1571 
1572 ! ==============================================================================
1573 ! Locals
1574 ! ==============================================================================
1575 
1576  INTEGER :: errorflag
1577  TYPE(t_grid), POINTER :: pgrid
1578  TYPE(t_global), POINTER :: global
1579 
1580 ! ******************************************************************************
1581 ! Start
1582 ! ******************************************************************************
1583 
1584  global => pregion%global
1585 
1586  CALL registerfunction(global,'RFLU_CreateApproxCentroids',&
1587  'RFLU_ModGeometry.F90')
1588 
1589  IF ( global%myProcid == masterproc .AND. &
1590  global%verbLevel >= verbose_high ) THEN
1591  WRITE(stdout,'(A,1X,A)') solver_name,'Creating approximate centroids...'
1592  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1593  pregion%iRegionGlobal
1594  END IF ! global%verbLevel
1595 
1596  pgrid => pregion%grid
1597 
1598 ! ******************************************************************************
1599 ! Nullify memory
1600 ! ******************************************************************************
1601 
1602  CALL rflu_nullifyapproxcentroids(pregion)
1603 
1604 ! ******************************************************************************
1605 ! Allocate memory
1606 ! ******************************************************************************
1607 
1608  ALLOCATE(pgrid%cofgApp(xcoord:zcoord,pgrid%nCellsTot),stat=errorflag)
1609  global%error = errorflag
1610  IF ( global%error /= err_none ) THEN
1611  CALL errorstop(global,err_allocate,__line__,'pGrid%cofgApp')
1612  END IF ! global%error
1613 
1614 ! ******************************************************************************
1615 ! End
1616 ! ******************************************************************************
1617 
1618  IF ( global%myProcid == masterproc .AND. &
1619  global%verbLevel >= verbose_high ) THEN
1620  WRITE(stdout,'(A,1X,A,A)') solver_name,'Creating approximate '// &
1621  'centroids done.'
1622  END IF ! global%verbLevel
1623 
1624  CALL deregisterfunction(global)
1625 
1626  END SUBROUTINE rflu_createapproxcentroids
1627 
1628 
1629 
1630 
1631 
1632 
1633 ! ******************************************************************************
1634 !
1635 ! Purpose: Create distance from cell centroid to face centroid.
1636 !
1637 ! Description: None.
1638 !
1639 ! Input:
1640 ! pRegion Pointer to region
1641 !
1642 ! Output: None.
1643 !
1644 ! Notes: None.
1645 !
1646 ! ******************************************************************************
1647 
1648  SUBROUTINE rflu_createfacedist(pRegion)
1649 
1650  IMPLICIT NONE
1651 
1652 ! ******************************************************************************
1653 ! Declarations and definitions
1654 ! ******************************************************************************
1655 
1656 ! ==============================================================================
1657 ! Parameters
1658 ! ==============================================================================
1659 
1660  TYPE(t_region), POINTER :: pregion
1661 
1662 ! ==============================================================================
1663 ! Locals
1664 ! ==============================================================================
1665 
1666  INTEGER :: errorflag,ipatch
1667  TYPE(t_grid), POINTER :: pgrid
1668  TYPE(t_patch), POINTER :: ppatch
1669  TYPE(t_global), POINTER :: global
1670 
1671 ! ******************************************************************************
1672 ! Start
1673 ! ******************************************************************************
1674 
1675  global => pregion%global
1676 
1677  CALL registerfunction(global,'RFLU_CreateFaceDist',&
1678  'RFLU_ModGeometry.F90')
1679 
1680  IF ( global%myProcid == masterproc .AND. &
1681  global%verbLevel >= verbose_high ) THEN
1682  WRITE(stdout,'(A,1X,A)') solver_name,'Creating face distance...'
1683  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1684  pregion%iRegionGlobal
1685  END IF ! global%verbLevel
1686 
1687  pgrid => pregion%grid
1688 
1689 ! ******************************************************************************
1690 ! Nullify memory
1691 ! ******************************************************************************
1692 
1693  CALL rflu_nullifyfacedist(pregion)
1694 
1695 ! ******************************************************************************
1696 ! Allocate memory
1697 ! ******************************************************************************
1698 
1699  ALLOCATE(pgrid%cofgDist(2,pgrid%nFaces),stat=errorflag)
1700  global%error = errorflag
1701  IF ( global%error /= err_none ) THEN
1702  CALL errorstop(global,err_allocate,__line__,'pGrid%cofgDist')
1703  END IF ! global%error
1704 
1705  DO ipatch = 1,pgrid%nPatches
1706  ppatch => pregion%patches(ipatch)
1707 
1708  IF ( global%myProcid == masterproc .AND. &
1709  global%verbLevel >= verbose_high ) THEN
1710  WRITE(stdout,'(A,5X,A,1X,I3)') solver_name,'Patch:',ipatch
1711  END IF ! global%verbLevel
1712 
1713  ALLOCATE(ppatch%cofgDist(ppatch%nBFaces),stat=errorflag)
1714  global%error = errorflag
1715  IF ( global%error /= err_none ) THEN
1716  CALL errorstop(global,err_allocate,__line__,'pPatch%cofgDist')
1717  END IF ! global%error
1718  END DO ! iPatch
1719 
1720 ! ******************************************************************************
1721 ! End
1722 ! ******************************************************************************
1723 
1724  IF ( global%myProcid == masterproc .AND. &
1725  global%verbLevel >= verbose_high ) THEN
1726  WRITE(stdout,'(A,1X,A,A)') solver_name,'Creating face distance done.'
1727  END IF ! global%verbLevel
1728 
1729  CALL deregisterfunction(global)
1730 
1731  END SUBROUTINE rflu_createfacedist
1732 
1733 
1734 
1735 
1736 
1737 
1738 
1739 ! ******************************************************************************
1740 !
1741 ! Purpose: Create geometry.
1742 !
1743 ! Description: None.
1744 !
1745 ! Input:
1746 ! pRegion Pointer to region
1747 !
1748 ! Output: None.
1749 !
1750 ! Notes: None.
1751 !
1752 ! ******************************************************************************
1753 
1754  SUBROUTINE rflu_creategeometry(pRegion)
1755 
1756  IMPLICIT NONE
1757 
1758 ! ******************************************************************************
1759 ! Declarations and definitions
1760 ! ******************************************************************************
1761 
1762 ! ==============================================================================
1763 ! Parameters
1764 ! ==============================================================================
1765 
1766  TYPE(t_region), POINTER :: pregion
1767 
1768 ! ==============================================================================
1769 ! Locals
1770 ! ==============================================================================
1771 
1772  INTEGER :: errorflag,ibv,ic,ifc,ipatch
1773  TYPE(t_grid), POINTER :: pgrid
1774  TYPE(t_patch), POINTER :: ppatch
1775  TYPE(t_global), POINTER :: global
1776 
1777 ! ******************************************************************************
1778 ! Start
1779 ! ******************************************************************************
1780 
1781  global => pregion%global
1782 
1783  CALL registerfunction(global,'RFLU_CreateGeometry',&
1784  'RFLU_ModGeometry.F90')
1785 
1786  IF ( global%myProcid == masterproc .AND. &
1787  global%verbLevel >= verbose_high ) THEN
1788  WRITE(stdout,'(A,1X,A)') solver_name,'Creating geometry...'
1789  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1790  pregion%iRegionGlobal
1791  END IF ! global%verbLevel
1792 
1793  pgrid => pregion%grid
1794 
1795 ! ******************************************************************************
1796 ! Nullify memory
1797 ! ******************************************************************************
1798 
1799  CALL rflu_nullifygeometry(pregion)
1800 
1801 ! ******************************************************************************
1802 ! Allocate memory for interior grid geometry
1803 ! ******************************************************************************
1804 
1805  IF ( global%myProcid == masterproc .AND. &
1806  global%verbLevel >= verbose_high ) THEN
1807  WRITE(stdout,'(A,3X,A)') solver_name,'Interior geometry...'
1808  END IF ! global%verbLevel
1809 
1810 ! ==============================================================================
1811 ! Volume and volume centroids
1812 ! ==============================================================================
1813 
1814  ALLOCATE(pgrid%vol(pgrid%nCellsTot),stat=errorflag)
1815  global%error = errorflag
1816  IF ( global%error /= err_none ) THEN
1817  CALL errorstop(global,err_allocate,__line__,'pGrid%vol')
1818  END IF ! global%error
1819 
1820  ALLOCATE(pgrid%cofg(xcoord:zcoord,pgrid%nCellsTot),stat=errorflag)
1821  global%error = errorflag
1822  IF ( global%error /= err_none ) THEN
1823  CALL errorstop(global,err_allocate,__line__,'pGrid%cofg')
1824  END IF ! global%error
1825 
1826  DO ic = 1,pgrid%nCellsTot ! Explicit loop because of ASCI White problem
1827  pgrid%vol(ic) = 0.0_rfreal
1828  pgrid%cofg(xcoord,ic) = 0.0_rfreal
1829  pgrid%cofg(ycoord,ic) = 0.0_rfreal
1830  pgrid%cofg(zcoord,ic) = 0.0_rfreal
1831  END DO ! ic
1832 
1833 ! ==============================================================================
1834 ! Face normals and centroids
1835 ! ==============================================================================
1836 
1837  ALLOCATE(pgrid%fn(xcoord:xyzmag,pgrid%nFacesTot),stat=errorflag)
1838  global%error = errorflag
1839  IF ( global%error /= err_none ) THEN
1840  CALL errorstop(global,err_allocate,__line__,'pGrid%fn')
1841  END IF ! global%error
1842 
1843  ALLOCATE(pgrid%fc(xcoord:zcoord,pgrid%nFacesTot),stat=errorflag)
1844  global%error = errorflag
1845  IF ( global%error /= err_none ) THEN
1846  CALL errorstop(global,err_allocate,__line__,'pGrid%fc')
1847  END IF ! global%error
1848 
1849  DO ifc = 1,pgrid%nFacesTot
1850  pgrid%fn(xcoord,ifc) = 0.0_rfreal
1851  pgrid%fn(ycoord,ifc) = 0.0_rfreal
1852  pgrid%fn(zcoord,ifc) = 0.0_rfreal
1853  pgrid%fn(xyzmag,ifc) = 0.0_rfreal
1854 
1855  pgrid%fc(xcoord,ifc) = 0.0_rfreal
1856  pgrid%fc(ycoord,ifc) = 0.0_rfreal
1857  pgrid%fc(zcoord,ifc) = 0.0_rfreal
1858  END DO ! ifc
1859 
1860 ! ******************************************************************************
1861 ! Allocate memory for patch geometry
1862 ! ******************************************************************************
1863 
1864  IF ( global%myProcid == masterproc .AND. &
1865  global%verbLevel >= verbose_high ) THEN
1866  WRITE(stdout,'(A,3X,A)') solver_name,'Patch geometry...'
1867  END IF ! global%verbLevel
1868 
1869  DO ipatch = 1,pgrid%nPatches
1870  ppatch => pregion%patches(ipatch)
1871 
1872  IF ( global%myProcid == masterproc .AND. &
1873  global%verbLevel >= verbose_high ) THEN
1874  WRITE(stdout,'(A,5X,A,1X,I3)') solver_name,'Patch:',ipatch
1875  END IF ! global%verbLevel
1876 
1877 ! ==============================================================================
1878 ! Face normal and centroid
1879 ! ==============================================================================
1880 
1881  ALLOCATE(ppatch%fn(xcoord:xyzmag,ppatch%nBFacesTot),stat=errorflag)
1882  global%error = errorflag
1883  IF ( global%error /= err_none ) THEN
1884  CALL errorstop(global,err_allocate,__line__,'region%patches%fn')
1885  END IF ! global%error
1886 
1887  ALLOCATE(ppatch%fc(xcoord:zcoord,ppatch%nBFacesTot),stat=errorflag)
1888  global%error = errorflag
1889  IF ( global%error /= err_none ) THEN
1890  CALL errorstop(global,err_allocate,__line__,'region%patches%fc')
1891  END IF ! global%error
1892 
1893  DO ifc = 1,ppatch%nBFacesTot
1894  ppatch%fn(xcoord,ifc) = 0.0_rfreal
1895  ppatch%fn(ycoord,ifc) = 0.0_rfreal
1896  ppatch%fn(zcoord,ifc) = 0.0_rfreal
1897  ppatch%fn(xyzmag,ifc) = 0.0_rfreal
1898 
1899  ppatch%fc(xcoord,ifc) = 0.0_rfreal
1900  ppatch%fc(ycoord,ifc) = 0.0_rfreal
1901  ppatch%fc(zcoord,ifc) = 0.0_rfreal
1902  END DO ! ifc
1903 
1904 ! ==============================================================================
1905 ! Vertex normals
1906 ! ==============================================================================
1907 
1908  IF ( pregion%mixtInput%moveGrid .EQV. .true. ) THEN
1909  ALLOCATE(ppatch%bvn(xcoord:zcoord,ppatch%nBVertTot),stat=errorflag)
1910  global%error = errorflag
1911  IF ( global%error /= err_none ) THEN
1912  CALL errorstop(global,err_allocate,__line__,'pPatch%bvn')
1913  END IF ! global%error
1914 
1915  DO ibv = 1,ppatch%nBVertTot
1916  ppatch%bvn(xcoord,ibv) = 0.0_rfreal
1917  ppatch%bvn(ycoord,ibv) = 0.0_rfreal
1918  ppatch%bvn(zcoord,ibv) = 0.0_rfreal
1919  END DO ! ibv
1920  ELSE
1921  nullify(ppatch%bvn)
1922  END IF ! pRegion%mixtInput%moveGrid
1923  END DO ! iPatch
1924 
1925 ! ******************************************************************************
1926 ! End
1927 ! ******************************************************************************
1928 
1929  IF ( global%myProcid == masterproc .AND. &
1930  global%verbLevel >= verbose_high ) THEN
1931  WRITE(stdout,'(A,1X,A)') solver_name,'Creating geometry done.'
1932  END IF ! global%verbLevel
1933 
1934  CALL deregisterfunction(global)
1935 
1936  END SUBROUTINE rflu_creategeometry
1937 
1938 
1939 
1940 
1941 
1942 
1943 
1944 
1945 ! ******************************************************************************
1946 !
1947 ! Purpose: Destroy approximate cell centroids
1948 !
1949 ! Description: None.
1950 !
1951 ! Input:
1952 ! pRegion Pointer to region
1953 !
1954 ! Output: None.
1955 !
1956 ! Notes: None.
1957 !
1958 ! ******************************************************************************
1959 
1960  SUBROUTINE rflu_destroyapproxcentroids(pRegion)
1961 
1962  IMPLICIT NONE
1963 
1964 ! ******************************************************************************
1965 ! Declarations and definitions
1966 ! ******************************************************************************
1967 
1968 ! ==============================================================================
1969 ! Parameters
1970 ! ==============================================================================
1971 
1972  TYPE(t_region), POINTER :: pregion
1973 
1974 ! ==============================================================================
1975 ! Locals
1976 ! ==============================================================================
1977 
1978  INTEGER :: errorflag
1979  TYPE(t_grid), POINTER :: pgrid
1980  TYPE(t_global), POINTER :: global
1981 
1982 ! ******************************************************************************
1983 ! Start
1984 ! ******************************************************************************
1985 
1986  global => pregion%global
1987 
1988  CALL registerfunction(global,'RFLU_DestroyApproxCentroids',&
1989  'RFLU_ModGeometry.F90')
1990 
1991  IF ( global%myProcid == masterproc .AND. &
1992  global%verbLevel >= verbose_high ) THEN
1993  WRITE(stdout,'(A,1X,A,A)') solver_name,'Destroying approximate ', &
1994  'centroids...'
1995  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1996  pregion%iRegionGlobal
1997  END IF ! global%verbLevel
1998 
1999  pgrid => pregion%grid
2000 
2001 ! ******************************************************************************
2002 ! Deallocate memory
2003 ! ******************************************************************************
2004 
2005  DEALLOCATE(pgrid%cofgApp,stat=errorflag)
2006  global%error = errorflag
2007  IF ( global%error /= err_none ) THEN
2008  CALL errorstop(global,err_deallocate,__line__,'pGrid%cofgApp')
2009  END IF ! global%error
2010 
2011 ! ******************************************************************************
2012 ! Nullify memory
2013 ! ******************************************************************************
2014 
2015  CALL rflu_nullifyapproxcentroids(pregion)
2016 
2017 ! ******************************************************************************
2018 ! End
2019 ! ******************************************************************************
2020 
2021  IF ( global%myProcid == masterproc .AND. &
2022  global%verbLevel >= verbose_high ) THEN
2023  WRITE(stdout,'(A,1X,A,A)') solver_name,'Destroying approximate '// &
2024  'centroids done.'
2025  END IF ! global%verbLevel
2026 
2027  CALL deregisterfunction(global)
2028 
2029  END SUBROUTINE rflu_destroyapproxcentroids
2030 
2031 
2032 
2033 
2034 
2035 
2036 ! ******************************************************************************
2037 !
2038 ! Purpose: Destroy distance from cell centroid to face centroid.
2039 !
2040 ! Description: None.
2041 !
2042 ! Input:
2043 ! pRegion Pointer to region
2044 !
2045 ! Output: None.
2046 !
2047 ! Notes: None.
2048 !
2049 ! ******************************************************************************
2050 
2051  SUBROUTINE rflu_destroyfacedist(pRegion)
2052 
2053  IMPLICIT NONE
2054 
2055 ! ******************************************************************************
2056 ! Declarations and definitions
2057 ! ******************************************************************************
2058 
2059 ! ==============================================================================
2060 ! Parameters
2061 ! ==============================================================================
2062 
2063  TYPE(t_region), POINTER :: pregion
2064 
2065 ! ==============================================================================
2066 ! Locals
2067 ! ==============================================================================
2068 
2069  INTEGER :: errorflag,ipatch
2070  TYPE(t_grid), POINTER :: pgrid
2071  TYPE(t_patch), POINTER :: ppatch
2072  TYPE(t_global), POINTER :: global
2073 
2074 ! ******************************************************************************
2075 ! Start
2076 ! ******************************************************************************
2077 
2078  global => pregion%global
2079 
2080  CALL registerfunction(global,'RFLU_DestroyFaceDist',&
2081  'RFLU_ModGeometry.F90')
2082 
2083  IF ( global%myProcid == masterproc .AND. &
2084  global%verbLevel >= verbose_high ) THEN
2085  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying face distance...'
2086  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2087  pregion%iRegionGlobal
2088  END IF ! global%verbLevel
2089 
2090  pgrid => pregion%grid
2091 
2092 ! ******************************************************************************
2093 ! Deallocate memory
2094 ! ******************************************************************************
2095 
2096  DEALLOCATE(pgrid%cofgDist,stat=errorflag)
2097  global%error = errorflag
2098  IF ( global%error /= err_none ) THEN
2099  CALL errorstop(global,err_deallocate,__line__,'pGrid%cofgDist')
2100  END IF ! global%error
2101 
2102  DO ipatch = 1,pgrid%nPatches
2103  ppatch => pregion%patches(ipatch)
2104 
2105  IF ( global%myProcid == masterproc .AND. &
2106  global%verbLevel >= verbose_high ) THEN
2107  WRITE(stdout,'(A,5X,A,1X,I3)') solver_name,'Patch:',ipatch
2108  END IF ! global%verbLevel
2109 
2110  DEALLOCATE(ppatch%cofgDist,stat=errorflag)
2111  global%error = errorflag
2112  IF ( global%error /= err_none ) THEN
2113  CALL errorstop(global,err_deallocate,__line__,'pPatch%cofgDist')
2114  END IF ! global%error
2115  END DO ! iPatch
2116 
2117 ! ******************************************************************************
2118 ! Nullify memory
2119 ! ******************************************************************************
2120 
2121  CALL rflu_nullifyfacedist(pregion)
2122 
2123 ! ******************************************************************************
2124 ! End
2125 ! ******************************************************************************
2126 
2127  IF ( global%myProcid == masterproc .AND. &
2128  global%verbLevel >= verbose_high ) THEN
2129  WRITE(stdout,'(A,1X,A,A)') solver_name,'Destroying face distance done.'
2130  END IF ! global%verbLevel
2131 
2132  CALL deregisterfunction(global)
2133 
2134  END SUBROUTINE rflu_destroyfacedist
2135 
2136 
2137 
2138 
2139 
2140 ! ******************************************************************************
2141 !
2142 ! Purpose: Destroy geometry.
2143 !
2144 ! Description: None.
2145 !
2146 ! Input:
2147 ! pRegion Pointer to region
2148 !
2149 ! Output: None.
2150 !
2151 ! Notes: None.
2152 !
2153 ! ******************************************************************************
2154 
2155  SUBROUTINE rflu_destroygeometry(pRegion)
2156 
2157  IMPLICIT NONE
2158 
2159 ! ******************************************************************************
2160 ! Declarations and definitions
2161 ! ******************************************************************************
2162 
2163 ! ==============================================================================
2164 ! Parameters
2165 ! ==============================================================================
2166 
2167  TYPE(t_region), POINTER :: pregion
2168 
2169 ! ==============================================================================
2170 ! Locals
2171 ! ==============================================================================
2172 
2173  INTEGER :: errorflag,ipatch
2174  TYPE(t_grid), POINTER :: pgrid
2175  TYPE(t_patch), POINTER :: ppatch
2176  TYPE(t_global), POINTER :: global
2177 
2178 ! ******************************************************************************
2179 ! Start
2180 ! ******************************************************************************
2181 
2182  global => pregion%global
2183 
2184  CALL registerfunction(global,'RFLU_DestroyGeometry',&
2185  'RFLU_ModGeometry.F90')
2186 
2187  IF ( global%myProcid == masterproc .AND. &
2188  global%verbLevel >= verbose_high ) THEN
2189  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying geometry...'
2190  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2191  pregion%iRegionGlobal
2192  END IF ! global%verbLevel
2193 
2194  pgrid => pregion%grid
2195 
2196 ! ******************************************************************************
2197 ! Deallocate memory for interior grid geometry
2198 ! ******************************************************************************
2199 
2200  DEALLOCATE(pgrid%vol,stat=errorflag)
2201  global%error = errorflag
2202  IF ( global%error /= err_none ) THEN
2203  CALL errorstop(global,err_deallocate,__line__,'region%grid%vol')
2204  END IF ! global%error
2205 
2206  DEALLOCATE(pgrid%fn,stat=errorflag)
2207  global%error = errorflag
2208  IF ( global%error /= err_none ) THEN
2209  CALL errorstop(global,err_deallocate,__line__,'region%grid%fn')
2210  END IF ! global%error
2211 
2212  IF ( ASSOCIATED(pgrid%fc) .EQV. .true. ) THEN
2213  DEALLOCATE(pgrid%fc,stat=errorflag)
2214  global%error = errorflag
2215  IF ( global%error /= err_none ) THEN
2216  CALL errorstop(global,err_deallocate,__line__,'region%grid%fc')
2217  END IF ! global%error
2218  END IF ! ASSOCIATED
2219 
2220  IF ( ASSOCIATED(pgrid%cofg) .EQV. .true. ) THEN
2221  DEALLOCATE(pgrid%cofg,stat=errorflag)
2222  global%error = errorflag
2223  IF ( global%error /= err_none ) THEN
2224  CALL errorstop(global,err_deallocate,__line__,'region%grid%cofg')
2225  END IF ! global%error
2226  END IF ! ASSOCIATED
2227 
2228 ! ******************************************************************************
2229 ! Deallocate memory for patch geometry
2230 ! ******************************************************************************
2231 
2232  DO ipatch = 1,pgrid%nPatches
2233  ppatch => pregion%patches(ipatch)
2234 
2235  DEALLOCATE(ppatch%fn,stat=errorflag)
2236  global%error = errorflag
2237  IF ( global%error /= err_none ) THEN
2238  CALL errorstop(global,err_deallocate,__line__,'region%patches%fn')
2239  END IF ! global%error
2240 
2241  IF ( ASSOCIATED(ppatch%fc) .EQV. .true. ) THEN
2242  DEALLOCATE(ppatch%fc,stat=errorflag)
2243  global%error = errorflag
2244  IF ( global%error /= err_none ) THEN
2245  CALL errorstop(global,err_deallocate,__line__,'region%patches%fc')
2246  END IF ! global%error
2247  END IF ! ASSOCIATED
2248 
2249  IF ( ASSOCIATED(ppatch%bvn) .EQV. .true. ) THEN
2250  DEALLOCATE(ppatch%bvn,stat=errorflag)
2251  global%error = errorflag
2252  IF ( global%error /= err_none ) THEN
2253  CALL errorstop(global,err_deallocate,__line__,'pPatch%bvn')
2254  END IF ! global%error
2255  END IF ! ASSOCIATED
2256  END DO ! iPatch
2257 
2258 ! ******************************************************************************
2259 ! Nullify memory
2260 ! ******************************************************************************
2261 
2262  CALL rflu_nullifygeometry(pregion)
2263 
2264 ! ******************************************************************************
2265 ! End
2266 ! ******************************************************************************
2267 
2268  IF ( global%myProcid == masterproc .AND. &
2269  global%verbLevel >= verbose_high ) THEN
2270  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying geometry done.'
2271  END IF ! global%verbLevel
2272 
2273  CALL deregisterfunction(global)
2274 
2275  END SUBROUTINE rflu_destroygeometry
2276 
2277 
2278 
2279 
2280 
2281 ! ******************************************************************************
2282 !
2283 ! Purpose: Nullify approximate cell centroids.
2284 !
2285 ! Description: None.
2286 !
2287 ! Input:
2288 ! pRegion Pointer to region
2289 !
2290 ! Output: None.
2291 !
2292 ! Notes: None.
2293 !
2294 ! ******************************************************************************
2295 
2296  SUBROUTINE rflu_nullifyapproxcentroids(pRegion)
2297 
2298  IMPLICIT NONE
2299 
2300 ! ******************************************************************************
2301 ! Declarations and definitions
2302 ! ******************************************************************************
2303 
2304 ! ==============================================================================
2305 ! Parameters
2306 ! ==============================================================================
2307 
2308  TYPE(t_region), POINTER :: pregion
2309 
2310 ! ==============================================================================
2311 ! Locals
2312 ! ==============================================================================
2313 
2314  TYPE(t_grid), POINTER :: pgrid
2315  TYPE(t_global), POINTER :: global
2316 
2317 ! ******************************************************************************
2318 ! Start
2319 ! ******************************************************************************
2320 
2321  global => pregion%global
2322 
2323  CALL registerfunction(global,'RFLU_NullifyApproxCentroids',&
2324  'RFLU_ModGeometry.F90')
2325 
2326  IF ( global%myProcid == masterproc .AND. &
2327  global%verbLevel >= verbose_high ) THEN
2328  WRITE(stdout,'(A,1X,A)') solver_name, &
2329  'Nullifying approximate centroids...'
2330  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2331  pregion%iRegionGlobal
2332  END IF ! global%verbLevel
2333 
2334  pgrid => pregion%grid
2335 
2336 ! ******************************************************************************
2337 ! Nullify memory
2338 ! ******************************************************************************
2339 
2340  nullify(pgrid%cofgApp)
2341 
2342 ! ******************************************************************************
2343 ! End
2344 ! ******************************************************************************
2345 
2346  IF ( global%myProcid == masterproc .AND. &
2347  global%verbLevel >= verbose_high ) THEN
2348  WRITE(stdout,'(A,1X,A,A)') solver_name, &
2349  'Nullifying approximate centroids done.'
2350  END IF ! global%verbLevel
2351 
2352  CALL deregisterfunction(global)
2353 
2354  END SUBROUTINE rflu_nullifyapproxcentroids
2355 
2356 
2357 
2358 
2359 
2360 
2361 ! ******************************************************************************
2362 !
2363 ! Purpose: Nullify face distance.
2364 !
2365 ! Description: None.
2366 !
2367 ! Input:
2368 ! pRegion Pointer to region
2369 !
2370 ! Output: None.
2371 !
2372 ! Notes: None.
2373 !
2374 ! ******************************************************************************
2375 
2376  SUBROUTINE rflu_nullifyfacedist(pRegion)
2377 
2378  IMPLICIT NONE
2379 
2380 ! ******************************************************************************
2381 ! Declarations and definitions
2382 ! ******************************************************************************
2383 
2384 ! ==============================================================================
2385 ! Parameters
2386 ! ==============================================================================
2387 
2388  TYPE(t_region), POINTER :: pregion
2389 
2390 ! ==============================================================================
2391 ! Locals
2392 ! ==============================================================================
2393 
2394  INTEGER :: ipatch
2395  TYPE(t_grid), POINTER :: pgrid
2396  TYPE(t_patch), POINTER :: ppatch
2397  TYPE(t_global), POINTER :: global
2398 
2399 ! ******************************************************************************
2400 ! Start
2401 ! ******************************************************************************
2402 
2403  global => pregion%global
2404 
2405  CALL registerfunction(global,'RFLU_NullifyFaceDist',&
2406  'RFLU_ModGeometry.F90')
2407 
2408  IF ( global%myProcid == masterproc .AND. &
2409  global%verbLevel >= verbose_high ) THEN
2410  WRITE(stdout,'(A,1X,A)') solver_name, &
2411  'Nullifying face distance...'
2412  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2413  pregion%iRegionGlobal
2414  END IF ! global%verbLevel
2415 
2416  pgrid => pregion%grid
2417 
2418 ! ******************************************************************************
2419 ! Nullify memory
2420 ! ******************************************************************************
2421 
2422  nullify(pgrid%cofgDist)
2423 
2424  DO ipatch = 1,pgrid%nPatches
2425  ppatch => pregion%patches(ipatch)
2426 
2427  nullify(ppatch%cofgDist)
2428  END DO ! iPatch
2429 
2430 ! ******************************************************************************
2431 ! End
2432 ! ******************************************************************************
2433 
2434  IF ( global%myProcid == masterproc .AND. &
2435  global%verbLevel >= verbose_high ) THEN
2436  WRITE(stdout,'(A,1X,A,A)') solver_name, &
2437  'Nullifying face distance done.'
2438  END IF ! global%verbLevel
2439 
2440  CALL deregisterfunction(global)
2441 
2442  END SUBROUTINE rflu_nullifyfacedist
2443 
2444 
2445 
2446 
2447 
2448 
2449 ! ******************************************************************************
2450 !
2451 ! Purpose: Nullify geometry.
2452 !
2453 ! Description: None.
2454 !
2455 ! Input:
2456 ! pRegion Pointer to region
2457 !
2458 ! Output: None.
2459 !
2460 ! Notes: None.
2461 !
2462 ! ******************************************************************************
2463 
2464  SUBROUTINE rflu_nullifygeometry(pRegion)
2465 
2466  IMPLICIT NONE
2467 
2468 ! ******************************************************************************
2469 ! Declarations and definitions
2470 ! ******************************************************************************
2471 
2472 ! ==============================================================================
2473 ! Parameters
2474 ! ==============================================================================
2475 
2476  TYPE(t_region), POINTER :: pregion
2477 
2478 ! ==============================================================================
2479 ! Locals
2480 ! ==============================================================================
2481 
2482  INTEGER :: ipatch
2483  TYPE(t_grid), POINTER :: pgrid
2484  TYPE(t_patch), POINTER :: ppatch
2485  TYPE(t_global), POINTER :: global
2486 
2487 ! ******************************************************************************
2488 ! Start
2489 ! ******************************************************************************
2490 
2491  global => pregion%global
2492 
2493  CALL registerfunction(global,'RFLU_NullifyGeometry',&
2494  'RFLU_ModGeometry.F90')
2495 
2496  IF ( global%myProcid == masterproc .AND. &
2497  global%verbLevel >= verbose_high ) THEN
2498  WRITE(stdout,'(A,1X,A)') solver_name,'Nullifying geometry...'
2499  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2500  pregion%iRegionGlobal
2501  END IF ! global%verbLevel
2502 
2503  pgrid => pregion%grid
2504 
2505 ! ******************************************************************************
2506 ! Nullify memory for interior grid geometry
2507 ! ******************************************************************************
2508 
2509  nullify(pgrid%vol)
2510  nullify(pgrid%cofg)
2511 
2512  nullify(pgrid%fn)
2513  nullify(pgrid%fc)
2514 
2515 ! ******************************************************************************
2516 ! Nullify memory for patch geometry
2517 ! ******************************************************************************
2518 
2519  DO ipatch = 1,pgrid%nPatches
2520  ppatch => pregion%patches(ipatch)
2521 
2522  nullify(ppatch%fn)
2523  nullify(ppatch%fc)
2524  nullify(ppatch%bvn)
2525  END DO ! iPatch
2526 
2527 ! ******************************************************************************
2528 ! End
2529 ! ******************************************************************************
2530 
2531  IF ( global%myProcid == masterproc .AND. &
2532  global%verbLevel >= verbose_high ) THEN
2533  WRITE(stdout,'(A,1X,A)') solver_name,'Nullifying geometry done.'
2534  END IF ! global%verbLevel
2535 
2536  CALL deregisterfunction(global)
2537 
2538  END SUBROUTINE rflu_nullifygeometry
2539 
2540 
2541 
2542 ! ******************************************************************************
2543 ! End
2544 ! ******************************************************************************
2545 
2546 END MODULE rflu_modgeometry
2547 
2548 
2549 ! ******************************************************************************
2550 !
2551 ! RCS Revision history:
2552 !
2553 ! $Log: RFLU_ModGeometry.F90,v $
2554 ! Revision 1.35 2008/12/06 08:44:22 mtcampbe
2555 ! Updated license.
2556 !
2557 ! Revision 1.34 2008/11/19 22:17:33 mtcampbe
2558 ! Added Illinois Open Source License/Copyright
2559 !
2560 ! Revision 1.33 2007/07/08 21:45:03 gzheng
2561 ! changed the PRESENT is used for PGI compiler
2562 !
2563 ! Revision 1.32 2007/04/14 15:54:36 mtcampbe
2564 ! Sudden death fix
2565 !
2566 ! Revision 1.31 2006/04/13 18:08:17 haselbac
2567 ! Cosmetics only
2568 !
2569 ! Revision 1.30 2006/04/07 15:19:19 haselbac
2570 ! Removed tabs
2571 !
2572 ! Revision 1.29 2006/03/25 21:52:57 haselbac
2573 ! Substantial changes because of sype patches
2574 !
2575 ! Revision 1.28 2005/01/13 21:42:19 haselbac
2576 ! Bug fix in computation of face distances
2577 !
2578 ! Revision 1.27 2004/12/19 15:47:36 haselbac
2579 ! Added routines for face distance
2580 !
2581 ! Revision 1.26 2004/10/19 19:27:58 haselbac
2582 ! Substantial clean-up
2583 !
2584 ! Revision 1.25 2004/01/22 16:03:59 haselbac
2585 ! Made contents of modules PRIVATE, only procs PUBLIC, to avoid errors on ALC
2586 ! and titan
2587 !
2588 ! Revision 1.24 2003/11/25 21:03:24 haselbac
2589 ! Added additional output when checking data structure
2590 !
2591 ! Revision 1.23 2003/09/02 02:52:32 haselbac
2592 ! Added value of error to error messages
2593 !
2594 ! Revision 1.22 2003/08/20 02:09:58 haselbac
2595 ! Changed verbosity conditions to reduce solver output in GENx runs
2596 !
2597 ! Revision 1.21 2003/06/04 22:08:30 haselbac
2598 ! Added Nullify routines, some cosmetics
2599 !
2600 ! Revision 1.20 2003/05/06 01:04:02 haselbac
2601 ! Added NULLIFY for pPatch%bvn
2602 !
2603 ! Revision 1.19 2003/05/02 02:34:41 haselbac
2604 ! Changed if-statements around volume ratio output (f90 quirk)
2605 !
2606 ! Revision 1.18 2003/04/16 18:34:23 haselbac
2607 ! Removed commented-out statement
2608 !
2609 ! Revision 1.17 2003/04/07 14:25:14 haselbac
2610 ! Changed volErr definition and limit
2611 !
2612 ! Revision 1.16 2003/03/22 00:01:35 haselbac
2613 ! Fixed bug: Init in wrong places
2614 !
2615 ! Revision 1.15 2003/03/21 23:09:23 haselbac
2616 ! Fixed subtle bug: Added init to RFLU_CreateGeometry
2617 !
2618 ! Revision 1.14 2003/03/15 18:08:54 haselbac
2619 ! Bug fixes for centroid, || comps, other changes
2620 !
2621 ! Revision 1.13 2003/01/28 16:31:18 haselbac
2622 ! Now contains BuildBVertexNormals, print out locs of extrema in volumes,
2623 ! bug fixes, scaled coordinates
2624 !
2625 ! Revision 1.12 2002/12/20 23:18:37 haselbac
2626 ! Fixed output bug: no output for verbosity=0
2627 !
2628 ! Revision 1.11 2002/11/08 21:27:17 haselbac
2629 ! Write out volume ratio for moving-grid cases
2630 !
2631 ! Revision 1.10 2002/10/27 19:05:57 haselbac
2632 ! Bug fixes (removed HACK_PERIODIC distinctions), changed creation of
2633 ! geometry
2634 !
2635 ! Revision 1.9 2002/10/16 21:13:34 haselbac
2636 ! Increased VOL_ERR_LIMIT to 1.0 (X29-new)
2637 !
2638 ! Revision 1.8 2002/10/08 15:49:21 haselbac
2639 ! {IO}STAT=global%error replaced by {IO}STAT=errorFlag - SGI problem
2640 !
2641 ! Revision 1.7 2002/10/05 19:04:39 haselbac
2642 ! Increased volume tolerance to 0.5, more CHECK output
2643 !
2644 ! Revision 1.6 2002/09/09 15:07:22 haselbac
2645 ! global now under regions, bug fix for periodic hack
2646 !
2647 ! Revision 1.5 2002/07/25 15:01:35 haselbac
2648 ! Deallocation changed for OLES, more checking output and error checks,
2649 ! verbosity levels changed
2650 !
2651 ! Revision 1.4 2002/06/27 15:50:34 haselbac
2652 ! Modifications for parallelization, added CHECK_DATASTRUCT flag
2653 !
2654 ! Revision 1.3 2002/06/17 13:39:45 haselbac
2655 ! Prefixed SOLVER_NAME to all screen output
2656 !
2657 ! Revision 1.2 2002/05/04 16:39:51 haselbac
2658 ! New modules, more checking, deallocate fc for 1st order
2659 !
2660 ! Revision 1.1 2002/04/11 18:48:48 haselbac
2661 ! Initial revision
2662 !
2663 ! ******************************************************************************
2664 
2665 
2666 
2667 
2668 
2669 
2670 
2671 
2672 
2673 
2674 
2675 
2676 
2677 
2678 
2679 
2680 
2681 
2682 
rflu_modgeometry::rflu_nullifygeometry
subroutine, public rflu_nullifygeometry(pRegion)
Definition: RFLU_ModGeometry.F90:2464
facevectortria
subroutine facevectortria(xyzNodes, fVecX, fVecY, fVecZ)
Definition: FaceVector.F90:49
rflu_modcellfaceedgeinfo::rflu_getglobalcellkind
INTEGER function, public rflu_getglobalcellkind(global, pGrid, icg)
Definition: RFLU_ModCellFaceEdgeInfo.F90:163
rflu_modgeometry::rflu_computefacedist
subroutine, public rflu_computefacedist(pRegion)
Definition: RFLU_ModGeometry.F90:1451
rflu_modgeometry::rflu_destroyapproxcentroids
subroutine, public rflu_destroyapproxcentroids(pRegion)
Definition: RFLU_ModGeometry.F90:1960
rflu_modgeometry::rflu_createfacedist
subroutine, public rflu_createfacedist(pRegion)
Definition: RFLU_ModGeometry.F90:1648
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_modgeometry::rflu_destroygeometry
subroutine, public rflu_destroygeometry(pRegion)
Definition: RFLU_ModGeometry.F90:2155
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
ic
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com WITHOUT WARRANTY OF ANY **EXPRESS OR INCLUDING BUT NOT LIMITED TO THE WARRANTIES **OF FITNESS FOR A PARTICULAR PURPOSE AND **NONINFRINGEMENT IN NO EVENT SHALL THE CONTRIBUTORS OR **COPYRIGHT HOLDERS BE LIABLE FOR ANY DAMAGES OR OTHER WHETHER IN AN ACTION OF TORT OR **Arising OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE **USE OR OTHER DEALINGS WITH THE SOFTWARE **********************************************************************INTERFACE SUBROUTINE ic
Definition: RFLO_FindSourceCell.h:27
modgrid::t_grid
Definition: ModGrid.F90:56
sqrt
double sqrt(double d)
Definition: double.h:73
rflu_modgeometry::rflu_buildgeometry
subroutine, public rflu_buildgeometry(pRegion, sypeFaceFlag)
Definition: RFLU_ModGeometry.F90:280
rflu_modgeometry::rflu_nullifyfacedist
subroutine rflu_nullifyfacedist(pRegion)
Definition: RFLU_ModGeometry.F90:2376
rflu_modgeometry::rflu_nullifyapproxcentroids
subroutine, public rflu_nullifyapproxcentroids(pRegion)
Definition: RFLU_ModGeometry.F90:2296
rflu_modcellfaceedgeinfo::rflu_getfacekind
INTEGER function, public rflu_getfacekind(global, c1k, c2k)
Definition: RFLU_ModCellFaceEdgeInfo.F90:358
modsortsearch::quicksortrfreal
subroutine quicksortrfreal(a, n)
Definition: ModSortSearch.F90:722
rflu_printlocinfo
subroutine rflu_printlocinfo(pRegion, locUnsorted, nLocUnsorted, locInfoMode, outputMode)
Definition: RFLU_PrintLocInfo.F90:57
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
rflu_modgeometry::rflu_computeapproxcentroids
subroutine, public rflu_computeapproxcentroids(pRegion)
Definition: RFLU_ModGeometry.F90:1208
rflu_modcellfaceedgeinfo
Definition: RFLU_ModCellFaceEdgeInfo.F90:40
dot_product
long double dot_product(pnt vec1, pnt vec2)
Definition: utilities/rc_cmp/util.cpp:387
facevectorquad
subroutine facevectorquad(xyzNodes, fVecX, fVecY, fVecZ)
Definition: FaceVector.F90:80
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
rflu_modgeometry::rflu_destroyfacedist
subroutine, public rflu_destroyfacedist(pRegion)
Definition: RFLU_ModGeometry.F90:2051
rflu_modgeometry::rflu_creategeometry
subroutine, public rflu_creategeometry(pRegion)
Definition: RFLU_ModGeometry.F90:1754
rflu_modgeometry::rflu_buildbvertexnormals
subroutine, public rflu_buildbvertexnormals(pRegion)
Definition: RFLU_ModGeometry.F90:110
rflu_modgeometry::rflu_createapproxcentroids
subroutine, public rflu_createapproxcentroids(pRegion)
Definition: RFLU_ModGeometry.F90:1558
facecentroidtria
subroutine facecentroidtria(xyz, fCenX, fCenY, fCenZ)
Definition: FaceCentroid.F90:47
facecentroidquad
subroutine facecentroidquad(xyz, fCenX, fCenY, fCenZ)
Definition: FaceCentroid.F90:73
rflu_modgeometry
Definition: RFLU_ModGeometry.F90:46
modbndpatch::t_patch
Definition: ModBndPatch.F90:91