Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModCENTAUR.F90
Go to the documentation of this file.
1 ! *********************************************************************
2 ! * Rocstar Simulation Suite *
3 ! * Copyright@2015, Illinois Rocstar LLC. All rights reserved. *
4 ! * *
5 ! * Illinois Rocstar LLC *
6 ! * Champaign, IL *
7 ! * www.illinoisrocstar.com *
8 ! * sales@illinoisrocstar.com *
9 ! * *
10 ! * License: See LICENSE file in top level of distribution package or *
11 ! * http://opensource.org/licenses/NCSA *
12 ! *********************************************************************
13 ! *********************************************************************
14 ! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *
15 ! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *
16 ! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *
17 ! * NONINFRINGEMENT. IN NO EVENT SHALL THE CONTRIBUTORS OR *
18 ! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
19 ! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, *
20 ! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE *
21 ! * USE OR OTHER DEALINGS WITH THE SOFTWARE. *
22 ! *********************************************************************
23 ! ******************************************************************************
24 !
25 ! Purpose: Collection of routines to read and convert CENTAUR grids.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModCENTAUR.F90,v 1.4 2008/12/06 08:45:03 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 modgrid, ONLY: t_grid
46  USE modbndpatch, ONLY: t_patch
47  USE moddatastruct, ONLY: t_region
48  USE modmpi
49 
51 
52  IMPLICIT NONE
53 
54 ! ******************************************************************************
55 ! Declarations and definitions
56 ! ******************************************************************************
57 
58  PRIVATE
59 
60 ! ==============================================================================
61 ! Data
62 ! ==============================================================================
63 
64  CHARACTER(CHRLEN) :: &
65  RCSIdentString = '$RCSfile: RFLU_ModCENTAUR.F90,v $ $Revision: 1.4 $'
66 
68  INTEGER :: nBQuads,nBTris
69  INTEGER, DIMENSION(:,:), POINTER :: bInfo,bTri2v,bQuad2v
70  CHARACTER(CHRLEN) :: title
71  CHARACTER(CHRLEN), DIMENSION(:), POINTER :: bName
72  END TYPE t_gridcentaur
73 
74  TYPE(t_gridcentaur) :: gridCENTAUR
75 
76 ! ==============================================================================
77 ! Public procedures
78 ! ==============================================================================
79 
80  PUBLIC :: rflu_convcentaur2rocflu, &
83 
84 ! ******************************************************************************
85 ! Routines
86 ! ******************************************************************************
87 
88  CONTAINS
89 
90 
91 
92 
93 
94 
95 ! ******************************************************************************
96 !
97 ! Purpose: Check connectivity.
98 !
99 ! Description: None.
100 !
101 ! Input:
102 ! pRegion Pointer to region
103 !
104 ! Output: None.
105 !
106 ! Notes: None.
107 !
108 ! ******************************************************************************
109 
110  SUBROUTINE rflu_checkgridcentaur(pRegion)
111 
112  IMPLICIT NONE
113 
114 ! ******************************************************************************
115 ! Declarations and definitions
116 ! ******************************************************************************
117 
118 ! ==============================================================================
119 ! Arguments
120 ! ==============================================================================
121 
122  TYPE(t_region), POINTER :: pregion
123 
124 ! ==============================================================================
125 ! Local variables
126 ! ==============================================================================
127 
128  INTEGER :: errorflag,cvmax,cvmin
129  TYPE(t_grid), POINTER :: pgrid
130  TYPE(t_global), POINTER :: global
131 
132 ! ******************************************************************************
133 ! Start
134 ! ******************************************************************************
135 
136  global => pregion%global
137 
138  CALL registerfunction(global,'RFLU_CheckGridCENTAUR', &
139  'RFLU_ModCENTAUR.F90')
140 
141  IF ( global%verbLevel > verbose_none ) THEN
142  WRITE(stdout,'(A,3X,A)') solver_name, &
143  'Checking connectivity arrays...'
144  END IF ! global%verbLevel
145 
146 ! ******************************************************************************
147 ! Set grid pointer
148 ! ******************************************************************************
149 
150  pgrid => pregion%grid
151 
152 ! ******************************************************************************
153 ! Volume grid
154 ! ******************************************************************************
155 
156  IF ( global%verbLevel > verbose_none ) THEN
157  WRITE(stdout,'(A,5X,A)') solver_name, &
158  'Volume grid...'
159  END IF ! global%verbLevel
160 
161 ! ==============================================================================
162 ! Tetrahedra
163 ! ==============================================================================
164 
165  IF ( pgrid%nTetsTot > 0 ) THEN
166  cvmin = minval(pgrid%tet2v(1:4,1:pgrid%nTetsTot))
167  cvmax = maxval(pgrid%tet2v(1:4,1:pgrid%nTetsTot))
168 
169  IF ( pgrid%nTetsTot == pgrid%nCellsTot ) THEN
170  IF ( cvmin /= 1 .OR. cvmax /= pgrid%nVertTot ) THEN
171  global%error = err_vertex_number
172  END IF ! cvmin
173  ELSE
174  IF ( cvmin < 1 .OR. cvmax > pgrid%nVertTot ) THEN
175  global%error = err_vertex_number
176  END IF ! vmin
177  END IF ! cvmin
178 
179  IF ( global%error /= err_none ) THEN
180  IF ( global%verbLevel > verbose_none ) THEN
181  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
182  END IF ! global%verbLevel
183  CALL errorstop(global,global%error,__line__)
184  END IF ! global%error
185  END IF ! pGrid
186 
187 ! ==============================================================================
188 ! Hexahedra
189 ! ==============================================================================
190 
191  IF ( pgrid%nHexsTot > 0 ) THEN
192  cvmin = minval(pgrid%hex2v(1:8,1:pgrid%nHexsTot))
193  cvmax = maxval(pgrid%hex2v(1:8,1:pgrid%nHexsTot))
194 
195  IF ( pgrid%nHexsTot == pgrid%nCellsTot ) THEN
196  IF ( cvmin /= 1 .OR. cvmax /= pgrid%nVertTot ) THEN
197  global%error = err_vertex_number
198  END IF ! cvmin
199  ELSE
200  IF ( cvmin < 1 .OR. cvmax > pgrid%nVertTot ) THEN
201  global%error = err_vertex_number
202  END IF ! vmin
203  END IF ! cvmin
204 
205  IF ( global%error /= err_none ) THEN
206  IF ( global%verbLevel > verbose_none ) THEN
207  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
208  END IF ! global%verbLevel
209  CALL errorstop(global,global%error,__line__)
210  END IF ! global%error
211  END IF ! pGrid
212 
213 ! ==============================================================================
214 ! Prisms
215 ! ==============================================================================
216 
217  IF ( pgrid%nPrisTot > 0 ) THEN
218  cvmin = minval(pgrid%pri2v(1:6,1:pgrid%nPrisTot))
219  cvmax = maxval(pgrid%pri2v(1:6,1:pgrid%nPrisTot))
220 
221  IF ( pgrid%nPrisTot == pgrid%nCellsTot ) THEN
222  IF ( cvmin /= 1 .OR. cvmax /= pgrid%nVertTot ) THEN
223  global%error = err_vertex_number
224  END IF ! cvmin
225  ELSE
226  IF ( cvmin < 1 .OR. cvmax > pgrid%nVertTot ) THEN
227  global%error = err_vertex_number
228  END IF ! vmin
229  END IF ! cvmin
230 
231  IF ( global%error /= err_none ) THEN
232  IF ( global%verbLevel > verbose_none ) THEN
233  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
234  END IF ! global%verbLevel
235  CALL errorstop(global,global%error,__line__)
236  END IF ! global%error
237  END IF ! pGrid
238 
239 ! ==============================================================================
240 ! Pyramids
241 ! ==============================================================================
242 
243  IF ( pgrid%nPyrsTot > 0 ) THEN
244  cvmin = minval(pgrid%pyr2v(1:5,1:pgrid%nPyrsTot))
245  cvmax = maxval(pgrid%pyr2v(1:5,1:pgrid%nPyrsTot))
246 
247  IF ( pgrid%nPyrsTot == pgrid%nCellsTot ) THEN
248  IF ( cvmin /= 1 .OR. cvmax /= pgrid%nVertTot ) THEN
249  global%error = err_vertex_number
250  END IF ! cvmin
251  ELSE
252  IF ( cvmin < 1 .OR. cvmax > pgrid%nVertTot ) THEN
253  global%error = err_vertex_number
254  END IF ! vmin
255  END IF ! cvmin
256 
257  IF ( global%error /= err_none ) THEN
258  IF ( global%verbLevel > verbose_none ) THEN
259  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
260  END IF ! global%verbLevel
261  CALL errorstop(global,global%error,__line__)
262  END IF ! global%error
263  END IF ! pGrid
264 
265 ! ******************************************************************************
266 ! Surface grid
267 ! ******************************************************************************
268 
269  IF ( global%verbLevel > verbose_none ) THEN
270  WRITE(stdout,'(A,5X,A)') solver_name,'Surface grid...'
271  END IF ! global%verbLevel
272 
273  IF ( gridcentaur%nBTris > 0 ) THEN
274  cvmin = minval(gridcentaur%bTri2v(:,:))
275  cvmax = maxval(gridcentaur%bTri2v(:,:))
276 
277  IF ( cvmin < 1 .OR. cvmax > pgrid%nVertTot ) THEN
278  global%error = err_vertex_number
279  END IF ! cvmin
280 
281  IF ( global%error /= err_none ) THEN
282  IF ( global%verbLevel > verbose_none ) THEN
283  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
284  END IF ! global%verbLevel
285  CALL errorstop(global,global%error,__line__)
286  END IF ! global%error
287  END IF ! gridCENTAUR
288 
289  IF ( gridcentaur%nBQuads > 0 ) THEN
290  cvmin = minval(gridcentaur%bQuad2v(:,:))
291  cvmax = maxval(gridcentaur%bQuad2v(:,:))
292 
293  IF ( cvmin < 1 .OR. cvmax > pgrid%nVertTot ) THEN
294  global%error = err_vertex_number
295  END IF ! cvmin
296 
297  IF ( global%error /= err_none ) THEN
298  IF ( global%verbLevel > verbose_none ) THEN
299  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
300  END IF ! global%verbLevel
301  CALL errorstop(global,global%error,__line__)
302  END IF ! global%error
303  END IF ! gridCENTAUR
304 
305 ! ******************************************************************************
306 ! End
307 ! ******************************************************************************
308 
309  IF ( global%verbLevel > verbose_none ) THEN
310  WRITE(stdout,'(A,3X,A)') solver_name, &
311  'Checking connectivity arrays done.'
312  END IF ! global%verbLevel
313 
314  CALL deregisterfunction(global)
315 
316  END SUBROUTINE rflu_checkgridcentaur
317 
318 
319 
320 
321 
322 ! ******************************************************************************
323 !
324 ! Purpose: Convert grid format from CENTAUR to ROCFLU.
325 !
326 ! Description: None.
327 !
328 ! Input:
329 ! pRegion Pointer to region
330 !
331 ! Output: None.
332 !
333 ! Notes:
334 ! 1. bcName from CENTAUR file is discarded. It is NOT transferred to the
335 ! Rocflu data structure, instead, the name is read from the bc file.
336 ! 2. IMPORTANT: If empty patches are detected (the case for multi-zone grids
337 ! when hybconvert is instructed to ignore the interzone boundary), these
338 ! are deleted automatically. This means that the number of patches changes
339 ! and hence the mapping of boundary conditions to boundary patches changes
340 ! also. Therefore if empty patches were eliminated, the user will have to
341 ! edit the boundary-condition file accordingly.
342 !
343 ! ******************************************************************************
344 
345  SUBROUTINE rflu_convcentaur2rocflu(pRegion)
346 
347  IMPLICIT NONE
348 
349 ! ******************************************************************************
350 ! Declarations and definitions
351 ! ******************************************************************************
352 
353 ! ==============================================================================
354 ! Arguments
355 ! ==============================================================================
356 
357  TYPE(t_region), POINTER :: pregion
358 
359 ! ==============================================================================
360 ! Local variables
361 ! ==============================================================================
362 
363  INTEGER :: errorflag,ifl,ipatch,ipatch2,iqbeg,iqend,itbeg,itend,nbquads, &
364  nbtris,npatchesold
365  TYPE(t_grid), POINTER :: pgrid
366  TYPE(t_patch), POINTER :: ppatch
367  TYPE(t_global), POINTER :: global
368 
369 ! ******************************************************************************
370 ! Start
371 ! ******************************************************************************
372 
373  global => pregion%global
374 
375  CALL registerfunction(global,'RFLU_ConvCENTAUR2ROCFLU', &
376  'RFLU_ModCENTAUR.F90')
377 
378  IF ( global%verbLevel > verbose_none ) THEN
379  WRITE(stdout,'(A,1X,A)') solver_name, &
380  'Converting from CENTAUR to ROCFLU format...'
381  END IF ! global%verbLevel
382 
383 ! ==============================================================================
384 ! Set grid pointer and initialize variables
385 ! ==============================================================================
386 
387  pgrid => pregion%grid
388 
389  pgrid%nEdges = 0
390  pgrid%nEdgesTot = 0
391 
392  pgrid%nFaces = 0
393  pgrid%nFacesTot = 0
394 
395 ! ==============================================================================
396 ! Check for and eliminate empty patches. NOTE: boundary names are not copied
397 ! and the user must adjust the boundary-condition file if empty patches were
398 ! indeed eliminated...
399 ! ==============================================================================
400 
401  npatchesold = pgrid%nPatches
402 
403  ipatch = 0
404 
405  IF ( pgrid%nPatches > 0 ) THEN
406  ipatch = ipatch + 1
407 
408  DO ipatch2 = 1,npatchesold
409  IF ( ipatch2 /= 1 ) THEN
410  itbeg = gridcentaur%bInfo(2,ipatch2-1) + 1
411  iqbeg = gridcentaur%bInfo(3,ipatch2-1) + 1
412  ELSE
413  itbeg = 1
414  iqbeg = 1
415  END IF ! iPatch
416 
417  itend = gridcentaur%bInfo(2,ipatch2)
418  iqend = gridcentaur%bInfo(3,ipatch2)
419 
420  nbtris = itend - itbeg + 1
421  nbquads = iqend - iqbeg + 1
422 
423  IF ( (nbtris + nbquads) /= 0 ) THEN
424  gridcentaur%bInfo(1,ipatch) = gridcentaur%bInfo(1,ipatch2)
425  gridcentaur%bInfo(2,ipatch) = gridcentaur%bInfo(2,ipatch2)
426  gridcentaur%bInfo(3,ipatch) = gridcentaur%bInfo(3,ipatch2)
427 
428  ipatch = ipatch + 1
429  ELSE
430  WRITE(stdout,'(A,3X,A,1X,I3,1X,A)') solver_name, &
431  '*** WARNING *** Patch',ipatch2,'is empty and will be deleted!'
432 
433  pgrid%nPatches = pgrid%nPatches - 1
434  END IF ! nBTris
435  END DO ! iPatch2
436  END IF ! pGrid%nPatches
437 
438 ! ==============================================================================
439 ! Convert patch data structure
440 ! ==============================================================================
441 
442  global%nPatches = pgrid%nPatches
443 
444  IF ( pgrid%nPatches > 0 ) THEN
445  ALLOCATE(pregion%patches(pgrid%nPatches),stat=errorflag)
446  global%error = errorflag
447  IF ( global%error /= err_none ) THEN
448  CALL errorstop(global,err_allocate,__line__,'pRegion%patches')
449  END IF ! global%error
450 
451  DO ipatch = 1,pgrid%nPatches
452  ppatch => pregion%patches(ipatch)
453 
454  ppatch%bcType = gridcentaur%bInfo(1,ipatch)
455 
456  ppatch%iPatchGlobal = ipatch
457  ppatch%iBorder = patch_iborder_default
458  ppatch%renumFlag = .false.
459 
460  IF ( ipatch /= 1 ) THEN
461  itbeg = gridcentaur%bInfo(2,ipatch-1) + 1
462  iqbeg = gridcentaur%bInfo(3,ipatch-1) + 1
463  ELSE
464  itbeg = 1
465  iqbeg = 1
466  END IF ! iPatch
467 
468  itend = gridcentaur%bInfo(2,ipatch)
469  iqend = gridcentaur%bInfo(3,ipatch)
470 
471  ppatch%nBTrisTot = itend - itbeg + 1
472  ppatch%nBQuadsTot = iqend - iqbeg + 1
473  ppatch%nBVertTot = 0
474 
475  ppatch%nBTris = ppatch%nBTrisTot
476  ppatch%nBQuads = ppatch%nBQuadsTot
477  ppatch%nBVert = ppatch%nBVertTot
478 
479  ppatch%nBFacesTot = ppatch%nBTrisTot + ppatch%nBQuadsTot
480  ppatch%nBFaces = ppatch%nBFacesTot
481 
482  ppatch%nBTrisMax = rflu_setmaxdimension(global,ppatch%nBTrisTot)
483  ppatch%nBQuadsMax = rflu_setmaxdimension(global,ppatch%nBQuadsTot)
484  ppatch%nBVertMax = rflu_setmaxdimension(global,ppatch%nBVertTot)
485 
486  ppatch%nBFacesMax = rflu_setmaxdimension(global,ppatch%nBFacesTot)
487 
488  ppatch%nBCellsVirt = 0
489 
490  IF ( ppatch%nBTrisMax > 0 ) THEN
491  ALLOCATE(ppatch%bTri2v(3,ppatch%nBTrisMax),stat=errorflag)
492  global%error = errorflag
493  IF ( global%error /= err_none ) THEN
494  CALL errorstop(global,err_allocate,__line__,'pPatch%bTri2v')
495  END IF ! global%error
496  ELSE
497  nullify(ppatch%bTri2v)
498  END IF ! pPatch%nBTrisMax
499 
500  IF ( ppatch%nBTrisTot > 0 ) THEN
501  ppatch%bTri2v(1:3,1:ppatch%nBTrisTot) = &
502  gridcentaur%bTri2v(1:3,itbeg:itend)
503  END IF ! pPatch
504 
505  IF ( ppatch%nBQuadsMax > 0 ) THEN
506  ALLOCATE(ppatch%bQuad2v(4,ppatch%nBQuadsMax),stat=errorflag)
507  global%error = errorflag
508  IF ( global%error /= err_none ) THEN
509  CALL errorstop(global,err_allocate,__line__,'pPatch%bQuad2v')
510  END IF ! global%error
511  ELSE
512  nullify(ppatch%bQuad2v)
513  END IF ! pPatch%nBQuadsMax
514 
515  IF ( ppatch%nBQuadsTot > 0 ) THEN
516  ppatch%bQuad2v(1:4,1:ppatch%nBQuadsTot) = &
517  gridcentaur%bQuad2v(1:4,iqbeg:iqend)
518  END IF ! pPatch
519  END DO ! iPatch
520  END IF ! pGrid%nPatches
521 
522 ! ==============================================================================
523 ! Compute number of faces on each patch and set patch quantities
524 ! ==============================================================================
525 
526  DO ipatch = 1,pgrid%nPatches
527  ppatch => pregion%patches(ipatch)
528 
529  ppatch%nBFacesTot = ppatch%nBTrisTot + ppatch%nBQuadsTot
530 
531  ppatch%nBFaces = ppatch%nBFacesTot
532  ppatch%nBQuads = ppatch%nBQuadsTot
533  ppatch%nBTris = ppatch%nBTrisTot
534  ppatch%nBVert = ppatch%nBVertTot
535 
536  ppatch%nBFacesMax = rflu_setmaxdimension(global,ppatch%nBFacesTot)
537  END DO ! iPatch
538 
539 ! ==============================================================================
540 ! Check that number of triangular and quadrilateral faces correct and set
541 ! number of boundary faces
542 ! ==============================================================================
543 
544  nbtris = 0
545  nbquads = 0
546 
547  DO ipatch = 1,pgrid%nPatches
548  ppatch => pregion%patches(ipatch)
549 
550  nbtris = nbtris + ppatch%nBTris
551  nbquads = nbquads + ppatch%nBQuads
552  END DO ! iPatch
553 
554  IF ( nbtris /= gridcentaur%nBTris .OR. &
555  nbquads /= gridcentaur%nBQuads ) THEN
556  CALL errorstop(global,err_nbfaces_wrong,__line__)
557  END IF ! nBTris
558 
559  pgrid%nBFaces = nbtris + nbquads
560  pgrid%nBFacesTot = pgrid%nBFaces
561 
562 ! ******************************************************************************
563 ! Deallocate CENTAUR memory
564 ! ******************************************************************************
565 
566  IF ( pgrid%nPatches > 0 ) THEN
567  IF ( gridcentaur%nBTris > 0 ) THEN
568  DEALLOCATE(gridcentaur%bTri2v,stat=errorflag)
569  global%error = errorflag
570  IF ( global%error /= err_none ) THEN
571  CALL errorstop(global,err_deallocate,__line__,'gridCENTAUR%bTri2v')
572  END IF ! global%error
573  END IF ! gridCENTAUR
574 
575  IF ( gridcentaur%nBQuads > 0 ) THEN
576  DEALLOCATE(gridcentaur%bQuad2v,stat=errorflag)
577  global%error = errorflag
578  IF ( global%error /= err_none ) THEN
579  CALL errorstop(global,err_deallocate,__line__,'gridCENTAUR%bQuad2v')
580  END IF ! global%error
581  END IF ! gridCENTAUR
582 
583  DEALLOCATE(gridcentaur%bInfo,stat=errorflag)
584  global%error = errorflag
585  IF ( global%error /= err_none ) THEN
586  CALL errorstop(global,err_deallocate,__line__,'gridCENTAUR%bInfo')
587  END IF ! global%error
588 
589  DEALLOCATE(gridcentaur%bName,stat=errorflag)
590  global%error = errorflag
591  IF ( global%error /= err_none ) THEN
592  CALL errorstop(global,err_deallocate,__line__,'gridCENTAUR%bName')
593  END IF ! global%error
594  END IF ! pGrid%nPatches
595 
596 ! *****************************************************************************
597 ! Allocate memory for boundary face lists bf2c and bf2v
598 ! *****************************************************************************
599 
600  DO ipatch = 1,pgrid%nPatches
601  ppatch => pregion%patches(ipatch)
602 
603  ALLOCATE(ppatch%bf2c(ppatch%nBFacesMax),stat=errorflag)
604  global%error = errorflag
605  IF ( global%error /= err_none ) THEN
606  CALL errorstop(global,err_allocate,__line__,'pPatch%bf2c')
607  END IF ! global%error
608 
609  ALLOCATE(ppatch%bf2v(4,ppatch%nBFacesMax),stat=errorflag)
610  global%error = errorflag
611  IF ( global%error /= err_none ) THEN
612  CALL errorstop(global,err_allocate,__line__,'pPatch%bf2v')
613  END IF ! global%error
614 
615  DO ifl = 1,ppatch%nBFacesMax
616  ppatch%bf2v(1,ifl) = vert_none
617  ppatch%bf2v(2,ifl) = vert_none
618  ppatch%bf2v(3,ifl) = vert_none
619  ppatch%bf2v(4,ifl) = vert_none
620  END DO ! ifl
621  END DO ! iPatch
622 
623 ! ******************************************************************************
624 ! End
625 ! ******************************************************************************
626 
627  IF ( global%verbLevel > verbose_none ) THEN
628  WRITE(stdout,'(A,1X,A)') solver_name, &
629  'Converting from CENTAUR to ROCFLU format done.'
630  END IF ! global%verbLevel
631 
632  CALL deregisterfunction(global)
633 
634  END SUBROUTINE rflu_convcentaur2rocflu
635 
636 
637 
638 
639 
640 
641 
642 ! *******************************************************************************
643 !
644 ! Purpose: Print CENTAUR grid information.
645 !
646 ! Description: None.
647 !
648 ! Input:
649 ! pRegion Pointer to region
650 !
651 ! Output: None.
652 !
653 ! Notes: None.
654 !
655 ! *******************************************************************************
656 
657  SUBROUTINE rflu_printgridcentaurinfo(pRegion)
658 
659  IMPLICIT NONE
660 
661 ! ******************************************************************************
662 ! Declarations and definitions
663 ! ******************************************************************************
664 
665 ! ==============================================================================
666 ! Arguments
667 ! ==============================================================================
668 
669  TYPE(t_region), POINTER :: pregion
670 
671 ! ==============================================================================
672 ! Locals
673 ! ==============================================================================
674 
675  TYPE(t_grid), POINTER :: pgrid
676 
677 ! ******************************************************************************
678 ! Start, set grid pointer
679 ! ******************************************************************************
680 
681  pgrid => pregion%grid
682 
683 ! ******************************************************************************
684 ! Write information
685 ! ******************************************************************************
686 
687  WRITE(stdout,'(A,3X,A)') solver_name,'Grid Statistics:'
688  WRITE(stdout,'(A,5X,A,2X,I9)') solver_name,'Vertices: ', &
689  pgrid%nVertTot
690  WRITE(stdout,'(A,5X,A,2X,I9)') solver_name,'Cells: ', &
691  pgrid%nCellsTot
692  WRITE(stdout,'(A,7X,A,I9)') solver_name,'Tetrahedra: ', &
693  pgrid%nTetsTot
694  WRITE(stdout,'(A,7X,A,I9)') solver_name,'Hexahedra: ', &
695  pgrid%nHexsTot
696  WRITE(stdout,'(A,7X,A,I9)') solver_name,'Prisms: ', &
697  pgrid%nPrisTot
698  WRITE(stdout,'(A,7X,A,I9)') solver_name,'Pyramids: ', &
699  pgrid%nPyrsTot
700  WRITE(stdout,'(A,5X,A,2X,I9)') solver_name,'Patches: ', &
701  pgrid%nPatches
702 
703  IF ( pgrid%nPatches > 0 ) THEN
704  WRITE(stdout,'(A,5X,A,2X,I9)') solver_name,'Patch faces: ', &
705  gridcentaur%bInfo(2,pgrid%nPatches) &
706  + gridcentaur%bInfo(3,pgrid%nPatches)
707  WRITE(stdout,'(A,7X,A,I9)') solver_name,'Triangles: ', &
708  gridcentaur%bInfo(2,pgrid%nPatches)
709  WRITE(stdout,'(A,7X,A,I9)') solver_name,'Quadrilaterals: ', &
710  gridcentaur%bInfo(3,pgrid%nPatches)
711  END IF ! pGrid%nPatches
712 
713 ! ******************************************************************************
714 ! End
715 ! ******************************************************************************
716 
717  END SUBROUTINE rflu_printgridcentaurinfo
718 
719 
720 
721 
722 
723 
724 
725 
726 ! *******************************************************************************
727 !
728 ! Purpose: Read grid file from CENTAUR in ASCII format.
729 !
730 ! Description: None.
731 !
732 ! Input:
733 ! pRegion Pointer to region
734 !
735 ! Output: None.
736 !
737 ! Notes: None.
738 !
739 ! *******************************************************************************
740 
741  SUBROUTINE rflu_readgridcentaurascii(pRegion)
742 
744 
746 
747  IMPLICIT NONE
748 
749 ! ******************************************************************************
750 ! Declarations and definitions
751 ! ******************************************************************************
752 
753 ! ==============================================================================
754 ! Arguments
755 ! ==============================================================================
756 
757  TYPE(t_region), POINTER :: pregion
758 
759 ! ==============================================================================
760 ! Local variables
761 ! ==============================================================================
762 
763  CHARACTER(CHRLEN) :: ifilename
764  INTEGER :: dummyinteger,errorflag,i,ifile,j
765  TYPE(t_grid), POINTER :: pgrid
766  TYPE(t_global), POINTER :: global
767 
768 ! ******************************************************************************
769 ! Start, open file and read title
770 ! ******************************************************************************
771 
772  global => pregion%global
773 
774  CALL registerfunction(global,'RFLU_ReadGridCENTAURASCII', &
775  'RFLU_ModCENTAUR.F90')
776 
777  IF ( global%verbLevel > verbose_none ) THEN
778  WRITE(stdout,'(A,1X,A)') solver_name,'Reading ASCII CENTAUR grid file...'
779  END IF ! global%verbLevel
780 
781  ifile = if_grid
782 
783  CALL buildfilenameplain(global,filedest_indir,'.hyb.asc',ifilename)
784 
785  OPEN(ifile,file=ifilename,form="FORMATTED",status="OLD",iostat=errorflag)
786  global%error = errorflag
787  IF ( global%error /= err_none ) THEN
788  CALL errorstop(global,err_file_open,__line__,ifilename)
789  END IF
790 
791  READ(ifile,'(A80)') gridcentaur%title
792 
793 ! ==============================================================================
794 ! Coordinates
795 ! ==============================================================================
796 
797  pgrid => pregion%grid
798 
799  READ(ifile,'(I8)') pgrid%nVertTot
800 
801  pgrid%nVertMax = rflu_setmaxdimension(global,pgrid%nVertTot)
802 
803  ALLOCATE(pgrid%xyz(3,pgrid%nVertMax),stat=errorflag)
804  global%error = errorflag
805  IF ( global%error /= err_none ) THEN
806  CALL errorstop(global,err_allocate,__line__,'grid%xyz')
807  END IF ! global%error
808 
809  IF ( global%verbLevel > verbose_none ) THEN
810  WRITE(stdout,'(A,3X,A)') solver_name,'Coordinates...'
811  END IF ! global%verbLevel
812 
813  DO i = 1,3
814  READ(ifile,'(5E16.9)') (pgrid%xyz(i,j),j=1,pgrid%nVertTot)
815  END DO ! i
816 
817  READ(ifile,'(10I8)') (dummyinteger,i=1,pgrid%nVertTot)
818 
819 ! ==============================================================================
820 ! Cell connectivity
821 ! ==============================================================================
822 
823  READ(ifile,'(I8)') pgrid%nTetsTot
824 
825  pgrid%nTetsMax = rflu_setmaxdimension(global,pgrid%nTetsTot)
826 
827  IF ( pgrid%nTetsMax > 0 ) THEN
828  ALLOCATE(pgrid%tet2v(4,pgrid%nTetsMax),stat=errorflag)
829  global%error = errorflag
830  IF ( global%error /= err_none ) THEN
831  CALL errorstop(global,err_allocate,__line__,'pGrid%tet2v')
832  END IF ! global%error
833  ELSE
834  nullify(pgrid%tet2v)
835  END IF ! pGrid%nTetsMax
836 
837  IF ( pgrid%nTetsTot > 0 ) THEN
838  IF ( global%verbLevel > verbose_none ) THEN
839  WRITE(stdout,'(A,3X,A)') solver_name,'Tetrahedra...'
840  END IF ! global%verbLevel
841 
842  DO i = 1,4
843  READ(ifile,'(10I8)') (pgrid%tet2v(i,j),j=1,pgrid%nTetsTot)
844  END DO ! i
845 
846  READ(ifile,'(10I8)') (dummyinteger,i=1,pgrid%nTetsTot)
847  END IF ! pGrid%nTetsTot
848 
849 
850  READ(ifile,'(I8)') pgrid%nHexsTot
851 
852  pgrid%nHexsMax = rflu_setmaxdimension(global,pgrid%nHexsTot)
853 
854  IF ( pgrid%nHexsMax > 0 ) THEN
855  ALLOCATE(pgrid%hex2v(8,pgrid%nHexsMax),stat=errorflag)
856  global%error = errorflag
857  IF ( global%error /= err_none ) THEN
858  CALL errorstop(global,err_allocate,__line__,'pGrid%hex2v')
859  END IF ! global%error
860  ELSE
861  nullify(pgrid%hex2v)
862  END IF ! pGrid%nHexsMax
863 
864  IF ( pgrid%nHexsTot > 0 ) THEN
865  IF ( global%verbLevel > verbose_none ) THEN
866  WRITE(stdout,'(A,3X,A)') solver_name,'Hexahedra...'
867  END IF ! global%verbLevel
868 
869  DO i = 1,8
870  READ(ifile,'(10I8)') (pgrid%hex2v(i,j),j=1,pgrid%nHexsTot)
871  END DO ! i
872 
873  READ(ifile,'(10I8)') (dummyinteger,i=1,pgrid%nHexsTot)
874  END IF ! pGrid%nHexsTot
875 
876 
877  READ(ifile,'(I8)') pgrid%nPrisTot
878 
879  pgrid%nPrisMax = rflu_setmaxdimension(global,pgrid%nPrisTot)
880 
881  IF ( pgrid%nPrisMax > 0 ) THEN
882  ALLOCATE(pgrid%pri2v(6,pgrid%nPrisMax),stat=errorflag)
883  global%error = errorflag
884  IF ( global%error /= err_none ) THEN
885  CALL errorstop(global,err_allocate,__line__,'pGrid%pri2v')
886  END IF ! global%error
887  ELSE
888  nullify(pgrid%pri2v)
889  END IF ! pGrid%nPrisMax
890 
891  IF ( pgrid%nPrisTot > 0 ) THEN
892  IF ( global%verbLevel > verbose_none ) THEN
893  WRITE(stdout,'(A,3X,A)') solver_name,'Prisms...'
894  END IF ! global%verbLevel
895 
896  DO i = 1,6
897  READ(ifile,'(10I8)') (pgrid%pri2v(i,j),j=1,pgrid%nPrisTot)
898  END DO ! i
899 
900  READ(ifile,'(10I8)') (dummyinteger,i=1,pgrid%nPrisTot)
901  END IF ! pGrid%nPrisTot
902 
903 
904  READ(ifile,'(I8)') pgrid%nPyrsTot
905 
906  pgrid%nPyrsMax = rflu_setmaxdimension(global,pgrid%nPyrsTot)
907 
908  IF ( pgrid%nPyrsMax > 0 ) THEN
909  ALLOCATE(pgrid%pyr2v(5,pgrid%nPyrsMax),stat=errorflag)
910  global%error = errorflag
911  IF ( global%error /= err_none ) THEN
912  CALL errorstop(global,err_allocate,__line__,'pGrid%pyr2v')
913  END IF ! global%error
914  ELSE
915  nullify(pgrid%pyr2v)
916  END IF ! pGrid%nPyrsMax
917 
918  IF ( pgrid%nPyrsTot > 0 ) THEN
919  IF ( global%verbLevel > verbose_none ) THEN
920  WRITE(stdout,'(A,3X,A)') solver_name,'Pyramids...'
921  END IF ! global%verbLevel
922 
923  DO i = 1,5
924  READ(ifile,'(10I8)') (pgrid%pyr2v(i,j),j=1,pgrid%nPyrsTot)
925  END DO ! i
926 
927  READ(ifile,'(10I8)') (dummyinteger,i=1,pgrid%nPyrsTot)
928  END IF ! pGrid%nPyrsTot
929 
930 ! ******************************************************************************
931 ! Set grid size variables
932 ! ******************************************************************************
933 
934  pgrid%nCellsTot = pgrid%nTetsTot + pgrid%nHexsTot + pgrid%nPrisTot &
935  + pgrid%nPyrsTot
936  pgrid%nCellsMax = rflu_setmaxdimension(global,pgrid%nCellsTot)
937 
938  pgrid%nVert = pgrid%nVertTot
939  pgrid%nCells = pgrid%nCellsTot
940  pgrid%nTets = pgrid%nTetsTot
941  pgrid%nHexs = pgrid%nHexsTot
942  pgrid%nPris = pgrid%nPrisTot
943  pgrid%nPyrs = pgrid%nPyrsTot
944 
945 ! ==============================================================================
946 ! Boundary types
947 ! ==============================================================================
948 
949  IF ( global%verbLevel > verbose_none ) THEN
950  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary information...'
951  END IF ! global%verbLevel
952 
953  READ(ifile,'(I8)') pgrid%nPatches
954 
955  IF ( pgrid%nPatches > 0 ) THEN
956  ALLOCATE(gridcentaur%bInfo(3,pgrid%nPatches),stat=errorflag)
957  global%error = errorflag
958  IF ( global%error /= err_none ) THEN
959  CALL errorstop(global,err_allocate,__line__,'gridCENTAUR%bInfo')
960  END IF ! global%error
961 
962  DO i = 1,3
963  READ(ifile,'(10I8)') (gridcentaur%bInfo(i,j),j=1,pgrid%nPatches)
964  END DO ! i
965 
966  ALLOCATE(gridcentaur%bName(pgrid%nPatches),stat=errorflag)
967  global%error = errorflag
968  IF ( global%error /= err_none ) THEN
969  CALL errorstop(global,err_allocate,__line__,'gridCENTAUR%bName')
970  END IF ! global%error
971 
972  READ(ifile,'(A80)') (gridcentaur%bName(i),i=1,pgrid%nPatches)
973  END IF ! pGrid%nPatches
974 
975 ! ==============================================================================
976 ! Boundary face connectivity
977 ! ==============================================================================
978 
979  IF ( pgrid%nPatches > 0 ) THEN
980  READ(ifile,'(I8)') gridcentaur%nBTris
981 
982  IF ( gridcentaur%nBTris > 0 ) THEN
983  ALLOCATE(gridcentaur%bTri2v(3,gridcentaur%nBTris),stat=errorflag)
984  global%error = errorflag
985  IF ( global%error /= err_none ) THEN
986  CALL errorstop(global,err_allocate,__line__,'gridCENTAUR%bTri2v')
987  END IF ! global%error
988 
989  IF ( global%verbLevel > verbose_none ) THEN
990  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary triangles...'
991  END IF ! global%verbLevel
992 
993  DO i = 1,3
994  READ(ifile,'(10I8)') (gridcentaur%bTri2v(i,j), &
995  j=1,gridcentaur%nBTris)
996  END DO ! i
997  END IF ! gridCENTAUR
998 
999  READ(ifile,'(I8)') gridcentaur%nBQuads
1000 
1001  IF ( gridcentaur%nBQuads > 0 ) THEN
1002  ALLOCATE(gridcentaur%bQuad2v(4,gridcentaur%nBQuads),stat=errorflag)
1003  global%error = errorflag
1004  IF ( global%error /= err_none ) THEN
1005  CALL errorstop(global,err_allocate,__line__,'gridCENTAUR%bQuad2v')
1006  END IF ! global%error
1007 
1008  IF ( global%verbLevel > verbose_none ) THEN
1009  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary quadrilaterals...'
1010  END IF ! global%verbLevel
1011 
1012  DO i = 1,4
1013  READ(ifile,'(10I8)') (gridcentaur%bQuad2v(i,j), &
1014  j=1,gridcentaur%nBQuads)
1015  END DO ! i
1016  END IF ! gridCENTAUR
1017  ELSE
1018  gridcentaur%nBTris = 0
1019  gridcentaur%nBQuads = 0
1020  END IF ! pGrid%nPatches
1021 
1022 ! ******************************************************************************
1023 ! Check validity of connectivity arrays
1024 ! ******************************************************************************
1025 
1026  IF ( global%checkLevel > check_none ) THEN
1027  CALL rflu_checkgridcentaur(pregion)
1028  END IF ! global%checkLevel
1029 
1030 ! ******************************************************************************
1031 ! Print grid statistics
1032 ! ******************************************************************************
1033 
1034  IF ( global%verbLevel > verbose_none ) THEN
1035  CALL rflu_printgridcentaurinfo(pregion)
1036  END IF ! global%verbLevel
1037 
1038 ! ******************************************************************************
1039 ! Close file
1040 ! ******************************************************************************
1041 
1042  CLOSE(ifile, iostat=errorflag)
1043  global%error = errorflag
1044  IF ( global%error /= err_none ) THEN
1045  CALL errorstop(global,err_file_close,__line__,ifilename)
1046  END IF ! global%error
1047 
1048 ! ******************************************************************************
1049 ! End
1050 ! ******************************************************************************
1051 
1052  IF ( global%verbLevel > verbose_none ) THEN
1053  WRITE(stdout,'(A,1X,A)') solver_name, &
1054  'Reading ASCII CENTAUR grid file done.'
1055  END IF ! global%verbLevel
1056 
1057  CALL deregisterfunction(global)
1058 
1059  END SUBROUTINE rflu_readgridcentaurascii
1060 
1061 
1062 
1063 
1064 
1065 
1066 
1067 ! *******************************************************************************
1068 !
1069 ! Purpose: Read grid file from CENTAUR in binary 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_readgridcentaurbinary(pRegion)
1083 
1085 
1086  IMPLICIT NONE
1087 
1088 ! ******************************************************************************
1089 ! Declarations and definitions
1090 ! ******************************************************************************
1091 
1092 ! ==============================================================================
1093 ! Arguments
1094 ! ==============================================================================
1095 
1096  TYPE(t_region), POINTER :: pregion
1097 
1098 ! ==============================================================================
1099 ! Local variables
1100 ! ==============================================================================
1101 
1102  CHARACTER(CHRLEN) :: ifilename
1103  INTEGER :: dummyinteger,errorflag,i,ifile,j
1104  TYPE(t_grid), POINTER :: pgrid
1105  TYPE(t_global), POINTER :: global
1106 
1107 ! ******************************************************************************
1108 ! Start, open file and read title
1109 ! ******************************************************************************
1110 
1111  global => pregion%global
1112 
1113  CALL registerfunction(global,'RFLU_ReadGridCENTAURBinary', &
1114  'RFLU_ModCENTAUR.F90')
1115 
1116  IF ( global%verbLevel > verbose_none ) THEN
1117  WRITE(stdout,'(A,1X,A)') solver_name,'Reading binary CENTAUR grid file...'
1118  END IF ! global%verbLevel
1119 
1120  ifile = if_grid
1121 
1122  CALL buildfilenameplain(global,filedest_indir,'.hyb.bin',ifilename)
1123 
1124  OPEN(ifile,file=ifilename,form="UNFORMATTED",status="OLD",iostat=errorflag)
1125  global%error = errorflag
1126  IF ( global%error /= err_none ) THEN
1127  CALL errorstop(global,err_file_open,__line__,ifilename)
1128  END IF
1129 
1130  READ(ifile) gridcentaur%title
1131 
1132 ! ==============================================================================
1133 ! Coordinates
1134 ! ==============================================================================
1135 
1136  pgrid => pregion%grid
1137 
1138  READ(ifile) pgrid%nVertTot
1139 
1140  pgrid%nVertMax = rflu_setmaxdimension(global,pgrid%nVertTot)
1141 
1142  ALLOCATE(pgrid%xyz(3,pgrid%nVertMax),stat=errorflag)
1143  global%error = errorflag
1144  IF ( global%error /= err_none ) THEN
1145  CALL errorstop(global,err_allocate,__line__,'grid%xyz')
1146  END IF ! global%error
1147 
1148  IF ( global%verbLevel > verbose_none ) THEN
1149  WRITE(stdout,'(A,3X,A)') solver_name,'Coordinates...'
1150  END IF ! global%verbLevel
1151 
1152  READ(ifile) ((pgrid%xyz(i,j),j=1,pgrid%nVertTot),i=1,3)
1153  READ(ifile) (dummyinteger,i=1,pgrid%nVertTot)
1154 
1155 ! ==============================================================================
1156 ! Cell connectivity
1157 ! ==============================================================================
1158 
1159  READ(ifile) pgrid%nTetsTot
1160 
1161  pgrid%nTetsMax = rflu_setmaxdimension(global,pgrid%nTetsTot)
1162 
1163  IF ( pgrid%nTetsMax > 0 ) THEN
1164  ALLOCATE(pgrid%tet2v(4,pgrid%nTetsMax),stat=errorflag)
1165  global%error = errorflag
1166  IF ( global%error /= err_none ) THEN
1167  CALL errorstop(global,err_allocate,__line__,'pGrid%tet2v')
1168  END IF ! global%error
1169  ELSE
1170  nullify(pgrid%tet2v)
1171  END IF ! pGrid%nTetsMax
1172 
1173  IF ( pgrid%nTetsTot > 0 ) THEN
1174  IF ( global%verbLevel > verbose_none ) THEN
1175  WRITE(stdout,'(A,3X,A)') solver_name,'Tetrahedra...'
1176  END IF ! global%verbLevel
1177 
1178  READ(ifile) ((pgrid%tet2v(i,j),j=1,pgrid%nTetsTot),i=1,4)
1179 
1180  READ(ifile) (dummyinteger,i=1,pgrid%nTetsTot)
1181  END IF ! pGrid%nTetsTot
1182 
1183 
1184  READ(ifile) pgrid%nHexsTot
1185 
1186  pgrid%nHexsMax = rflu_setmaxdimension(global,pgrid%nHexsTot)
1187 
1188  IF ( pgrid%nHexsMax > 0 ) THEN
1189  ALLOCATE(pgrid%hex2v(8,pgrid%nHexsMax),stat=errorflag)
1190  global%error = errorflag
1191  IF ( global%error /= err_none ) THEN
1192  CALL errorstop(global,err_allocate,__line__,'pGrid%hex2v')
1193  END IF ! global%error
1194  ELSE
1195  nullify(pgrid%hex2v)
1196  END IF ! pGrid%nHexsMax
1197 
1198  IF ( pgrid%nHexsTot > 0 ) THEN
1199  IF ( global%verbLevel > verbose_none ) THEN
1200  WRITE(stdout,'(A,3X,A)') solver_name,'Hexahedra...'
1201  END IF ! global%verbLevel
1202 
1203  READ(ifile) ((pgrid%hex2v(i,j),j=1,pgrid%nHexsTot),i=1,8)
1204 
1205  READ(ifile) (dummyinteger,i=1,pgrid%nHexsTot)
1206  END IF ! pGrid%nHexsTot
1207 
1208 
1209  READ(ifile) pgrid%nPrisTot
1210 
1211  pgrid%nPrisMax = rflu_setmaxdimension(global,pgrid%nPrisTot)
1212 
1213  IF ( pgrid%nPrisMax > 0 ) THEN
1214  ALLOCATE(pgrid%pri2v(6,pgrid%nPrisMax),stat=errorflag)
1215  global%error = errorflag
1216  IF ( global%error /= err_none ) THEN
1217  CALL errorstop(global,err_allocate,__line__,'pGrid%pri2v')
1218  END IF ! global%error
1219  ELSE
1220  nullify(pgrid%pri2v)
1221  END IF ! pGrid%nPrisMax
1222 
1223  IF ( pgrid%nPrisTot > 0 ) THEN
1224  IF ( global%verbLevel > verbose_none ) THEN
1225  WRITE(stdout,'(A,3X,A)') solver_name,'Prisms...'
1226  END IF ! global%verbLevel
1227 
1228  READ(ifile) ((pgrid%pri2v(i,j),j=1,pgrid%nPrisTot),i=1,6)
1229 
1230  READ(ifile) (dummyinteger,i=1,pgrid%nPrisTot)
1231  END IF ! pGrid%nPrisTot
1232 
1233 
1234  READ(ifile) pgrid%nPyrsTot
1235 
1236  pgrid%nPyrsMax = rflu_setmaxdimension(global,pgrid%nPyrsTot)
1237 
1238  IF ( pgrid%nPyrsMax > 0 ) THEN
1239  ALLOCATE(pgrid%pyr2v(5,pgrid%nPyrsMax),stat=errorflag)
1240  global%error = errorflag
1241  IF ( global%error /= err_none ) THEN
1242  CALL errorstop(global,err_allocate,__line__,'pGrid%pyr2v')
1243  END IF ! global%error
1244  ELSE
1245  nullify(pgrid%pyr2v)
1246  END IF ! pGrid%nPyrsMax
1247 
1248  IF ( pgrid%nPyrsTot > 0 ) THEN
1249  IF ( global%verbLevel > verbose_none ) THEN
1250  WRITE(stdout,'(A,3X,A)') solver_name,'Pyramids...'
1251  END IF ! global%verbLevel
1252 
1253  READ(ifile) ((pgrid%pyr2v(i,j),j=1,pgrid%nPyrsTot),i=1,5)
1254 
1255  READ(ifile) (dummyinteger,i=1,pgrid%nPyrsTot)
1256  END IF ! pGrid%nPyrsTot
1257 
1258 ! ******************************************************************************
1259 ! Set grid size variables
1260 ! ******************************************************************************
1261 
1262  pgrid%nCellsTot = pgrid%nTetsTot + pgrid%nHexsTot + pgrid%nPrisTot &
1263  + pgrid%nPyrsTot
1264 
1265  pgrid%nVert = pgrid%nVertTot
1266  pgrid%nCells = pgrid%nCellsTot
1267  pgrid%nTets = pgrid%nTetsTot
1268  pgrid%nHexs = pgrid%nHexsTot
1269  pgrid%nPris = pgrid%nPrisTot
1270  pgrid%nPyrs = pgrid%nPyrsTot
1271 
1272 ! ==============================================================================
1273 ! Boundary types
1274 ! ==============================================================================
1275 
1276  IF ( global%verbLevel > verbose_none ) THEN
1277  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary information...'
1278  END IF ! global%verbLevel
1279 
1280  READ(ifile) pgrid%nPatches
1281 
1282  IF ( pgrid%nPatches > 0 ) THEN
1283  ALLOCATE(gridcentaur%bInfo(3,pgrid%nPatches),stat=errorflag)
1284  global%error = errorflag
1285  IF ( global%error /= err_none ) THEN
1286  CALL errorstop(global,err_allocate,__line__,'gridCENTAUR%bInfo')
1287  END IF ! global%error
1288 
1289  READ(ifile) ((gridcentaur%bInfo(i,j),j=1,pgrid%nPatches),i=1,3)
1290 
1291  ALLOCATE(gridcentaur%bName(pgrid%nPatches),stat=errorflag)
1292  global%error = errorflag
1293  IF ( global%error /= err_none ) THEN
1294  CALL errorstop(global,err_allocate,__line__,'gridCENTAUR%bName')
1295  END IF ! global%error
1296 
1297  READ(ifile) (gridcentaur%bName(i),i=1,pgrid%nPatches)
1298  END IF ! pGrid%nPatches
1299 
1300 ! ==============================================================================
1301 ! Boundary face connectivity
1302 ! ==============================================================================
1303 
1304  IF ( pgrid%nPatches > 0 ) THEN
1305  READ(ifile) gridcentaur%nBTris
1306 
1307  IF ( gridcentaur%nBTris > 0 ) THEN
1308  ALLOCATE(gridcentaur%bTri2v(3,gridcentaur%nBTris),stat=errorflag)
1309  global%error = errorflag
1310  IF ( global%error /= err_none ) THEN
1311  CALL errorstop(global,err_allocate,__line__,'gridCENTAUR%bTri2v')
1312  END IF ! global%error
1313 
1314  IF ( global%verbLevel > verbose_none ) THEN
1315  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary triangles...'
1316  END IF ! global%verbLevel
1317 
1318  READ(ifile) ((gridcentaur%bTri2v(i,j),j=1,gridcentaur%nBTris),i=1,3)
1319  END IF ! gridCENTAUR
1320 
1321  READ(ifile) gridcentaur%nBQuads
1322 
1323  IF ( gridcentaur%nBQuads > 0 ) THEN
1324  ALLOCATE(gridcentaur%bQuad2v(4,gridcentaur%nBQuads),stat=errorflag)
1325  global%error = errorflag
1326  IF ( global%error /= err_none ) THEN
1327  CALL errorstop(global,err_allocate,__line__,'gridCENTAUR%bQuad2v')
1328  END IF ! global%error
1329 
1330  IF ( global%verbLevel > verbose_none ) THEN
1331  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary quadrilaterals...'
1332  END IF ! global%verbLevel
1333 
1334  READ(ifile) ((gridcentaur%bQuad2v(i,j),j=1,gridcentaur%nBQuads),i=1,4)
1335  END IF ! gridCENTAUR
1336  ELSE
1337  gridcentaur%nBTris = 0
1338  gridcentaur%nBQuads = 0
1339  END IF ! pGrid%nPatches
1340 
1341 ! ******************************************************************************
1342 ! Check validity of connectivity arrays
1343 ! ******************************************************************************
1344 
1345  IF ( global%checkLevel > check_none ) THEN
1346  CALL rflu_checkgridcentaur(pregion)
1347  END IF ! global%checkLevel
1348 
1349 ! ******************************************************************************
1350 ! Print grid statistics
1351 ! ******************************************************************************
1352 
1353  IF ( global%verbLevel > verbose_none ) THEN
1354  CALL rflu_printgridcentaurinfo(pregion)
1355  END IF ! global%verbLevel
1356 
1357 ! ******************************************************************************
1358 ! Close file
1359 ! ******************************************************************************
1360 
1361  CLOSE(ifile, iostat=errorflag)
1362  global%error = errorflag
1363  IF ( global%error /= err_none ) THEN
1364  CALL errorstop(global,err_file_close,__line__,ifilename)
1365  END IF ! global%error
1366 
1367 ! ******************************************************************************
1368 ! End
1369 ! ******************************************************************************
1370 
1371  IF ( global%verbLevel > verbose_none ) THEN
1372  WRITE(stdout,'(A,1X,A)') solver_name, &
1373  'Reading binary CENTAUR grid file done.'
1374  END IF ! global%verbLevel
1375 
1376  CALL deregisterfunction(global)
1377 
1378  END SUBROUTINE rflu_readgridcentaurbinary
1379 
1380 
1381 
1382 
1383 
1384 
1385 ! ******************************************************************************
1386 ! End
1387 ! ******************************************************************************
1388 
1389 
1390 END MODULE rflu_modcentaur
1391 
1392 ! ******************************************************************************
1393 !
1394 ! RCS Revision history:
1395 !
1396 ! $Log: RFLU_ModCENTAUR.F90,v $
1397 ! Revision 1.4 2008/12/06 08:45:03 mtcampbe
1398 ! Updated license.
1399 !
1400 ! Revision 1.3 2008/11/19 22:18:13 mtcampbe
1401 ! Added Illinois Open Source License/Copyright
1402 !
1403 ! Revision 1.2 2006/03/25 22:04:28 haselbac
1404 ! Changes because of sype patches
1405 !
1406 ! Revision 1.1 2005/04/15 15:09:06 haselbac
1407 ! Initial revision
1408 !
1409 ! Revision 1.4 2005/01/20 14:54:56 haselbac
1410 ! Added setting of nBFaces and nBFacesTot
1411 !
1412 ! Revision 1.3 2004/11/03 17:09:24 haselbac
1413 ! Removed setting of vertex and cell flags
1414 !
1415 ! Revision 1.2 2004/10/19 19:31:02 haselbac
1416 ! Removed renumbering of bface lists, cosmetics
1417 !
1418 ! Revision 1.1 2004/07/06 15:15:46 haselbac
1419 ! Initial revision
1420 !
1421 ! ******************************************************************************
1422 
1423 
1424 
1425 
1426 
1427 
1428 
1429 
1430 
1431 
subroutine, public rflu_sype_setsypepatchesflag(global)
subroutine rflu_checkgridcentaur(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_convcentaur2rocflu(pRegion)
subroutine buildfilenameplain(global, dest, ext, fileName)
blockLoc i
Definition: read.cpp:79
subroutine, public rflu_readgridcentaurascii(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)
j indices j
Definition: Indexing.h:6
subroutine, public rflu_readgridcentaurbinary(pRegion)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine rflu_printgridcentaurinfo(pRegion)
subroutine deregisterfunction(global)
Definition: ModError.F90:469