Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModGAMBIT.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 GAMBIT grids.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModGAMBIT.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 
39 MODULE rflu_modgambit
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 
50  USE rflu_modgrid
51 
52  USE modbuildfilenames, ONLY: buildfilenameplain
53 
54  USE rflu_moddimensions, ONLY: rflu_setmaxdimension
55 
56  IMPLICIT NONE
57 
58 ! ******************************************************************************
59 ! Declarations and definitions
60 ! ******************************************************************************
61 
62  PRIVATE
63 
64 ! ==============================================================================
65 ! Data
66 ! ==============================================================================
67 
68  TYPE t_patchgambit
69  INTEGER :: bcType,nFaces
70  INTEGER, DIMENSION(:), POINTER :: bf2ct,bf2cgi,bf2fli
71  END TYPE t_patchgambit
72 
73  TYPE t_gridgambit
74  CHARACTER(CHRLEN) :: title
75  INTEGER :: MTYP,NDFCD,NDFVL,NDP,NELGP,NFLAGS,NGP,NGRPS,NTYPE
76  INTEGER :: nMappings,nPatches
77  INTEGER, DIMENSION(:), POINTER :: ct
78  INTEGER, DIMENSION(:,:), POINTER :: c2v,patch2bc
79  TYPE(t_patchgambit), DIMENSION(:), POINTER :: patches
80  END TYPE t_gridgambit
81 
82  CHARACTER(CHRLEN) :: &
83  RCSIdentString = '$RCSfile: RFLU_ModGAMBIT.F90,v $ $Revision: 1.4 $'
84 
85 ! ------------------------------------------------------------------------------
86 ! GAMBIT element types
87 ! ------------------------------------------------------------------------------
88 
89  INTEGER, PARAMETER :: GAMBIT_NTYPE_EDGE = 1, &
90  GAMBIT_NTYPE_QUAD = 2, &
91  GAMBIT_NTYPE_TRI = 3, &
92  GAMBIT_NTYPE_HEX = 4, &
93  GAMBIT_NTYPE_PRI = 5, &
94  GAMBIT_NTYPE_TET = 6, &
95  GAMBIT_NTYPE_PYR = 7
96 
97 ! ------------------------------------------------------------------------------
98 ! Mapping of GAMBIT face local to cell to corresponding ROCFLU face
99 ! ------------------------------------------------------------------------------
100 
101  INTEGER, DIMENSION(4), PARAMETER :: f2fTetGAMBIT = (/4,1,2,3/)
102  INTEGER, DIMENSION(6), PARAMETER :: f2fHexGAMBIT = (/2,3,4,5,1,6/)
103  INTEGER, DIMENSION(5), PARAMETER :: f2fPriGAMBIT = (/2,3,4,1,5/)
104  INTEGER, DIMENSION(5), PARAMETER :: f2fPyrGAMBIT = (/1,2,3,4,5/)
105 
106 ! ------------------------------------------------------------------------------
107 ! Mapping of faces to vertices for GAMBIT
108 ! ------------------------------------------------------------------------------
109 
110  INTEGER, DIMENSION(4,4), PARAMETER :: f2vTetGAMBIT = &
111  RESHAPE((/2,1,3,VERT_NONE,1,2,4,VERT_NONE,2,3,4,VERT_NONE,3,1,4, &
112  VERT_NONE/), (/4,4/))
113  INTEGER, DIMENSION(4,6), PARAMETER :: f2vHexGAMBIT = &
114  RESHAPE((/1,2,6,5,2,4,8,6,4,3,7,8,3,1,5,7,2,1,3,4,5,6,7,8/), (/4,6/))
115  INTEGER, DIMENSION(4,5), PARAMETER :: f2vPriGAMBIT = &
116  RESHAPE((/1,2,5,4,2,3,6,5,3,1,4,6,1,3,2,VERT_NONE,4,5,6, &
117  VERT_NONE/), (/4,5/))
118  INTEGER, DIMENSION(4,5), PARAMETER :: f2vPyrGAMBIT = &
119  RESHAPE((/1,3,4,2,1,2,5,VERT_NONE,2,4,5,VERT_NONE,4,3,5,VERT_NONE,3,1,5, &
120  VERT_NONE/), (/4,5/))
121 
122  TYPE(t_gridgambit) :: gridGAMBIT
123 
124 ! ==============================================================================
125 ! Public procedures
126 ! ==============================================================================
127 
128  PUBLIC :: rflu_convgambit2rocflu, &
129  rflu_readgridgambitneutral
130 
131 ! ******************************************************************************
132 ! Routines
133 ! ******************************************************************************
134 
135  CONTAINS
136 
137 
138 
139 
140 
141 
142 
143 
144 ! ******************************************************************************
145 !
146 ! Purpose: Check connectivity.
147 !
148 ! Description: None.
149 !
150 ! Input:
151 ! pRegion Pointer to region
152 !
153 ! Output: None.
154 !
155 ! Notes: None.
156 !
157 ! ******************************************************************************
158 
159  SUBROUTINE rflu_checkgridgambit(pRegion)
160 
161  IMPLICIT NONE
162 
163 ! ******************************************************************************
164 ! Declarations and definitions
165 ! ******************************************************************************
166 
167 ! ==============================================================================
168 ! Arguments
169 ! ==============================================================================
170 
171  TYPE(t_region), POINTER :: pregion
172 
173 ! ==============================================================================
174 ! Local variables
175 ! ==============================================================================
176 
177  INTEGER :: errorflag,icg,ivgmax,ivgmin
178  TYPE(t_grid), POINTER :: pgrid
179  TYPE(t_global), POINTER :: global
180 
181 ! ******************************************************************************
182 ! Start
183 ! ******************************************************************************
184 
185  global => pregion%global
186 
187  CALL registerfunction(global,'RFLU_CheckGridGAMBIT', &
188  'RFLU_ModGAMBIT.F90')
189 
190  IF ( global%verbLevel > verbose_none ) THEN
191  WRITE(stdout,'(A,3X,A)') solver_name, &
192  'Checking connectivity arrays...'
193  END IF ! global%verbLevel
194 
195 ! ******************************************************************************
196 ! Set grid pointer
197 ! ******************************************************************************
198 
199  pgrid => pregion%grid
200 
201 ! ******************************************************************************
202 ! Volume grid. NOTE only do volume grid because GAMBIT format specifies
203 ! boundary grid in terms of volume grid faces, so checking volume grid only
204 ! is ok.
205 ! ******************************************************************************
206 
207  DO icg = 1,pgrid%nCellsTot
208  SELECT CASE ( gridgambit%ct(icg) )
209  CASE ( gambit_ntype_hex )
210  ivgmin = minval(gridgambit%c2v(1:8,icg))
211  ivgmax = minval(gridgambit%c2v(1:8,icg))
212  CASE ( gambit_ntype_tet )
213  ivgmin = minval(gridgambit%c2v(1:4,icg))
214  ivgmax = minval(gridgambit%c2v(1:4,icg))
215  CASE ( gambit_ntype_pri )
216  ivgmin = minval(gridgambit%c2v(1:6,icg))
217  ivgmax = minval(gridgambit%c2v(1:6,icg))
218  CASE ( gambit_ntype_pyr )
219  ivgmin = minval(gridgambit%c2v(1:5,icg))
220  ivgmax = minval(gridgambit%c2v(1:5,icg))
221  CASE default
222  END SELECT ! gridGAMBIT%ct
223 
224  IF ( ivgmin < 1 .OR. ivgmax > pgrid%nVertTot ) THEN
225  global%error = err_vertex_number
226  END IF ! ivgMin
227 
228  IF ( global%error /= err_none ) THEN
229  IF ( global%verbLevel > verbose_none ) THEN
230  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
231  END IF ! global%verbLevel
232  CALL errorstop(global,global%error,__line__)
233  END IF ! global%error
234  END DO ! icg
235 
236 ! ******************************************************************************
237 ! End
238 ! ******************************************************************************
239 
240  IF ( global%verbLevel > verbose_none ) THEN
241  WRITE(stdout,'(A,3X,A)') solver_name, &
242  'Checking connectivity arrays done.'
243  END IF ! global%verbLevel
244 
245  CALL deregisterfunction(global)
246 
247  END SUBROUTINE rflu_checkgridgambit
248 
249 
250 
251 
252 
253 
254 
255 ! ******************************************************************************
256 !
257 ! Purpose: Convert grid format from GAMBIT to ROCFLU.
258 !
259 ! Description: None.
260 !
261 ! Input:
262 ! pRegion Pointer to region
263 !
264 ! Output: None.
265 !
266 ! Notes: None.
267 !
268 ! ******************************************************************************
269 
270  SUBROUTINE rflu_convgambit2rocflu(pRegion)
271 
272  IMPLICIT NONE
273 
274 ! ******************************************************************************
275 ! Declarations and definitions
276 ! ******************************************************************************
277 
278 ! ==============================================================================
279 ! Arguments
280 ! ==============================================================================
281 
282  TYPE(t_region), POINTER :: pregion
283 
284 ! ==============================================================================
285 ! Local variables
286 ! ==============================================================================
287 
288  CHARACTER(CHRLEN) :: ifilename
289  INTEGER :: errorflag,ibegmax,ibegmin,ibeg1,ibeg2,icg,icl,ict,iendmax, &
290  iendmin,iend1,iend2,ifg,ifile,ifl,ifl2,imap,imap2,ipatch, &
291  ipatch2,ivg,ivl,j
292  TYPE(t_grid), POINTER :: pgrid
293  TYPE(t_patch), POINTER :: ppatch
294  TYPE(t_patchgambit), POINTER :: ppatchgambit
295  TYPE(t_global), POINTER :: global
296 
297 ! ******************************************************************************
298 ! Start
299 ! ******************************************************************************
300 
301  global => pregion%global
302 
303  CALL registerfunction(global,'RFLU_ConvGAMBIT2ROCFLU', &
304  'RFLU_ModGAMBIT.F90')
305 
306  IF ( global%verbLevel > verbose_none ) THEN
307  WRITE(stdout,'(A,1X,A)') solver_name, &
308  'Converting from GAMBIT to ROCFLU format...'
309  END IF ! global%verbLevel
310 
311 ! ******************************************************************************
312 ! Set grid pointer and initialize variables
313 ! ******************************************************************************
314 
315  pgrid => pregion%grid
316 
317  pgrid%nEdges = 0
318  pgrid%nEdgesTot = 0
319 
320  pgrid%nFaces = 0
321  pgrid%nFacesTot = 0
322 
323 ! ******************************************************************************
324 ! Allocate memory for cell connectivity arrays
325 ! ******************************************************************************
326 
327  IF ( pgrid%nTetsMax > 0 ) THEN
328  ALLOCATE(pgrid%tet2v(4,pgrid%nTetsMax),stat=errorflag)
329  global%error = errorflag
330  IF ( global%error /= err_none ) THEN
331  CALL errorstop(global,err_allocate,__line__,'pGrid%tet2v')
332  END IF ! global%error
333  ELSE
334  nullify(pgrid%tet2v)
335  END IF ! pGrid%nTetsTot
336 
337  IF ( pgrid%nHexsMax > 0 ) THEN
338  ALLOCATE(pgrid%hex2v(8,pgrid%nHexsMax),stat=errorflag)
339  global%error = errorflag
340  IF ( global%error /= err_none ) THEN
341  CALL errorstop(global,err_allocate,__line__,'pGrid%hex2v')
342  END IF ! global%error
343  ELSE
344  nullify(pgrid%hex2v)
345  END IF ! pGrid%nHexsTot
346 
347  IF ( pgrid%nPrisMax > 0 ) THEN
348  ALLOCATE(pgrid%pri2v(6,pgrid%nPrisMax),stat=errorflag)
349  global%error = errorflag
350  IF ( global%error /= err_none ) THEN
351  CALL errorstop(global,err_allocate,__line__,'pGrid%pri2v')
352  END IF ! global%error
353  ELSE
354  nullify(pgrid%pri2v)
355  END IF ! pGrid%nPrisTot
356 
357  IF ( pgrid%nPyrsMax > 0 ) THEN
358  ALLOCATE(pgrid%pyr2v(5,pgrid%nPyrsMax),stat=errorflag)
359  global%error = errorflag
360  IF ( global%error /= err_none ) THEN
361  CALL errorstop(global,err_allocate,__line__,'pGrid%pyr2v')
362  END IF ! global%error
363  ELSE
364  nullify(pgrid%pyr2v)
365  END IF ! pGrid%nPyrsTot
366 
367 ! ==============================================================================
368 ! Allocate memory for cell mapping, needed to convert GAMBITs boundary data
369 ! structure, because for given boundary face, the data structure gives global
370 ! cell number, not local one.
371 ! ==============================================================================
372 
373  ALLOCATE(pgrid%cellGlob2Loc(2,pgrid%nCellsTot),stat=errorflag)
374  global%error = errorflag
375  IF ( global%error /= err_none ) THEN
376  CALL errorstop(global,err_allocate,__line__,'pGrid%cellGlob2Loc')
377  END IF ! global%error
378 
379 ! ******************************************************************************
380 ! Copy connectivity information from GAMBIT format to Rocflu format. NOTE
381 ! renumbering of vertices.
382 ! ******************************************************************************
383 
384  IF ( global%verbLevel > verbose_none ) THEN
385  WRITE(stdout,'(A,3X,A)') solver_name,'Converting connectivity...'
386  END IF ! global%verbLevel
387 
388  pgrid%nTets = 0
389  pgrid%nHexs = 0
390  pgrid%nPris = 0
391  pgrid%nPyrs = 0
392 
393  DO icg = 1,pgrid%nCellsTot
394  SELECT CASE ( gridgambit%ct(icg) )
395  CASE ( gambit_ntype_tet )
396  pgrid%nTets = pgrid%nTets + 1
397 
398  pgrid%tet2v(1,pgrid%nTets) = gridgambit%c2v(1,icg)
399  pgrid%tet2v(2,pgrid%nTets) = gridgambit%c2v(2,icg)
400  pgrid%tet2v(3,pgrid%nTets) = gridgambit%c2v(4,icg)
401  pgrid%tet2v(4,pgrid%nTets) = gridgambit%c2v(3,icg)
402 
403  pgrid%cellGlob2Loc(1,icg) = cell_type_tet
404  pgrid%cellGlob2Loc(2,icg) = pgrid%nTets
405  CASE ( gambit_ntype_hex )
406  pgrid%nHexs = pgrid%nHexs + 1
407 
408  pgrid%hex2v(1,pgrid%nHexs) = gridgambit%c2v(1,icg)
409  pgrid%hex2v(2,pgrid%nHexs) = gridgambit%c2v(2,icg)
410  pgrid%hex2v(3,pgrid%nHexs) = gridgambit%c2v(4,icg)
411  pgrid%hex2v(4,pgrid%nHexs) = gridgambit%c2v(3,icg)
412  pgrid%hex2v(5,pgrid%nHexs) = gridgambit%c2v(5,icg)
413  pgrid%hex2v(6,pgrid%nHexs) = gridgambit%c2v(6,icg)
414  pgrid%hex2v(7,pgrid%nHexs) = gridgambit%c2v(8,icg)
415  pgrid%hex2v(8,pgrid%nHexs) = gridgambit%c2v(7,icg)
416 
417  pgrid%cellGlob2Loc(1,icg) = cell_type_hex
418  pgrid%cellGlob2Loc(2,icg) = pgrid%nHexs
419  CASE ( gambit_ntype_pri )
420  pgrid%nPris = pgrid%nPris + 1
421 
422  pgrid%pri2v(1,pgrid%nPris) = gridgambit%c2v(1,icg)
423  pgrid%pri2v(2,pgrid%nPris) = gridgambit%c2v(2,icg)
424  pgrid%pri2v(3,pgrid%nPris) = gridgambit%c2v(3,icg)
425  pgrid%pri2v(4,pgrid%nPris) = gridgambit%c2v(4,icg)
426  pgrid%pri2v(5,pgrid%nPris) = gridgambit%c2v(5,icg)
427  pgrid%pri2v(6,pgrid%nPris) = gridgambit%c2v(6,icg)
428 
429  pgrid%cellGlob2Loc(1,icg) = cell_type_pri
430  pgrid%cellGlob2Loc(2,icg) = pgrid%nPris
431  CASE ( gambit_ntype_pyr )
432  pgrid%nPyrs = pgrid%nPyrs + 1
433 
434  pgrid%pyr2v(1,pgrid%nPyrs) = gridgambit%c2v(1,icg)
435  pgrid%pyr2v(2,pgrid%nPyrs) = gridgambit%c2v(2,icg)
436  pgrid%pyr2v(3,pgrid%nPyrs) = gridgambit%c2v(4,icg)
437  pgrid%pyr2v(4,pgrid%nPyrs) = gridgambit%c2v(3,icg)
438  pgrid%pyr2v(5,pgrid%nPyrs) = gridgambit%c2v(5,icg)
439 
440  pgrid%cellGlob2Loc(1,icg) = cell_type_pyr
441  pgrid%cellGlob2Loc(2,icg) = pgrid%nPyrs
442  CASE default
443  CALL errorstop(global,err_reached_default,__line__)
444  END SELECT ! gridGAMBIT%ct
445  END DO ! icg
446 
447  IF ( global%verbLevel > verbose_none ) THEN
448  WRITE(stdout,'(A,3X,A)') solver_name,'Converting connectivity done.'
449  END IF ! global%verbLevel
450 
451 ! ******************************************************************************
452 ! Convert patch data structure
453 ! ******************************************************************************
454 
455  IF ( global%verbLevel > verbose_none ) THEN
456  WRITE(stdout,'(A,3X,A)') solver_name,'Converting patch data structure...'
457  END IF ! global%verbLevel
458 
459 ! ==============================================================================
460 ! Read patch mapping file
461 ! ==============================================================================
462 
463  IF ( global%verbLevel > verbose_none ) THEN
464  WRITE(stdout,'(A,5X,A)') solver_name,'Reading patch mapping file...'
465  END IF ! global%verbLevel
466 
467 ! ------------------------------------------------------------------------------
468 ! Open file
469 ! ------------------------------------------------------------------------------
470 
471  ifile = if_grid
472 
473  CALL buildfilenameplain(global,filedest_indir,'.ggi',ifilename)
474 
475  OPEN(ifile,file=ifilename,form="FORMATTED",status="OLD",iostat=errorflag)
476  global%error = errorflag
477  IF ( global%error /= err_none ) THEN
478  CALL errorstop(global,err_file_open,__line__,ifilename)
479  END IF ! global%error
480 
481 ! ------------------------------------------------------------------------------
482 ! Read file
483 ! ------------------------------------------------------------------------------
484 
485  READ(ifile,*) pgrid%nPatches
486  READ(ifile,*) gridgambit%nMappings
487 
488  ALLOCATE(gridgambit%patch2bc(3,gridgambit%nMappings),stat=errorflag)
489  global%error = errorflag
490  IF ( global%error /= err_none ) THEN
491  CALL errorstop(global,err_allocate,__line__,'gridGAMBIT%patch2bc')
492  END IF ! global%error
493 
494  DO imap = 1,gridgambit%nMappings
495  READ(ifile,*) (gridgambit%patch2bc(j,imap),j=1,3)
496  END DO ! iMap
497 
498 ! ------------------------------------------------------------------------------
499 ! Close file
500 ! ------------------------------------------------------------------------------
501 
502  CLOSE(ifile,iostat=errorflag)
503  global%error = errorflag
504  IF ( global%error /= err_none ) THEN
505  CALL errorstop(global,err_file_close,__line__,ifilename)
506  END IF ! global%error
507 
508  IF ( global%verbLevel > verbose_none ) THEN
509  WRITE(stdout,'(A,5X,A)') solver_name,'Reading patch mapping file done.'
510  END IF ! global%verbLevel
511 
512 ! ==============================================================================
513 ! Check for consistent input - somewhat complicated...
514 ! ==============================================================================
515 
516  IF ( global%checkLevel > check_none ) THEN
517  IF ( global%verbLevel > verbose_none ) THEN
518  WRITE(stdout,'(A,5X,A)') solver_name,'Checking patch mapping entries...'
519  END IF ! global%verbLevel
520 
521  DO imap = 1,gridgambit%nMappings
522  IF ( gridgambit%patch2bc(2,imap) < gridgambit%patch2bc(1,imap) ) THEN
523  IF ( global%verbLevel > verbose_none ) THEN
524  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
525  END IF ! global%verbLevel
526  CALL errorstop(global,err_patch_numbering,__line__)
527  END IF ! gridGAMBIT
528  END DO ! iMap
529 
530  IF ( minval(gridgambit%patch2bc(3,:)) /= 1 .OR. &
531  maxval(gridgambit%patch2bc(3,:)) /= pgrid%nPatches ) THEN
532  IF ( global%verbLevel > verbose_none ) THEN
533  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
534  END IF ! global%verbLevel
535  CALL errorstop(global,err_patch_numbering,__line__)
536  END IF ! gridGAMBIT
537 
538  DO imap = 1,gridgambit%nMappings
539  DO imap2 = 1,gridgambit%nMappings
540 
541  IF ( imap /= imap2 ) THEN
542  ibeg1 = gridgambit%patch2bc(1,imap)
543  iend1 = gridgambit%patch2bc(2,imap)
544 
545  ibeg2 = gridgambit%patch2bc(1,imap2)
546  iend2 = gridgambit%patch2bc(2,imap2)
547 
548  IF ( ibeg1 < ibeg2 ) THEN
549  ibegmin = ibeg1
550  iendmin = iend1
551  ibegmax = ibeg2
552  iendmax = iend2
553  ELSE IF ( ibeg1 > ibeg2 ) THEN
554  ibegmin = ibeg2
555  iendmin = iend2
556  ibegmax = ibeg1
557  iendmax = iend1
558  ELSE ! iBeg1 and iBeg2 have the same value
559  IF ( global%verbLevel > verbose_none ) THEN
560  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
561  END IF ! global%verbLevel
562  CALL errorstop(global,err_patch_numbering,__line__)
563  END IF ! iBeg1
564 
565  IF ( iendmin >= ibegmax ) THEN
566  IF ( global%verbLevel > verbose_none ) THEN
567  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
568  END IF ! global%verbLevel
569  CALL errorstop(global,err_patch_numbering,__line__)
570  END IF ! iEndMin
571  END IF ! iMap
572 
573  END DO ! iMap2
574  END DO ! iMap
575 
576  IF ( global%verbLevel > verbose_none ) THEN
577  WRITE(stdout,'(A,5X,A)') solver_name, &
578  'Checking patch mapping entries done.'
579  END IF ! global%verbLevel
580  END IF ! global%checkLevel
581 
582 ! ==============================================================================
583 ! Allocate patch memory and initialize patch structure
584 ! ==============================================================================
585 
586  ALLOCATE(pregion%patches(pgrid%nPatches),stat=errorflag)
587  global%error = errorflag
588  IF ( global%error /= err_none ) THEN
589  CALL errorstop(global,err_allocate,__line__,'pRegion%patches')
590  END IF ! global%error
591 
592  DO ipatch = 1,pgrid%nPatches
593  ppatch => pregion%patches(ipatch)
594 
595  ppatch%nBTris = 0
596  ppatch%nBQuads = 0
597  ppatch%nBVert = 0
598 
599  ppatch%iPatchGlobal = ipatch
600  ppatch%iBorder = patch_iborder_default
601  ppatch%renumFlag = .false.
602  END DO ! iPatch
603 
604  global%nPatches = pgrid%nPatches
605 
606 ! ==============================================================================
607 ! Determine number of faces on each patch and set number of boundary faces
608 ! ==============================================================================
609 
610  DO ipatch = 1,gridgambit%nPatches
611  ppatchgambit => gridgambit%patches(ipatch)
612 
613  DO imap = 1,gridgambit%nMappings
614  IF ( ipatch >= gridgambit%patch2bc(1,imap) .AND. &
615  ipatch <= gridgambit%patch2bc(2,imap) ) THEN
616  ipatch2 = gridgambit%patch2bc(3,imap)
617  END IF ! iPatch
618  END DO ! iMap
619 
620  ppatch => pregion%patches(ipatch2)
621 
622  DO ifg = 1,ppatchgambit%nFaces
623  ict = ppatchgambit%bf2ct(ifg)
624  ifl = ppatchgambit%bf2fli(ifg)
625 
626  SELECT CASE ( ict )
627  CASE ( gambit_ntype_tet )
628  ppatch%nBTris = ppatch%nBTris + 1
629  CASE ( gambit_ntype_hex )
630  ppatch%nBQuads = ppatch%nBQuads + 1
631  CASE ( gambit_ntype_pri )
632  IF ( f2vprigambit(4,ifl) == vert_none ) THEN
633  ppatch%nBTris = ppatch%nBTris + 1
634  ELSE
635  ppatch%nBQuads = ppatch%nBQuads + 1
636  END IF ! f2vPriGAMBIT
637  CASE ( gambit_ntype_pyr )
638  IF ( f2vpyrgambit(4,ifl) == vert_none ) THEN
639  ppatch%nBTris = ppatch%nBTris + 1
640  ELSE
641  ppatch%nBQuads = ppatch%nBQuads + 1
642  END IF ! f2vPyrGAMBIT
643  CASE default
644  CALL errorstop(global,err_reached_default,__line__)
645  END SELECT ! ict
646  END DO ! ifg
647  END DO ! iPatch
648 
649 ! ==============================================================================
650 ! Set total boundary patch quantities and number of boundary faces
651 ! ==============================================================================
652 
653  pgrid%nBFaces = 0
654 
655  DO ipatch = 1,pgrid%nPatches
656  ppatch => pregion%patches(ipatch)
657 
658  ppatch%nBFaces = ppatch%nBTris + ppatch%nBQuads
659  pgrid%nBFaces = pgrid%nBFaces + ppatch%nBFaces
660 
661  ppatch%nBFacesTot = ppatch%nBFaces
662  ppatch%nBQuadsTot = ppatch%nBQuads
663  ppatch%nBTrisTot = ppatch%nBTris
664  ppatch%nBVertTot = ppatch%nBVert
665 
666  ppatch%nBTrisMax = rflu_setmaxdimension(global,ppatch%nBTrisTot)
667  ppatch%nBQuadsMax = rflu_setmaxdimension(global,ppatch%nBQuadsTot)
668  ppatch%nBFacesMax = rflu_setmaxdimension(global,ppatch%nBFacesTot)
669  ppatch%nBVertMax = rflu_setmaxdimension(global,ppatch%nBVertTot)
670 
671  ppatch%nBCellsVirt = 0
672  END DO ! iPatch
673 
674  pgrid%nBFacesTot = pgrid%nBFaces
675 
676 ! ==============================================================================
677 ! Allocate memory for boundary-face connectivity
678 ! ==============================================================================
679 
680  DO ipatch = 1,pgrid%nPatches
681  ppatch => pregion%patches(ipatch)
682 
683  IF ( ppatch%nBTrisMax > 0 ) THEN
684  ALLOCATE(ppatch%bTri2v(3,ppatch%nBTrisMax),stat=errorflag)
685  global%error = errorflag
686  IF ( global%error /= err_none ) THEN
687  CALL errorstop(global,err_allocate,__line__,'pPatch%bTri2v')
688  END IF ! global%error
689  ELSE
690  nullify(ppatch%bTri2v)
691  END IF ! pPatch%nBTrisMax
692 
693  IF ( ppatch%nBQuadsMax > 0 ) THEN
694  ALLOCATE(ppatch%bQuad2v(4,ppatch%nBQuadsMax),stat=errorflag)
695  global%error = errorflag
696  IF ( global%error /= err_none ) THEN
697  CALL errorstop(global,err_allocate,__line__,'pPatch%bQuad2v')
698  END IF ! global%error
699  ELSE
700  nullify(ppatch%bQuad2v)
701  END IF ! pPatch%nBQuadsMax
702  END DO ! iPatch
703 
704 ! ==============================================================================
705 ! Build boundary face connectivity
706 ! ==============================================================================
707 
708  DO ipatch = 1,pgrid%nPatches
709  ppatch => pregion%patches(ipatch)
710 
711  ppatch%nBTris = 0
712  ppatch%nBQuads = 0
713  END DO ! iPatch
714 
715 ! ------------------------------------------------------------------------------
716 ! Loop over patches
717 ! ------------------------------------------------------------------------------
718 
719  DO ipatch = 1,gridgambit%nPatches
720  ppatchgambit => gridgambit%patches(ipatch)
721 
722 ! --- Get mapped new patch number ----------------------------------------------
723 
724  DO imap = 1,gridgambit%nMappings
725  IF ( ipatch >= gridgambit%patch2bc(1,imap) .AND. &
726  ipatch <= gridgambit%patch2bc(2,imap) ) THEN
727  ipatch2 = gridgambit%patch2bc(3,imap)
728  END IF ! iPatch
729  END DO ! iMap
730 
731  ppatch => pregion%patches(ipatch2)
732 
733 ! --- Loop over faces on patch -------------------------------------------------
734 
735  DO ifg = 1,ppatchgambit%nFaces
736  ict = ppatchgambit%bf2ct(ifg)
737  icg = ppatchgambit%bf2cgi(ifg)
738  ifl = ppatchgambit%bf2fli(ifg)
739 
740 ! ----- Check that cell types agree (defensive coding)
741 
742  SELECT CASE ( pgrid%cellGlob2Loc(1,icg) )
743  CASE ( cell_type_tet )
744  IF ( ict /= gambit_ntype_tet ) THEN
745  CALL errorstop(global,err_ntype_invalid,__line__)
746  END IF ! ict
747  CASE ( cell_type_hex )
748  IF ( ict /= gambit_ntype_hex ) THEN
749  CALL errorstop(global,err_ntype_invalid,__line__)
750  END IF ! ict
751  CASE ( cell_type_pri )
752  IF ( ict /= gambit_ntype_pri ) THEN
753  CALL errorstop(global,err_ntype_invalid,__line__)
754  END IF ! ict
755  CASE ( cell_type_pyr )
756  IF ( ict /= gambit_ntype_pyr ) THEN
757  CALL errorstop(global,err_ntype_invalid,__line__)
758  END IF ! ict
759  CASE default
760  CALL errorstop(global,err_reached_default,__line__)
761  END SELECT ! pGrid%cellGlob2Loc
762 
763 ! ----- Get local cell index
764 
765  icl = pgrid%cellGlob2Loc(2,icg)
766 
767 ! ----- Store boundary-face connectivity
768 
769  SELECT CASE ( ict )
770  CASE ( gambit_ntype_tet )
771  ppatch%nBTris = ppatch%nBTris + 1
772 
773  DO ivl = 1,3
774  ifl2 = f2ftetgambit(ifl)
775  ivg = pgrid%tet2v(f2vtet(ivl,ifl2),icl)
776 
777  ppatch%bTri2v(ivl,ppatch%nBTris) = ivg
778  END DO ! ivl
779  CASE ( gambit_ntype_hex )
780  ppatch%nBQuads = ppatch%nBQuads + 1
781 
782  DO ivl = 1,4
783  ifl2 = f2fhexgambit(ifl)
784  ivg = pgrid%hex2v(f2vhex(ivl,ifl2),icl)
785 
786  ppatch%bQuad2v(ivl,ppatch%nBQuads) = ivg
787  END DO ! ivl
788  CASE ( gambit_ntype_pri )
789  IF ( f2vprigambit(4,ifl) == vert_none ) THEN
790  ppatch%nBTris = ppatch%nBTris + 1
791 
792  DO ivl = 1,3
793  ifl2 = f2fprigambit(ifl)
794  ivg = pgrid%pri2v(f2vpri(ivl,ifl2),icl)
795 
796  ppatch%bTri2v(ivl,ppatch%nBTris) = ivg
797  END DO ! ivl
798  ELSE
799  ppatch%nBQuads = ppatch%nBQuads + 1
800 
801  DO ivl = 1,4
802  ifl2 = f2fprigambit(ifl)
803  ivg = pgrid%pri2v(f2vpri(ivl,ifl2),icl)
804 
805  ppatch%bQuad2v(ivl,ppatch%nBQuads) = ivg
806  END DO ! ivl
807  END IF ! f2vPriGAMBIT
808  CASE ( gambit_ntype_pyr )
809  IF ( f2vpyrgambit(4,ifl) == vert_none ) THEN
810  ppatch%nBTris = ppatch%nBTris + 1
811 
812  DO ivl = 1,3
813  ifl2 = f2fpyrgambit(ifl)
814  ivg = pgrid%pyr2v(f2vpyr(ivl,ifl2),icl)
815 
816  ppatch%bTri2v(ivl,ppatch%nBTris) = ivg
817  END DO ! ivl
818  ELSE
819  ppatch%nBQuads = ppatch%nBQuads + 1
820 
821  DO ivl = 1,4
822  ifl2 = f2fpyrgambit(ifl)
823  ivg = pgrid%pyr2v(f2vpyr(ivl,ifl2),icl)
824 
825  ppatch%bQuad2v(ivl,ppatch%nBQuads) = ivg
826  END DO ! ivl
827  END IF ! f2vPyrGAMBIT
828  CASE default
829  CALL errorstop(global,err_reached_default,__line__)
830  END SELECT ! ict
831  END DO ! ifg
832  END DO ! iPatch
833 
834  IF ( global%verbLevel > verbose_none ) THEN
835  WRITE(stdout,'(A,3X,A)') solver_name, &
836  'Converting patch data structure done.'
837  END IF ! global%verbLevel
838 
839 ! ******************************************************************************
840 ! Dellocate temporary memory
841 ! ******************************************************************************
842 
843  DEALLOCATE(pgrid%cellGlob2Loc,stat=errorflag)
844  global%error = errorflag
845  IF ( global%error /= err_none ) THEN
846  CALL errorstop(global,err_deallocate,__line__,'pGrid%cellGlob2Loc')
847  END IF ! global%error
848 
849 ! ******************************************************************************
850 ! Allocate memory for other Rocflu data structures
851 ! ******************************************************************************
852 
853  DO ipatch = 1,pgrid%nPatches
854  ppatch => pregion%patches(ipatch)
855 
856  ALLOCATE(ppatch%bf2c(ppatch%nBFacesMax),stat=errorflag)
857  global%error = errorflag
858  IF ( global%error /= err_none ) THEN
859  CALL errorstop(global,err_allocate,__line__,'pPatch%bf2c')
860  END IF ! global%error
861 
862  ALLOCATE(ppatch%bf2v(4,ppatch%nBFacesMax),stat=errorflag)
863  global%error = errorflag
864  IF ( global%error /= err_none ) THEN
865  CALL errorstop(global,err_allocate,__line__,'pPatch%bf2v')
866  END IF ! global%error
867 
868  DO ifl = 1,ppatch%nBFacesMax
869  ppatch%bf2v(1,ifl) = vert_none
870  ppatch%bf2v(2,ifl) = vert_none
871  ppatch%bf2v(3,ifl) = vert_none
872  ppatch%bf2v(4,ifl) = vert_none
873  END DO ! ifl
874  END DO ! iPatch
875 
876 ! ******************************************************************************
877 ! Deallocate GAMBIT memory
878 ! ******************************************************************************
879 
880  DEALLOCATE(gridgambit%ct,stat=errorflag)
881  global%error = errorflag
882  IF ( global%error /= err_none ) THEN
883  CALL errorstop(global,err_deallocate,__line__,'gridGAMBIT%ct')
884  END IF ! global%error
885 
886  DEALLOCATE(gridgambit%c2v,stat=errorflag)
887  global%error = errorflag
888  IF ( global%error /= err_none ) THEN
889  CALL errorstop(global,err_deallocate,__line__,'gridGAMBIT%c2v')
890  END IF ! global%error
891 
892  DEALLOCATE(gridgambit%patches,stat=errorflag)
893  global%error = errorflag
894  IF ( global%error /= err_none ) THEN
895  CALL errorstop(global,err_deallocate,__line__,'gridGAMBIT%patches')
896  END IF ! global%error
897 
898 ! ******************************************************************************
899 ! End
900 ! ******************************************************************************
901 
902  IF ( global%verbLevel > verbose_none ) THEN
903  WRITE(stdout,'(A,1X,A)') solver_name, &
904  'Converting from GAMBIT to ROCFLU format done.'
905  END IF ! global%verbLevel
906 
907  CALL deregisterfunction(global)
908 
909  END SUBROUTINE rflu_convgambit2rocflu
910 
911 
912 
913 
914 
915 
916 
917 
918 
919 ! *******************************************************************************
920 !
921 ! Purpose: Print GAMBIT grid information.
922 !
923 ! Description: None.
924 !
925 ! Input:
926 ! pRegion Pointer to region
927 !
928 ! Output: None.
929 !
930 ! Notes: None.
931 !
932 ! *******************************************************************************
933 
934  SUBROUTINE rflu_printgridgambitinfo(pRegion)
935 
936  IMPLICIT NONE
937 
938 ! ******************************************************************************
939 ! Declarations and definitions
940 ! ******************************************************************************
941 
942 ! ==============================================================================
943 ! Arguments
944 ! ==============================================================================
945 
946  TYPE(t_region), POINTER :: pregion
947 
948 ! ==============================================================================
949 ! Locals
950 ! ==============================================================================
951 
952  INTEGER :: ipatch
953  TYPE(t_grid), POINTER :: pgrid
954  TYPE(t_patchgambit), POINTER :: ppatchgambit
955 
956 ! ******************************************************************************
957 ! Start, set grid pointer
958 ! ******************************************************************************
959 
960  pgrid => pregion%grid
961 
962 ! ******************************************************************************
963 ! Write information
964 ! ******************************************************************************
965 
966  WRITE(stdout,'(A,3X,A)') solver_name,'Grid Statistics:'
967  WRITE(stdout,'(A,5X,A,2X,I9)') solver_name,'Vertices: ', &
968  pgrid%nVertTot
969  WRITE(stdout,'(A,5X,A,2X,I9)') solver_name,'Cells: ', &
970  pgrid%nCellsTot
971  WRITE(stdout,'(A,5X,A,2X,I9)') solver_name,'Patches: ', &
972  gridgambit%nPatches
973 
974  IF ( gridgambit%nPatches > 0 ) THEN
975  WRITE(stdout,'(A,5X,A)') solver_name,'Patch statistics:'
976 
977  DO ipatch = 1,gridgambit%nPatches
978  ppatchgambit => gridgambit%patches(ipatch)
979 
980  WRITE(stdout,'(A,7X,A,2X,I4)') solver_name,'Patch:',ipatch
981  WRITE(stdout,'(A,7X,A,1X,I9)') solver_name,'Faces:',ppatchgambit%nFaces
982  END DO ! iPatch
983  END IF ! gridGAMBIT%nPatches
984 
985 ! ******************************************************************************
986 ! End
987 ! ******************************************************************************
988 
989  END SUBROUTINE rflu_printgridgambitinfo
990 
991 
992 
993 
994 
995 
996 
997 
998 
999 
1000 ! *******************************************************************************
1001 !
1002 ! Purpose: Read grid file from GAMBIT in neutral format.
1003 !
1004 ! Description: None.
1005 !
1006 ! Input:
1007 ! pRegion Pointer to region
1008 !
1009 ! Output: None.
1010 !
1011 ! Notes:
1012 ! 1. CENTAUR cell and node pointers are not read in - read into the
1013 ! dummy integer idum.
1014 !
1015 ! *******************************************************************************
1016 
1017  SUBROUTINE rflu_readgridgambitneutral(pRegion)
1018 
1019  USE modbuildfilenames, ONLY: buildfilenameplain
1020 
1021  IMPLICIT NONE
1022 
1023 ! ******************************************************************************
1024 ! Declarations and definitions
1025 ! ******************************************************************************
1026 
1027 ! ==============================================================================
1028 ! Arguments
1029 ! ==============================================================================
1030 
1031  TYPE(t_region), POINTER :: pregion
1032 
1033 ! ==============================================================================
1034 ! Local variables
1035 ! ==============================================================================
1036 
1037  CHARACTER(CHRLEN) :: dummystring,ifilename,sectionstring,versionstring
1038  INTEGER :: itype,nentry
1039  INTEGER :: dummyinteger,errorflag,icg,icl,ifile,ifl,ipatch,ivg,ivl, &
1040  loopcounter
1041  TYPE(t_grid), POINTER :: pgrid
1042  TYPE(t_global), POINTER :: global
1043  TYPE(t_patchgambit), POINTER :: ppatchgambit
1044 
1045 ! ******************************************************************************
1046 ! Start, open file
1047 ! ******************************************************************************
1048 
1049  global => pregion%global
1050 
1051  CALL registerfunction(global,'RFLU_ReadGridGAMBITNeutral', &
1052  'RFLU_ModGAMBIT.F90')
1053 
1054  IF ( global%verbLevel > verbose_none ) THEN
1055  WRITE(stdout,'(A,1X,A)') solver_name,'Reading GAMBIT neutral grid file...'
1056  END IF ! global%verbLevel
1057 
1058  ifile = if_grid
1059 
1060  CALL buildfilenameplain(global,filedest_indir,'.neu',ifilename)
1061 
1062  OPEN(ifile,file=ifilename,form="FORMATTED",status="OLD",iostat=errorflag)
1063  global%error = errorflag
1064  IF ( global%error /= err_none ) THEN
1065  CALL errorstop(global,err_file_open,__line__,ifilename)
1066  END IF
1067 
1068 ! ******************************************************************************
1069 ! Set grid pointer and initialize variables
1070 ! ******************************************************************************
1071 
1072  pgrid => pregion%grid
1073 
1074  pgrid%nVert = 0
1075  pgrid%nTets = 0
1076  pgrid%nHexs = 0
1077  pgrid%nPris = 0
1078  pgrid%nPyrs = 0
1079 
1080  pgrid%nPatches = 0
1081 
1082  ipatch = 0
1083 
1084 ! ******************************************************************************
1085 ! Read header
1086 ! ******************************************************************************
1087 
1088  READ(ifile,'(2(A20))') dummystring,versionstring
1089  READ(ifile,*) dummystring
1090  READ(ifile,*) gridgambit%title
1091 
1092  READ(ifile,*) dummystring
1093  READ(ifile,*) dummystring
1094  READ(ifile,*) dummystring
1095 
1096  READ(ifile,*) pgrid%nVert,pgrid%nCells,gridgambit%NGRPS, &
1097  gridgambit%nPatches,gridgambit%NDFCD,gridgambit%NDFVL
1098 
1099  READ(ifile,*) dummystring
1100 
1101  IF ( trim(dummystring) /= "ENDOFSECTION" ) THEN
1102  CALL errorstop(global,err_string_invalid,__line__)
1103  END IF ! TRIM(sectionString)
1104 
1105  pgrid%nVertTot = pgrid%nVert
1106  pgrid%nCellsTot = pgrid%nCells
1107 
1108  pgrid%nVertMax = rflu_setmaxdimension(global,pgrid%nVertTot)
1109  pgrid%nCellsMax = rflu_setmaxdimension(global,pgrid%nCellsTot)
1110 
1111 ! ******************************************************************************
1112 ! Allocate memory
1113 ! ******************************************************************************
1114 
1115  ALLOCATE(pgrid%xyz(xcoord:zcoord,pgrid%nVertMax),stat=errorflag)
1116  global%error = errorflag
1117  IF ( global%error /= err_none ) THEN
1118  CALL errorstop(global,err_allocate,__line__,'grid%xyz')
1119  END IF ! global%error
1120 
1121  ALLOCATE(gridgambit%ct(pgrid%nCellsTot),stat=errorflag)
1122  global%error = errorflag
1123  IF ( global%error /= err_none ) THEN
1124  CALL errorstop(global,err_allocate,__line__,'gridGAMBIT%ct')
1125  END IF ! global%error
1126 
1127  ALLOCATE(gridgambit%c2v(8,pgrid%nCellsTot),stat=errorflag)
1128  global%error = errorflag
1129  IF ( global%error /= err_none ) THEN
1130  CALL errorstop(global,err_allocate,__line__,'gridGAMBIT%c2v')
1131  END IF ! global%error
1132 
1133  DO icg = 1,pgrid%nCellsTot
1134  gridgambit%c2v(1,icg) = c2v_init
1135  gridgambit%c2v(2,icg) = c2v_init
1136  gridgambit%c2v(3,icg) = c2v_init
1137  gridgambit%c2v(4,icg) = c2v_init
1138  gridgambit%c2v(5,icg) = c2v_init
1139  gridgambit%c2v(6,icg) = c2v_init
1140  gridgambit%c2v(7,icg) = c2v_init
1141  gridgambit%c2v(8,icg) = c2v_init
1142  END DO ! icg
1143 
1144  ALLOCATE(gridgambit%patches(gridgambit%nPatches),stat=errorflag)
1145  global%error = errorflag
1146  IF ( global%error /= err_none ) THEN
1147  CALL errorstop(global,err_allocate,__line__,'gridGAMBIT%patches')
1148  END IF ! global%error
1149 
1150 ! ******************************************************************************
1151 ! Read sections
1152 ! ******************************************************************************
1153 
1154  loopcounter = 0
1155 
1156  DO ! set up infinite loop
1157  loopcounter = loopcounter + 1
1158 
1159 ! ==============================================================================
1160 ! Read section string and take appropriate action
1161 ! ==============================================================================
1162 
1163  READ(ifile,'(A32)',iostat=errorflag,end=100) sectionstring
1164 
1165 ! ==============================================================================
1166 ! Coordinates
1167 ! ==============================================================================
1168 
1169  IF ( adjustl(trim(sectionstring)) == &
1170  "NODAL COORDINATES"//" "//adjustl(trim(versionstring)) ) THEN
1171  IF ( global%verbLevel > verbose_low ) THEN
1172  WRITE(stdout,'(A,3X,A)') solver_name,'Reading coordinate section...'
1173  END IF ! global%verbLevel
1174 
1175  DO ivl = 1,pgrid%nVertTot
1176  READ(ifile,*) ivg
1177  backspace(ifile)
1178 
1179  READ(ifile,*) dummyinteger,pgrid%xyz(xcoord:zcoord,ivg)
1180  END DO ! ivl
1181 
1182 ! ==============================================================================
1183 ! Element connectivity
1184 ! ==============================================================================
1185 
1186  ELSE IF ( adjustl(trim(sectionstring)) == &
1187  "ELEMENTS/CELLS"//" "//adjustl(trim(versionstring)) ) THEN
1188  IF ( global%verbLevel > verbose_low ) THEN
1189  WRITE(stdout,'(A,3X,A)') solver_name,'Reading element connectivity...'
1190  END IF ! global%verbLevel
1191 
1192  DO icl = 1,pgrid%nCellsTot
1193  READ(ifile,*) icg
1194  backspace(ifile)
1195 
1196  READ(ifile,*) dummystring,gridgambit%NTYPE,gridgambit%NDP
1197  backspace(ifile)
1198 
1199  gridgambit%ct(icg) = gridgambit%NTYPE
1200 
1201 ! ------------------------------------------------------------------------------
1202 ! Read element connectivity
1203 ! ------------------------------------------------------------------------------
1204 
1205  SELECT CASE ( gridgambit%NTYPE )
1206 
1207 ! --------- Edge ---------------------------------------------------------------
1208 
1209  CASE ( gambit_ntype_edge )
1210  CALL errorstop(global,err_ntype_invalid,__line__)
1211 
1212 ! --------- Quadrilateral ------------------------------------------------------
1213 
1214  CASE ( gambit_ntype_quad )
1215  CALL errorstop(global,err_ntype_invalid,__line__)
1216 
1217 ! --------- Triangle -----------------------------------------------------------
1218 
1219  CASE ( gambit_ntype_tri )
1220  CALL errorstop(global,err_ntype_invalid,__line__)
1221 
1222 ! --------- Hexahedron ---------------------------------------------------------
1223 
1224  CASE ( gambit_ntype_hex )
1225  IF ( gridgambit%NDP == 8 ) THEN
1226  READ(ifile,*) dummystring,dummystring,dummystring, &
1227  gridgambit%c2v(1:7,icg)
1228 
1229  IF ( gridgambit%NDP == 8 ) THEN
1230  pgrid%nHexs = pgrid%nHexs + 1
1231 
1232  READ(ifile,*) gridgambit%c2v(8,icg)
1233  END IF ! iFile
1234  ELSE
1235  CALL errorstop(global,err_ndp_invalid,__line__)
1236  END IF ! gridGAMBIT%NDP
1237 
1238 ! --------- Prism --------------------------------------------------------------
1239 
1240  CASE ( gambit_ntype_pri )
1241  IF ( gridgambit%NDP == 6 ) THEN
1242  pgrid%nPris = pgrid%nPris + 1
1243 
1244  READ(ifile,*) dummystring,dummystring,dummystring, &
1245  gridgambit%c2v(1:6,icg)
1246  ELSE
1247  CALL errorstop(global,err_ndp_invalid,__line__)
1248  END IF ! gridGAMBIT%NDP
1249 
1250 ! --------- Tetrahedron --------------------------------------------------------
1251 
1252  CASE ( gambit_ntype_tet )
1253  IF ( gridgambit%NDP == 4 ) THEN
1254  pgrid%nTets = pgrid%nTets + 1
1255 
1256  READ(ifile,*) dummystring,dummystring,dummystring, &
1257  gridgambit%c2v(1:4,icg)
1258  ELSE
1259  CALL errorstop(global,err_ndp_invalid,__line__)
1260  END IF ! gridGAMBIT%NDP
1261 
1262 ! --------- Pyramid ------------------------------------------------------------
1263 
1264  CASE ( gambit_ntype_pyr )
1265  IF ( gridgambit%NDP == 5 ) THEN
1266  pgrid%nPyrs = pgrid%nPyrs + 1
1267 
1268  READ(ifile,*) dummystring,dummystring,dummystring, &
1269  gridgambit%c2v(1:5,icg)
1270  ELSE
1271  CALL errorstop(global,err_ndp_invalid,__line__)
1272  END IF ! gridGAMBIT%NDP
1273 
1274 ! --------- Unknown ------------------------------------------------------------
1275 
1276  CASE default
1277  CALL errorstop(global,err_reached_default,__line__)
1278  END SELECT ! gridGAMBIT%NTYPE
1279  END DO ! icl
1280 
1281 ! ==============================================================================
1282 ! Element group
1283 ! ==============================================================================
1284 
1285  ELSE IF ( adjustl(trim(sectionstring)) == &
1286  "ELEMENT GROUP"//" "//adjustl(trim(versionstring)) ) THEN
1287  IF ( global%verbLevel > verbose_low ) THEN
1288  WRITE(stdout,'(A,3X,A)') solver_name, &
1289  'Reading element group information...'
1290  END IF ! global%verbLevel
1291 
1292  READ(ifile,*) dummystring,gridgambit%NGP,dummystring,gridgambit%NELGP, &
1293  dummystring,gridgambit%MTYP,dummystring,gridgambit%NFLAGS
1294 
1295  READ(ifile,*) dummystring
1296 
1297  READ(ifile,'(10(I8))') (dummyinteger,ifl=1,gridgambit%NFLAGS)
1298  READ(ifile,'(10(I8))') (dummyinteger,icl=1,gridgambit%NELGP)
1299 
1300 ! ==============================================================================
1301 ! Boundary information
1302 ! ==============================================================================
1303 
1304  ELSE IF ( adjustl(trim(sectionstring)) == &
1305  "BOUNDARY CONDITIONS"//" "//adjustl(trim(versionstring)) ) THEN
1306  IF ( global%verbLevel > verbose_low ) THEN
1307  WRITE(stdout,'(A,3X,A)') solver_name, &
1308  'Reading boundary condition information...'
1309  END IF ! global%verbLevel
1310 
1311  ipatch = ipatch + 1
1312 
1313  ppatchgambit => gridgambit%patches(ipatch)
1314 
1315  READ(ifile,'(A32,2(I10))') dummystring,itype,nentry
1316 
1317 ! ------------------------------------------------------------------------------
1318 ! Read face or vertex data. NOTE in either case, values are not read.
1319 ! ------------------------------------------------------------------------------
1320 
1321  SELECT CASE ( itype )
1322 
1323 ! ------- Face data ------------------------------------------------------------
1324 
1325  CASE ( 1 ) ! Face data
1326  ppatchgambit%nFaces = nentry
1327 
1328  ALLOCATE(ppatchgambit%bf2cgi(ppatchgambit%nFaces),stat=errorflag)
1329  global%error = errorflag
1330  IF ( global%error /= err_none ) THEN
1331  CALL errorstop(global,err_allocate,__line__, &
1332  'pPatchGAMBIT%bf2cgi')
1333  END IF ! global%error
1334 
1335  ALLOCATE(ppatchgambit%bf2ct(ppatchgambit%nFaces),stat=errorflag)
1336  global%error = errorflag
1337  IF ( global%error /= err_none ) THEN
1338  CALL errorstop(global,err_allocate,__line__, &
1339  'pPatchGAMBIT%bf2ct')
1340  END IF ! global%error
1341 
1342  ALLOCATE(ppatchgambit%bf2fli(ppatchgambit%nFaces),stat=errorflag)
1343  global%error = errorflag
1344  IF ( global%error /= err_none ) THEN
1345  CALL errorstop(global,err_allocate,__line__, &
1346  'pPatchGAMBIT%bf2fli')
1347  END IF ! global%error
1348 
1349  DO ifl = 1,ppatchgambit%nFaces
1350  READ(ifile,*) ppatchgambit%bf2cgi(ifl), &
1351  ppatchgambit%bf2ct(ifl), &
1352  ppatchgambit%bf2fli(ifl)
1353  END DO ! ifl
1354 
1355 ! ------- Vertex data ----------------------------------------------------------
1356 
1357  CASE ( 0 ) ! Vertex data
1358  DO ivl = 1,nentry
1359  READ(ifile,*) dummyinteger
1360  END DO ! ivl
1361 
1362 ! ------- Unknown --------------------------------------------------------------
1363 
1364  CASE default
1365  CALL errorstop(global,err_reached_default,__line__)
1366  END SELECT ! ITYPE
1367 
1368 ! ==============================================================================
1369 ! Unknown section string
1370 ! ==============================================================================
1371 
1372  ELSE
1373  CALL errorstop(global,err_reached_default,__line__)
1374  END IF ! TRIM(sectionString)
1375 
1376 ! ==============================================================================
1377 ! Read end of section string
1378 ! ==============================================================================
1379 
1380  READ(ifile,*) dummystring
1381 
1382  IF ( trim(dummystring) /= "ENDOFSECTION" ) THEN
1383  CALL errorstop(global,err_string_invalid,__line__)
1384  END IF ! TRIM(sectionString)
1385 
1386 ! ==============================================================================
1387 ! Guard against infinite loop - might be unnecessary because of read errors?
1388 ! ==============================================================================
1389 
1390  IF ( loopcounter >= limit_infinite_loop ) THEN
1391  CALL errorstop(global,err_infinite_loop,__line__)
1392  END IF ! loopCounter
1393  END DO ! <empty>
1394 
1395 ! ******************************************************************************
1396 ! EOF condition. NOTE assume that this is ok, because GAMBIT grid files do not
1397 ! have a dedicated EOF marker, and hence need to use READ statement to detect
1398 ! EOF condition.
1399 ! ******************************************************************************
1400 
1401  global%warnCounter = global%warnCounter + 1
1402 
1403 100 WRITE(stdout,*) solver_name,'*** WARNING *** Encountered EOF.'
1404 
1405 ! ******************************************************************************
1406 ! Set sizes
1407 ! ******************************************************************************
1408 
1409  pgrid%nTetsTot = pgrid%nTets
1410  pgrid%nHexsTot = pgrid%nHexs
1411  pgrid%nPrisTot = pgrid%nPris
1412  pgrid%nPyrsTot = pgrid%nPyrs
1413 
1414  pgrid%nTetsMax = rflu_setmaxdimension(global,pgrid%nTetsTot)
1415  pgrid%nHexsMax = rflu_setmaxdimension(global,pgrid%nHexsTot)
1416  pgrid%nPrisMax = rflu_setmaxdimension(global,pgrid%nPrisTot)
1417  pgrid%nPyrsMax = rflu_setmaxdimension(global,pgrid%nPyrsTot)
1418 
1419 ! ******************************************************************************
1420 ! Check validity of connectivity arrays
1421 ! ******************************************************************************
1422 
1423  IF ( global%checkLevel > check_none ) THEN
1424  CALL rflu_checkgridgambit(pregion)
1425  END IF ! global%checkLevel
1426 
1427 ! ******************************************************************************
1428 ! Print grid statistics
1429 ! ******************************************************************************
1430 
1431  IF ( global%verbLevel > verbose_none ) THEN
1432  CALL rflu_printgridgambitinfo(pregion)
1433  END IF ! global%verbLevel
1434 
1435 ! ******************************************************************************
1436 ! Close file
1437 ! ******************************************************************************
1438 
1439  CLOSE(ifile,iostat=errorflag)
1440  global%error = errorflag
1441  IF ( global%error /= err_none ) THEN
1442  CALL errorstop(global,err_file_close,__line__,ifilename)
1443  END IF ! global%error
1444 
1445 ! ******************************************************************************
1446 ! End
1447 ! ******************************************************************************
1448 
1449  IF ( global%verbLevel > verbose_none ) THEN
1450  WRITE(stdout,'(A,1X,A)') solver_name, &
1451  'Reading GAMBIT neutral grid file done.'
1452  END IF ! global%verbLevel
1453 
1454  CALL deregisterfunction(global)
1455 
1456  END SUBROUTINE rflu_readgridgambitneutral
1457 
1458 
1459 
1460 
1461 
1462 
1463 ! ******************************************************************************
1464 ! End
1465 ! ******************************************************************************
1466 
1467 
1468 END MODULE rflu_modgambit
1469 
1470 ! ******************************************************************************
1471 !
1472 ! RCS Revision history:
1473 !
1474 ! $Log: RFLU_ModGAMBIT.F90,v $
1475 ! Revision 1.4 2008/12/06 08:45:03 mtcampbe
1476 ! Updated license.
1477 !
1478 ! Revision 1.3 2008/11/19 22:18:14 mtcampbe
1479 ! Added Illinois Open Source License/Copyright
1480 !
1481 ! Revision 1.2 2006/03/25 22:04:29 haselbac
1482 ! Changes because of sype patches
1483 !
1484 ! Revision 1.1 2005/04/15 15:09:09 haselbac
1485 ! Initial revision
1486 !
1487 ! Revision 1.3 2005/01/20 14:54:56 haselbac
1488 ! Added setting of nBFaces and nBFacesTot
1489 !
1490 ! Revision 1.2 2004/11/03 17:12:15 haselbac
1491 ! Removed setting of vertex and cell flags
1492 !
1493 ! Revision 1.1 2004/11/03 15:06:57 haselbac
1494 ! Initial revision
1495 !
1496 ! ******************************************************************************
1497 
1498 
1499 
1500 
1501 
1502 
1503 
1504 
1505 
rflu_modgrid
Definition: RFLU_ModGrid.F90:39
Container_from_circulator::end
iterator end()
Definition: circulator.h:756
rflu_modgambit
Definition: RFLU_ModGAMBIT.F90:39
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
Attribute::status
int status() const
Obtain the status of the attribute.
Definition: Attribute.h:240
rflu_modgambit::t_patchgambit
Definition: RFLU_ModGAMBIT.F90:68
modgrid::t_grid
Definition: ModGrid.F90:56
buildfilenameplain
subroutine buildfilenameplain(global, dest, ext, fileName)
Definition: BuildFileNamePlain.F90:48
rflu_modgambit::rflu_readgridgambitneutral
subroutine, public rflu_readgridgambitneutral(pRegion)
Definition: RFLU_ModGAMBIT.F90:1017
rflu_modgambit::rflu_convgambit2rocflu
subroutine, public rflu_convgambit2rocflu(pRegion)
Definition: RFLU_ModGAMBIT.F90:270
form
**********************************************************************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
Definition: RFLO_ReadDataFileInt.h:26
rflu_modgambit::rflu_checkgridgambit
subroutine rflu_checkgridgambit(pRegion)
Definition: RFLU_ModGAMBIT.F90:159
rflu_moddimensions::rflu_setmaxdimension
INTEGER function, public rflu_setmaxdimension(global, nXyzTot)
Definition: RFLU_ModDimensions.F90:559
j
j indices j
Definition: Indexing.h:6
rflu_moddimensions
Definition: RFLU_ModDimensions.F90:39
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
rflu_modgambit::t_gridgambit
Definition: RFLU_ModGAMBIT.F90:73
modbndpatch::t_patch
Definition: ModBndPatch.F90:91
rflu_modgambit::rflu_printgridgambitinfo
subroutine rflu_printgridgambitinfo(pRegion)
Definition: RFLU_ModGAMBIT.F90:934