Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModDimensions.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, read, and write dimension files.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModDimensions.F90,v 1.15 2008/12/06 08:44:21 mtcampbe Exp $
34 !
35 ! Copyright: (c) 2004-2006 by the University of Illinois
36 !
37 ! ******************************************************************************
38 
40 
41  USE modparameters
42  USE moddatatypes
43  USE moderror
44  USE modglobal, ONLY: t_global
45  USE modbndpatch, ONLY: t_patch
46  USE modborder, ONLY: t_border
47  USE moddatastruct, ONLY: t_region
48  USE modgrid, ONLY: t_grid
49  USE modmpi
50 
51  IMPLICIT NONE
52 
53  PRIVATE
54  PUBLIC :: rflu_readdimensions, &
61 
62 ! ******************************************************************************
63 ! Declarations and definitions
64 ! ******************************************************************************
65 
66 ! ==============================================================================
67 ! Public
68 ! ==============================================================================
69 
70  INTEGER, PARAMETER, PUBLIC :: WRITE_DIMENS_MODE_FORCE = 0, &
71  WRITE_DIMENS_MODE_MAYBE = 1
72 
73 ! ==============================================================================
74 ! Private
75 ! ==============================================================================
76 
77  CHARACTER(CHRLEN), PRIVATE :: RCSIdentString = &
78  '$RCSfile: RFLU_ModDimensions.F90,v $ $Revision: 1.15 $'
79 
80  INTEGER, PARAMETER, PRIVATE :: ratioMax2Tot = 4
81 
82 ! ******************************************************************************
83 ! Routines
84 ! ******************************************************************************
85 
86  CONTAINS
87 
88 
89 
90 
91 
92 
93 ! ******************************************************************************
94 !
95 ! Purpose: Read dimensions.
96 !
97 ! Description: None.
98 !
99 ! Input:
100 ! pRegion Pointer to region
101 !
102 ! Output: None.
103 !
104 ! Notes: None.
105 !
106 ! ******************************************************************************
107 
108  SUBROUTINE rflu_readdimensions(pRegion)
109 
110  USE rflu_modgrid
111 
114 
115  IMPLICIT NONE
116 
117 ! ******************************************************************************
118 ! Declarations and definitions
119 ! ******************************************************************************
120 
121 ! ==============================================================================
122 ! Arguments
123 ! ==============================================================================
124 
125  TYPE(t_region), POINTER :: pregion
126 
127 ! ==============================================================================
128 ! Local variables
129 ! ==============================================================================
130 
131  CHARACTER(CHRLEN) :: ifilename,sectionstring,timestring1,timestring2
132  INTEGER :: errorflag,dummy,iborder,ipatch,ifile,loopcounter
133  REAL(RFREAL) :: currenttime
134  TYPE(t_border), POINTER :: pborder
135  TYPE(t_grid), POINTER :: pgrid
136  TYPE(t_patch), POINTER :: ppatch
137  TYPE(t_global), POINTER :: global
138 
139 ! ******************************************************************************
140 ! Start
141 ! ******************************************************************************
142 
143  global => pregion%global
144 
145  CALL registerfunction(global,'RFLU_ReadDimensions',&
146  'RFLU_ModDimensions.F90')
147 
148  IF ( global%myProcid == masterproc .AND. &
149  global%verbLevel >= verbose_high ) THEN
150  WRITE(stdout,'(A,1X,A)') solver_name,'Reading dimensions...'
151  END IF ! global%verbLevel
152 
153  ifile = if_dims
154 
155  IF ( (global%flowType == flow_unsteady) .AND. &
156  (pregion%mixtInput%moveGrid .EQV. .true.) ) THEN
157 
158 ! TEMPORARY - Read files from time zero because 1) for GENx do not write
159 ! dimension files and 2) because for standalone computations in which rflupost
160 ! is to merge the files, the dimensions of the serial region at the given
161 ! time-stamp at which postprocessing occurs is not known because that file
162 ! does not exist. When need to merge files, need to write new routines which
163 ! will compute dimensions of serial region from parallel regions. This is not
164 ! as straightforward as may appear at first sight because vertices cannot be
165 ! summed... Do not actually need to build vertex lists, but would need to
166 ! estimate number of vertices.
167  IF ( global%timeStamp > 0.0_rfreal ) THEN
168  global%warnCounter = global%warnCounter + 1
169 
170  IF ( global%myProcid == masterproc .AND. &
171  global%verbLevel >= verbose_none ) THEN
172  WRITE(stdout,'(A,3X,A,1X,A)') solver_name,'*** WARNING ***', &
173  'Hard-code - read file from time zero.'
174  END IF ! global%myProcid
175  END IF ! global%timeStamp
176 
177  currenttime = 0.0_rfreal
178 ! END TEMPORARY
179 
180  CALL buildfilenameunsteady(global,filedest_indir,'.dim', &
181  pregion%iRegionGlobal,currenttime, &
182  ifilename)
183 
184  IF ( global%myProcid == masterproc .AND. &
185  global%verbLevel >= verbose_high ) THEN
186  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
187  pregion%iRegionGlobal
188  WRITE(stdout,'(A,3X,A,1X,1PE11.5)') solver_name,'Current time:', &
189  currenttime
190  END IF ! global%verbLevel
191  ELSE
192  CALL buildfilenamebasic(global,filedest_indir,'.dim', &
193  pregion%iRegionGlobal,ifilename)
194 
195  IF ( global%myProcid == masterproc .AND. &
196  global%verbLevel >= verbose_high ) THEN
197  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
198  pregion%iRegionGlobal
199  END IF ! global%verbLevel
200  END IF ! global
201 
202  OPEN(ifile,file=ifilename,form="FORMATTED",status="OLD", &
203  iostat=errorflag)
204  global%error = errorflag
205  IF ( global%error /= err_none ) THEN
206  CALL errorstop(global,err_file_open,__line__,trim(ifilename))
207  END IF ! global%error
208 
209 ! ==============================================================================
210 ! Header and general information
211 ! ==============================================================================
212 
213  IF ( global%myProcid == masterproc .AND. &
214  global%verbLevel >= verbose_high ) THEN
215  WRITE(stdout,'(A,3X,A)') solver_name,'Header information...'
216  END IF ! global%verbLevel
217 
218  READ(ifile,'(A)') sectionstring
219  IF ( trim(sectionstring) /= '# ROCFLU dimensions file' ) THEN
220  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
221  END IF ! TRIM
222 
223 ! ==============================================================================
224 ! Rest of file
225 ! ==============================================================================
226 
227  pgrid => pregion%grid
228 
229  loopcounter = 0
230 
231  DO ! set up infinite loop
232  loopcounter = loopcounter + 1
233 
234  READ(ifile,'(A)') sectionstring
235 
236  SELECT CASE ( trim(sectionstring) )
237 
238 ! ------------------------------------------------------------------------------
239 ! Vertices
240 ! ------------------------------------------------------------------------------
241 
242  CASE ( '# Vertices' )
243  IF ( global%myProcid == masterproc .AND. &
244  global%verbLevel >= verbose_high ) THEN
245  WRITE(stdout,'(A,3X,A)') solver_name,'Vertices...'
246  END IF ! global%verbLevel
247 
248  READ(ifile,'(3(I8))') pgrid%nVert,pgrid%nVertTot,pgrid%nVertMax
249 
250 ! ------------------------------------------------------------------------------
251 ! Cells
252 ! ------------------------------------------------------------------------------
253 
254  CASE ( '# Cells' )
255  IF ( global%myProcid == masterproc .AND. &
256  global%verbLevel >= verbose_high ) THEN
257  WRITE(stdout,'(A,3X,A)') solver_name,'Cells...'
258  END IF ! global%verbLevel
259 
260  READ(ifile,'(3(I8))') pgrid%nCells,pgrid%nCellsTot,pgrid%nCellsMax
261 
262 ! ------------------------------------------------------------------------------
263 ! Tetrahedra
264 ! ------------------------------------------------------------------------------
265 
266  CASE ( '# Tetrahedra' )
267  IF ( global%myProcid == masterproc .AND. &
268  global%verbLevel >= verbose_high ) THEN
269  WRITE(stdout,'(A,3X,A)') solver_name,'Tetrahedra...'
270  END IF ! global%verbLevel
271 
272  READ(ifile,'(3(I8))') pgrid%nTets,pgrid%nTetsTot,pgrid%nTetsMax
273 
274 ! ------------------------------------------------------------------------------
275 ! Hexahedra
276 ! ------------------------------------------------------------------------------
277 
278  CASE ( '# Hexahedra' )
279  IF ( global%myProcid == masterproc .AND. &
280  global%verbLevel >= verbose_high ) THEN
281  WRITE(stdout,'(A,3X,A)') solver_name,'Hexahedra...'
282  END IF ! global%verbLevel
283 
284  READ(ifile,'(3(I8))') pgrid%nHexs,pgrid%nHexsTot,pgrid%nHexsMax
285 
286 ! ------------------------------------------------------------------------------
287 ! Prisms
288 ! ------------------------------------------------------------------------------
289 
290  CASE ( '# Prisms' )
291  IF ( global%myProcid == masterproc .AND. &
292  global%verbLevel >= verbose_high ) THEN
293  WRITE(stdout,'(A,3X,A)') solver_name,'Prisms...'
294  END IF ! global%verbLevel
295 
296  READ(ifile,'(3(I8))') pgrid%nPris,pgrid%nPrisTot,pgrid%nPrisMax
297 
298 ! ------------------------------------------------------------------------------
299 ! Pyramids
300 ! ------------------------------------------------------------------------------
301 
302  CASE ( '# Pyramids' )
303  IF ( global%myProcid == masterproc .AND. &
304  global%verbLevel >= verbose_high ) THEN
305  WRITE(stdout,'(A,3X,A)') solver_name,'Pyramids...'
306  END IF ! global%verbLevel
307 
308  READ(ifile,'(3(I8))') pgrid%nPyrs,pgrid%nPyrsTot,pgrid%nPyrsMax
309 
310 ! ------------------------------------------------------------------------------
311 ! Patches (old style, retained for backward compatibility). NOTE
312 ! initialize new variables here so as to make sure that all new data
313 ! comes out of this routine with sensible values.
314 ! ------------------------------------------------------------------------------
315 
316  CASE ( '# Patches' )
317  IF ( global%myProcid == masterproc .AND. &
318  global%verbLevel >= verbose_high ) THEN
319  WRITE(stdout,'(A,3X,A)') solver_name,'Patches...'
320  END IF ! global%verbLevel
321 
322  READ(ifile,'(2(I8))') pgrid%nPatches,global%nPatches
323 
324  IF ( pgrid%nPatches > patch_dimens_npatchmax ) THEN
325  CALL errorstop(global,err_patch_dimens,__line__)
326  END IF ! pGrid%nPatches
327 
328  DO ipatch = 1,pgrid%nPatches
329  READ(ifile,'(5(I8))',iostat=errorflag) &
330  pgrid%patchDimens(patch_dimens_ipglobal ,ipatch), &
331  pgrid%patchDimens(patch_dimens_nbtris ,ipatch), &
332  pgrid%patchDimens(patch_dimens_nbtristot ,ipatch), &
333  pgrid%patchDimens(patch_dimens_nbquads ,ipatch), &
334  pgrid%patchDimens(patch_dimens_nbquadstot ,ipatch)
335 
336  pgrid%patchDimens(patch_dimens_nbtrismax,ipatch) = &
337  pgrid%patchDimens(patch_dimens_nbtristot,ipatch)
338  pgrid%patchDimens(patch_dimens_nbquadsmax,ipatch) = &
339  pgrid%patchDimens(patch_dimens_nbquadstot,ipatch)
340  pgrid%patchDimens(patch_dimens_nbcellsvirt,ipatch) = 0
341  END DO ! iPatch
342 
343 ! ------------------------------------------------------------------------------
344 ! Patches (new style)
345 ! ------------------------------------------------------------------------------
346 
347  CASE ( '# Patches (v2)' )
348  IF ( global%myProcid == masterproc .AND. &
349  global%verbLevel >= verbose_high ) THEN
350  WRITE(stdout,'(A,3X,A)') solver_name,'Patches...'
351  END IF ! global%verbLevel
352 
353  READ(ifile,'(2(I8))') pgrid%nPatches,global%nPatches
354 
355  IF ( pgrid%nPatches > patch_dimens_npatchmax ) THEN
356  CALL errorstop(global,err_patch_dimens,__line__)
357  END IF ! pGrid%nPatches
358 
359  DO ipatch = 1,pgrid%nPatches
360  READ(ifile,'(8(I8))',iostat=errorflag) &
361  pgrid%patchDimens(patch_dimens_ipglobal ,ipatch), &
362  pgrid%patchDimens(patch_dimens_nbtris ,ipatch), &
363  pgrid%patchDimens(patch_dimens_nbtristot ,ipatch), &
364  pgrid%patchDimens(patch_dimens_nbtrismax ,ipatch), &
365  pgrid%patchDimens(patch_dimens_nbquads ,ipatch), &
366  pgrid%patchDimens(patch_dimens_nbquadstot ,ipatch), &
367  pgrid%patchDimens(patch_dimens_nbquadsmax ,ipatch), &
368  pgrid%patchDimens(patch_dimens_nbcellsvirt,ipatch)
369  END DO ! iPatch
370 
371 ! ------------------------------------------------------------------------------
372 ! Borders
373 ! ------------------------------------------------------------------------------
374 
375  CASE ( '# Borders' )
376  IF ( global%myProcid == masterproc .AND. &
377  global%verbLevel >= verbose_high ) THEN
378  WRITE(stdout,'(A,3X,A)') solver_name,'Borders...'
379  END IF ! global%verbLevel
380 
381  READ(ifile,'(I8)') pgrid%nBorders
382 
383  DO iborder = 1,pgrid%nBorders
384  READ(ifile,'(7(I8))') &
385  pgrid%borderInfo(border_info_irglob,iborder), &
386  pgrid%borderInfo(border_info_ibord ,iborder), &
387  pgrid%borderInfo(border_info_ncsend,iborder), &
388  pgrid%borderInfo(border_info_ncrecv,iborder), &
389  pgrid%borderInfo(border_info_nvsend,iborder), &
390  pgrid%borderInfo(border_info_nvrecv,iborder), &
391  pgrid%borderInfo(border_info_nvshar,iborder)
392  END DO ! iBorder
393 
394 ! ------------------------------------------------------------------------------
395 ! End marker
396 ! ------------------------------------------------------------------------------
397 
398  CASE ( '# End' )
399  IF ( global%myProcid == masterproc .AND. &
400  global%verbLevel >= verbose_high ) THEN
401  WRITE(stdout,'(A,3X,A)') solver_name,'End marker...'
402  END IF ! global%verbLevel
403 
404  EXIT
405 
406 ! ------------------------------------------------------------------------------
407 ! Invalid section string
408 ! ------------------------------------------------------------------------------
409 
410  CASE default
411  IF ( global%verbLevel >= verbose_high ) THEN
412  WRITE(stdout,'(A,3X,A)') solver_name,sectionstring
413  END IF ! verbosityLevel
414 
415  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
416 
417  END SELECT ! TRIM
418 
419 ! ------------------------------------------------------------------------------
420 ! Guard against infinite loop - might be unnecessary because of read errors?
421 ! ------------------------------------------------------------------------------
422 
423  IF ( loopcounter >= limit_infinite_loop ) THEN
424  CALL errorstop(global,err_infinite_loop,__line__)
425  END IF ! loopCounter
426 
427  END DO ! <empty>
428 
429 ! ==============================================================================
430 ! Close file
431 ! ==============================================================================
432 
433  CLOSE(ifile,iostat=errorflag)
434  global%error = errorflag
435  IF ( global%myProcid == masterproc .AND. &
436  global%error /= err_none ) THEN
437  CALL errorstop(global,err_file_close,__line__,ifilename)
438  END IF ! global%error
439 
440 ! ******************************************************************************
441 ! End
442 ! ******************************************************************************
443 
444  IF ( global%myProcid == masterproc .AND. &
445  global%verbLevel >= verbose_high ) THEN
446  WRITE(stdout,'(A,1X,A)') solver_name,'Reading dimensions done.'
447  END IF ! global%verbLevel
448 
449  CALL deregisterfunction(global)
450 
451  END SUBROUTINE rflu_readdimensions
452 
453 
454 
455 
456 
457 
458 
459 ! ******************************************************************************
460 !
461 ! Purpose: Wrapper function for reading dimensions.
462 !
463 ! Description: None.
464 !
465 ! Input:
466 ! pRegion Pointer to region
467 !
468 ! Output: None.
469 !
470 ! Notes: None.
471 !
472 ! ******************************************************************************
473 
474  SUBROUTINE rflu_readdimensionswrapper(pRegion)
475 
476 #ifdef GENX
478 #endif
479 
480 #ifdef PLAG
482 #endif
483 
484  IMPLICIT NONE
485 
486 ! ******************************************************************************
487 ! Declarations and definitions
488 ! ******************************************************************************
489 
490 ! ==============================================================================
491 ! Arguments
492 ! ==============================================================================
493 
494  TYPE(t_region), POINTER :: pregion
495 
496 ! ==============================================================================
497 ! Local variables
498 ! ==============================================================================
499 
500  TYPE(t_global), POINTER :: global
501 
502 ! ******************************************************************************
503 ! Start
504 ! ******************************************************************************
505 
506  global => pregion%global
507 
508  CALL registerfunction(global,'RFLU_ReadDimensionsWrapper',&
509  'RFLU_ModDimensions.F90')
510 
511 ! ******************************************************************************
512 ! Call routines
513 ! ******************************************************************************
514 
515 ! TEMPORARY
516 !#ifndef GENX
517  CALL rflu_readdimensions(pregion)
518 !#else
519 ! CALL RFLU_GENX_GetDimensions(pRegion)
520 !#endif
521 ! END TEMPORARY
522 
523 #ifdef PLAG
524  IF ( global%plagUsed .EQV. .true. ) THEN
525  CALL plag_rflu_readdimensions(pregion)
526  END IF ! plagUsed
527 #endif
528 
529 ! ******************************************************************************
530 ! End
531 ! ******************************************************************************
532 
533  CALL deregisterfunction(global)
534 
535  END SUBROUTINE rflu_readdimensionswrapper
536 
537 
538 
539 
540 
541 
542 
543 ! ******************************************************************************
544 !
545 ! Purpose: Set maximum dimension.
546 !
547 ! Description: None.
548 !
549 ! Input:
550 ! global Pointer to global data
551 ! nXyzTot Some total dimension
552 !
553 ! Output: None.
554 !
555 ! Notes: None.
556 !
557 ! ******************************************************************************
558 
559  INTEGER FUNCTION rflu_setmaxdimension(global,nXyzTot)
560 
561  IMPLICIT NONE
562 
563 ! ******************************************************************************
564 ! Declarations and definitions
565 ! ******************************************************************************
566 
567 ! ==============================================================================
568 ! Arguments
569 ! ==============================================================================
570 
571  INTEGER, INTENT(IN) :: nxyztot
572  TYPE(t_global), POINTER :: global
573 
574 ! ******************************************************************************
575 ! Start
576 ! ******************************************************************************
577 
578  IF ( (global%moduleType == module_type_part) .AND. &
579  (global%syPePatchesFlag .EQV. .true.) ) THEN
580  rflu_setmaxdimension = int(4*ratiomax2tot*nxyztot)
581  ELSE
582  rflu_setmaxdimension = ratiomax2tot*nxyztot
583  END IF ! global%moduleType
584 
585 ! ******************************************************************************
586 ! End
587 ! ******************************************************************************
588 
589  END FUNCTION rflu_setmaxdimension
590 
591 
592 
593 
594 
595 
596 
597 
598 ! ******************************************************************************
599 !
600 ! Purpose: Set maximum dimensions.
601 !
602 ! Description: None.
603 !
604 ! Input:
605 ! pRegion Pointer to region
606 !
607 ! Output: None.
608 !
609 ! Notes: None.
610 !
611 ! ******************************************************************************
612 
613  SUBROUTINE rflu_setmaxdimensions(pRegion)
614 
615  IMPLICIT NONE
616 
617 ! ******************************************************************************
618 ! Declarations and definitions
619 ! ******************************************************************************
620 
621 ! ==============================================================================
622 ! Arguments
623 ! ==============================================================================
624 
625  TYPE(t_region), POINTER :: pregion
626 
627 ! ==============================================================================
628 ! Local variables
629 ! ==============================================================================
630 
631  INTEGER :: ipatch
632  TYPE(t_global), POINTER :: global
633  TYPE(t_grid), POINTER :: pgrid
634  TYPE(t_patch), POINTER :: ppatch
635 
636 ! ******************************************************************************
637 ! Start
638 ! ******************************************************************************
639 
640  global => pregion%global
641 
642  CALL registerfunction(global,'RFLU_SetMaxDimensions',&
643  'RFLU_ModDimensions.F90')
644 
645  IF ( global%myProcid == masterproc .AND. &
646  global%verbLevel >= verbose_high ) THEN
647  WRITE(stdout,'(A,1X,A)') solver_name,'Setting maximum dimensions...'
648  END IF ! global%verbLevel
649 
650 ! ******************************************************************************
651 ! Set pointers and variables
652 ! ******************************************************************************
653 
654  pgrid => pregion%grid
655 
656 ! ******************************************************************************
657 ! Print information
658 ! ******************************************************************************
659 
660  IF ( global%myProcid == masterproc .AND. &
661  global%verbLevel >= verbose_high ) THEN
662  WRITE(stdout,'(A,3X,A,1X,I2)') solver_name,'Ratio:',ratiomax2tot
663  END IF ! global%verbLevel
664 
665 ! ******************************************************************************
666 ! Set maximum dimensions
667 ! ******************************************************************************
668 
669  pgrid%nVertMax = ratiomax2tot*pgrid%nVertTot
670 
671  pgrid%nTetsMax = ratiomax2tot*pgrid%nTetsTot
672  pgrid%nHexsMax = ratiomax2tot*pgrid%nHexsTot
673  pgrid%nPrisMax = ratiomax2tot*pgrid%nPrisTot
674  pgrid%nPyrsMax = ratiomax2tot*pgrid%nPyrsTot
675 
676  pgrid%nCellsMax = pgrid%nTetsMax &
677  + pgrid%nHexsMax &
678  + pgrid%nPrisMax &
679  + pgrid%nPyrsMax
680 
681  DO ipatch = 1,pgrid%nPatches
682  ppatch => pregion%patches(ipatch)
683 
684  ppatch%nBTrisMax = ratiomax2tot*ppatch%nBTrisTot
685  ppatch%nBQuadsMax = ratiomax2tot*ppatch%nBQuadsTot
686  END DO ! iPatch
687 
688 ! ******************************************************************************
689 ! End
690 ! ******************************************************************************
691 
692  IF ( global%myProcid == masterproc .AND. &
693  global%verbLevel >= verbose_high) THEN
694  WRITE(stdout,'(A,1X,A)') solver_name,'Setting maximum dimensions done.'
695  END IF ! global%verbLevel
696 
697  CALL deregisterfunction(global)
698 
699  END SUBROUTINE rflu_setmaxdimensions
700 
701 
702 
703 
704 
705 ! ******************************************************************************
706 !
707 ! Purpose: Write dimensions.
708 !
709 ! Description: None.
710 !
711 ! Input:
712 ! pRegion Pointer to region
713 !
714 ! Output: None.
715 !
716 ! Notes: None.
717 !
718 ! ******************************************************************************
719 
720  SUBROUTINE rflu_writedimensions(pRegion)
721 
724 
725  IMPLICIT NONE
726 
727 ! ******************************************************************************
728 ! Declarations and definitions
729 ! ******************************************************************************
730 
731 ! ==============================================================================
732 ! Arguments
733 ! ==============================================================================
734 
735  TYPE(t_region), POINTER :: pregion
736 
737 ! ==============================================================================
738 ! Local variables
739 ! ==============================================================================
740 
741  CHARACTER(CHRLEN) :: ifilename,sectionstring
742  INTEGER :: errorflag,iborder,ipatch,ifile
743  TYPE(t_border), POINTER :: pborder
744  TYPE(t_grid), POINTER :: pgrid
745  TYPE(t_patch), POINTER :: ppatch
746  TYPE(t_global), POINTER :: global
747 
748 ! ******************************************************************************
749 ! Start
750 ! ******************************************************************************
751  global => pregion%global
752 
753  CALL registerfunction(global,'RFLU_WriteDimensions',&
754  'RFLU_ModDimensions.F90')
755 
756  IF ( global%myProcid == masterproc .AND. &
757  global%verbLevel >= verbose_med ) THEN
758  WRITE(stdout,'(A,1X,A)') solver_name,'Writing dimensions...'
759  END IF ! global%verbLevel
760 
761  ifile = if_dims
762 
763  IF ( global%flowType == flow_unsteady .AND. &
764  (pregion%mixtInput%moveGrid .EQV. .true.) ) THEN
765  CALL buildfilenameunsteady(global,filedest_indir,'.dim', &
766  pregion%iRegionGlobal,global%currentTime, &
767  ifilename)
768 
769  IF ( global%myProcid == masterproc .AND. &
770  global%verbLevel >= verbose_high ) THEN
771  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
772  pregion%iRegionGlobal
773  WRITE(stdout,'(A,3X,A,1X,1PE11.5)') solver_name,'Current time:', &
774  global%currentTime
775  END IF ! global%verbLevel
776  ELSE
777  CALL buildfilenamebasic(global,filedest_indir,'.dim', &
778  pregion%iRegionGlobal,ifilename)
779 
780  IF ( global%myProcid == masterproc .AND. &
781  global%verbLevel >= verbose_high ) THEN
782  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
783  pregion%iRegionGlobal
784  END IF ! global%verbLevel
785  END IF ! global
786 
787  OPEN(ifile,file=ifilename,form="FORMATTED",status="UNKNOWN", &
788  iostat=errorflag)
789  global%error = errorflag
790  IF ( global%error /= err_none ) THEN
791  CALL errorstop(global,err_file_open,__line__,ifilename)
792  END IF ! global%error
793 
794 ! ==============================================================================
795 ! Header and general information
796 ! ==============================================================================
797 
798  IF ( global%myProcid == masterproc .AND. &
799  global%verbLevel >= verbose_high ) THEN
800  WRITE(stdout,'(A,3X,A)') solver_name,'Header information...'
801  END IF ! global%verbLevel
802 
803  sectionstring = '# ROCFLU dimensions file'
804  WRITE(ifile,'(A)') trim(sectionstring)
805 
806 ! ==============================================================================
807 ! Write dimensions
808 ! ==============================================================================
809 
810  pgrid => pregion%grid
811 
812  sectionstring = '# Vertices'
813  WRITE(ifile,'(A)') trim(sectionstring)
814  WRITE(ifile,'(3(I8))') pgrid%nVert,pgrid%nVertTot,pgrid%nVertMax
815 
816  sectionstring = '# Cells'
817  WRITE(ifile,'(A)') trim(sectionstring)
818  WRITE(ifile,'(3(I8))') pgrid%nCells,pgrid%nCellsTot,pgrid%nCellsMax
819 
820  sectionstring = '# Tetrahedra'
821  WRITE(ifile,'(A)') trim(sectionstring)
822  WRITE(ifile,'(3(I8))') pgrid%nTets,pgrid%nTetsTot,pgrid%nTetsMax
823 
824  sectionstring = '# Hexahedra'
825  WRITE(ifile,'(A)') trim(sectionstring)
826  WRITE(ifile,'(3(I8))') pgrid%nHexs,pgrid%nHexsTot,pgrid%nHexsMax
827 
828  sectionstring = '# Prisms'
829  WRITE(ifile,'(A)') trim(sectionstring)
830  WRITE(ifile,'(3(I8))') pgrid%nPris,pgrid%nPrisTot,pgrid%nPrisMax
831 
832  sectionstring = '# Pyramids'
833  WRITE(ifile,'(A)') trim(sectionstring)
834  WRITE(ifile,'(3(I8))') pgrid%nPyrs,pgrid%nPyrsTot,pgrid%nPyrsMax
835 
836  sectionstring = '# Patches (v2)'
837  WRITE(ifile,'(A)') trim(sectionstring)
838  WRITE(ifile,'(2(I8))') pgrid%nPatches,global%nPatches
839 
840  DO ipatch = 1,pgrid%nPatches
841  ppatch => pregion%patches(ipatch)
842 
843  WRITE(ifile,'(8(I8))') ppatch%iPatchGlobal, &
844  ppatch%nBTris,ppatch%nBTrisTot, &
845  ppatch%nBTrisMax,ppatch%nBQuads, &
846  ppatch%nBQuadsTot,ppatch%nBQuadsMax, &
847  ppatch%nBCellsVirt
848  END DO ! iPatch
849 
850 
851  sectionstring = '# Borders'
852  WRITE(ifile,'(A)') trim(sectionstring)
853  WRITE(ifile,'(I8)') pgrid%nBorders
854 
855  DO iborder = 1,pgrid%nBorders
856  pborder => pgrid%borders(iborder)
857 
858  WRITE(ifile,'(7(I8))') pborder%iRegionGlobal,pborder%iBorder, &
859  pborder%nCellsSend,pborder%nCellsRecv, &
860  pborder%nVertSend,pborder%nVertRecv, &
861  pborder%nVertShared
862  END DO ! iBorder
863 
864 ! ==============================================================================
865 ! End marker
866 ! ==============================================================================
867 
868  IF ( global%myProcid == masterproc .AND. &
869  global%verbLevel >= verbose_high ) THEN
870  WRITE(stdout,'(A,3X,A)') solver_name,'End marker...'
871  END IF ! global%verbLevel
872 
873  sectionstring = '# End'
874  WRITE(ifile,'(A)') trim(sectionstring)
875 
876 ! ==============================================================================
877 ! Close file
878 ! ==============================================================================
879 
880  CLOSE(ifile,iostat=errorflag)
881  global%error = errorflag
882  IF ( global%myProcid == masterproc .AND. &
883  global%error /= err_none ) THEN
884  CALL errorstop(global,err_file_close,__line__,ifilename)
885  END IF ! global%error
886 ! ******************************************************************************
887 ! End
888 ! ******************************************************************************
889 
890  IF ( global%myProcid == masterproc .AND. &
891  global%verbLevel >= verbose_high ) THEN
892  WRITE(stdout,'(A,1X,A)') solver_name,'Writing dimensions done.'
893  END IF ! global%verbLevel
894 
895  CALL deregisterfunction(global)
896 
897  END SUBROUTINE rflu_writedimensions
898 
899 
900 
901 
902 
903 
904 
905 
906 
907 ! ******************************************************************************
908 !
909 ! Purpose: Write border dimensions.
910 !
911 ! Description: None.
912 !
913 ! Input:
914 ! pRegion Pointer to region
915 !
916 ! Output: None.
917 !
918 ! Notes:
919 ! 1. This routine must only be called from the preprocessor to write the
920 ! border information.
921 ! 2. This routine reads the dimensions file until the borders section is
922 ! found, then the borders information is written.
923 !
924 ! ******************************************************************************
925 
926  SUBROUTINE rflu_writedimensionsborders(pRegion)
927 
930 
931  IMPLICIT NONE
932 
933 ! ******************************************************************************
934 ! Declarations and definitions
935 ! ******************************************************************************
936 
937 ! ==============================================================================
938 ! Arguments
939 ! ==============================================================================
940 
941  TYPE(t_region), POINTER :: pregion
942 
943 ! ==============================================================================
944 ! Local variables
945 ! ==============================================================================
946 
947  CHARACTER(CHRLEN) :: dummystring,ifilename,sectionstring
948  INTEGER :: errorflag,iborder,ipatch,ifile,loopcounter
949  TYPE(t_border), POINTER :: pborder
950  TYPE(t_grid), POINTER :: pgrid
951  TYPE(t_patch), POINTER :: ppatch
952  TYPE(t_global), POINTER :: global
953 
954 ! ******************************************************************************
955 ! Start
956 ! ******************************************************************************
957 
958  global => pregion%global
959 
960  CALL registerfunction(global,'RFLU_WriteDimensionsBorders',&
961  'RFLU_ModDimensions.F90')
962 
963  IF ( global%myProcid == masterproc .AND. &
964  global%verbLevel >= verbose_med ) THEN
965  WRITE(stdout,'(A,1X,A)') solver_name,'Writing border dimensions...'
966  END IF ! global%verbLevel
967 
968  ifile = if_dims
969 
970  IF ( global%flowType == flow_unsteady .AND. &
971  (pregion%mixtInput%moveGrid .EQV. .true.) ) THEN
972  CALL buildfilenameunsteady(global,filedest_indir,'.dim', &
973  pregion%iRegionGlobal,global%currentTime, &
974  ifilename)
975 
976  IF ( global%myProcid == masterproc .AND. &
977  global%verbLevel >= verbose_high ) THEN
978  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
979  pregion%iRegionGlobal
980  WRITE(stdout,'(A,3X,A,1X,1PE11.5)') solver_name,'Current time:', &
981  global%currentTime
982  END IF ! global%verbLevel
983  ELSE
984  CALL buildfilenamebasic(global,filedest_indir,'.dim', &
985  pregion%iRegionGlobal,ifilename)
986 
987  IF ( global%myProcid == masterproc .AND. &
988  global%verbLevel >= verbose_high ) THEN
989  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
990  pregion%iRegionGlobal
991  END IF ! global%verbLevel
992  END IF ! global
993 
994  OPEN(ifile,file=ifilename,form="FORMATTED",status="OLD", &
995  iostat=errorflag)
996  global%error = errorflag
997  IF ( global%error /= err_none ) THEN
998  CALL errorstop(global,err_file_open,__line__,ifilename)
999  END IF ! global%error
1000 
1001 ! ==============================================================================
1002 ! Read dimensions file line by line until hit border section, then write it.
1003 ! ==============================================================================
1004 
1005  pgrid => pregion%grid
1006 
1007  loopcounter = 0
1008 
1009  DO ! set up infinite loop
1010  loopcounter = loopcounter + 1
1011 
1012  READ(ifile,'(A)') dummystring
1013 
1014  SELECT CASE ( trim(dummystring) )
1015 
1016 ! ------------------------------------------------------------------------------
1017 ! Borders section. NOTE once found borders section, write information,
1018 ! end string, and exit infinite loop.
1019 ! ------------------------------------------------------------------------------
1020 
1021  CASE ( '# Borders' )
1022  WRITE(ifile,'(I8)') pgrid%nBorders
1023 
1024  DO iborder = 1,pgrid%nBorders
1025  pborder => pgrid%borders(iborder)
1026 
1027  WRITE(ifile,'(7(I8))') pborder%iRegionGlobal,pborder%iBorder, &
1028  pborder%nCellsSend,pborder%nCellsRecv, &
1029  pborder%nVertSend,pborder%nVertRecv, &
1030  pborder%nVertShared
1031  END DO ! iBorder
1032 
1033  sectionstring = '# End'
1034  WRITE(ifile,'(A)') trim(sectionstring)
1035 
1036  EXIT
1037 
1038 ! ------------------------------------------------------------------------------
1039 ! End marker. NOTE this must not happen in present context, so trap as
1040 ! an error.
1041 ! ------------------------------------------------------------------------------
1042 
1043  CASE ( '# End' )
1044  IF ( global%myProcid == masterproc .AND. &
1045  global%verbLevel >= verbose_high ) THEN
1046  WRITE(stdout,'(A,3X,A)') solver_name,'End marker...'
1047  END IF ! global%verbLevel
1048 
1049  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
1050  END SELECT ! TRIM
1051 
1052 ! ------------------------------------------------------------------------------
1053 ! Guard against infinite loop - might be unnecessary because of read errors?
1054 ! ------------------------------------------------------------------------------
1055 
1056  IF ( loopcounter >= limit_infinite_loop ) THEN
1057  CALL errorstop(global,err_infinite_loop,__line__)
1058  END IF ! loopCounter
1059  END DO ! <empty>
1060 
1061 ! ==============================================================================
1062 ! Close file
1063 ! ==============================================================================
1064 
1065  CLOSE(ifile,iostat=errorflag)
1066  global%error = errorflag
1067  IF ( global%myProcid == masterproc .AND. &
1068  global%error /= err_none ) THEN
1069  CALL errorstop(global,err_file_close,__line__,ifilename)
1070  END IF ! global%error
1071 
1072 ! ******************************************************************************
1073 ! End
1074 ! ******************************************************************************
1075 
1076  IF ( global%myProcid == masterproc .AND. &
1077  global%verbLevel >= verbose_high ) THEN
1078  WRITE(stdout,'(A,1X,A)') solver_name,'Writing border dimensions done.'
1079  END IF ! global%verbLevel
1080 
1081  CALL deregisterfunction(global)
1082 
1083  END SUBROUTINE rflu_writedimensionsborders
1084 
1085 
1086 
1087 
1088 
1089 
1090 
1091 
1092 ! ******************************************************************************
1093 !
1094 ! Purpose: Wrapper function for writing dimensions.
1095 !
1096 ! Description: None.
1097 !
1098 ! Input:
1099 ! pRegion Pointer to region
1100 ! writeMode Writing mode
1101 !
1102 ! Output: None.
1103 !
1104 ! Notes:
1105 ! 1. Need to call this subroutine even if grid is not moving because
1106 ! Rocpart dimension file needs to be written.
1107 !
1108 ! ******************************************************************************
1109 
1110  SUBROUTINE rflu_writedimensionswrapper(pRegion,writeMode)
1111 
1112 #ifdef PLAG
1114 #endif
1115 
1116 #ifdef GENX
1118 #endif
1119 
1120  IMPLICIT NONE
1121 
1122 ! ******************************************************************************
1123 ! Declarations and definitions
1124 ! ******************************************************************************
1125 
1126 ! ==============================================================================
1127 ! Arguments
1128 ! ==============================================================================
1129 
1130  INTEGER, INTENT(IN) :: writemode
1131  TYPE(t_region), POINTER :: pregion
1132 
1133 ! ==============================================================================
1134 ! Local variables
1135 ! ==============================================================================
1136 
1137  TYPE(t_global), POINTER :: global
1138 
1139 ! ******************************************************************************
1140 ! Start
1141 ! ******************************************************************************
1142 
1143  global => pregion%global
1144 
1145  CALL registerfunction(global,'RFLU_WriteDimensionsWrapper',&
1146  'RFLU_ModDimensions.F90')
1147 
1148 ! ******************************************************************************
1149 ! Call routines
1150 ! ******************************************************************************
1151 
1152 #ifdef GENX
1153  IF ( rflu_genx_decidewritefile(global) .EQV. .true. ) THEN
1154 #endif
1155  IF ( writemode == write_dimens_mode_force ) THEN
1156  CALL rflu_writedimensions(pregion)
1157  ELSE
1158  IF ( pregion%mixtInput%moveGrid .EQV. .true. ) THEN
1159  CALL rflu_writedimensions(pregion)
1160  END IF ! pRegion%mixtInput%moveGrid
1161  END IF ! writeMode
1162 #ifdef GENX
1163  END IF ! RFLU_GENX_DecideWriteFile
1164 #endif
1165 
1166 #ifdef PLAG
1167  IF ( global%plagUsed .EQV. .true. ) THEN
1168  CALL plag_rflu_writedimensions(pregion)
1169  END IF ! plagUsed
1170 #endif
1171 
1172 ! ******************************************************************************
1173 ! End
1174 ! ******************************************************************************
1175 
1176  CALL deregisterfunction(global)
1177 
1178  END SUBROUTINE rflu_writedimensionswrapper
1179 
1180 
1181 
1182 
1183 
1184 
1185 
1186 
1187 ! ******************************************************************************
1188 ! End
1189 ! ******************************************************************************
1190 
1191 END MODULE rflu_moddimensions
1192 
1193 
1194 ! ******************************************************************************
1195 !
1196 ! RCS Revision history:
1197 !
1198 ! $Log: RFLU_ModDimensions.F90,v $
1199 ! Revision 1.15 2008/12/06 08:44:21 mtcampbe
1200 ! Updated license.
1201 !
1202 ! Revision 1.14 2008/11/19 22:17:32 mtcampbe
1203 ! Added Illinois Open Source License/Copyright
1204 !
1205 ! Revision 1.13 2007/03/20 17:34:22 fnajjar
1206 ! Modified USE calls to streamline with new module PLAG_ModDimensions
1207 !
1208 ! Revision 1.12 2006/12/15 13:21:18 haselbac
1209 ! Fixed bug in format statement, found by ifort
1210 !
1211 ! Revision 1.11 2006/10/08 18:21:31 haselbac
1212 ! Changes to make code work with PathScale compilers on hpc cluster at UF
1213 !
1214 ! Revision 1.10 2006/04/07 15:19:19 haselbac
1215 ! Removed tabs
1216 !
1217 ! Revision 1.9 2006/03/25 23:52:15 haselbac
1218 ! Restored backward compatibility thru new keyword for patches
1219 !
1220 ! Revision 1.8 2006/03/25 21:51:47 haselbac
1221 ! Substantial changes because of sype patches
1222 !
1223 ! Revision 1.7 2005/06/11 20:52:27 haselbac
1224 ! Fixed comment and note
1225 !
1226 ! Revision 1.6 2005/06/11 20:33:55 haselbac
1227 ! Removed ifdef GENX because now always read from 0 if grid moves
1228 !
1229 ! Revision 1.5 2005/04/15 15:06:49 haselbac
1230 ! Added vertex dimensions to border section
1231 !
1232 ! Revision 1.4 2004/12/29 21:06:30 haselbac
1233 ! Modified reading of border dims to mirror patch dims
1234 !
1235 ! Revision 1.3 2004/12/04 03:29:22 haselbac
1236 ! Added reading/writing of border dims, routine to write border dims
1237 !
1238 ! Revision 1.2 2004/10/19 19:27:49 haselbac
1239 ! Added/removed procs, adapted to changes in other procs
1240 !
1241 ! Revision 1.1 2004/07/06 15:14:26 haselbac
1242 ! Initial revision
1243 !
1244 ! ******************************************************************************
1245 
1246 
1247 
1248 
1249 
1250 
1251 
1252 
1253 
1254 
1255 
1256 
subroutine buildfilenamebasic(global, dest, ext, id, fileName)
subroutine, public rflu_readdimensionswrapper(pRegion)
subroutine, public rflu_writedimensionswrapper(pRegion, writeMode)
subroutine, public rflu_genx_getdimensions(pRegion)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
int status() const
Obtain the status of the attribute.
Definition: Attribute.h:240
subroutine, public rflu_setmaxdimensions(pRegion)
subroutine, public plag_rflu_readdimensions(pRegion)
**********************************************************************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 form
INTEGER function, public rflu_setmaxdimension(global, nXyzTot)
subroutine, public rflu_readdimensions(pRegion)
subroutine, public rflu_writedimensions(pRegion)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine, public rflu_writedimensionsborders(pRegion)
subroutine, public plag_rflu_writedimensions(pRegion)
subroutine deregisterfunction(global)
Definition: ModError.F90:469
LOGICAL function, public rflu_genx_decidewritefile(global)
subroutine buildfilenameunsteady(global, dest, ext, id, tm, fileName)