Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModMESH3D.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 MESH3D grids.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModMESH3D.F90,v 1.5 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 
53 
54  IMPLICIT NONE
55 
56 ! ******************************************************************************
57 ! Declarations and definitions
58 ! ******************************************************************************
59 
60  PRIVATE
61 
62 ! ==============================================================================
63 ! Data
64 ! ==============================================================================
65 
66  CHARACTER(CHRLEN) :: &
67  RCSIdentString = '$RCSfile: RFLU_ModMESH3D.F90,v $ $Revision: 1.5 $'
68 
70  INTEGER :: nBQuads,nBTris,nMappings,nPatches
71  INTEGER, DIMENSION(:), POINTER :: bTri2p
72  INTEGER, DIMENSION(:,:), POINTER :: bTri2v,patch2bc
73  END TYPE t_gridmesh3d
74 
75  TYPE(t_gridmesh3d) :: gridMESH3D
76 
77 ! ==============================================================================
78 ! Public procedures
79 ! ==============================================================================
80 
81  PUBLIC :: rflu_convmesh3d2rocflu, &
83 
84 ! ******************************************************************************
85 ! Routines
86 ! ******************************************************************************
87 
88  CONTAINS
89 
90 
91 
92 
93 
94 
95 
96 ! ******************************************************************************
97 !
98 ! Purpose: Convert grid format from MESH3D to ROCFLU.
99 !
100 ! Description: None.
101 !
102 ! Input:
103 ! pRegion Pointer to region
104 !
105 ! Output: None.
106 !
107 ! Notes: None.
108 !
109 ! ******************************************************************************
110 
111  SUBROUTINE rflu_convmesh3d2rocflu(pRegion)
112 
113  IMPLICIT NONE
114 
115 ! ******************************************************************************
116 ! Declarations and definitions
117 ! ******************************************************************************
118 
119 ! ==============================================================================
120 ! Arguments
121 ! ==============================================================================
122 
123  TYPE(t_region), POINTER :: pregion
124 
125 ! ==============================================================================
126 ! Local variables
127 ! ==============================================================================
128 
129  CHARACTER(CHRLEN) :: ifilename
130  INTEGER :: errorflag,i,ibegmax,ibegmin,ibeg1,ibeg2,ic,iendmax,iendmin, &
131  iend1,iend2,ifile,ifl,imap,imap2,ipatch,it,nbtris,term
132  INTEGER, DIMENSION(:), ALLOCATABLE :: cntr
133  TYPE(t_grid), POINTER :: pgrid
134  TYPE(t_patch), POINTER :: ppatch
135  TYPE(t_global), POINTER :: global
136 
137 ! ******************************************************************************
138 ! Start
139 ! ******************************************************************************
140 
141  global => pregion%global
142 
143  CALL registerfunction(global,'RFLU_ConvMESH3D2ROCFLU', &
144  'RFLU_ModMESH3D.F90')
145 
146  IF ( global%verbLevel > verbose_none ) THEN
147  WRITE(stdout,'(A,1X,A)') solver_name, &
148  'Converting from MESH3D to ROCFLU format...'
149  END IF ! global%verbLevel
150 
151 ! ==============================================================================
152 ! Set grid pointer and initialize variables
153 ! ==============================================================================
154 
155  pgrid => pregion%grid
156 
157  pgrid%nEdges = 0
158  pgrid%nEdgesTot = 0
159 
160  pgrid%nFaces = 0
161  pgrid%nFacesTot = 0
162 
163 ! ==============================================================================
164 ! Read additional info on grid, required for mapping of patches
165 ! ==============================================================================
166 
167  IF ( global%verbLevel > verbose_none ) THEN
168  WRITE(stdout,'(A,3X,A)') solver_name, &
169  'Reading MESH3D information file...'
170  END IF ! global%verbLevel
171 
172  ifile = if_grid
173 
174  CALL buildfilenameplain(global,filedest_indir,'.mgi',ifilename)
175 
176  OPEN(ifile,file=ifilename,form="FORMATTED",status="OLD",iostat=errorflag)
177  global%error = errorflag
178  IF ( global%error /= err_none ) THEN
179  CALL errorstop(global,err_file_open,__line__,ifilename)
180  END IF ! global%error
181 
182 ! ==============================================================================
183 ! Convert patch data structure
184 ! ==============================================================================
185 
186  READ(ifile,*) gridmesh3d%nPatches
187 
188  pgrid => pregion%grid
189 
190  READ(ifile,*) pgrid%nPatches
191 
192  ALLOCATE(pregion%patches(pgrid%nPatches),stat=errorflag)
193  global%error = errorflag
194  IF ( global%error /= err_none ) THEN
195  CALL errorstop(global,err_allocate,__line__,'pRegion%patches')
196  END IF ! global%error
197 
198  READ(ifile,*) gridmesh3d%nMappings
199 
200  ALLOCATE(gridmesh3d%patch2bc(3,gridmesh3d%nMappings),stat=errorflag)
201  global%error = errorflag
202  IF ( global%error /= err_none ) THEN
203  CALL errorstop(global,err_allocate,__line__,'gridMESH3D%patch2bc')
204  END IF ! global%error
205 
206  DO imap = 1,gridmesh3d%nMappings
207  READ(ifile,*) (gridmesh3d%patch2bc(i,imap),i=1,3)
208  END DO ! iMap
209 
210  CLOSE(ifile,iostat=errorflag)
211  global%error = errorflag
212  IF ( global%error /= err_none ) THEN
213  CALL errorstop(global,err_file_close,__line__,ifilename)
214  END IF ! global%error
215 
216 ! ==============================================================================
217 ! Check for consistent input - somewhat complicated...
218 ! ==============================================================================
219 
220  IF ( global%checkLevel > check_none ) THEN
221  IF ( global%verbLevel > verbose_none ) THEN
222  WRITE(stdout,'(A,5X,A)') solver_name,'Checking patch mapping entries...'
223  END IF ! global%verbLevel
224 
225  DO imap = 1,gridmesh3d%nMappings
226  IF ( gridmesh3d%patch2bc(2,imap) < gridmesh3d%patch2bc(1,imap) ) THEN
227  IF ( global%verbLevel > verbose_none ) THEN
228  WRITE(stdout,'(A,7X,A)') solver_name,'Check failed.'
229  END IF ! global%verbLevel
230  CALL errorstop(global,err_patch_numbering,__line__)
231  END IF ! gridMESH3D
232  END DO ! iMap
233 
234  DO imap = 1,gridmesh3d%nMappings
235  IF ( minval(gridmesh3d%patch2bc(3,:)) /= 1 .OR. &
236  maxval(gridmesh3d%patch2bc(3,:)) /= pgrid%nPatches ) THEN
237  IF ( global%verbLevel > verbose_none ) THEN
238  WRITE(stdout,'(A,7X,A)') solver_name,'Check failed.'
239  END IF ! global%verbLevel
240  CALL errorstop(global,err_patch_numbering,__line__)
241  END IF ! gridMESH3D
242  END DO ! iMap
243 
244  DO imap = 1,gridmesh3d%nMappings
245  DO imap2 = 1,gridmesh3d%nMappings
246 
247  IF ( imap /= imap2 ) THEN
248  ibeg1 = gridmesh3d%patch2bc(1,imap)
249  iend1 = gridmesh3d%patch2bc(2,imap)
250 
251  ibeg2 = gridmesh3d%patch2bc(1,imap2)
252  iend2 = gridmesh3d%patch2bc(2,imap2)
253 
254  IF ( ibeg1 < ibeg2 ) THEN
255  ibegmin = ibeg1
256  iendmin = iend1
257  ibegmax = ibeg2
258  iendmax = iend2
259  ELSE IF ( ibeg1 > ibeg2 ) THEN
260  ibegmin = ibeg2
261  iendmin = iend2
262  ibegmax = ibeg1
263  iendmax = iend1
264  ELSE ! iBeg1 and iBeg2 have the same value
265  IF ( global%verbLevel > verbose_none ) THEN
266  WRITE(stdout,'(A,7X,A)') solver_name,'Check failed.'
267  END IF ! global%verbLevel
268  CALL errorstop(global,err_patch_numbering,__line__)
269  END IF ! iBeg1
270 
271  IF ( iendmax <= iendmin .OR. iendmin >= ibegmax ) THEN
272  IF ( global%verbLevel > verbose_none ) THEN
273  WRITE(stdout,'(A,7X,A)') solver_name,'Check failed.'
274  END IF ! global%verbLevel
275  CALL errorstop(global,err_patch_numbering,__line__)
276  END IF ! iEndMax
277  END IF ! iMap
278 
279  END DO ! iMap2
280  END DO ! iMap
281 
282  IF ( global%verbLevel > verbose_none ) THEN
283  WRITE(stdout,'(A,5X,A)') solver_name, &
284  'Checking patch mapping entries done.'
285  END IF ! global%verbLevel
286  END IF ! global%checkLevel
287 
288  IF ( global%verbLevel > verbose_none ) THEN
289  WRITE(stdout,'(A,3X,A)') solver_name, &
290  'Information file read successfully...'
291  END IF ! global%verbLevel
292 
293 ! ******************************************************************************
294 ! Convert to ROCFLU format
295 ! ******************************************************************************
296 
297  global%nPatches = pgrid%nPatches
298 
299 ! ==============================================================================
300 ! Generate boundary triangle lists - NOTE renumbering!
301 ! ==============================================================================
302 
303  IF ( global%verbLevel > verbose_none ) THEN
304  WRITE(stdout,'(A,3X,A)') solver_name, &
305  'Generating boundary triangle lists...'
306  END IF ! global%verbLevel
307 
308 ! ------------------------------------------------------------------------------
309 ! Count number of boundary faces
310 ! ------------------------------------------------------------------------------
311 
312  ALLOCATE(cntr(pgrid%nPatches),stat=errorflag)
313  global%error = errorflag
314  IF ( global%error /= err_none ) THEN
315  CALL errorstop(global,err_allocate,__line__,'cntr')
316  END IF ! global%error
317 
318  cntr(:) = 0
319 
320  DO it = 1,gridmesh3d%nBTris
321  DO imap = 1,gridmesh3d%nMappings
322  IF ( gridmesh3d%bTri2p(it) >= gridmesh3d%patch2bc(1,imap) .AND. &
323  gridmesh3d%bTri2p(it) <= gridmesh3d%patch2bc(2,imap) ) THEN
324  ipatch = gridmesh3d%patch2bc(3,imap)
325 
326  cntr(ipatch) = cntr(ipatch) + 1
327  EXIT
328  END IF ! gridMESH3D
329  END DO ! iMap
330  END DO ! it
331 
332  DO ipatch = 1,pgrid%nPatches
333  ppatch => pregion%patches(ipatch)
334 
335  ppatch%nBTris = cntr(ipatch)
336  ppatch%nBQuads = 0
337  ppatch%nBVert = 0
338 
339  ppatch%iPatchGlobal = ipatch
340  ppatch%iBorder = patch_iborder_default
341  ppatch%renumFlag = .false.
342 
343  IF ( ipatch > 1 ) THEN
344  cntr(ipatch) = cntr(ipatch) + cntr(ipatch-1)
345  END IF ! iPatch
346  END DO ! iPatch
347 
348  IF ( cntr(pgrid%nPatches) /= gridmesh3d%nBTris ) THEN
349  CALL errorstop(global,err_nbfaces_wrong,__line__)
350  END IF ! grid
351 
352 ! ------------------------------------------------------------------------------
353 ! Set total boundary patch quantities and number of boundary faces
354 ! ------------------------------------------------------------------------------
355 
356  pgrid%nBFaces = 0
357 
358  DO ipatch = 1,pgrid%nPatches
359  ppatch => pregion%patches(ipatch)
360 
361  ppatch%nBFaces = ppatch%nBTris + ppatch%nBQuads
362  pgrid%nBFaces = pgrid%nBFaces + ppatch%nBFaces
363 
364  ppatch%nBFacesTot = ppatch%nBFaces
365  ppatch%nBQuadsTot = ppatch%nBQuads
366  ppatch%nBTrisTot = ppatch%nBTris
367  ppatch%nBVertTot = ppatch%nBVert
368 
369  ppatch%nBTrisMax = rflu_setmaxdimension(global,ppatch%nBTrisTot)
370  ppatch%nBQuadsMax = rflu_setmaxdimension(global,ppatch%nBQuadsTot)
371  ppatch%nBFacesMax = rflu_setmaxdimension(global,ppatch%nBFacesTot)
372  ppatch%nBVertMax = rflu_setmaxdimension(global,ppatch%nBVertTot)
373 
374  ppatch%nBCellsVirt = 0
375  END DO ! iPatch
376 
377  pgrid%nBFacesTot = pgrid%nBFaces
378 
379 ! ------------------------------------------------------------------------------
380 ! Build face lists
381 ! ------------------------------------------------------------------------------
382 
383  DO ipatch = 1,pgrid%nPatches
384  ppatch => pregion%patches(ipatch)
385 
386  ALLOCATE(ppatch%bTri2v(3,ppatch%nBTrisMax),stat=errorflag)
387  global%error = errorflag
388  IF ( global%error /= err_none ) THEN
389  CALL errorstop(global,err_allocate,__line__,'pPatch%bTri2v')
390  END IF ! global%error
391  END DO ! iPatch
392 
393  cntr(:) = 0
394 
395  DO it = 1,gridmesh3d%nBTris
396  DO imap = 1,gridmesh3d%nMappings
397  IF ( gridmesh3d%bTri2p(it) >= gridmesh3d%patch2bc(1,imap) .AND. &
398  gridmesh3d%bTri2p(it) <= gridmesh3d%patch2bc(2,imap) ) THEN
399  ipatch = gridmesh3d%patch2bc(3,imap)
400  ppatch => pregion%patches(ipatch)
401 
402  cntr(ipatch) = cntr(ipatch) + 1
403 
404  ppatch%bTri2v(1,cntr(ipatch)) = gridmesh3d%bTri2v(1,it)
405  ppatch%bTri2v(2,cntr(ipatch)) = gridmesh3d%bTri2v(3,it)
406  ppatch%bTri2v(3,cntr(ipatch)) = gridmesh3d%bTri2v(2,it)
407  EXIT
408  END IF ! gridMESH3D
409  END DO ! iMap
410  END DO ! it
411 
412  DEALLOCATE(cntr,stat=errorflag)
413  global%error = errorflag
414  IF ( global%error /= err_none ) THEN
415  CALL errorstop(global,err_deallocate,__line__,'cntr')
416  END IF ! global%error
417 
418  IF ( global%verbLevel > verbose_none ) THEN
419  WRITE(stdout,'(A,3X,A)') solver_name, &
420  'Generating boundary triangle lists done.'
421  END IF ! global%verbLevel
422 
423 ! ==============================================================================
424 ! Convert tetrahedra to ROCFLU format - NOTE renumbering!
425 ! ==============================================================================
426 
427  IF ( global%verbLevel > verbose_none ) THEN
428  WRITE(stdout,'(A,3X,A)') solver_name,'Renumbering tetrahedra...'
429  END IF ! global%verbLevel
430 
431  DO ic = 1,pgrid%nTetsTot
432  term = pgrid%tet2v(2,ic)
433  pgrid%tet2v(2,ic) = pgrid%tet2v(3,ic)
434  pgrid%tet2v(3,ic) = term
435  END DO ! iv
436 
437  IF ( global%verbLevel > verbose_none ) THEN
438  WRITE(stdout,'(A,3X,A)') solver_name,'Renumbering tetrahedra done.'
439  END IF ! global%verbLevel
440 
441 ! ==============================================================================
442 ! Initialize other cell types
443 ! ==============================================================================
444 
445  pgrid%nHexsTot = 0
446  pgrid%nPrisTot = 0
447  pgrid%nPyrsTot = 0
448 
449  pgrid%nHexs = pgrid%nHexsTot
450  pgrid%nPris = pgrid%nPrisTot
451  pgrid%nPyrs = pgrid%nPyrsTot
452 
453 ! ******************************************************************************
454 ! Deallocate MESH3D memory
455 ! ******************************************************************************
456 
457  DEALLOCATE(gridmesh3d%patch2bc,stat=errorflag)
458  global%error = errorflag
459  IF ( global%error /= err_none ) THEN
460  CALL errorstop(global,err_deallocate,__line__,'gridMESH3D%patch2bc')
461  END IF ! global%error
462 
463  DEALLOCATE(gridmesh3d%bTri2v,stat=errorflag)
464  global%error = errorflag
465  IF ( global%error /= err_none ) THEN
466  CALL errorstop(global,err_deallocate,__line__,'gridMESH3D%bTri2v')
467  END IF ! global%error
468 
469  DEALLOCATE(gridmesh3d%bTri2p,stat=errorflag)
470  global%error = errorflag
471  IF ( global%error /= err_none ) THEN
472  CALL errorstop(global,err_deallocate,__line__,'gridMESH3D%bTri2p')
473  END IF ! global%error
474 
475 ! ******************************************************************************
476 ! Allocate memory for boundary face lists bf2c and bf2v
477 ! ******************************************************************************
478 
479  DO ipatch = 1,pgrid%nPatches
480  ppatch => pregion%patches(ipatch)
481 
482  ALLOCATE(ppatch%bf2c(ppatch%nBFacesMax),stat=errorflag)
483  global%error = errorflag
484  IF ( global%error /= err_none ) THEN
485  CALL errorstop(global,err_allocate,__line__,'pPatch%bf2c')
486  END IF ! global%error
487 
488  ALLOCATE(ppatch%bf2v(4,ppatch%nBFacesMax),stat=errorflag)
489  global%error = errorflag
490  IF ( global%error /= err_none ) THEN
491  CALL errorstop(global,err_allocate,__line__,'pPatch%bf2v')
492  END IF ! global%error
493 
494  DO ifl = 1,ppatch%nBFacesMax
495  ppatch%bf2v(1,ifl) = vert_none
496  ppatch%bf2v(2,ifl) = vert_none
497  ppatch%bf2v(3,ifl) = vert_none
498  ppatch%bf2v(4,ifl) = vert_none
499  END DO ! ifl
500  END DO ! iPatch
501 
502 ! ******************************************************************************
503 ! End
504 ! ******************************************************************************
505 
506  IF ( global%verbLevel > verbose_none ) THEN
507  WRITE(stdout,'(A,1X,A)') solver_name, &
508  'Converting from MESH3D to ROCFLU format done.'
509  END IF ! global%verbLevel
510 
511  CALL deregisterfunction(global)
512 
513  END SUBROUTINE rflu_convmesh3d2rocflu
514 
515 
516 
517 
518 
519 
520 
521 ! ******************************************************************************
522 !
523 ! Purpose: Read grid file from MESH3D in ASCII format.
524 !
525 ! Description: None.
526 !
527 ! Input:
528 ! pRegion Pointer to region
529 !
530 ! Output: None.
531 !
532 ! Notes:
533 ! 1. Part of the file is read directly into the grid data structure, while
534 ! the remainder needs to be processed in RFLU_ConvMESH3D2ROCFLU.F90.
535 !
536 ! ******************************************************************************
537 
538  SUBROUTINE rflu_readgridmesh3d(pRegion)
539 
540  IMPLICIT NONE
541 
542 ! ******************************************************************************
543 ! Declarations and definitions
544 ! ******************************************************************************
545 
546 ! ==============================================================================
547 ! Arguments
548 ! ==============================================================================
549 
550  TYPE(t_region), POINTER :: pregion
551 
552 ! ==============================================================================
553 ! Local variables
554 ! ==============================================================================
555 
556  CHARACTER(CHRLEN) :: dummystring,ifilename
557  INTEGER :: cvmax,cvmin,dummyinteger,errorflag,i,ic,ifile,it,iv
558  TYPE(t_grid), POINTER :: pgrid
559  TYPE(t_global), POINTER :: global
560 
561 ! ******************************************************************************
562 ! Start
563 ! ******************************************************************************
564 
565  gridmesh3d%nBTris = 0
566  gridmesh3d%nBQuads = 0
567 
568 ! ******************************************************************************
569 ! Read grid file
570 ! ******************************************************************************
571 
572  global => pregion%global
573 
574  CALL registerfunction(global,'RFLU_ReadGridMESH3D', &
575  'RFLU_ModMESH3D.F90')
576 
577  IF ( global%verbLevel > verbose_none ) THEN
578  WRITE(stdout,'(A,1X,A)') solver_name,'Reading MESH3D grid file...'
579  END IF ! global%verbLevel
580 
581  ifile = if_grid
582 
583  CALL buildfilenameplain(global,filedest_indir,'.m3d',ifilename)
584 
585  OPEN(ifile,file=ifilename,form="FORMATTED",status="OLD",iostat=errorflag )
586  global%error = errorflag
587  IF ( global%error /= err_none ) THEN
588  CALL errorstop(global,err_file_open,__line__,ifilename)
589  END IF ! global%error
590 
591 ! ==============================================================================
592 ! Coordinates
593 ! ==============================================================================
594 
595  pgrid => pregion%grid
596 
597  IF ( global%verbLevel > verbose_none ) THEN
598  WRITE(stdout,'(A,3X,A)') solver_name,'Coordinates...'
599  END IF ! global%verbLevel
600 
601  READ(ifile,'(A)') dummystring
602  READ(ifile,*) pgrid%nVertTot
603  READ(ifile,'(A)') dummystring
604 
605  pgrid%nVert = pgrid%nVertTot
606  pgrid%nVertMax = rflu_setmaxdimension(global,pgrid%nVertTot)
607 
608  ALLOCATE(pgrid%xyz(3,pgrid%nVertMax),stat=errorflag)
609  global%error = errorflag
610  IF ( global%error /= err_none ) THEN
611  CALL errorstop(global,err_allocate,__line__,'pGrid%xyz')
612  END IF ! global%error
613 
614  DO iv = 1,pgrid%nVertTot
615  READ(ifile,*) (pgrid%xyz(i,iv),i=1,3)
616  END DO ! iv
617 
618 ! ==============================================================================
619 ! Boundary Faces
620 ! ==============================================================================
621 
622  IF ( global%verbLevel > verbose_none ) THEN
623  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary faces...'
624  END IF ! global%verbLevel
625 
626  READ(ifile,'(A)') dummystring
627  READ(ifile,*) gridmesh3d%nBTris
628  READ(ifile,'(A)') dummystring
629 
630  ALLOCATE(gridmesh3d%bTri2p(gridmesh3d%nBTris),stat=errorflag)
631  global%error = errorflag
632  IF ( global%error /= err_none ) THEN
633  CALL errorstop(global,err_allocate,__line__,'gridMESH3D%bTri2p')
634  END IF ! global%error
635 
636  ALLOCATE(gridmesh3d%bTri2v(3,gridmesh3d%nBTris),stat=errorflag)
637  global%error = errorflag
638  IF ( global%error /= err_none ) THEN
639  CALL errorstop(global,err_allocate,__line__,'gridMESH3D%bTri2v')
640  END IF ! global%error
641 
642  DO it = 1,gridmesh3d%nBTris
643  READ(ifile,*) (gridmesh3d%bTri2v(iv,it),iv=1,3),gridmesh3d%bTri2p(it)
644  END DO ! it
645 
646 ! ==============================================================================
647 ! Connectivity
648 ! ==============================================================================
649 
650  IF ( global%verbLevel > verbose_none ) THEN
651  WRITE(stdout,'(A,3X,A)') solver_name,'Connectivity...'
652  END IF ! global%verbLevel
653 
654  READ(ifile,'(A)') dummystring
655  READ(ifile,*) pgrid%nTetsTot
656  READ(ifile,'(A)') dummystring
657 
658  pgrid%nTets = pgrid%nTetsTot
659  pgrid%nTetsMax = rflu_setmaxdimension(global,pgrid%nTetsTot)
660 
661  pgrid%nCells = pgrid%nTets ! MESH3D only generates tetrahedral grids
662  pgrid%nCellsTot = pgrid%nTetsTot
663  pgrid%nCellsMax = pgrid%nTetsMax
664 
665  ALLOCATE(pgrid%tet2v(4,pgrid%nTetsMax),stat=errorflag)
666  global%error = errorflag
667  IF ( global%error /= err_none ) THEN
668  CALL errorstop(global,err_allocate,__line__,'pGrid%tet2v')
669  END IF ! global%error
670 
671  DO ic = 1,pgrid%nTetsTot
672  READ(ifile,*) (pgrid%tet2v(iv,ic),iv=1,4)
673  END DO ! ic
674 
675 ! ==============================================================================
676 ! Checking - only valid for tetrahedral grids, cf. RFLU_ReadGridCENTAUR.F90
677 ! ==============================================================================
678 
679  IF ( global%checkLevel > check_none ) THEN
680  IF ( global%verbLevel > verbose_none ) THEN
681  WRITE(stdout,'(A,3X,A)') solver_name, &
682  'Checking face connectivity array entries...'
683  END IF ! global%verbLevel
684 
685  cvmin = minval(gridmesh3d%bTri2v(1:3,1:gridmesh3d%nBTris))
686  cvmax = maxval(gridmesh3d%bTri2v(1:3,1:gridmesh3d%nBTris))
687 
688  IF ( cvmin < 1 .OR. cvmax > pgrid%nVertTot ) THEN
689  IF ( global%verbLevel > verbose_none ) THEN
690  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
691  END IF ! global%verbLevel
692  CALL errorstop(global,err_vertex_number,__line__)
693  END IF ! cvmin
694 
695  IF ( global%verbLevel > verbose_none ) THEN
696  WRITE(stdout,'(A,3X,A)') solver_name, &
697  'Checking face connectivity array entries done.'
698  END IF ! global%verbLevel
699 
700 
701  IF ( global%verbLevel > verbose_none ) THEN
702  WRITE(stdout,'(A,3X,A)') solver_name, &
703  'Checking cell connectivity array entries...'
704  END IF ! global%verbLevel
705 
706  cvmin = minval(pgrid%tet2v(1:4,1:pgrid%nTetsTot))
707  cvmax = maxval(pgrid%tet2v(1:4,1:pgrid%nTetsTot))
708 
709  IF ( cvmin /= 1 .OR. cvmax /= pgrid%nVertTot ) THEN
710  IF ( global%verbLevel > verbose_none ) THEN
711  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
712  END IF ! global%verbLevel
713  CALL errorstop(global,err_vertex_number,__line__)
714  END IF ! cvmin
715 
716  IF ( global%verbLevel > verbose_none ) THEN
717  WRITE(stdout,'(A,3X,A)') solver_name, &
718  'Checking cell connectivity array entries done.'
719  END IF ! global%verbLevel
720  END IF ! global%checkLevel
721 
722  CLOSE(ifile,iostat=errorflag)
723  global%error = errorflag
724  IF ( global%error /= err_none ) THEN
725  CALL errorstop(global,err_file_close,__line__,ifilename)
726  END IF ! global%error
727 
728 ! ******************************************************************************
729 ! Print grid statistics
730 ! ******************************************************************************
731 
732  IF ( global%verbLevel > verbose_none ) THEN
733  WRITE(stdout,'(A,3X,A)') solver_name,'Grid Statistics:'
734  WRITE(stdout,'(A,5X,A,2X,I9)') solver_name,'Vertices: ', &
735  pgrid%nVertTot
736  WRITE(stdout,'(A,5X,A,2X,I9)') solver_name,'Tetrahedra: ', &
737  pgrid%nTetsTot
738  WRITE(stdout,'(A,5X,A,2X,I9)') solver_name,'Boundary triangles:', &
739  gridmesh3d%nBTris
740  END IF ! global%verbLevel
741 
742 ! ******************************************************************************
743 ! End
744 ! ******************************************************************************
745 
746  IF ( global%verbLevel > verbose_none ) THEN
747  WRITE(stdout,'(A,1X,A)') solver_name,'Reading MESH3D grid file done.'
748  END IF ! global%verbLevel
749 
750  CALL deregisterfunction(global)
751 
752  END SUBROUTINE rflu_readgridmesh3d
753 
754 
755 
756 
757 
758 
759 ! ******************************************************************************
760 ! End
761 ! ******************************************************************************
762 
763 
764 END MODULE rflu_modmesh3d
765 
766 ! ******************************************************************************
767 !
768 ! RCS Revision history:
769 !
770 ! $Log: RFLU_ModMESH3D.F90,v $
771 ! Revision 1.5 2008/12/06 08:45:03 mtcampbe
772 ! Updated license.
773 !
774 ! Revision 1.4 2008/11/19 22:18:14 mtcampbe
775 ! Added Illinois Open Source License/Copyright
776 !
777 ! Revision 1.3 2006/04/18 21:02:38 haselbac
778 ! Fixed checks; bug arose bcos of max-dimensioned arrays for sype
779 !
780 ! Revision 1.2 2006/03/25 22:04:29 haselbac
781 ! Changes because of sype patches
782 !
783 ! Revision 1.1 2005/04/15 15:09:10 haselbac
784 ! Initial revision
785 !
786 ! Revision 1.4 2005/01/20 14:54:56 haselbac
787 ! Added setting of nBFaces and nBFacesTot
788 !
789 ! Revision 1.3 2004/11/03 17:09:24 haselbac
790 ! Removed setting of vertex and cell flags
791 !
792 ! Revision 1.2 2004/10/19 19:31:12 haselbac
793 ! Removed renumbering of bface lists
794 !
795 ! Revision 1.1 2004/07/06 15:15:48 haselbac
796 ! Initial revision
797 !
798 ! ******************************************************************************
799 
800 
801 
802 
803 
804 
805 
806 
807 
subroutine, public rflu_readgridmesh3d(pRegion)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
int status() const
Obtain the status of the attribute.
Definition: Attribute.h:240
**********************************************************************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 ic
subroutine buildfilenameplain(global, dest, ext, fileName)
blockLoc i
Definition: read.cpp:79
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com WITHOUT WARRANTY OF ANY **EXPRESS OR INCLUDING BUT NOT LIMITED TO THE WARRANTIES **OF FITNESS FOR A PARTICULAR PURPOSE AND **NONINFRINGEMENT IN NO EVENT SHALL THE CONTRIBUTORS OR **COPYRIGHT HOLDERS BE LIABLE FOR ANY DAMAGES OR OTHER WHETHER IN AN ACTION OF TORT OR **Arising OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE **USE OR OTHER DEALINGS WITH THE SOFTWARE **********************************************************************INTERFACE SUBROUTINE form
INTEGER function, public rflu_setmaxdimension(global, nXyzTot)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine, public rflu_convmesh3d2rocflu(pRegion)
subroutine deregisterfunction(global)
Definition: ModError.F90:469