Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModPatchUtils.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: Collection of routines for patch operations.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModPatchUtils.F90,v 1.7 2008/12/06 08:44:23 mtcampbe Exp $
34 !
35 ! Copyright: (c) 2006 by the University of Illinois
36 !
37 ! ******************************************************************************
38 
39 MODULE rflu_modpatchutils
40 
41  USE modparameters
42  USE moddatatypes
43  USE modglobal, ONLY: t_global
44  USE modgrid, ONLY: t_grid
45  USE modbndpatch, ONLY: t_patch
46  USE moddatastruct, ONLY: t_region
47  USE moderror
48  USE modmpi
49 
50  IMPLICIT NONE
51 
52 ! ******************************************************************************
53 ! Definitions and declarations
54 ! ******************************************************************************
55 
56 ! ==============================================================================
57 ! Private data
58 ! ==============================================================================
59 
60  CHARACTER(CHRLEN), PRIVATE :: &
61  RCSIdentString = '$RCSfile: RFLU_ModPatchUtils.F90,v $ $Revision: 1.7 $'
62 
63 ! ==============================================================================
64 ! Public functions
65 ! ==============================================================================
66 
67  PUBLIC :: rflu_buildpatchneighbormaps, &
68  rflu_checkpatchbcconsistency, &
69  rflu_computepatchnormalsglobal, &
70  rflu_computepatchnormalslocal, &
71  rflu_createpatchneighbormaps, &
72  rflu_destroypatchneighbormaps, &
73  rflu_getpatchnormaldirection
74 
75 ! ==============================================================================
76 ! Private functions
77 ! ==============================================================================
78 
79 
80 
81 ! ******************************************************************************
82 ! Routines
83 ! ******************************************************************************
84 
85  CONTAINS
86 
87 
88 
89 
90 
91 
92 ! ******************************************************************************
93 !
94 ! Purpose: Build patch-neighbor maps, which indicate whether any two patches
95 ! share vertices.
96 !
97 ! Description: None.
98 !
99 ! Input:
100 ! pRegion Pointer to region data
101 !
102 ! Output: None.
103 !
104 ! Notes: None.
105 !
106 ! ******************************************************************************
107 
108 SUBROUTINE rflu_buildpatchneighbormaps(pRegion)
109 
110  USE modsortsearch
111 
112  IMPLICIT NONE
113 
114 ! ******************************************************************************
115 ! Declarations and definitions
116 ! ******************************************************************************
117 
118 ! ==============================================================================
119 ! Arguments
120 ! ==============================================================================
121 
122  TYPE(t_region), POINTER :: pregion
123 
124 ! ==============================================================================
125 ! Locals
126 ! ==============================================================================
127 
128  INTEGER :: errorflag,iloc,ipatch,ipatch2,ivg,ivl
129  TYPE(t_global), POINTER :: global
130  TYPE(t_grid), POINTER :: pgrid
131  TYPE(t_patch), POINTER :: ppatch,ppatch2
132 
133 ! ******************************************************************************
134 ! Start
135 ! ******************************************************************************
136 
137  global => pregion%global
138 
139  CALL registerfunction(global,'RFLU_BuildPatchNeighborMaps',&
140  'RFLU_ModPatchUtils.F90')
141 
142  IF ( global%myProcid == masterproc .AND. &
143  global%verbLevel >= verbose_high ) THEN
144  WRITE(stdout,'(A,1X,A)') solver_name,'Building patch-neighbor maps...'
145  END IF ! global%myProcid
146 
147  pgrid => pregion%grid
148 
149 ! ******************************************************************************
150 ! Loop over patches
151 ! ******************************************************************************
152 
153  IF ( pgrid%nPatches > 0 ) THEN
154  DO ipatch = 1,pgrid%nPatches
155  ppatch => pregion%patches(ipatch)
156 
157  DO ipatch2 = ipatch+1,pgrid%nPatches
158  ppatch2 => pregion%patches(ipatch2)
159 
160  ivlloop: DO ivl = 1,ppatch%nBVert
161  ivg = ppatch%bv(ivl)
162 
163  CALL binarysearchinteger(ppatch2%bv(1:ppatch2%nBVert),ppatch2%nBVert, &
164  ivg,iloc)
165 
166  IF ( iloc /= element_not_found ) THEN
167  ppatch%nbMap(ppatch2%iPatchGlobal) = .true.
168 
169  EXIT ivlloop
170  END IF ! iLoc
171  END DO ivlloop
172  END DO ! iPatch2
173  END DO ! iPatch
174 
175  DO ipatch2 = 1,pgrid%nPatches
176  ppatch2 => pregion%patches(ipatch2)
177 
178  DO ipatch = ipatch2+1,pgrid%nPatches
179  ppatch => pregion%patches(ipatch)
180 
181  ppatch%nbMap(ppatch2%iPatchGlobal) = ppatch2%nbMap(ppatch%iPatchGlobal)
182  END DO ! iPatch
183  END DO ! iPatch2
184  END IF ! pGrid%nPatches
185 
186 ! ******************************************************************************
187 ! End
188 ! ******************************************************************************
189 
190  IF ( global%myProcid == masterproc .AND. &
191  global%verbLevel >= verbose_high ) THEN
192  WRITE(stdout,'(A,1X,A)') solver_name,'Building patch-neighbor maps done.'
193  END IF ! global%myProcid
194 
195  CALL deregisterfunction(global)
196 
197 END SUBROUTINE rflu_buildpatchneighbormaps
198 
199 
200 
201 
202 
203 
204 
205 ! ******************************************************************************
206 !
207 ! Purpose: Checking consistency of patch geometry with boundary conditions.
208 !
209 ! Description: None.
210 !
211 ! Input:
212 ! pRegion Pointer to region data
213 !
214 ! Output: None.
215 !
216 ! Notes: None.
217 !
218 ! ******************************************************************************
219 
220 SUBROUTINE rflu_checkpatchbcconsistency(pRegion)
221 
222  USE modtools
223 
224  IMPLICIT NONE
225 
226 ! ******************************************************************************
227 ! Declarations and definitions
228 ! ******************************************************************************
229 
230 ! ==============================================================================
231 ! Arguments
232 ! ==============================================================================
233 
234  TYPE(t_region), POINTER :: pregion
235 
236 ! ==============================================================================
237 ! Locals
238 ! ==============================================================================
239 
240  INTEGER :: errorflag,ipatch,ipatchrelated
241  REAL(RFREAL) :: anglesum,eqtol
242  TYPE(t_global), POINTER :: global
243  TYPE(t_grid), POINTER :: pgrid
244  TYPE(t_patch), POINTER :: ppatch,ppatchrelated
245 
246 ! ******************************************************************************
247 ! Start
248 ! ******************************************************************************
249 
250  global => pregion%global
251 
252  CALL registerfunction(global,'RFLU_CheckPatchBcConsistency',&
253  'RFLU_ModPatchUtils.F90')
254 
255  IF ( global%myProcid == masterproc .AND. &
256  global%verbLevel >= verbose_high ) THEN
257  WRITE(stdout,'(A,1X,A)') solver_name,'Checking patch/bc consistency...'
258  END IF ! global%myProcid
259 
260  pgrid => pregion%grid
261 
262  eqtol = 1.0e-12_rfreal
263 
264 ! ******************************************************************************
265 ! Loop over patches
266 ! ******************************************************************************
267 
268  DO ipatch = 1,pgrid%nPatches
269  ppatch => pregion%patches(ipatch)
270 
271  SELECT CASE ( ppatch%bcType )
272  CASE ( bc_periodic )
273  ipatchrelated = ppatch%iPatchRelated
274  ppatchrelated => pregion%patches(ipatchrelated)
275 
276  anglesum = ppatch%angleRelated+ppatchrelated%angleRelated
277 
278  IF ( floatequal(anglesum,0.0_rfreal,eqtol) .EQV. .false. ) THEN
279  CALL errorstop(global,err_patch_bc_inconsistent,__line__)
280  END IF ! FloatEqual
281 
282  IF ( ppatch%axisRelated /= ppatchrelated%axisRelated ) THEN
283  CALL errorstop(global,err_patch_bc_inconsistent,__line__)
284  END IF ! pPatch%axisRelated
285 
286  IF ( ppatch%axisRelated /= 1 .AND. &
287  ppatch%axisRelated /= 2 .AND. &
288  ppatch%axisRelated /= 3 ) THEN
289  CALL errorstop(global,err_patch_bc_inconsistent,__line__)
290  END IF ! pPatch%axisRelated
291  CASE ( bc_symmetry )
292  IF ( ppatch%flatFlag .EQV. .false. ) THEN
293  CALL errorstop(global,err_patch_bc_inconsistent,__line__)
294  END IF ! pPatch%flatFlag
295  END SELECT ! pPatch%bcType
296  END DO ! iPatch
297 
298 ! ******************************************************************************
299 ! End
300 ! ******************************************************************************
301 
302  IF ( global%myProcid == masterproc .AND. &
303  global%verbLevel >= verbose_high ) THEN
304  WRITE(stdout,'(A,1X,A)') solver_name,'Checking patch/bc consistency done.'
305  END IF ! global%myProcid
306 
307  CALL deregisterfunction(global)
308 
309 END SUBROUTINE rflu_checkpatchbcconsistency
310 
311 
312 
313 
314 
315 ! *******************************************************************************
316 !
317 ! Purpose: Compute global patch normal vectors and flatness flags.
318 !
319 ! Description: None.
320 !
321 ! Input:
322 ! regions Data for regions
323 !
324 ! Output: None.
325 !
326 ! Notes: None.
327 !
328 ! ******************************************************************************
329 
330 SUBROUTINE rflu_computepatchnormalsglobal(regions)
331 
332  IMPLICIT NONE
333 
334 ! ******************************************************************************
335 ! Declarations and definitions
336 ! ******************************************************************************
337 
338 ! ==============================================================================
339 ! Arguments
340 ! ==============================================================================
341 
342  TYPE(t_region), DIMENSION(:), POINTER :: regions
343 
344 ! ==============================================================================
345 ! Locals
346 ! ==============================================================================
347 
348  LOGICAL :: xflatflag,yflatflag,zflatflag
349  LOGICAL, DIMENSION(:), ALLOCATABLE :: flatflag
350  INTEGER :: errorflag,ifl,ipatch,ireg
351  REAL(RFREAL) :: eqtol,nx,nxmax,nxmin,ny,nymax,nymin,nz,nzmax,nzmin
352  REAL(RFREAL), DIMENSION(:,:), ALLOCATABLE :: globalvals,localvals
353  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: pfnext
354  TYPE(t_global), POINTER :: global
355  TYPE(t_grid), POINTER :: pgrid
356  TYPE(t_patch), POINTER :: ppatch
357  TYPE(t_region), POINTER :: pregion
358 
359 ! ******************************************************************************
360 ! Start, set pointers and variables
361 ! ******************************************************************************
362 
363  global => regions(1)%global
364 
365  CALL registerfunction(global,'RFLU_ComputePatchNormalsGlobal',&
366  'RFLU_ModPatchUtils.F90')
367 
368  IF ( global%myProcid == masterproc .AND. &
369  global%verbLevel >= verbose_high ) THEN
370  WRITE(stdout,'(A,1X,A)') solver_name, &
371  'Computing global patch normal vectors...'
372  END IF ! global%myProcid
373 
374  eqtol = 1.0e-5_rfreal
375 
376  IF ( global%myProcid == masterproc .AND. &
377  global%verbLevel >= verbose_high) THEN
378  WRITE(stdout,'(A,3X,A,1X,E15.8)') solver_name,'Tolerance:',eqtol
379  WRITE(stdout,'(A,3X,A,2X,A,2X,A,2X,A)') solver_name, 'Local','Global', &
380  'Flat','Normal vector'
381  END IF ! global%myProcid
382 
383 ! ******************************************************************************
384 ! Allocate and initialize temporary memory
385 ! ******************************************************************************
386 
387  ALLOCATE(pfnext(min_val:max_val,xcoord:zcoord,global%nPatches), &
388  stat=errorflag)
389  global%error = errorflag
390  IF ( global%error /= err_none ) THEN
391  CALL errorstop(global,err_allocate,__line__,'pfnExt')
392  END IF ! global%error
393 
394  DO ipatch = 1,global%nPatches
395  pfnext(min_val,xcoord,ipatch) = huge(1.0_rfreal)
396  pfnext(min_val,ycoord,ipatch) = huge(1.0_rfreal)
397  pfnext(min_val,zcoord,ipatch) = huge(1.0_rfreal)
398 
399  pfnext(max_val,xcoord,ipatch) = -huge(1.0_rfreal)
400  pfnext(max_val,ycoord,ipatch) = -huge(1.0_rfreal)
401  pfnext(max_val,zcoord,ipatch) = -huge(1.0_rfreal)
402  END DO ! iPatch
403 
404  ALLOCATE(flatflag(global%nPatches),stat=errorflag)
405  global%error = errorflag
406  IF ( global%error /= err_none ) THEN
407  CALL errorstop(global,err_allocate,__line__,'flatFlag')
408  END IF ! global%error
409 
410 ! ******************************************************************************
411 ! Compute local extrema of patch face-normal vectors
412 ! ******************************************************************************
413 
414  DO ireg = 1,global%nRegionsLocal
415  pregion => regions(ireg)
416  pgrid => pregion%grid
417 
418  DO ipatch = 1,pgrid%nPatches
419  ppatch => pregion%patches(ipatch)
420 
421  nxmin = pfnext(min_val,xcoord,ppatch%iPatchGlobal)
422  nymin = pfnext(min_val,ycoord,ppatch%iPatchGlobal)
423  nzmin = pfnext(min_val,zcoord,ppatch%iPatchGlobal)
424 
425  nxmax = pfnext(max_val,xcoord,ppatch%iPatchGlobal)
426  nymax = pfnext(max_val,ycoord,ppatch%iPatchGlobal)
427  nzmax = pfnext(max_val,zcoord,ppatch%iPatchGlobal)
428 
429  DO ifl = 1,ppatch%nBFaces
430  nx = ppatch%fn(xcoord,ifl)
431  ny = ppatch%fn(ycoord,ifl)
432  nz = ppatch%fn(zcoord,ifl)
433 
434  nxmax = max(nx,nxmax)
435  nxmin = min(nx,nxmin)
436 
437  nymax = max(ny,nymax)
438  nymin = min(ny,nymin)
439 
440  nzmax = max(nz,nzmax)
441  nzmin = min(nz,nzmin)
442  END DO ! ifl
443 
444  pfnext(min_val,xcoord,ppatch%iPatchGlobal) = nxmin
445  pfnext(min_val,ycoord,ppatch%iPatchGlobal) = nymin
446  pfnext(min_val,zcoord,ppatch%iPatchGlobal) = nzmin
447 
448  pfnext(max_val,xcoord,ppatch%iPatchGlobal) = nxmax
449  pfnext(max_val,ycoord,ppatch%iPatchGlobal) = nymax
450  pfnext(max_val,zcoord,ppatch%iPatchGlobal) = nzmax
451  END DO ! iPatch
452  END DO ! iReg
453 
454 ! ******************************************************************************
455 ! Compute global extrema of patch face-normal vectors
456 ! ******************************************************************************
457 
458  ALLOCATE(localvals(xcoord:zcoord,global%nPatches),stat=errorflag)
459  global%error = errorflag
460  IF ( global%error /= err_none ) THEN
461  CALL errorstop(global,err_allocate,__line__,'localVals')
462  END IF ! global%error
463 
464  ALLOCATE(globalvals(xcoord:zcoord,global%nPatches),stat=errorflag)
465  global%error = errorflag
466  IF ( global%error /= err_none ) THEN
467  CALL errorstop(global,err_allocate,__line__,'globalVals')
468  END IF ! global%error
469 
470  DO ipatch = 1,global%nPatches
471  localvals(xcoord,ipatch) = pfnext(min_val,xcoord,ipatch)
472  localvals(ycoord,ipatch) = pfnext(min_val,ycoord,ipatch)
473  localvals(zcoord,ipatch) = pfnext(min_val,zcoord,ipatch)
474  END DO ! iPatch
475 
476  CALL mpi_allreduce(localvals,globalvals,(zcoord-xcoord+1)*global%nPatches, &
477  mpi_rfreal,mpi_min,global%mpiComm,errorflag)
478  global%error = errorflag
479  IF ( global%error /= err_none ) THEN
480  CALL errorstop(global,err_mpi_trouble,__line__)
481  END IF ! global%errorFlag
482 
483  DO ipatch = 1,global%nPatches
484  pfnext(min_val,xcoord,ipatch) = globalvals(xcoord,ipatch)
485  pfnext(min_val,ycoord,ipatch) = globalvals(ycoord,ipatch)
486  pfnext(min_val,zcoord,ipatch) = globalvals(zcoord,ipatch)
487 
488  localvals(xcoord,ipatch) = pfnext(max_val,xcoord,ipatch)
489  localvals(ycoord,ipatch) = pfnext(max_val,ycoord,ipatch)
490  localvals(zcoord,ipatch) = pfnext(max_val,zcoord,ipatch)
491  END DO ! iPatch
492 
493  CALL mpi_allreduce(localvals,globalvals,(zcoord-xcoord+1)*global%nPatches, &
494  mpi_rfreal,mpi_max,global%mpiComm,errorflag)
495  global%error = errorflag
496  IF ( global%error /= err_none ) THEN
497  CALL errorstop(global,err_mpi_trouble,__line__)
498  END IF ! global%errorFlag
499 
500  DO ipatch = 1,global%nPatches
501  pfnext(max_val,xcoord,ipatch) = globalvals(xcoord,ipatch)
502  pfnext(max_val,ycoord,ipatch) = globalvals(ycoord,ipatch)
503  pfnext(max_val,zcoord,ipatch) = globalvals(zcoord,ipatch)
504  END DO ! iPatch
505 
506  DEALLOCATE(localvals,stat=errorflag)
507  global%error = errorflag
508  IF ( global%error /= err_none ) THEN
509  CALL errorstop(global,err_deallocate,__line__,'localVals')
510  END IF ! global%error
511 
512  DEALLOCATE(globalvals,stat=errorflag)
513  global%error = errorflag
514  IF ( global%error /= err_none ) THEN
515  CALL errorstop(global,err_deallocate,__line__,'globalVals')
516  END IF ! global%error
517 
518 ! ******************************************************************************
519 ! Determine whether patches are flat
520 ! ******************************************************************************
521 
522  DO ipatch = 1,global%nPatches
523  nxmin = pfnext(min_val,xcoord,ipatch)
524  nymin = pfnext(min_val,ycoord,ipatch)
525  nzmin = pfnext(min_val,zcoord,ipatch)
526 
527  nxmax = pfnext(max_val,xcoord,ipatch)
528  nymax = pfnext(max_val,ycoord,ipatch)
529  nzmax = pfnext(max_val,zcoord,ipatch)
530 
531  CALL rflu_setpatchflatflags(global,nxmin,nxmax,nymin,nymax,nzmin,nzmax, &
532  eqtol,xflatflag,yflatflag,zflatflag)
533 
534  IF ( (xflatflag .EQV. .true.) .AND. &
535  (yflatflag .EQV. .true.) .AND. &
536  (zflatflag .EQV. .true.) ) THEN
537  flatflag(ipatch) = .true.
538  ELSE
539  flatflag(ipatch) = .false.
540  END IF ! xFlatFlag
541  END DO ! iPatch
542 
543 ! ******************************************************************************
544 ! Set patch normal and flatness flag
545 ! ******************************************************************************
546 
547  DO ireg = 1,global%nRegionsLocal
548  pregion => regions(ireg)
549  pgrid => pregion%grid
550 
551  DO ipatch = 1,pgrid%nPatches
552  ppatch => pregion%patches(ipatch)
553 
554  IF ( flatflag(ppatch%iPatchGlobal) .EQV. .true. ) THEN
555  ppatch%flatFlag = .true.
556 
557  ppatch%pn(xcoord) = pfnext(max_val,xcoord,ppatch%iPatchGlobal)
558  ppatch%pn(ycoord) = pfnext(max_val,ycoord,ppatch%iPatchGlobal)
559  ppatch%pn(zcoord) = pfnext(max_val,zcoord,ppatch%iPatchGlobal)
560  ELSE
561  ppatch%flatFlag = .false.
562 
563  ppatch%pn(xcoord) = REAL(crazy_value_int,kind=rfreal)
564  ppatch%pn(ycoord) = REAL(crazy_value_int,kind=rfreal)
565  ppatch%pn(zcoord) = REAL(CRAZY_VALUE_INT,KIND=RFREAL)
566  END IF ! flatFlag
567 
568  IF ( global%myProcid == masterproc .AND. &
569  global%verbLevel >= verbose_high ) THEN
570  IF ( ppatch%flatFlag .EQV. .true. ) THEN
571  WRITE(stdout,'(A,2X,I4,4X,I4,6X,L1,3(2X,E13.6))') &
572  solver_name,ipatch,ppatch%iPatchGlobal,ppatch%flatFlag, &
573  ppatch%pn(xcoord:zcoord)
574  ELSE
575  WRITE(stdout,'(A,2X,I4,4X,I4,6X,L1)') &
576  solver_name,ipatch,ppatch%iPatchGlobal,ppatch%flatFlag
577  END IF ! pPatch%flatFlag
578  END IF ! global%myProcid
579  END DO ! iPatch
580  END DO ! iReg
581 
582 ! ******************************************************************************
583 ! Deallocate temporary memory
584 ! ******************************************************************************
585 
586  DEALLOCATE(pfnext,stat=errorflag)
587  global%error = errorflag
588  IF ( global%error /= err_none ) THEN
589  CALL errorstop(global,err_deallocate,__line__,'pfnExt')
590  END IF ! global%error
591 
592  DEALLOCATE(flatflag,stat=errorflag)
593  global%error = errorflag
594  IF ( global%error /= err_none ) THEN
595  CALL errorstop(global,err_deallocate,__line__,'flatFlag')
596  END IF ! global%error
597 
598 ! ******************************************************************************
599 ! End
600 ! ******************************************************************************
601 
602  IF ( global%myProcid == masterproc .AND. &
603  global%verbLevel >= verbose_high ) THEN
604  WRITE(stdout,'(A,1X,A)') solver_name, &
605  'Computing global patch normal vectors done.'
606  END IF ! global%verbLevel
607 
608  CALL deregisterfunction(global)
609 
610 END SUBROUTINE rflu_computepatchnormalsglobal
611 
612 
613 
614 
615 
616 
617 
618 ! *******************************************************************************
619 !
620 ! Purpose: Compute global patch normal vectors and flatness flags.
621 !
622 ! Description: None.
623 !
624 ! Input:
625 ! pRegion Pointer to region data
626 !
627 ! Output: None.
628 !
629 ! Notes: None.
630 !
631 ! ******************************************************************************
632 
633 SUBROUTINE rflu_computepatchnormalslocal(pRegion)
634 
635  IMPLICIT NONE
636 
637 ! ******************************************************************************
638 ! Declarations and definitions
639 ! ******************************************************************************
640 
641 ! ==============================================================================
642 ! Arguments
643 ! ==============================================================================
644 
645  TYPE(t_region), POINTER :: pregion
646 
647 ! ==============================================================================
648 ! Locals
649 ! ==============================================================================
650 
651  LOGICAL :: xflatflag,yflatflag,zflatflag
652  INTEGER :: errorflag,ifl,ipatch
653  REAL(RFREAL) :: eqtol,nx,nxmax,nxmin,ny,nymax,nymin,nz,nzmax,nzmin
654  TYPE(t_global), POINTER :: global
655  TYPE(t_grid), POINTER :: pgrid
656  TYPE(t_patch), POINTER :: ppatch
657 
658 ! ******************************************************************************
659 ! Start, set pointers and variables
660 ! ******************************************************************************
661 
662  global => pregion%global
663 
664  CALL registerfunction(global,'RFLU_ComputePatchNormalsLocal',&
665  'RFLU_ModPatchUtils.F90')
666 
667  IF ( global%myProcid == masterproc .AND. &
668  global%verbLevel >= verbose_high ) THEN
669  WRITE(stdout,'(A,1X,A)') solver_name, &
670  'Computing patch normal vectors...'
671  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
672  pregion%iRegionGlobal
673  END IF ! global%myProcid
674 
675  eqtol = 1.0e-5_rfreal
676 
677  IF ( global%myProcid == masterproc .AND. &
678  global%verbLevel >= verbose_high) THEN
679  WRITE(stdout,'(A,3X,A,1X,E15.8)') solver_name,'Tolerance:',eqtol
680  WRITE(stdout,'(A,3X,A,2X,A,2X,A,2X,A)') solver_name,'Local','Global', &
681  'Flat','Normal vector'
682  END IF ! global%myProcid
683 
684  pgrid => pregion%grid
685 
686 ! ******************************************************************************
687 ! Compute patch normal vectors
688 ! ******************************************************************************
689 
690  DO ipatch = 1,pgrid%nPatches
691  ppatch => pregion%patches(ipatch)
692 
693  nxmin = huge(1.0_rfreal)
694  nymin = huge(1.0_rfreal)
695  nzmin = huge(1.0_rfreal)
696 
697  nxmax = -huge(1.0_rfreal)
698  nymax = -huge(1.0_rfreal)
699  nzmax = -huge(1.0_rfreal)
700 
701 ! ==============================================================================
702 ! Compute local extrema of patch face-normal vectors
703 ! ==============================================================================
704 
705  DO ifl = 1,ppatch%nBFaces
706  nx = ppatch%fn(xcoord,ifl)
707  ny = ppatch%fn(ycoord,ifl)
708  nz = ppatch%fn(zcoord,ifl)
709 
710  nxmax = max(nx,nxmax)
711  nxmin = min(nx,nxmin)
712 
713  nymax = max(ny,nymax)
714  nymin = min(ny,nymin)
715 
716  nzmax = max(nz,nzmax)
717  nzmin = min(nz,nzmin)
718  END DO ! ifl
719 
720 ! ==============================================================================
721 ! Determine whether patches are flat
722 ! ==============================================================================
723 
724  CALL rflu_setpatchflatflags(global,nxmin,nxmax,nymin,nymax,nzmin,nzmax, &
725  eqtol,xflatflag,yflatflag,zflatflag)
726 
727 ! ==============================================================================
728 ! Set patch normal and flatness flag
729 ! ==============================================================================
730 
731  IF ( (xflatflag .EQV. .true.) .AND. &
732  (yflatflag .EQV. .true.) .AND. &
733  (zflatflag .EQV. .true.) ) THEN
734  ppatch%flatFlag = .true.
735 
736  ppatch%pn(xcoord) = nxmax
737  ppatch%pn(ycoord) = nymax
738  ppatch%pn(zcoord) = nzmax
739  ELSE
740  ppatch%flatFlag = .false.
741 
742  ppatch%pn(xcoord) = REAL(crazy_value_int,kind=rfreal)
743  ppatch%pn(ycoord) = REAL(crazy_value_int,kind=rfreal)
744  ppatch%pn(zcoord) = REAL(CRAZY_VALUE_INT,KIND=RFREAL)
745  END IF ! xFlatFlag
746 
747  IF ( global%myProcid == masterproc .AND. &
748  global%verbLevel >= verbose_high ) THEN
749  IF ( ppatch%flatFlag .EQV. .true. ) THEN
750  WRITE(stdout,'(A,2X,I4,4X,I4,6X,L1,3(2X,E13.6))') &
751  solver_name,ipatch,ppatch%iPatchGlobal,ppatch%flatFlag, &
752  ppatch%pn(xcoord:zcoord)
753  ELSE
754  WRITE(stdout,'(A,2X,I4,4X,I4,6X,L1)') &
755  solver_name,ipatch,ppatch%iPatchGlobal,ppatch%flatFlag
756  END IF ! pPatch%flatFlag
757  END IF ! global%myProcid
758  END DO ! iPatch
759 
760 ! ******************************************************************************
761 ! End
762 ! ******************************************************************************
763 
764  IF ( global%myProcid == masterproc .AND. &
765  global%verbLevel >= verbose_high ) THEN
766  WRITE(stdout,'(A,1X,A)') solver_name, &
767  'Computing patch normal vectors done.'
768  END IF ! global%verbLevel
769 
770  CALL deregisterfunction(global)
771 
772 END SUBROUTINE rflu_computepatchnormalslocal
773 
774 
775 
776 
777 
778 
779 ! ******************************************************************************
780 !
781 ! Purpose: Create patch-neighbor maps.
782 !
783 ! Description: None.
784 !
785 ! Input:
786 ! pRegion Pointer to region data
787 !
788 ! Output: None.
789 !
790 ! Notes: None.
791 !
792 ! ******************************************************************************
793 
794 SUBROUTINE rflu_createpatchneighbormaps(pRegion)
795 
796  IMPLICIT NONE
797 
798 ! ******************************************************************************
799 ! Declarations and definitions
800 ! ******************************************************************************
801 
802 ! ==============================================================================
803 ! Arguments
804 ! ==============================================================================
805 
806  TYPE(t_region), POINTER :: pregion
807 
808 ! ==============================================================================
809 ! Locals
810 ! ==============================================================================
811 
812  INTEGER :: errorflag,ipatch,ipatch2
813  TYPE(t_global), POINTER :: global
814  TYPE(t_grid), POINTER :: pgrid
815  TYPE(t_patch), POINTER :: ppatch
816 
817 ! ******************************************************************************
818 ! Start
819 ! ******************************************************************************
820 
821  global => pregion%global
822 
823  CALL registerfunction(global,'RFLU_CreatePatchNeighborMaps',&
824  'RFLU_ModPatchUtils.F90')
825 
826  IF ( global%myProcid == masterproc .AND. &
827  global%verbLevel >= verbose_high ) THEN
828  WRITE(stdout,'(A,1X,A)') solver_name,'Creating patch-neighbor maps...'
829  END IF ! global%myProcid
830 
831  pgrid => pregion%grid
832 
833 ! ******************************************************************************
834 ! Loop over patches and allocate memory
835 ! ******************************************************************************
836 
837  DO ipatch = 1,pgrid%nPatches
838  ppatch => pregion%patches(ipatch)
839 
840  ALLOCATE(ppatch%nbMap(global%nPatches),stat=errorflag)
841  global%error = errorflag
842  IF ( global%error /= err_none ) THEN
843  CALL errorstop(global,err_allocate,__line__,'pPatch%nbMap')
844  END IF ! global%error
845 
846  DO ipatch2 = 1,global%nPatches
847  ppatch%nbMap(ipatch2) = .false.
848  END DO ! iPatch2
849  END DO ! iPatch
850 
851 ! ******************************************************************************
852 ! End
853 ! ******************************************************************************
854 
855  IF ( global%myProcid == masterproc .AND. &
856  global%verbLevel >= verbose_high ) THEN
857  WRITE(stdout,'(A,1X,A)') solver_name,'Creating patch-neighbor maps done.'
858  END IF ! global%myProcid
859 
860  CALL deregisterfunction(global)
861 
862 END SUBROUTINE rflu_createpatchneighbormaps
863 
864 
865 
866 
867 
868 
869 
870 
871 
872 ! ******************************************************************************
873 !
874 ! Purpose: Destroy patch-neighbor maps.
875 !
876 ! Description: None.
877 !
878 ! Input:
879 ! pRegion Pointer to region data
880 !
881 ! Output: None.
882 !
883 ! Notes: None.
884 !
885 ! ******************************************************************************
886 
887 SUBROUTINE rflu_destroypatchneighbormaps(pRegion)
888 
889  IMPLICIT NONE
890 
891 ! ******************************************************************************
892 ! Declarations and definitions
893 ! ******************************************************************************
894 
895 ! ==============================================================================
896 ! Arguments
897 ! ==============================================================================
898 
899  TYPE(t_region), POINTER :: pregion
900 
901 ! ==============================================================================
902 ! Locals
903 ! ==============================================================================
904 
905  INTEGER :: errorflag,ipatch
906  TYPE(t_global), POINTER :: global
907  TYPE(t_grid), POINTER :: pgrid
908  TYPE(t_patch), POINTER :: ppatch
909 
910 ! ******************************************************************************
911 ! Start
912 ! ******************************************************************************
913 
914  global => pregion%global
915 
916  CALL registerfunction(global,'RFLU_DestroyPatchNeighborMaps',&
917  'RFLU_ModPatchUtils.F90')
918 
919  IF ( global%myProcid == masterproc .AND. &
920  global%verbLevel >= verbose_high ) THEN
921  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying patch-neighbor maps...'
922  END IF ! global%myProcid
923 
924  pgrid => pregion%grid
925 
926 ! ******************************************************************************
927 ! Loop over patches and deallocate memory
928 ! ******************************************************************************
929 
930  DO ipatch = 1,pgrid%nPatches
931  ppatch => pregion%patches(ipatch)
932 
933  DEALLOCATE(ppatch%nbMap,stat=errorflag)
934  global%error = errorflag
935  IF ( global%error /= err_none ) THEN
936  CALL errorstop(global,err_deallocate,__line__,'pPatch%nbMap')
937  END IF ! global%error
938  END DO ! iPatch
939 
940 ! ******************************************************************************
941 ! End
942 ! ******************************************************************************
943 
944  IF ( global%myProcid == masterproc .AND. &
945  global%verbLevel >= verbose_high ) THEN
946  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying patch-neighbor maps done.'
947  END IF ! global%myProcid
948 
949  CALL deregisterfunction(global)
950 
951 END SUBROUTINE rflu_destroypatchneighbormaps
952 
953 
954 
955 
956 ! ******************************************************************************
957 !
958 ! Purpose: Determine whether patches are flat by checking normal extrema.
959 !
960 ! Description: Checking whether extrema have same sign (if yes, and extrema are
961 ! equal, have flat patch; if not, and extrema are close to zero, also have
962 ! flat patch)
963 !
964 ! Input:
965 ! global Pointer to global data
966 ! nxMin Minimum of x-component of normal vector
967 ! nxMax Maximum of x-component of normal vector
968 ! nyMin Minimum of y-component of normal vector
969 ! nyMax Maximum of y-component of normal vector
970 ! nzMin Minimum of z-component of normal vector
971 ! nzMax Maximum of z-component of normal vector
972 ! eqTol Equality tolerance
973 !
974 ! Output:
975 ! xFlatFlag Flatness flag for x-component
976 ! yFlatFlag Flatness flag for y-component
977 ! zFlatFlag Flatness flag for z-component
978 !
979 ! Notes: None.
980 !
981 ! ******************************************************************************
982 
983 SUBROUTINE rflu_setpatchflatflags(global,nxMin,nxMax,nyMin,nyMax,nzMin,nzMax, &
984  eqtol,xflatflag,yflatflag,zflatflag)
985 
986  USE modtools
987 
988  IMPLICIT NONE
989 
990 ! ******************************************************************************
991 ! Declarations and definitions
992 ! ******************************************************************************
993 
994 ! ==============================================================================
995 ! Arguments
996 ! ==============================================================================
997 
998  LOGICAL, INTENT(OUT) :: xflatflag,yflatflag,zflatflag
999  REAL(RFREAL), INTENT(IN) :: eqtol,nxmax,nxmin,nymax,nymin,nzmax,nzmin
1000  TYPE(t_global), POINTER :: global
1001 
1002 ! ==============================================================================
1003 ! Locals
1004 ! ==============================================================================
1005 
1006 ! ******************************************************************************
1007 ! Start
1008 ! ******************************************************************************
1009 
1010  CALL registerfunction(global,'RFLU_SetPatchFlatFlags',&
1011  'RFLU_ModPatchUtils.F90')
1012 
1013 ! ******************************************************************************
1014 ! Determine flatness flags
1015 ! ******************************************************************************
1016 
1017  IF ( (sign(1.0_rfreal,nxmin) == sign(1.0_rfreal,nxmax)) ) THEN
1018  IF ( floatequal(nxmin,nxmax,eqtol) .EQV. .true. ) THEN
1019  xflatflag = .true.
1020  ELSE
1021  xflatflag = .false.
1022  END IF ! FloatEqual
1023  ELSE
1024  IF ( (floatequal(abs(nxmin),epsilon(1.0_rfreal),eqtol)) .AND. &
1025  (floatequal(abs(nxmax),epsilon(1.0_rfreal),eqtol)) ) THEN
1026  xflatflag = .true.
1027  ELSE
1028  xflatflag = .false.
1029  END IF ! FloatEqual
1030  END IF ! FloatEqual
1031 
1032  IF ( (sign(1.0_rfreal,nymin) == sign(1.0_rfreal,nymax)) ) THEN
1033  IF ( floatequal(nymin,nymax,eqtol) .EQV. .true. ) THEN
1034  yflatflag = .true.
1035  ELSE
1036  yflatflag = .false.
1037  END IF ! FloatEqual
1038  ELSE
1039  IF ( (floatequal(abs(nymin),epsilon(1.0_rfreal),eqtol)) .AND. &
1040  (floatequal(abs(nymax),epsilon(1.0_rfreal),eqtol)) ) THEN
1041  yflatflag = .true.
1042  ELSE
1043  yflatflag = .false.
1044  END IF ! FloatEqual
1045  END IF ! FloatEqual
1046 
1047  IF ( (sign(1.0_rfreal,nzmin) == sign(1.0_rfreal,nzmax)) ) THEN
1048  IF ( floatequal(nzmin,nzmax,eqtol) .EQV. .true. ) THEN
1049  zflatflag = .true.
1050  ELSE
1051  zflatflag = .false.
1052  END IF ! FloatEqual
1053  ELSE
1054  IF ( (floatequal(abs(nzmin),epsilon(1.0_rfreal),eqtol)) .AND. &
1055  (floatequal(abs(nzmax),epsilon(1.0_rfreal),eqtol)) ) THEN
1056  zflatflag = .true.
1057  ELSE
1058  zflatflag = .false.
1059  END IF ! FloatEqual
1060  END IF ! FloatEqual
1061 
1062 ! ******************************************************************************
1063 ! End
1064 ! ******************************************************************************
1065 
1066  CALL deregisterfunction(global)
1067 
1068 END SUBROUTINE rflu_setpatchflatflags
1069 
1070 
1071 
1072 
1073 
1074 
1075 ! ******************************************************************************
1076 !
1077 ! Purpose: Get patch normal direction.
1078 !
1079 ! Description: None.
1080 !
1081 ! Input:
1082 ! global Pointer to global data
1083 ! pPatch Pointer to patch data
1084 !
1085 ! Output:
1086 ! pnDir Patch normal direction (equal to coordinate index if normal
1087 ! aligned with coordinate direction, otherwise set to
1088 ! CRAZY_VALUE_INT)
1089 ! pnDirFlag Patch normal direction flag (TRUE if normal aligned with
1090 ! coordinate axis, FALSE otherwise)
1091 !
1092 ! Notes: None.
1093 !
1094 ! ******************************************************************************
1095 
1096 SUBROUTINE rflu_getpatchnormaldirection(global,pPatch,pnDir,pnDirFlag)
1097 
1098  USE modtools
1099 
1100  IMPLICIT NONE
1101 
1102 ! ******************************************************************************
1103 ! Declarations and definitions
1104 ! ******************************************************************************
1105 
1106 ! ==============================================================================
1107 ! Arguments
1108 ! ==============================================================================
1109 
1110  LOGICAL, INTENT(OUT) :: pndirflag
1111  INTEGER, INTENT(OUT) :: pndir
1112  TYPE(t_global), POINTER :: global
1113  TYPE(t_patch), POINTER :: ppatch
1114 
1115 ! ==============================================================================
1116 ! Locals
1117 ! ==============================================================================
1118 
1119  REAL(RFREAL) :: pndirtemp(1)
1120 
1121 ! ******************************************************************************
1122 ! Start
1123 ! ******************************************************************************
1124 
1125  CALL registerfunction(global,'RFLU_GetPatchNormalDirection',&
1126  'RFLU_ModPatchUtils.F90')
1127 
1128 ! ******************************************************************************
1129 !
1130 ! ******************************************************************************
1131 
1132  IF ( ppatch%flatFlag .EQV. .false. ) THEN
1133  pndir = crazy_value_int
1134  pndirflag = .false.
1135  ELSE
1136  pndirtemp = maxloc(abs(ppatch%pn(xcoord:zcoord)))
1137  pndir = nint(pndirtemp(1))
1138  pndirflag = floatequal(abs(ppatch%pn(pndir)),1.0_rfreal,1.0e-6_rfreal)
1139  END IF ! pPatch%flatFlag
1140 
1141 ! ******************************************************************************
1142 ! End
1143 ! ******************************************************************************
1144 
1145  CALL deregisterfunction(global)
1146 
1147 END SUBROUTINE rflu_getpatchnormaldirection
1148 
1149 
1150 
1151 
1152 
1153 END MODULE rflu_modpatchutils
1154 
1155 ! ******************************************************************************
1156 !
1157 ! RCS Revision history:
1158 !
1159 ! $Log: RFLU_ModPatchUtils.F90,v $
1160 ! Revision 1.7 2008/12/06 08:44:23 mtcampbe
1161 ! Updated license.
1162 !
1163 ! Revision 1.6 2008/11/19 22:17:34 mtcampbe
1164 ! Added Illinois Open Source License/Copyright
1165 !
1166 ! Revision 1.5 2006/12/21 12:21:43 haselbac
1167 ! Bug fix: Wrong operation argument to MPI call
1168 !
1169 ! Revision 1.4 2006/06/14 20:11:24 mparmar
1170 ! Bug fix: need to use iPatchGlobal instead of iPatch
1171 !
1172 ! Revision 1.3 2006/04/07 15:19:20 haselbac
1173 ! Removed tabs
1174 !
1175 ! Revision 1.2 2006/04/07 14:50:16 haselbac
1176 ! Added RFLU_GetPatchNormalDirection
1177 !
1178 ! Revision 1.1 2006/03/25 21:38:54 haselbac
1179 ! Initial revision
1180 !
1181 ! ******************************************************************************
1182 
1183 
1184 
1185 
1186 
1187 
1188 
1189 
1190 
1191 
1192 
1193 
1194 
1195 
sign
static SURF_BEGIN_NAMESPACE double sign(double x)
Definition: compute_curvature.C:31
rflu_modpatchutils::rflu_checkpatchbcconsistency
subroutine, public rflu_checkpatchbcconsistency(pRegion)
Definition: RFLU_ModPatchUtils.F90:220
max
Vector_n max(const Array_n_const &v1, const Array_n_const &v2)
Definition: Vector_n.h:354
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
rflu_modpatchutils::rflu_getpatchnormaldirection
subroutine, public rflu_getpatchnormaldirection(global, pPatch, pnDir, pnDirFlag)
Definition: RFLU_ModPatchUtils.F90:1096
modgrid::t_grid
Definition: ModGrid.F90:56
modsortsearch::binarysearchinteger
subroutine binarysearchinteger(a, n, v, i, j)
Definition: ModSortSearch.F90:98
rflu_modpatchutils::rflu_setpatchflatflags
subroutine rflu_setpatchflatflags(global, nxMin, nxMax, nyMin, nyMax, nzMin, nzMax, eqTol, xFlatFlag, yFlatFlag, zFlatFlag)
Definition: RFLU_ModPatchUtils.F90:983
rflu_modpatchutils::rflu_createpatchneighbormaps
subroutine, public rflu_createpatchneighbormaps(pRegion)
Definition: RFLU_ModPatchUtils.F90:794
rflu_modpatchutils::rflu_computepatchnormalsglobal
subroutine, public rflu_computepatchnormalsglobal(regions)
Definition: RFLU_ModPatchUtils.F90:330
rflu_modpatchutils::rflu_destroypatchneighbormaps
subroutine, public rflu_destroypatchneighbormaps(pRegion)
Definition: RFLU_ModPatchUtils.F90:887
rflu_modpatchutils
Definition: RFLU_ModPatchUtils.F90:39
min
Vector_n min(const Array_n_const &v1, const Array_n_const &v2)
Definition: Vector_n.h:346
rflu_modpatchutils::rflu_buildpatchneighbormaps
subroutine, public rflu_buildpatchneighbormaps(pRegion)
Definition: RFLU_ModPatchUtils.F90:108
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
rflu_modpatchutils::rflu_computepatchnormalslocal
subroutine, public rflu_computepatchnormalslocal(pRegion)
Definition: RFLU_ModPatchUtils.F90:633
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
modtools::floatequal
LOGICAL function floatequal(a, b, tolIn)
Definition: ModTools.F90:99
modbndpatch::t_patch
Definition: ModBndPatch.F90:91