Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModReadWriteGrid.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 read and write grid files.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModReadWriteGrid.F90,v 1.10 2008/12/06 08:44:23 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 moddatastruct, ONLY: t_region
47  USE modgrid, ONLY: t_grid
48  USE modmpi
49 
50  IMPLICIT NONE
51 
52  PRIVATE
53  PUBLIC :: rflu_readgridwrapper, &
55 
56 ! ******************************************************************************
57 ! Declarations and definitions
58 ! ******************************************************************************
59 
60  CHARACTER(CHRLEN) :: RCSIdentString = &
61  '$RCSfile: RFLU_ModReadWriteGrid.F90,v $ $Revision: 1.10 $'
62 
63 ! ******************************************************************************
64 ! Routines
65 ! ******************************************************************************
66 
67  CONTAINS
68 
69 
70 
71 
72 
73 
74 
75 
76 
77 ! ******************************************************************************
78 !
79 ! Purpose: Read grid in ASCII ROCFLU format.
80 !
81 ! Description: None.
82 !
83 ! Input:
84 ! pRegion Pointer to region
85 !
86 ! Output: None.
87 !
88 ! Notes:
89 ! 1. For GENX runs, read file from time zero if restarting. This is for
90 ! convenience and will have to be changed once grid adaptation is used.
91 !
92 ! ******************************************************************************
93 
94  SUBROUTINE rflu_readgridascii(pRegion)
95 
98 
99  IMPLICIT NONE
100 
101 ! ******************************************************************************
102 ! Declarations and definitions
103 ! ******************************************************************************
104 
105 ! ==============================================================================
106 ! Local variables
107 ! ==============================================================================
108 
109  CHARACTER(CHRLEN) :: ifilename,sectionstring,timestring1,timestring2
110  INTEGER :: errorflag,i,ifile,ipatch,j,k,loopcounter,nbcellsvirt, &
111  nbquadstot,nbtristot,nbverttot,nhexstot,npatches,npristot, &
112  npyrstot,ntetstot,nverttot,p,r
113  REAL(RFREAL) :: currenttime
114  TYPE(t_grid), POINTER :: pgrid
115  TYPE(t_patch), POINTER :: ppatch
116  TYPE(t_global), POINTER :: global
117 
118 ! ==============================================================================
119 ! Arguments
120 ! ==============================================================================
121 
122  TYPE(t_region), POINTER :: pregion
123 
124 ! ******************************************************************************
125 ! Start
126 ! ******************************************************************************
127 
128  global => pregion%global
129 
130  CALL registerfunction(global,'RFLU_ReadGridASCII',&
131  'RFLU_ModReadWriteGrid.F90')
132 
133  IF ( global%myProcid == masterproc .AND. &
134  global%verbLevel > verbose_none ) THEN
135  WRITE(stdout,'(A,1X,A)') solver_name,'Reading ASCII grid file...'
136  END IF ! global%verbLevel
137 
138  ifile = if_grid
139 
140  IF ( global%flowType == flow_unsteady .AND. &
141  (pregion%mixtInput%moveGrid .EQV. .true.) ) THEN
142  CALL buildfilenameunsteady(global,filedest_indir,'.grda', &
143  pregion%iRegionGlobal,global%currentTime, &
144  ifilename)
145 
146  IF ( global%myProcid == masterproc .AND. &
147  global%verbLevel > verbose_none ) THEN
148  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
149  pregion%iRegionGlobal
150  WRITE(stdout,'(A,3X,A,1X,1PE11.5)') solver_name,'Current time:', &
151  global%currentTime
152  END IF ! global%verbLevel
153  ELSE
154  CALL buildfilenamebasic(global,filedest_indir,'.grda', &
155  pregion%iRegionGlobal,ifilename)
156 
157  IF ( global%myProcid == masterproc .AND. &
158  global%verbLevel > verbose_none ) THEN
159  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
160  pregion%iRegionGlobal
161  END IF ! global%verbLevel
162  END IF ! global
163 
164  OPEN(ifile,file=ifilename,form="FORMATTED",status="OLD",iostat=errorflag)
165  global%error = errorflag
166  IF ( global%error /= err_none ) THEN
167  CALL errorstop(global,err_file_open,__line__,ifilename)
168  END IF ! global%error
169 
170 ! ==============================================================================
171 ! Read header stuff
172 ! ==============================================================================
173 
174  IF ( global%myProcid == masterproc .AND. &
175  global%verbLevel > verbose_low ) THEN
176  WRITE(stdout,'(A,3X,A)') solver_name,'Header information...'
177  END IF ! global%verbLevel
178 
179  READ(ifile,'(A)') sectionstring
180  IF ( trim(sectionstring) /= '# ROCFLU grid file' ) THEN
181  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
182  END IF ! TRIM
183 
184 ! ------------------------------------------------------------------------------
185 ! Precision and range
186 ! ------------------------------------------------------------------------------
187 
188  READ(ifile,'(A)') sectionstring
189  IF ( trim(sectionstring) /= '# Precision and range' ) THEN
190  CALL errorstop(global,err_invalid_marker,__line__,ifilename)
191  END IF ! TRIM
192 
193  READ(ifile,'(2(I8))') p,r
194  IF ( p < precision(1.0_rfreal) .OR. r < range(1.0_rfreal) ) THEN
195  CALL errorstop(global,err_prec_range,__line__)
196  END IF ! p
197 
198 ! ------------------------------------------------------------------------------
199 ! Initial residual and physical time
200 ! ------------------------------------------------------------------------------
201 
202  READ(ifile,'(A)') sectionstring
203  IF ( trim(sectionstring) /= '# Physical time' ) THEN
204  CALL errorstop(global,err_invalid_marker,__line__,ifilename)
205  END IF ! TRIM
206 
207  READ(ifile,'(E23.16)') currenttime
208 
209  IF ( global%flowType == flow_unsteady .AND. &
210  (pregion%mixtInput%moveGrid .EQV. .true.) ) THEN
211  IF ( global%currentTime < 0.0_rfreal ) THEN
212  global%currentTime = currenttime
213  ELSE
214  WRITE(timestring1,'(1PE11.5)') global%currentTime
215  WRITE(timestring2,'(1PE11.5)') currenttime
216  IF ( trim(timestring1) /= trim(timestring2) ) THEN
217  CALL errorstop(global,err_time_solution,__line__,trim(ifilename))
218  END IF ! global%currentTime
219  END IF ! global%currentTime
220  END IF ! global%flowType
221 
222 ! ==============================================================================
223 ! Dimensions
224 ! ==============================================================================
225 
226  READ(ifile,'(A)') sectionstring
227  IF ( trim(sectionstring) /= '# Dimensions' ) THEN
228  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
229  END IF ! TRIM
230 
231  pgrid => pregion%grid
232 
233  READ(ifile,'(5(I8))') nverttot,ntetstot,nhexstot,npristot,npyrstot
234 
235 ! ==============================================================================
236 ! Check dimensions (against those read from dimensions file)
237 ! ==============================================================================
238 
239  IF ( nverttot /= pgrid%nVertTot ) THEN
240  CALL errorstop(global,err_dimens_invalid,__line__)
241  END IF ! nVertTot
242 
243  IF ( ntetstot /= pgrid%nTetsTot ) THEN
244  CALL errorstop(global,err_dimens_invalid,__line__)
245  END IF ! nTetsTot
246 
247  IF ( nhexstot /= pgrid%nHexsTot ) THEN
248  CALL errorstop(global,err_dimens_invalid,__line__)
249  END IF ! nHexsTot
250 
251  IF ( npristot /= pgrid%nPrisTot ) THEN
252  CALL errorstop(global,err_dimens_invalid,__line__)
253  END IF ! nPrisTot
254 
255  IF ( npyrstot /= pgrid%nPyrsTot ) THEN
256  CALL errorstop(global,err_dimens_invalid,__line__)
257  END IF ! nPyrsTot
258 
259 ! ==============================================================================
260 ! Rest of file
261 ! ==============================================================================
262 
263  loopcounter = 0
264 
265  DO ! set up infinite loop
266  loopcounter = loopcounter + 1
267 
268  READ(ifile,'(A)') sectionstring
269 
270  SELECT CASE ( trim(sectionstring) )
271 
272 ! ------------------------------------------------------------------------------
273 ! Coordinates
274 ! ------------------------------------------------------------------------------
275 
276  CASE ( '# Coordinates' )
277  IF ( global%myProcid == masterproc .AND. &
278  global%verbLevel > verbose_low ) THEN
279  WRITE(stdout,'(A,3X,A)') solver_name,'Coordinates...'
280  END IF ! global%verbLevel
281 
282  DO i = 1,3
283  READ(ifile,'(5(E23.16))') (pgrid%xyz(i,j),j=1,pgrid%nVertTot)
284  END DO ! i
285 
286 ! ------------------------------------------------------------------------------
287 ! Tetrahedra
288 ! ------------------------------------------------------------------------------
289 
290  CASE ( '# Tetrahedra' )
291  IF ( pgrid%nTetsTot == 0 ) THEN
292  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
293  END IF ! pGrid%nTetsTot
294 
295  IF ( global%myProcid == masterproc .AND. &
296  global%verbLevel > verbose_low ) THEN
297  WRITE(stdout,'(A,3X,A)') solver_name,'Tetrahedra...'
298  END IF ! global%verbLevel
299 
300  DO i = 1,4
301  READ(ifile,'(10(I8))') (pgrid%tet2v(i,j),j=1,pgrid%nTetsTot)
302  END DO ! i
303 
304 ! ------------------------------------------------------------------------------
305 ! Hexahedra
306 ! ------------------------------------------------------------------------------
307 
308  CASE ( '# Hexahedra' )
309  IF ( pgrid%nHexsTot == 0 ) THEN
310  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
311  END IF ! pGrid%nHexsTot
312 
313  IF ( global%myProcid == masterproc .AND. &
314  global%verbLevel > verbose_low ) THEN
315  WRITE(stdout,'(A,3X,A)') solver_name,'Hexahedra...'
316  END IF ! global%verbLevel
317 
318  DO i = 1,8
319  READ(ifile,'(10(I8))') (pgrid%hex2v(i,j),j=1,pgrid%nHexsTot)
320  END DO ! i
321 
322 ! ------------------------------------------------------------------------------
323 ! Prisms
324 ! ------------------------------------------------------------------------------
325 
326  CASE ( '# Prisms' )
327  IF ( pgrid%nPrisTot == 0 ) THEN
328  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
329  END IF ! pGrid%nPrisTot
330 
331  IF ( global%myProcid == masterproc .AND. &
332  global%verbLevel > verbose_low ) THEN
333  WRITE(stdout,'(A,3X,A)') solver_name,'Prisms...'
334  END IF ! global%verbLevel
335 
336  DO i = 1,6
337  READ(ifile,'(10(I8))') (pgrid%pri2v(i,j),j=1,pgrid%nPrisTot)
338  END DO ! i
339 
340 ! ------------------------------------------------------------------------------
341 ! Pyramids
342 ! ------------------------------------------------------------------------------
343 
344  CASE ( '# Pyramids' )
345  IF ( pgrid%nPyrsTot == 0 ) THEN
346  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
347  END IF ! pGrid%nPyrsTot
348 
349  IF ( global%myProcid == masterproc .AND. &
350  global%verbLevel > verbose_low ) THEN
351  WRITE(stdout,'(A,3X,A)') solver_name,'Pyramids...'
352  END IF ! global%verbLevel
353 
354  DO i = 1,5
355  READ(ifile,'(10(I8))') (pgrid%pyr2v(i,j),j=1,pgrid%nPyrsTot)
356  END DO ! i
357 
358 ! ------------------------------------------------------------------------------
359 ! Boundaries (format v1)
360 ! ------------------------------------------------------------------------------
361 
362  CASE ( '# Boundaries' )
363  IF ( global%myProcid == masterproc .AND. &
364  global%verbLevel > verbose_low ) THEN
365  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary information...'
366  END IF ! global%verbLevel
367 
368  READ(ifile,*) npatches
369 
370  IF ( npatches /= pgrid%nPatches ) THEN
371  CALL errorstop(global,err_dimens_invalid,__line__)
372  END IF ! nPatches
373 
374 ! ------- Loop over patches ----------------------------------------------------
375 
376  DO ipatch = 1,pgrid%nPatches
377  ppatch => pregion%patches(ipatch)
378 
379 ! --------- Read dimensions
380 
381  READ(ifile,'(2(I8))') nbtristot,nbquadstot
382 
383 ! --------- Check dimensions
384 
385  IF ( nbtristot /= ppatch%nBTrisTot ) THEN
386  CALL errorstop(global,err_dimens_invalid,__line__)
387  END IF ! nBTrisTot
388 
389  IF ( nbquadstot /= ppatch%nBQuadsTot ) THEN
390  CALL errorstop(global,err_dimens_invalid,__line__)
391  END IF ! nBQuadsTot
392 
393 ! --------- Read data
394 
395  IF ( ppatch%nBTrisTot > 0 ) THEN
396  DO j = 1,3
397  READ(ifile,'(10(I8))') (ppatch%bTri2v(j,k),k=1,ppatch%nBTrisTot)
398  END DO ! j
399  END IF ! pPatch%nBTrisTot
400 
401  IF ( ppatch%nBQuadsTot > 0 ) THEN
402  DO j = 1,4
403  READ(ifile,'(10(I8))') (ppatch%bQuad2v(j,k), &
404  k=1,ppatch%nBQuadsTot)
405  END DO ! j
406  END IF ! pPatch%nBQuadsTot
407  END DO ! iPatch
408 
409 ! ------------------------------------------------------------------------------
410 ! Boundaries (format v2)
411 ! ------------------------------------------------------------------------------
412 
413  CASE ( '# Boundaries (v2)' )
414  IF ( global%myProcid == masterproc .AND. &
415  global%verbLevel > verbose_low ) THEN
416  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary information...'
417  END IF ! global%verbLevel
418 
419  READ(ifile,*) npatches
420 
421  IF ( npatches /= pgrid%nPatches ) THEN
422  CALL errorstop(global,err_dimens_invalid,__line__)
423  END IF ! nPatches
424 
425 ! ------- Loop over patches ----------------------------------------------------
426 
427  DO ipatch = 1,pgrid%nPatches
428  ppatch => pregion%patches(ipatch)
429 
430 ! --------- Read dimensions
431 
432  READ(ifile,'(3(I8))') nbtristot,nbquadstot,nbcellsvirt
433 
434 ! --------- Check dimensions
435 
436  IF ( nbtristot /= ppatch%nBTrisTot ) THEN
437  CALL errorstop(global,err_dimens_invalid,__line__)
438  END IF ! nBTrisTot
439 
440  IF ( nbquadstot /= ppatch%nBQuadsTot ) THEN
441  CALL errorstop(global,err_dimens_invalid,__line__)
442  END IF ! nBQuadsTot
443 
444  IF ( nbcellsvirt /= ppatch%nBCellsVirt ) THEN
445  CALL errorstop(global,err_dimens_invalid,__line__)
446  END IF ! nBCellsVirt
447 
448 ! --------- Read data
449 
450  IF ( ppatch%nBTrisTot > 0 ) THEN
451  DO j = 1,3
452  READ(ifile,'(10(I8))') (ppatch%bTri2v(j,k),k=1,ppatch%nBTrisTot)
453  END DO ! j
454  END IF ! pPatch%nBTrisTot
455 
456  IF ( ppatch%nBQuadsTot > 0 ) THEN
457  DO j = 1,4
458  READ(ifile,'(10(I8))') (ppatch%bQuad2v(j,k), &
459  k=1,ppatch%nBQuadsTot)
460  END DO ! j
461  END IF ! pPatch%nBQuadsTot
462 
463  IF ( ppatch%nBCellsVirt > 0 ) THEN
464  READ(ifile,'(10(I8))') (ppatch%bvc(k),k=1,ppatch%nBCellsVirt)
465  END IF ! pPatch%nBCellsVirt
466  END DO ! iPatch
467 
468 ! ------------------------------------------------------------------------------
469 ! End marker
470 ! ------------------------------------------------------------------------------
471 
472  CASE ( '# End' )
473  IF ( global%myProcid == masterproc .AND. &
474  global%verbLevel > verbose_low ) THEN
475  WRITE(stdout,'(A,3X,A)') solver_name,'End marker...'
476  END IF ! global%verbLevel
477 
478  EXIT
479 
480 ! ------------------------------------------------------------------------------
481 ! Invalid section string
482 ! ------------------------------------------------------------------------------
483 
484  CASE default
485  IF ( global%verbLevel > verbose_low ) THEN
486  WRITE(stdout,'(3X,A)') sectionstring
487  END IF ! global%verbLevel
488 
489  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
490 
491  END SELECT ! TRIM
492 
493 ! ==============================================================================
494 ! Guard against infinite loop - might be unnecessary because of read errors?
495 ! ==============================================================================
496 
497  IF ( loopcounter >= limit_infinite_loop ) THEN
498  CALL errorstop(global,err_infinite_loop,__line__)
499  END IF ! loopCounter
500 
501  END DO ! <empty>
502 
503 #ifdef CHECK_DATASTRUCT
504 ! ******************************************************************************
505 ! Write out connectivity so can check data structure
506 ! ******************************************************************************
507 
508  WRITE(stdout,'(A)') solver_name
509  WRITE(stdout,'(A,1X,A)') solver_name,'### START CHECK OUTPUT ###'
510  WRITE(stdout,'(A,1X,A)') solver_name,'Cell connectivity'
511 
512  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Number of tetrahedra:', &
513  pgrid%nTetsTot
514  DO i = 1,pgrid%nTetsTot
515  WRITE(stdout,'(A,5(1X,I6))') solver_name,i,pgrid%tet2v(1:4,i)
516  END DO ! i
517 
518  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Number of hexahedra:', &
519  pgrid%nHexsTot
520  DO i = 1,pgrid%nHexsTot
521  WRITE(stdout,'(A,9(1X,I6))') solver_name,i,pgrid%hex2v(1:8,i)
522  END DO ! i
523 
524  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Number of prisms:', &
525  pgrid%nPrisTot
526  DO i = 1,pgrid%nPrisTot
527  WRITE(stdout,'(A,7(1X,I6))') solver_name,i,pgrid%pri2v(1:6,i)
528  END DO ! i
529 
530  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Number of pyramids:', &
531  pgrid%nPyrsTot
532  DO i = 1,pgrid%nPyrsTot
533  WRITE(stdout,'(A,6(1X,I6))') solver_name,i,pgrid%pyr2v(1:5,i)
534  END DO ! i
535 
536  WRITE(stdout,'(A,1X,A)') solver_name,'Coordinates'
537  DO i = 1,pgrid%nVertTot
538  WRITE(stdout,'(A,1X,I6,3(1X,E18.9))') solver_name,i,pgrid%xyz(1:3,i)
539  END DO ! i
540  WRITE(stdout,'(A,1X,A)') solver_name,'### END CHECK OUTPUT ###'
541  WRITE(stdout,'(A)') solver_name
542 #endif
543 
544 ! ******************************************************************************
545 ! Close file
546 ! ******************************************************************************
547 
548  CLOSE(ifile,iostat=errorflag)
549  global%error = errorflag
550  IF ( global%error /= err_none ) THEN
551  CALL errorstop(global,err_file_close,__line__,ifilename)
552  END IF ! global%error
553 
554 ! ******************************************************************************
555 ! End
556 ! ******************************************************************************
557 
558  CALL deregisterfunction(global)
559 
560  IF ( global%myProcid == masterproc .AND. &
561  global%verbLevel > verbose_none ) THEN
562  WRITE(stdout,'(A,1X,A)') solver_name,'Reading ASCII grid file done.'
563  END IF ! global%verbLevel
564 
565  END SUBROUTINE rflu_readgridascii
566 
567 
568 
569 
570 
571 
572 
573 
574 ! ******************************************************************************
575 !
576 ! Purpose: Read grid in binary ROCFLU format.
577 !
578 ! Description: None.
579 !
580 ! Input:
581 ! pRegion Pointer to region
582 !
583 ! Output: None.
584 !
585 ! Notes:
586 ! 1. For GENX runs, read file from time zero if restarting. This is for
587 ! convenience and will have to be changed once grid adaptation is used.
588 !
589 ! ******************************************************************************
590 
591  SUBROUTINE rflu_readgridbinary(pRegion)
592 
595 
596  IMPLICIT NONE
597 
598 ! ******************************************************************************
599 ! Declarations and definitions
600 ! ******************************************************************************
601 
602 ! ==============================================================================
603 ! Local variables
604 ! ==============================================================================
605 
606  CHARACTER(CHRLEN) :: ifilename,sectionstring,timestring1,timestring2
607  INTEGER :: errorflag,i,ifile,ipatch,j,k,loopcounter,nbcellsvirt, &
608  nbquadstot,nbtristot,nbverttot,nhexstot,npatches,npristot, &
609  npyrstot,ntetstot,nverttot,p,r
610  REAL(RFREAL) :: currenttime
611  TYPE(t_grid), POINTER :: pgrid
612  TYPE(t_patch), POINTER :: ppatch
613  TYPE(t_global), POINTER :: global
614 
615 ! ==============================================================================
616 ! Arguments
617 ! ==============================================================================
618 
619  TYPE(t_region), POINTER :: pregion
620 
621 ! ******************************************************************************
622 ! Start
623 ! ******************************************************************************
624 
625  global => pregion%global
626 
627  CALL registerfunction(global,'RFLU_ReadGridBinary',&
628  'RFLU_ModReadWriteGrid.F90')
629 
630  IF ( global%myProcid == masterproc .AND. &
631  global%verbLevel > verbose_none ) THEN
632  WRITE(stdout,'(A,1X,A)') solver_name,'Reading binary grid file...'
633  END IF ! global%verbLevel
634 
635  ifile = if_grid
636 
637  IF ( global%flowType == flow_unsteady .AND. &
638  (pregion%mixtInput%moveGrid .EQV. .true.) ) THEN
639  CALL buildfilenameunsteady(global,filedest_indir,'.grd', &
640  pregion%iRegionGlobal,global%currentTime, &
641  ifilename)
642 
643  IF ( global%myProcid == masterproc .AND. &
644  global%verbLevel > verbose_none ) THEN
645  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
646  pregion%iRegionGlobal
647  WRITE(stdout,'(A,3X,A,1X,1PE11.5)') solver_name,'Current time:', &
648  global%currentTime
649  END IF ! global%verbLevel
650  ELSE
651  CALL buildfilenamebasic(global,filedest_indir,'.grd', &
652  pregion%iRegionGlobal,ifilename)
653 
654  IF ( global%myProcid == masterproc .AND. &
655  global%verbLevel > verbose_none ) THEN
656  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
657  pregion%iRegionGlobal
658  END IF ! global%verbLevel
659  END IF ! global
660 
661  OPEN(ifile,file=ifilename,form="UNFORMATTED",status="OLD",iostat=errorflag)
662  global%error = errorflag
663  IF ( global%error /= err_none ) THEN
664  CALL errorstop(global,err_file_open,__line__,ifilename)
665  END IF ! global%error
666 
667 ! ==============================================================================
668 ! Read header stuff
669 ! ==============================================================================
670 
671  IF ( global%myProcid == masterproc .AND. &
672  global%verbLevel > verbose_low ) THEN
673  WRITE(stdout,'(A,3X,A)') solver_name,'Header information...'
674  END IF ! global%verbLevel
675 
676  READ(ifile) sectionstring
677  IF ( trim(sectionstring) /= '# ROCFLU grid file' ) THEN
678  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
679  END IF ! TRIM
680 
681 ! ------------------------------------------------------------------------------
682 ! Precision and range
683 ! ------------------------------------------------------------------------------
684 
685  READ(ifile) sectionstring
686  IF ( trim(sectionstring) /= '# Precision and range' ) THEN
687  CALL errorstop(global,err_invalid_marker,__line__,ifilename)
688  END IF ! TRIM
689 
690  READ(ifile) p,r
691  IF ( p < precision(1.0_rfreal) .OR. r < range(1.0_rfreal) ) THEN
692  CALL errorstop(global,err_prec_range,__line__)
693  END IF ! p
694 
695 ! ------------------------------------------------------------------------------
696 ! Initial residual and physical time
697 ! ------------------------------------------------------------------------------
698 
699  READ(ifile) sectionstring
700  IF ( trim(sectionstring) /= '# Physical time' ) THEN
701  CALL errorstop(global,err_invalid_marker,__line__,ifilename)
702  END IF ! TRIM
703 
704  READ(ifile) currenttime
705 
706  IF ( global%flowType == flow_unsteady .AND. &
707  (pregion%mixtInput%moveGrid .EQV. .true.) ) THEN
708  IF ( global%currentTime < 0.0_rfreal ) THEN
709  global%currentTime = currenttime
710  ELSE
711  WRITE(timestring1,'(1PE11.5)') global%currentTime
712  WRITE(timestring2,'(1PE11.5)') currenttime
713  IF ( trim(timestring1) /= trim(timestring2) ) THEN
714  CALL errorstop(global,err_time_solution,__line__,trim(ifilename))
715  END IF ! global%currentTime
716  END IF ! global%currentTime
717  END IF ! global%flowType
718 
719 ! ==============================================================================
720 ! Dimensions
721 ! ==============================================================================
722 
723  READ(ifile) sectionstring
724  IF ( trim(sectionstring) /= '# Dimensions' ) THEN
725  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
726  END IF ! TRIM
727 
728  pgrid => pregion%grid
729 
730  READ(ifile) nverttot,ntetstot,nhexstot,npristot,npyrstot
731 
732 ! ==============================================================================
733 ! Check dimensions (against those read from dimensions file)
734 ! ==============================================================================
735 
736  IF ( nverttot /= pgrid%nVertTot ) THEN
737  CALL errorstop(global,err_dimens_invalid,__line__)
738  END IF ! nVertTot
739 
740  IF ( ntetstot /= pgrid%nTetsTot ) THEN
741  CALL errorstop(global,err_dimens_invalid,__line__)
742  END IF ! nTetsTot
743 
744  IF ( nhexstot /= pgrid%nHexsTot ) THEN
745  CALL errorstop(global,err_dimens_invalid,__line__)
746  END IF ! nHexsTot
747 
748  IF ( npristot /= pgrid%nPrisTot ) THEN
749  CALL errorstop(global,err_dimens_invalid,__line__)
750  END IF ! nPrisTot
751 
752  IF ( npyrstot /= pgrid%nPyrsTot ) THEN
753  CALL errorstop(global,err_dimens_invalid,__line__)
754  END IF ! nPyrsTot
755 
756 ! ==============================================================================
757 ! Rest of file
758 ! ==============================================================================
759 
760  loopcounter = 0
761 
762  DO ! set up infinite loop
763  loopcounter = loopcounter + 1
764 
765  READ(ifile) sectionstring
766 
767  SELECT CASE ( trim(sectionstring) )
768 
769 ! ------------------------------------------------------------------------------
770 ! Coordinates
771 ! ------------------------------------------------------------------------------
772 
773  CASE ( '# Coordinates' )
774  IF ( global%myProcid == masterproc .AND. &
775  global%verbLevel > verbose_low ) THEN
776  WRITE(stdout,'(A,3X,A)') solver_name,'Coordinates...'
777  END IF ! global%verbLevel
778 
779  DO i = 1,3
780  READ(ifile) (pgrid%xyz(i,j),j=1,pgrid%nVertTot)
781  END DO ! i
782 
783 ! ------------------------------------------------------------------------------
784 ! Tetrahedra
785 ! ------------------------------------------------------------------------------
786 
787  CASE ( '# Tetrahedra' )
788  IF ( pgrid%nTetsTot == 0 ) THEN
789  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
790  END IF ! pGrid%nTetsTot
791 
792  IF ( global%myProcid == masterproc .AND. &
793  global%verbLevel > verbose_low ) THEN
794  WRITE(stdout,'(A,3X,A)') solver_name,'Tetrahedra...'
795  END IF ! global%verbLevel
796 
797  DO i = 1,4
798  READ(ifile) (pgrid%tet2v(i,j),j=1,pgrid%nTetsTot)
799  END DO ! i
800 
801 ! ------------------------------------------------------------------------------
802 ! Hexahedra
803 ! ------------------------------------------------------------------------------
804 
805  CASE ( '# Hexahedra' )
806  IF ( pgrid%nHexsTot == 0 ) THEN
807  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
808  END IF ! pGrid%nHexsTot
809 
810  IF ( global%myProcid == masterproc .AND. &
811  global%verbLevel > verbose_low ) THEN
812  WRITE(stdout,'(A,3X,A)') solver_name,'Hexahedra...'
813  END IF ! global%verbLevel
814 
815  DO i = 1,8
816  READ(ifile) (pgrid%hex2v(i,j),j=1,pgrid%nHexsTot)
817  END DO ! i
818 
819 ! ------------------------------------------------------------------------------
820 ! Prisms
821 ! ------------------------------------------------------------------------------
822 
823  CASE ( '# Prisms' )
824  IF ( pgrid%nPrisTot == 0 ) THEN
825  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
826  END IF ! pGrid%nPrisTot
827 
828  IF ( global%myProcid == masterproc .AND. &
829  global%verbLevel > verbose_low ) THEN
830  WRITE(stdout,'(A,3X,A)') solver_name,'Prisms...'
831  END IF ! global%verbLevel
832 
833  DO i = 1,6
834  READ(ifile) (pgrid%pri2v(i,j),j=1,pgrid%nPrisTot)
835  END DO ! i
836 
837 ! ------------------------------------------------------------------------------
838 ! Pyramids
839 ! ------------------------------------------------------------------------------
840 
841  CASE ( '# Pyramids' )
842  IF ( pgrid%nPyrsTot == 0 ) THEN
843  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
844  END IF ! pGrid%nPyrsTot
845 
846  IF ( global%myProcid == masterproc .AND. &
847  global%verbLevel > verbose_low ) THEN
848  WRITE(stdout,'(A,3X,A)') solver_name,'Pyramids...'
849  END IF ! global%verbLevel
850 
851  DO i = 1,5
852  READ(ifile) (pgrid%pyr2v(i,j),j=1,pgrid%nPyrsTot)
853  END DO ! i
854 
855 ! ------------------------------------------------------------------------------
856 ! Boundaries (format v1)
857 ! ------------------------------------------------------------------------------
858 
859  CASE ( '# Boundaries' )
860  IF ( global%myProcid == masterproc .AND. &
861  global%verbLevel > verbose_low ) THEN
862  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary information...'
863  END IF ! global%verbLevel
864 
865  READ(ifile) npatches
866 
867  IF ( npatches /= pgrid%nPatches ) THEN
868  CALL errorstop(global,err_dimens_invalid,__line__)
869  END IF ! nPatches
870 
871 ! ------- Loop over patches ----------------------------------------------------
872 
873  DO ipatch = 1,pgrid%nPatches
874  ppatch => pregion%patches(ipatch)
875 
876 ! --------- Read dimensions
877 
878  READ(ifile) nbtristot,nbquadstot
879 
880 ! --------- Check dimensions
881 
882  IF ( nbtristot /= ppatch%nBTrisTot ) THEN
883  CALL errorstop(global,err_dimens_invalid,__line__)
884  END IF ! nBTris
885 
886  IF ( nbquadstot /= ppatch%nBQuadsTot ) THEN
887  CALL errorstop(global,err_dimens_invalid,__line__)
888  END IF ! nBQuads
889 
890 ! --------- Read data
891 
892  IF ( ppatch%nBTrisTot > 0 ) THEN
893  DO j = 1,3
894  READ(ifile) (ppatch%bTri2v(j,k),k=1,ppatch%nBTrisTot)
895  END DO ! j
896  END IF ! pPatch%nBTrisTot
897 
898  IF ( ppatch%nBQuadsTot > 0 ) THEN
899  DO j = 1,4
900  READ(ifile) (ppatch%bQuad2v(j,k),k=1,ppatch%nBQuadsTot)
901  END DO ! j
902  END IF ! pPatch%nBQuadsTot
903  END DO ! iPatch
904 
905 ! ------------------------------------------------------------------------------
906 ! Boundaries (format v2)
907 ! ------------------------------------------------------------------------------
908 
909  CASE ( '# Boundaries (v2)' )
910  IF ( global%myProcid == masterproc .AND. &
911  global%verbLevel > verbose_low ) THEN
912  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary information...'
913  END IF ! global%verbLevel
914 
915  READ(ifile) npatches
916 
917  IF ( npatches /= pgrid%nPatches ) THEN
918  CALL errorstop(global,err_dimens_invalid,__line__)
919  END IF ! nPatches
920 
921 ! ------- Loop over patches ----------------------------------------------------
922 
923  DO ipatch = 1,pgrid%nPatches
924  ppatch => pregion%patches(ipatch)
925 
926 ! --------- Read dimensions
927 
928  READ(ifile) nbtristot,nbquadstot,nbcellsvirt
929 
930 ! --------- Check dimensions
931 
932  IF ( nbtristot /= ppatch%nBTrisTot ) THEN
933  CALL errorstop(global,err_dimens_invalid,__line__)
934  END IF ! nBTris
935 
936  IF ( nbquadstot /= ppatch%nBQuadsTot ) THEN
937  CALL errorstop(global,err_dimens_invalid,__line__)
938  END IF ! nBQuads
939 
940  IF ( nbcellsvirt /= ppatch%nBCellsVirt ) THEN
941  CALL errorstop(global,err_dimens_invalid,__line__)
942  END IF ! nBCellsVirt
943 
944 ! --------- Read data
945 
946  IF ( ppatch%nBTrisTot > 0 ) THEN
947  DO j = 1,3
948  READ(ifile) (ppatch%bTri2v(j,k),k=1,ppatch%nBTrisTot)
949  END DO ! j
950  END IF ! pPatch%nBTrisTot
951 
952  IF ( ppatch%nBQuadsTot > 0 ) THEN
953  DO j = 1,4
954  READ(ifile) (ppatch%bQuad2v(j,k),k=1,ppatch%nBQuadsTot)
955  END DO ! j
956  END IF ! pPatch%nBQuadsTot
957 
958  IF ( ppatch%nBCellsVirt > 0 ) THEN
959  READ(ifile) (ppatch%bvc(k),k=1,ppatch%nBCellsVirt)
960  END IF ! pPatch%nBCellsVirt
961  END DO ! iPatch
962 
963 ! ------------------------------------------------------------------------------
964 ! End marker
965 ! ------------------------------------------------------------------------------
966 
967  CASE ( '# End' )
968  IF ( global%myProcid == masterproc .AND. &
969  global%verbLevel > verbose_low ) THEN
970  WRITE(stdout,'(A,3X,A)') solver_name,'End marker...'
971  END IF ! global%verbLevel
972 
973  EXIT
974 
975 ! ------------------------------------------------------------------------------
976 ! Invalid section string
977 ! ------------------------------------------------------------------------------
978 
979  CASE default
980  IF ( global%verbLevel > verbose_low ) THEN
981  WRITE(stdout,'(3X,A)') sectionstring
982  END IF ! global%verbLevel
983 
984  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
985 
986  END SELECT ! TRIM
987 
988 ! ==============================================================================
989 ! Guard against infinite loop - might be unnecessary because of read errors?
990 ! ==============================================================================
991 
992  IF ( loopcounter >= limit_infinite_loop ) THEN
993  CALL errorstop(global,err_infinite_loop,__line__)
994  END IF ! loopCounter
995 
996  END DO ! <empty>
997 
998 #ifdef CHECK_DATASTRUCT
999 ! ******************************************************************************
1000 ! Write out connectivity so can check data structure
1001 ! ******************************************************************************
1002 
1003  WRITE(stdout,'(A)') solver_name
1004  WRITE(stdout,'(A,1X,A)') solver_name,'### START CHECK OUTPUT ###'
1005  WRITE(stdout,'(A,1X,A)') solver_name,'Cell connectivity'
1006 
1007  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Number of tetrahedra:', &
1008  pgrid%nTetsTot
1009  DO i = 1,pgrid%nTetsTot
1010  WRITE(stdout,'(A,5(1X,I6))') solver_name,i,pgrid%tet2v(1:4,i)
1011  END DO ! i
1012 
1013  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Number of hexahedra:', &
1014  pgrid%nHexsTot
1015  DO i = 1,pgrid%nHexsTot
1016  WRITE(stdout,'(A,9(1X,I6))') solver_name,i,pgrid%hex2v(1:8,i)
1017  END DO ! i
1018 
1019  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Number of prisms:', &
1020  pgrid%nPrisTot
1021  DO i = 1,pgrid%nPrisTot
1022  WRITE(stdout,'(A,7(1X,I6))') solver_name,i,pgrid%pri2v(1:6,i)
1023  END DO ! i
1024 
1025  WRITE(stdout,'(A,1X,A,1X,I6)') solver_name,'Number of pyramids:', &
1026  pgrid%nPyrsTot
1027  DO i = 1,pgrid%nPyrsTot
1028  WRITE(stdout,'(A,6(1X,I6))') solver_name,i,pgrid%pyr2v(1:5,i)
1029  END DO ! i
1030 
1031  WRITE(stdout,'(A,1X,A)') solver_name,'Coordinates'
1032  DO i = 1,pgrid%nVertTot
1033  WRITE(stdout,'(A,1X,I6,3(1X,E18.9))') solver_name,i,pgrid%xyz(1:3,i)
1034  END DO ! i
1035  WRITE(stdout,'(A,1X,A)') solver_name,'### END CHECK OUTPUT ###'
1036  WRITE(stdout,'(A)') solver_name
1037 #endif
1038 
1039 ! ******************************************************************************
1040 ! Close file
1041 ! ******************************************************************************
1042 
1043  CLOSE(ifile,iostat=errorflag)
1044  global%error = errorflag
1045  IF ( global%error /= err_none ) THEN
1046  CALL errorstop(global,err_file_close,__line__,ifilename)
1047  END IF ! global%error
1048 
1049 ! ******************************************************************************
1050 ! End
1051 ! ******************************************************************************
1052 
1053  IF ( global%myProcid == masterproc .AND. &
1054  global%verbLevel > verbose_none ) THEN
1055  WRITE(stdout,'(A,1X,A)') solver_name,'Reading binary grid file done.'
1056  END IF ! global%verbLevel
1057 
1058  CALL deregisterfunction(global)
1059 
1060  END SUBROUTINE rflu_readgridbinary
1061 
1062 
1063 
1064 
1065 
1066 
1067 ! ******************************************************************************
1068 !
1069 ! Purpose: Wrapper for reading of grid files in ROCFLU format.
1070 !
1071 ! Description: None.
1072 !
1073 ! Input:
1074 ! pRegion Pointer to region
1075 !
1076 ! Output: None.
1077 !
1078 ! Notes: None.
1079 !
1080 ! ******************************************************************************
1081 
1082  SUBROUTINE rflu_readgridwrapper(pRegion)
1083 
1084 #ifdef GENX
1087 #endif
1088 
1089  IMPLICIT NONE
1090 
1091 ! ******************************************************************************
1092 ! Declarations and definitions
1093 ! ******************************************************************************
1094 
1095 ! ==============================================================================
1096 ! Arguments
1097 ! ==============================================================================
1098 
1099  TYPE(t_region), POINTER :: pregion
1100 
1101 ! ==============================================================================
1102 ! Local variables
1103 ! ==============================================================================
1104 
1105  TYPE(t_global), POINTER :: global
1106 
1107 ! ******************************************************************************
1108 ! Start
1109 ! ******************************************************************************
1110 
1111  global => pregion%global
1112 
1113  CALL registerfunction(global,'RFLU_ReadGridWrapper',&
1114  'RFLU_ModReadWriteGrid.F90')
1115 
1116 ! ******************************************************************************
1117 ! Read grid files
1118 ! ******************************************************************************
1119 
1120 #ifdef GENX
1121  IF ( rflu_genx_decidereadfile(global) .EQV. .false. ) THEN
1122 #endif
1123  IF ( global%gridFormat == format_ascii ) THEN
1124  CALL rflu_readgridascii(pregion)
1125  ELSE IF ( global%gridFormat == format_binary ) THEN
1126  CALL rflu_readgridbinary(pregion)
1127  ELSE
1128  CALL errorstop(global,err_reached_default,__line__)
1129  END IF ! global%gridFormat
1130 #ifdef GENX
1131  ELSE
1132  CALL rflu_genx_getgrid(pregion)
1133  END IF ! RFLU_GENX_DecideReadFile
1134 #endif
1135 
1136 ! ******************************************************************************
1137 ! End
1138 ! ******************************************************************************
1139 
1140  CALL deregisterfunction(global)
1141 
1142  END SUBROUTINE rflu_readgridwrapper
1143 
1144 
1145 
1146 
1147 
1148 
1149 ! ******************************************************************************
1150 !
1151 ! Purpose: Write grid in ASCII ROCFLU format.
1152 !
1153 ! Description: None.
1154 !
1155 ! Input:
1156 ! pRegion Pointer to region
1157 !
1158 ! Output: None.
1159 !
1160 ! Notes: None.
1161 !
1162 ! ******************************************************************************
1163 
1164  SUBROUTINE rflu_writegridascii(pRegion)
1165 
1168 
1169  IMPLICIT NONE
1170 
1171 ! ******************************************************************************
1172 ! Declarations and definitions
1173 ! ******************************************************************************
1174 
1175 ! ==============================================================================
1176 ! Local variables
1177 ! ==============================================================================
1178 
1179  CHARACTER(CHRLEN) :: ifilename,sectionstring
1180  INTEGER :: errorflag,i,ifile,ipatch,j,k
1181  TYPE(t_grid), POINTER :: pgrid
1182  TYPE(t_patch), POINTER :: ppatch
1183  TYPE(t_global), POINTER :: global
1184 
1185 ! ==============================================================================
1186 ! Arguments
1187 ! ==============================================================================
1188 
1189  TYPE(t_region), POINTER :: pregion
1190 
1191 ! ******************************************************************************
1192 ! Start
1193 ! ******************************************************************************
1194 
1195  global => pregion%global
1196 
1197  CALL registerfunction(global,'RFLU_WriteGridASCII',&
1198  'RFLU_ModReadWriteGrid.F90')
1199 
1200  IF ( global%myProcid == masterproc .AND. &
1201  global%verbLevel > verbose_none ) THEN
1202  WRITE(stdout,'(A,1X,A)') solver_name,'Writing ASCII grid file...'
1203  END IF ! global%verbLevel
1204 
1205  ifile = if_grid
1206 
1207  IF ( global%flowType == flow_unsteady .AND. &
1208  (pregion%mixtInput%moveGrid .EQV. .true.) ) THEN
1209  CALL buildfilenameunsteady(global,filedest_outdir,'.grda', &
1210  pregion%iRegionGlobal,global%currentTime, &
1211  ifilename)
1212 
1213  IF ( global%myProcid == masterproc .AND. &
1214  global%verbLevel > verbose_none ) THEN
1215  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1216  pregion%iRegionGlobal
1217  WRITE(stdout,'(A,3X,A,1X,1PE11.5)') solver_name,'Current time:', &
1218  global%currentTime
1219  END IF ! global%verbLevel
1220  ELSE
1221  CALL buildfilenamebasic(global,filedest_outdir,'.grda', &
1222  pregion%iRegionGlobal,ifilename)
1223 
1224  IF ( global%myProcid == masterproc .AND. &
1225  global%verbLevel > verbose_none ) THEN
1226  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1227  pregion%iRegionGlobal
1228  END IF ! global%verbLevel
1229  END IF ! global
1230 
1231  OPEN(ifile,file=ifilename,form="FORMATTED",status="UNKNOWN", &
1232  iostat=errorflag)
1233  global%error = errorflag
1234  IF ( global%error /= err_none ) THEN
1235  CALL errorstop(global,err_file_open,__line__,ifilename)
1236  END IF ! global%error
1237 
1238 ! ==============================================================================
1239 ! Header and general information
1240 ! ==============================================================================
1241 
1242  IF ( global%myProcid == masterproc .AND. &
1243  global%verbLevel > verbose_low ) THEN
1244  WRITE(stdout,'(A,3X,A)') solver_name,'Header information...'
1245  END IF ! global%verbLevel
1246 
1247  sectionstring = '# ROCFLU grid file'
1248  WRITE(ifile,'(A)') trim(sectionstring)
1249 
1250  sectionstring = '# Precision and range'
1251  WRITE(ifile,'(A)') trim(sectionstring)
1252  WRITE(ifile,'(2(I8))') precision(1.0_rfreal),range(1.0_rfreal)
1253 
1254  sectionstring = '# Physical time'
1255  WRITE(ifile,'(A)') trim(sectionstring)
1256  WRITE(ifile,'(E23.16)') global%currentTime
1257 
1258 ! ==============================================================================
1259 ! Dimensions
1260 ! ==============================================================================
1261 
1262  pgrid => pregion%grid
1263 
1264  sectionstring = '# Dimensions'
1265  WRITE(ifile,'(A)') trim(sectionstring)
1266  WRITE(ifile,'(5(I8))') pgrid%nVertTot,pgrid%nTetsTot,pgrid%nHexsTot, &
1267  pgrid%nPrisTot,pgrid%nPyrsTot
1268 
1269 ! ==============================================================================
1270 ! Coordinates
1271 ! ==============================================================================
1272 
1273  IF ( global%myProcid == masterproc .AND. &
1274  global%verbLevel > verbose_none ) THEN
1275  WRITE(stdout,'(A,3X,A)') solver_name,'Coordinates...'
1276  END IF ! global%verbLevel
1277 
1278  sectionstring = '# Coordinates'
1279  WRITE(ifile,'(A)') trim(sectionstring)
1280  DO i = 1,3
1281  WRITE(ifile,'(5(E23.16))') (pgrid%xyz(i,j),j=1,pgrid%nVertTot)
1282  END DO ! i
1283 
1284 ! ==============================================================================
1285 ! Connectivity
1286 ! ==============================================================================
1287 
1288  IF ( pgrid%nTetsTot > 0 ) THEN
1289  IF ( global%myProcid == masterproc .AND. &
1290  global%verbLevel > verbose_none ) THEN
1291  WRITE(stdout,'(A,3X,A)') solver_name,'Tetrahedra...'
1292  END IF ! global%verbLevel
1293 
1294  sectionstring = '# Tetrahedra'
1295  WRITE(ifile,'(A)') trim(sectionstring)
1296  DO i = 1,4
1297  WRITE(ifile,'(10(I8))') (pgrid%tet2v(i,j),j=1,pgrid%nTetsTot)
1298  END DO ! i
1299  END IF ! pGrid%nTetsTot
1300 
1301  IF ( pgrid%nHexsTot > 0 ) THEN
1302  IF ( global%myProcid == masterproc .AND. &
1303  global%verbLevel > verbose_low ) THEN
1304  WRITE(stdout,'(A,3X,A)') solver_name,'Hexahedra...'
1305  END IF ! global%verbLevel
1306 
1307  sectionstring = '# Hexahedra'
1308  WRITE(ifile,'(A)') trim(sectionstring)
1309  DO i = 1,8
1310  WRITE(ifile,'(10(I8))') (pgrid%hex2v(i,j),j=1,pgrid%nHexsTot)
1311  END DO ! i
1312  END IF ! pGrid%nHexsTot
1313 
1314  IF ( pgrid%nPrisTot > 0 ) THEN
1315  IF ( global%myProcid == masterproc .AND. &
1316  global%verbLevel > verbose_low ) THEN
1317  WRITE(stdout,'(A,3X,A)') solver_name,'Prisms...'
1318  END IF ! global%verbLevel
1319 
1320  sectionstring = '# Prisms'
1321  WRITE(ifile,'(A)') trim(sectionstring)
1322  DO i = 1,6
1323  WRITE(ifile,'(10(I8))') (pgrid%pri2v(i,j),j=1,pgrid%nPrisTot)
1324  END DO ! i
1325  END IF ! pGrid%nPrisTot
1326 
1327  IF ( pgrid%nPyrsTot > 0 ) THEN
1328  IF ( global%myProcid == masterproc .AND. &
1329  global%verbLevel > verbose_low ) THEN
1330  WRITE(stdout,'(A,3X,A)') solver_name,'Pyramids...'
1331  END IF ! global%verbLevel
1332 
1333  sectionstring = '# Pyramids'
1334  WRITE(ifile,'(A)') trim(sectionstring)
1335  DO i = 1,5
1336  WRITE(ifile,'(10(I8))') (pgrid%pyr2v(i,j),j=1,pgrid%nPyrsTot)
1337  END DO ! i
1338  END IF ! pGrid%nPyrsTot
1339 
1340 ! ==============================================================================
1341 ! Boundary information
1342 ! ==============================================================================
1343 
1344  IF ( global%myProcid == masterproc .AND. &
1345  global%verbLevel > verbose_low ) THEN
1346  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary information...'
1347  END IF ! global%verbLevel
1348 
1349  sectionstring = '# Boundaries (v2)'
1350  WRITE(ifile,'(A)') trim(sectionstring)
1351  WRITE(ifile,'(I8)') pgrid%nPatches
1352 
1353  DO ipatch = 1,pgrid%nPatches
1354  ppatch => pregion%patches(ipatch)
1355 
1356  WRITE(ifile,'(3(I8))') ppatch%nBTrisTot,ppatch%nBQuadsTot, &
1357  ppatch%nBCellsVirt
1358 
1359  IF ( ppatch%nBTrisTot > 0 ) THEN
1360  DO j = 1,3
1361  WRITE(ifile,'(10(I8))') (ppatch%bTri2v(j,k),k=1,ppatch%nBTrisTot)
1362  END DO ! j
1363  END IF ! pPatch%nBTrisTot
1364 
1365  IF ( ppatch%nBQuadsTot > 0 ) THEN
1366  DO j = 1,4
1367  WRITE(ifile,'(10(I8))') (ppatch%bQuad2v(j,k),k=1,ppatch%nBQuadsTot)
1368  END DO ! j
1369  END IF ! pPatch%nBQuadsTot
1370 
1371  IF ( ppatch%nBCellsVirt > 0 ) THEN
1372  WRITE(ifile,'(10(I8))') (ppatch%bvc(k),k=1,ppatch%nBCellsVirt)
1373  END IF ! pPatch%nBCellsVirt
1374  END DO ! iPatch
1375 
1376 ! ==============================================================================
1377 ! End marker
1378 ! ==============================================================================
1379 
1380  IF ( global%myProcid == masterproc .AND. &
1381  global%verbLevel > verbose_low ) THEN
1382  WRITE(stdout,'(A,3X,A)') solver_name,'End marker...'
1383  END IF ! global%verbLevel
1384 
1385  sectionstring = '# End'
1386  WRITE(ifile,'(A)') trim(sectionstring)
1387 
1388 ! ==============================================================================
1389 ! Close file
1390 ! ==============================================================================
1391 
1392  CLOSE(ifile,iostat=errorflag)
1393  global%error = errorflag
1394  IF ( global%myProcid == masterproc .AND. &
1395  global%error /= err_none ) THEN
1396  CALL errorstop(global,err_file_close,__line__,ifilename)
1397  END IF ! global%error
1398 
1399 ! ******************************************************************************
1400 ! End
1401 ! ******************************************************************************
1402 
1403  IF ( global%myProcid == masterproc .AND. &
1404  global%verbLevel > verbose_none ) THEN
1405  WRITE(stdout,'(A,1X,A)') solver_name,'Writing ASCII grid file done.'
1406  END IF ! global%verbLevel
1407 
1408  CALL deregisterfunction(global)
1409 
1410  END SUBROUTINE rflu_writegridascii
1411 
1412 
1413 
1414 
1415 
1416 
1417 
1418 ! ******************************************************************************
1419 !
1420 ! Purpose: Write grid in binary ROCFLU format.
1421 !
1422 ! Description: None.
1423 !
1424 ! Input:
1425 ! pRegion Pointer to region
1426 !
1427 ! Output: None.
1428 !
1429 ! Notes: None.
1430 !
1431 ! ******************************************************************************
1432 
1433  SUBROUTINE rflu_writegridbinary(pRegion)
1434 
1437 
1438  IMPLICIT NONE
1439 
1440 ! ******************************************************************************
1441 ! Declarations and definitions
1442 ! ******************************************************************************
1443 
1444 ! ==============================================================================
1445 ! Local variables
1446 ! ==============================================================================
1447 
1448  CHARACTER(CHRLEN) :: ifilename,sectionstring
1449  INTEGER :: errorflag,i,ifile,ipatch,j,k
1450  TYPE(t_grid), POINTER :: pgrid
1451  TYPE(t_patch), POINTER :: ppatch
1452  TYPE(t_global), POINTER :: global
1453 
1454 ! ==============================================================================
1455 ! Arguments
1456 ! ==============================================================================
1457 
1458  TYPE(t_region), POINTER :: pregion
1459 
1460 ! ******************************************************************************
1461 ! Start
1462 ! ******************************************************************************
1463 
1464  global => pregion%global
1465 
1466  CALL registerfunction(global,'RFLU_WriteGridBinary',&
1467  'RFLU_ModReadWriteGrid.F90')
1468 
1469  IF ( global%myProcid == masterproc .AND. &
1470  global%verbLevel > verbose_none ) THEN
1471  WRITE(stdout,'(A,1X,A)') solver_name,'Writing binary grid file...'
1472  END IF ! global%verbLevel
1473 
1474  ifile = if_grid
1475 
1476  IF ( global%flowType == flow_unsteady .AND. &
1477  (pregion%mixtInput%moveGrid .EQV. .true.) ) THEN
1478  CALL buildfilenameunsteady(global,filedest_outdir,'.grd', &
1479  pregion%iRegionGlobal,global%currentTime, &
1480  ifilename)
1481 
1482  IF ( global%myProcid == masterproc .AND. &
1483  global%verbLevel > verbose_none ) THEN
1484  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1485  pregion%iRegionGlobal
1486  WRITE(stdout,'(A,3X,A,1X,1PE11.5)') solver_name,'Current time:', &
1487  global%currentTime
1488  END IF ! global%verbLevel
1489  ELSE
1490  CALL buildfilenamebasic(global,filedest_outdir,'.grd', &
1491  pregion%iRegionGlobal,ifilename)
1492 
1493  IF ( global%myProcid == masterproc .AND. &
1494  global%verbLevel > verbose_none ) THEN
1495  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1496  pregion%iRegionGlobal
1497  END IF ! global%verbLevel
1498  END IF ! global
1499 
1500  OPEN(ifile,file=ifilename,form="UNFORMATTED",status="UNKNOWN", &
1501  iostat=errorflag)
1502  global%error = errorflag
1503  IF ( global%error /= err_none ) THEN
1504  CALL errorstop(global,err_file_open,__line__,ifilename)
1505  END IF ! global%error
1506 
1507 ! ==============================================================================
1508 ! Header and general information
1509 ! ==============================================================================
1510 
1511  IF ( global%myProcid == masterproc .AND. &
1512  global%verbLevel > verbose_low ) THEN
1513  WRITE(stdout,'(A,3X,A)') solver_name,'Header information...'
1514  END IF ! global%verbLevel
1515 
1516  sectionstring = '# ROCFLU grid file'
1517  WRITE(ifile) sectionstring
1518 
1519  sectionstring = '# Precision and range'
1520  WRITE(ifile) sectionstring
1521  WRITE(ifile) precision(1.0_rfreal),range(1.0_rfreal)
1522 
1523  sectionstring = '# Physical time'
1524  WRITE(ifile) sectionstring
1525  WRITE(ifile) global%currentTime
1526 
1527 ! ==============================================================================
1528 ! Dimensions
1529 ! ==============================================================================
1530 
1531  pgrid => pregion%grid
1532 
1533  sectionstring = '# Dimensions'
1534  WRITE(ifile) sectionstring
1535  WRITE(ifile) pgrid%nVertTot,pgrid%nTetsTot,pgrid%nHexsTot,pgrid%nPrisTot, &
1536  pgrid%nPyrsTot
1537 
1538 ! ==============================================================================
1539 ! Coordinates
1540 ! ==============================================================================
1541 
1542  IF ( global%myProcid == masterproc .AND. &
1543  global%verbLevel > verbose_none ) THEN
1544  WRITE(stdout,'(A,3X,A)') solver_name,'Coordinates...'
1545  END IF ! global%verbLevel
1546 
1547  sectionstring = '# Coordinates'
1548  WRITE(ifile) sectionstring
1549  DO i = 1,3
1550  WRITE(ifile) (pgrid%xyz(i,j),j=1,pgrid%nVertTot)
1551  END DO ! i
1552 
1553 ! ==============================================================================
1554 ! Connectivity
1555 ! ==============================================================================
1556 
1557  IF ( pgrid%nTetsTot > 0 ) THEN
1558  IF ( global%myProcid == masterproc .AND. &
1559  global%verbLevel > verbose_none ) THEN
1560  WRITE(stdout,'(A,3X,A)') solver_name,'Tetrahedra...'
1561  END IF ! global%verbLevel
1562 
1563  sectionstring = '# Tetrahedra'
1564  WRITE(ifile) sectionstring
1565  DO i = 1,4
1566  WRITE(ifile) (pgrid%tet2v(i,j),j=1,pgrid%nTetsTot)
1567  END DO ! i
1568  END IF ! pGrid%nTetsTot
1569 
1570  IF ( pgrid%nHexsTot > 0 ) THEN
1571  IF ( global%myProcid == masterproc .AND. &
1572  global%verbLevel > verbose_low ) THEN
1573  WRITE(stdout,'(A,3X,A)') solver_name,'Hexahedra...'
1574  END IF ! global%verbLevel
1575 
1576  sectionstring = '# Hexahedra'
1577  WRITE(ifile) sectionstring
1578  DO i = 1,8
1579  WRITE(ifile) (pgrid%hex2v(i,j),j=1,pgrid%nHexsTot)
1580  END DO ! i
1581  END IF ! pGrid%nHexsTot
1582 
1583  IF ( pgrid%nPrisTot > 0 ) THEN
1584  IF ( global%myProcid == masterproc .AND. &
1585  global%verbLevel > verbose_low ) THEN
1586  WRITE(stdout,'(A,3X,A)') solver_name,'Prisms...'
1587  END IF ! global%verbLevel
1588 
1589  sectionstring = '# Prisms'
1590  WRITE(ifile) sectionstring
1591  DO i = 1,6
1592  WRITE(ifile) (pgrid%pri2v(i,j),j=1,pgrid%nPrisTot)
1593  END DO ! i
1594  END IF ! pGrid%nPrisTot
1595 
1596  IF ( pgrid%nPyrsTot > 0 ) THEN
1597  IF ( global%myProcid == masterproc .AND. &
1598  global%verbLevel > verbose_low ) THEN
1599  WRITE(stdout,'(A,3X,A)') solver_name,'Pyramids...'
1600  END IF ! global%verbLevel
1601 
1602  sectionstring = '# Pyramids'
1603  WRITE(ifile) sectionstring
1604  DO i = 1,5
1605  WRITE(ifile) (pgrid%pyr2v(i,j),j=1,pgrid%nPyrsTot)
1606  END DO ! i
1607  END IF ! pGrid%nPyrsTot
1608 
1609 ! ==============================================================================
1610 ! Boundary information
1611 ! ==============================================================================
1612 
1613  IF ( global%myProcid == masterproc .AND. &
1614  global%verbLevel > verbose_low ) THEN
1615  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary information...'
1616  END IF ! global%verbLevel
1617 
1618  sectionstring = '# Boundaries (v2)'
1619  WRITE(ifile) sectionstring
1620  WRITE(ifile) pgrid%nPatches
1621 
1622  DO ipatch = 1,pgrid%nPatches
1623  ppatch => pregion%patches(ipatch)
1624 
1625  WRITE(ifile) ppatch%nBTrisTot,ppatch%nBQuadsTot,ppatch%nBCellsVirt
1626 
1627  IF ( ppatch%nBTrisTot > 0 ) THEN
1628  DO j = 1,3
1629  WRITE(ifile) (ppatch%bTri2v(j,k),k=1,ppatch%nBTrisTot)
1630  END DO ! pPatch%nBTrisTot
1631  END IF ! bound
1632 
1633  IF ( ppatch%nBQuadsTot > 0 ) THEN
1634  DO j = 1,4
1635  WRITE(ifile) (ppatch%bQuad2v(j,k),k=1,ppatch%nBQuadsTot)
1636  END DO ! j
1637  END IF ! pPatch%nBQuadsTot
1638 
1639  IF ( ppatch%nBCellsVirt > 0 ) THEN
1640  WRITE(ifile) (ppatch%bvc(k),k=1,ppatch%nBCellsVirt)
1641  END IF ! pPatch%nBCellsVirt
1642  END DO ! iPatch
1643 
1644 ! ==============================================================================
1645 ! End marker
1646 ! ==============================================================================
1647 
1648  IF ( global%myProcid == masterproc .AND. &
1649  global%verbLevel > verbose_low ) THEN
1650  WRITE(stdout,'(A,3X,A)') solver_name,'End marker...'
1651  END IF ! global%verbLevel
1652 
1653  sectionstring = '# End'
1654  WRITE(ifile) sectionstring
1655 
1656 ! ==============================================================================
1657 ! Close file
1658 ! ==============================================================================
1659 
1660  CLOSE(ifile,iostat=errorflag)
1661  global%error = errorflag
1662  IF ( global%myProcid == masterproc .AND. &
1663  global%error /= err_none ) THEN
1664  CALL errorstop(global,err_file_close,__line__,ifilename)
1665  END IF ! global%error
1666 
1667 ! ******************************************************************************
1668 ! End
1669 ! ******************************************************************************
1670 
1671  IF ( global%myProcid == masterproc .AND. &
1672  global%verbLevel > verbose_none ) THEN
1673  WRITE(stdout,'(A,1X,A)') solver_name,'Writing binary grid file done.'
1674  END IF ! global%verbLevel
1675 
1676  CALL deregisterfunction(global)
1677 
1678  END SUBROUTINE rflu_writegridbinary
1679 
1680 
1681 
1682 
1683 
1684 
1685 ! ******************************************************************************
1686 !
1687 ! Purpose: Wrapper for writing of grid files in ROCFLU format.
1688 !
1689 ! Description: None.
1690 !
1691 ! Input:
1692 ! pRegion Pointer to region
1693 !
1694 ! Output: None.
1695 !
1696 ! Notes: None.
1697 !
1698 ! ******************************************************************************
1699 
1700  SUBROUTINE rflu_writegridwrapper(pRegion)
1701 
1702 #ifdef GENX
1705 #endif
1706 
1707  IMPLICIT NONE
1708 
1709 ! ******************************************************************************
1710 ! Declarations and definitions
1711 ! ******************************************************************************
1712 
1713 ! ==============================================================================
1714 ! Local variables
1715 ! ==============================================================================
1716 
1717  TYPE(t_global), POINTER :: global
1718 
1719 ! ==============================================================================
1720 ! Arguments
1721 ! ==============================================================================
1722 
1723  TYPE(t_region), POINTER :: pregion
1724 
1725 ! ******************************************************************************
1726 ! Start
1727 ! ******************************************************************************
1728 
1729  global => pregion%global
1730 
1731  CALL registerfunction(global,'RFLU_WriteGridWrapper',&
1732  'RFLU_ModReadWriteGrid.F90')
1733 
1734 ! ******************************************************************************
1735 ! Read solution files
1736 ! ******************************************************************************
1737 
1738 #ifdef GENX
1739  IF ( rflu_genx_decidewritefile(global) .EQV. .false. ) THEN
1740 #endif
1741  IF ( global%gridFormat == format_ascii ) THEN
1742  CALL rflu_writegridascii(pregion)
1743  ELSE IF ( global%gridFormat == format_binary ) THEN
1744  CALL rflu_writegridbinary(pregion)
1745  ELSE
1746  CALL errorstop(global,err_reached_default,__line__)
1747  END IF ! global%gridFormat
1748 #ifdef GENX
1749  ELSE
1750  CALL rflu_genx_putgrid(pregion)
1751  END IF ! RFLU_GENX_DecideReadFile
1752 #endif
1753 
1754 ! ******************************************************************************
1755 ! End
1756 ! ******************************************************************************
1757 
1758  CALL deregisterfunction(global)
1759 
1760  END SUBROUTINE rflu_writegridwrapper
1761 
1762 
1763 
1764 
1765 
1766 
1767 ! ******************************************************************************
1768 ! End
1769 ! ******************************************************************************
1770 
1771 END MODULE rflu_modreadwritegrid
1772 
1773 
1774 ! ******************************************************************************
1775 !
1776 ! RCS Revision history:
1777 !
1778 ! $Log: RFLU_ModReadWriteGrid.F90,v $
1779 ! Revision 1.10 2008/12/06 08:44:23 mtcampbe
1780 ! Updated license.
1781 !
1782 ! Revision 1.9 2008/11/19 22:17:34 mtcampbe
1783 ! Added Illinois Open Source License/Copyright
1784 !
1785 ! Revision 1.8 2006/04/07 15:19:20 haselbac
1786 ! Removed tabs
1787 !
1788 ! Revision 1.7 2006/03/30 20:50:14 haselbac
1789 ! Added CASEs for backward compatibility
1790 !
1791 ! Revision 1.6 2006/03/25 21:55:41 haselbac
1792 ! Changes bcos of sype patches
1793 !
1794 ! Revision 1.5 2005/09/14 15:53:03 haselbac
1795 ! Bug fix: Now get proper time printed when reading/writing mv grid
1796 !
1797 ! Revision 1.4 2005/05/03 03:05:30 haselbac
1798 ! Bug fix in reading/writing of binary/ASCII files
1799 !
1800 ! Revision 1.3 2004/11/03 17:04:06 haselbac
1801 ! Removed IO of vertex and cell flags, and code related to HACK_PERIODIC
1802 !
1803 ! Revision 1.2 2004/10/19 19:28:27 haselbac
1804 ! Adapted to changes in GENX logic, rm r/w of bv and gs
1805 !
1806 ! Revision 1.1 2004/07/06 15:14:31 haselbac
1807 ! Initial revision
1808 !
1809 ! ******************************************************************************
1810 
1811 
1812 
1813 
1814 
1815 
1816 
1817 
1818 
1819 
1820 
1821 
unsigned char r() const
Definition: Color.h:68
subroutine buildfilenamebasic(global, dest, ext, id, fileName)
j indices k indices k
Definition: Indexing.h:6
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_readgridwrapper(pRegion)
subroutine, public rflu_genx_getgrid(pRegion)
subroutine rflu_readgridascii(pRegion)
blockLoc i
Definition: read.cpp:79
**********************************************************************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
LOGICAL function, public rflu_genx_decidereadfile(global)
subroutine, public rflu_writegridwrapper(pRegion)
j indices j
Definition: Indexing.h:6
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469
subroutine, public rflu_genx_putgrid(pRegion)
subroutine rflu_writegridascii(pRegion)
subroutine rflu_readgridbinary(pRegion)
subroutine rflu_writegridbinary(pRegion)
LOGICAL function, public rflu_genx_decidewritefile(global)
subroutine buildfilenameunsteady(global, dest, ext, id, tm, fileName)