Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModVGRIDns.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_ModVGRIDns.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_ModVGRIDns.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_gridvgridns
74 
75  TYPE(t_gridvgridns) :: gridVGRIDns
76 
77 ! ==============================================================================
78 ! Public procedures
79 ! ==============================================================================
80 
81  PUBLIC :: rflu_convvgridns2rocflu, &
83 
84 ! ******************************************************************************
85 ! Routines
86 ! ******************************************************************************
87 
88  CONTAINS
89 
90 
91 
92 
93 
94 
95 ! ******************************************************************************
96 !
97 ! Purpose: Convert grid format from VGRIDns to ROCFLU.
98 !
99 ! Description: None.
100 !
101 ! Input:
102 ! pRegion Pointer to region
103 !
104 ! Output: None.
105 !
106 ! Notes:
107 ! 1. Read triangles as 132 to reverse normal vector (inwards in VGRIDns)
108 !
109 ! ******************************************************************************
110 
111  SUBROUTINE rflu_convvgridns2rocflu(pRegion)
112 
113  IMPLICIT NONE
114 
115 ! ******************************************************************************
116 ! Declarations and definitions
117 ! ******************************************************************************
118 
119 ! ==============================================================================
120 ! Local variables
121 ! ==============================================================================
122 
123  CHARACTER(CHRLEN) :: ifilename
124  INTEGER :: errorflag,i,ibegmax,ibegmin,ibeg1,ibeg2,ic,iendmax, &
125  iendmin,iend1,iend2,ifile,ifl,imap,imap2,ipatch,it,term
126  INTEGER, DIMENSION(:), ALLOCATABLE :: cntr
127  TYPE(t_grid), POINTER :: pgrid
128  TYPE(t_patch), POINTER :: ppatch
129  TYPE(t_global), POINTER :: global
130 
131 ! ==============================================================================
132 ! Arguments
133 ! ==============================================================================
134 
135  TYPE(t_region), POINTER :: pregion
136 
137 ! ******************************************************************************
138 ! Start
139 ! ******************************************************************************
140 
141  global => pregion%global
142 
143  CALL registerfunction(global,'RFLU_ConvVGRIDns2ROCFLU', &
144  'RFLU_ModVGRIDns.F90')
145 
146  IF ( global%verbLevel > verbose_none ) THEN
147  WRITE(stdout,'(A,1X,A)') solver_name, &
148  'Converting from VGRIDns 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,'Reading VGRIDns information file...'
169  END IF ! global%verbLevel
170 
171  ifile = if_grid
172 
173  CALL buildfilenameplain(global,filedest_indir,'.vgi',ifilename)
174 
175  OPEN(ifile,file=ifilename,form="FORMATTED",status="OLD",iostat=errorflag )
176  global%error = errorflag
177  IF ( global%error /= err_none ) THEN
178  CALL errorstop(global,err_file_open,__line__,ifilename)
179  END IF ! global%error
180 
181  READ(ifile,*) pgrid%nPatches
182 
183  ALLOCATE(pregion%patches(pgrid%nPatches),stat=errorflag)
184  global%error = errorflag
185  IF ( global%error /= err_none ) THEN
186  CALL errorstop(global,err_allocate,__line__,'pRegion%patches')
187  END IF ! global%error
188 
189  READ(ifile,*) gridvgridns%nMappings
190 
191  ALLOCATE(gridvgridns%patch2bc(3,gridvgridns%nMappings), stat=errorflag )
192  global%error = errorflag
193  IF ( global%error /= err_none ) THEN
194  CALL errorstop(global,err_allocate,__line__,'gridVGRIDns%patch2bc')
195  END IF ! global%error
196 
197  DO imap = 1,gridvgridns%nMappings
198  READ(ifile,*) (gridvgridns%patch2bc(i,imap),i=1,3)
199  END DO ! iMap
200 
201 ! ==============================================================================
202 ! Check for consistent input - somewhat complicated...
203 ! ==============================================================================
204 
205  IF ( global%checkLevel > check_none ) THEN
206  IF ( global%verbLevel > verbose_none ) THEN
207  WRITE(stdout,'(A,3X,A)') solver_name,'Checking patch mapping entries...'
208  END IF ! global%verbLevel
209 
210  IF ( minval(gridvgridns%patch2bc(1,:)) /= 1 .OR. &
211  maxval(gridvgridns%patch2bc(2,:)) /= gridvgridns%nPatches ) THEN
212  IF ( global%verbLevel > verbose_none ) THEN
213  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
214  END IF ! global%verbLevel
215  CALL errorstop(global,err_patch_numbering,__line__)
216  END IF ! MINVAL
217 
218  DO imap = 1,gridvgridns%nMappings
219  IF ( gridvgridns%patch2bc(2,imap) < gridvgridns%patch2bc(1,imap) ) THEN
220  IF ( global%verbLevel > verbose_none ) THEN
221  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
222  END IF ! global%verbLevel
223  CALL errorstop(global,err_patch_numbering,__line__)
224  END IF ! gridVGRIDns
225  END DO ! iMap
226 
227  DO imap = 1,gridvgridns%nMappings
228  IF ( minval(gridvgridns%patch2bc(3,:)) /= 1 .OR. &
229  maxval(gridvgridns%patch2bc(3,:)) /= pgrid%nPatches ) THEN
230  IF ( global%verbLevel > verbose_none ) THEN
231  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
232  END IF ! global%verbLevel
233  CALL errorstop(global,err_patch_numbering,__line__)
234  END IF ! gridVGRIDns
235  END DO ! iMap
236 
237  DO imap = 1,gridvgridns%nMappings
238  DO imap2 = 1,gridvgridns%nMappings
239 
240  IF ( imap /= imap2 ) THEN
241  ibeg1 = gridvgridns%patch2bc(1,imap)
242  iend1 = gridvgridns%patch2bc(2,imap)
243 
244  ibeg2 = gridvgridns%patch2bc(1,imap2)
245  iend2 = gridvgridns%patch2bc(2,imap2)
246 
247  IF ( ibeg1 < ibeg2 ) THEN
248  ibegmin = ibeg1
249  iendmin = iend1
250  ibegmax = ibeg2
251  iendmax = iend2
252  ELSE IF ( ibeg1 > ibeg2 ) THEN
253  ibegmin = ibeg2
254  iendmin = iend2
255  ibegmax = ibeg1
256  iendmax = iend1
257  ELSE ! iBeg1 and iBeg2 have the same value
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,err_patch_numbering,__line__)
262  END IF ! iBeg1
263 
264  IF ( iendmax <= iendmin .OR. iendmin >= ibegmax ) THEN
265  IF ( global%verbLevel > verbose_none ) THEN
266  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
267  END IF ! global%verbLevel
268  CALL errorstop(global,err_patch_numbering,__line__)
269  END IF ! iEndMax
270  END IF ! iMap
271 
272  END DO ! iMap2
273  END DO ! iMap
274 
275  IF ( global%verbLevel > verbose_none ) THEN
276  WRITE(stdout,'(A,3X,A)') solver_name, &
277  'Checking patch mapping entries done.'
278  END IF ! global%verbLevel
279  END IF ! global%checkLevel
280 
281  CLOSE(ifile,iostat=errorflag)
282  global%error = errorflag
283  IF ( global%error /= err_none ) THEN
284  CALL errorstop(global,err_file_close,__line__,ifilename)
285  END IF ! global%error
286 
287  IF ( global%verbLevel > verbose_none ) THEN
288  WRITE(stdout,'(A,3X,A)') solver_name, &
289  'Reading VGRIDns information file done.'
290  END IF ! global%verbLevel
291 
292 ! ******************************************************************************
293 ! Convert to ROCFLU format
294 ! ******************************************************************************
295 
296  global%nPatches = pgrid%nPatches
297 
298 ! ==============================================================================
299 ! Generate boundary triangle lists
300 ! ==============================================================================
301 
302  IF ( global%verbLevel > verbose_none ) THEN
303  WRITE(stdout,'(A,3X,A)') solver_name, &
304  'Generating boundary triangle lists...'
305  END IF ! global%verbLevel
306 
307 ! ------------------------------------------------------------------------------
308 ! Count number of boundary faces
309 ! ------------------------------------------------------------------------------
310 
311  ALLOCATE(cntr(pgrid%nPatches),stat=errorflag)
312  global%error = errorflag
313  IF ( global%error /= err_none ) THEN
314  CALL errorstop(global,err_allocate,__line__,'cntr')
315  END IF ! global%error
316 
317  cntr(:) = 0
318 
319  DO it = 1,gridvgridns%nBTris
320  DO imap = 1,gridvgridns%nMappings
321  IF ( gridvgridns%bTri2p(it) >= gridvgridns%patch2bc(1,imap) .AND. &
322  gridvgridns%bTri2p(it) <= gridvgridns%patch2bc(2,imap) ) THEN
323  ipatch = gridvgridns%patch2bc(3,imap)
324 
325  cntr(ipatch) = cntr(ipatch) + 1
326  EXIT
327  END IF ! gridVGRIDns
328  END DO ! iMap
329  END DO ! it
330 
331  DO ipatch = 1,pgrid%nPatches
332  ppatch => pregion%patches(ipatch)
333 
334  ppatch%nBTris = cntr(ipatch)
335  ppatch%nBQuads = 0
336  ppatch%nBVert = 0
337 
338  ppatch%iPatchGlobal = ipatch
339  ppatch%iBorder = patch_iborder_default
340  ppatch%renumFlag = .false.
341 
342  IF ( ipatch > 1 ) THEN
343  cntr(ipatch) = cntr(ipatch) + cntr(ipatch-1)
344  END IF ! iPatch
345  END DO ! iPatch
346 
347  IF ( cntr(pgrid%nPatches) /= gridvgridns%nBTris ) THEN
348  CALL errorstop(global,err_nbfaces_wrong,__line__)
349  END IF ! grid
350 
351 ! ------------------------------------------------------------------------------
352 ! Set total boundary patch quantities and number of boundary faces
353 ! ------------------------------------------------------------------------------
354 
355  pgrid%nBFaces = 0
356 
357  DO ipatch = 1,pgrid%nPatches
358  ppatch => pregion%patches(ipatch)
359 
360  ppatch%nBFaces = ppatch%nBTris + ppatch%nBQuads
361  pgrid%nBFaces = pgrid%nBFaces + ppatch%nBFaces
362 
363  ppatch%nBFacesTot = ppatch%nBFaces
364  ppatch%nBQuadsTot = ppatch%nBQuads
365  ppatch%nBTrisTot = ppatch%nBTris
366  ppatch%nBVertTot = ppatch%nBVert
367 
368  ppatch%nBTrisMax = rflu_setmaxdimension(global,ppatch%nBTrisTot)
369  ppatch%nBQuadsMax = rflu_setmaxdimension(global,ppatch%nBQuadsTot)
370  ppatch%nBFacesMax = rflu_setmaxdimension(global,ppatch%nBFacesTot)
371  ppatch%nBVertMax = rflu_setmaxdimension(global,ppatch%nBVertTot)
372 
373  ppatch%nBCellsVirt = 0
374  END DO ! iPatch
375 
376  pgrid%nBFacesTot = pgrid%nBFaces
377 
378 ! ------------------------------------------------------------------------------
379 ! Build face lists
380 ! ------------------------------------------------------------------------------
381 
382  DO ipatch = 1,pgrid%nPatches
383  ppatch => pregion%patches(ipatch)
384 
385  ALLOCATE(ppatch%bTri2v(3,ppatch%nBTrisMax),stat=errorflag)
386  global%error = errorflag
387  IF ( global%error /= err_none ) THEN
388  CALL errorstop(global,err_allocate,__line__,'pPatch%bTri2v')
389  END IF ! global%error
390  END DO ! iPatch
391 
392  cntr(:) = 0
393 
394  DO it = 1,gridvgridns%nBTris
395  DO imap = 1,gridvgridns%nMappings
396  IF ( gridvgridns%bTri2p(it) >= gridvgridns%patch2bc(1,imap) .AND. &
397  gridvgridns%bTri2p(it) <= gridvgridns%patch2bc(2,imap) ) THEN
398  ipatch = gridvgridns%patch2bc(3,imap)
399  ppatch => pregion%patches(ipatch)
400 
401  cntr(ipatch) = cntr(ipatch) + 1
402 
403  ppatch%bTri2v(1,cntr(ipatch)) = gridvgridns%bTri2v(1,it)
404  ppatch%bTri2v(2,cntr(ipatch)) = gridvgridns%bTri2v(3,it)
405  ppatch%bTri2v(3,cntr(ipatch)) = gridvgridns%bTri2v(2,it)
406 
407  EXIT
408  END IF ! gridVGRIDns
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 VGRIDns memory
455 ! ******************************************************************************
456 
457  DEALLOCATE(gridvgridns%bTri2v,stat=errorflag)
458  global%error = errorflag
459  IF ( global%error /= err_none ) THEN
460  CALL errorstop(global,err_deallocate,__line__,'gridVGRIDns%bTri2v')
461  END IF ! global%error
462 
463  DEALLOCATE(gridvgridns%bTri2p,stat=errorflag)
464  global%error = errorflag
465  IF ( global%error /= err_none ) THEN
466  CALL errorstop(global,err_deallocate,__line__,'gridVGRIDns%bTri2p')
467  END IF ! global%error
468 
469 ! ******************************************************************************
470 ! Allocate memory for boundary face lists bf2c and bf2v
471 ! ******************************************************************************
472 
473  DO ipatch = 1,pgrid%nPatches
474  ppatch => pregion%patches(ipatch)
475 
476  ALLOCATE(ppatch%bf2c(ppatch%nBFacesMax),stat=errorflag)
477  global%error = errorflag
478  IF ( global%error /= err_none ) THEN
479  CALL errorstop(global,err_allocate,__line__,'pPatch%bf2c')
480  END IF ! global%error
481 
482  ALLOCATE(ppatch%bf2v(4,ppatch%nBFacesMax),stat=errorflag)
483  global%error = errorflag
484  IF ( global%error /= err_none ) THEN
485  CALL errorstop(global,err_allocate,__line__,'pPatch%bf2v')
486  END IF ! global%error
487 
488  DO ifl = 1,ppatch%nBFacesMax
489  ppatch%bf2v(1,ifl) = vert_none
490  ppatch%bf2v(2,ifl) = vert_none
491  ppatch%bf2v(3,ifl) = vert_none
492  ppatch%bf2v(4,ifl) = vert_none
493  END DO ! ifl
494  END DO ! iPatch
495 
496 ! ******************************************************************************
497 ! End
498 ! ******************************************************************************
499 
500  IF ( global%verbLevel > verbose_none ) THEN
501  WRITE(stdout,'(A,1X,A)') solver_name, &
502  'Converting from VGRIDns to ROCFLU format done.'
503  END IF ! global%verbLevel
504 
505  CALL deregisterfunction(global)
506 
507  END SUBROUTINE rflu_convvgridns2rocflu
508 
509 
510 
511 
512 
513 
514 
515 
516 ! ******************************************************************************
517 !
518 ! Purpose: Read grid file from VGRIDns.
519 !
520 ! Description: None.
521 !
522 ! Input:
523 ! pRegion Pointer to region
524 !
525 ! Output: None.
526 !
527 ! Notes:
528 ! 1. .mapbc file not read - information contained in .mapbc file is
529 ! found in more convenient way in user-provided .vgi file. See routine
530 ! RFLU_ConvVGRIDns2ROCFLU.F90.
531 ! 2. Only deals with tetrahedra!
532 !
533 ! ******************************************************************************
534 
535  SUBROUTINE rflu_readgridvgridns(pRegion)
536 
538 
539  IMPLICIT NONE
540 
541 ! ******************************************************************************
542 ! Declarations and definitions
543 ! ******************************************************************************
544 
545 ! ==============================================================================
546 ! Arguments
547 ! ==============================================================================
548 
549  TYPE(t_region), POINTER :: pregion
550 
551 ! ==============================================================================
552 ! Local variables
553 ! ==============================================================================
554 
555  CHARACTER(CHRLEN) :: dummystring,ifilename
556  INTEGER :: cvmax,cvmin,dummyinteger,errorflag,i,ic,ifile,it,iv
557  INTEGER, DIMENSION(:), ALLOCATABLE :: cntr
558  REAL(RFREAL) :: dummyreal
559  TYPE(t_grid), POINTER :: pgrid
560  TYPE(t_global), POINTER :: global
561 
562 ! ******************************************************************************
563 ! Start
564 ! ******************************************************************************
565 
566  gridvgridns%nBTris = 0
567  gridvgridns%nBQuads = 0
568 
569 ! ******************************************************************************
570 ! Read bc file
571 ! ******************************************************************************
572 
573  global => pregion%global
574 
575  CALL registerfunction(global,'RFLU_ReadGridVGRIDns', &
576  'RFLU_ModVGRIDns.F90')
577 
578  IF ( global%verbLevel > verbose_none ) THEN
579  WRITE(stdout,'(A,1X,A)') solver_name,'Reading VGRIDns grid file...'
580  END IF ! global%verbLevel
581 
582  ifile = if_grid
583 
584  CALL buildfilenameplain(global,filedest_indir,'.vbc',ifilename)
585 
586  OPEN(ifile,file=ifilename,form="FORMATTED",status="OLD",iostat=errorflag)
587  global%error = errorflag
588  IF ( global%error /= err_none ) THEN
589  CALL errorstop(global,err_file_open,__line__,ifilename)
590  END IF ! global%error
591 
592 ! ==============================================================================
593 ! General information
594 ! ==============================================================================
595 
596  IF ( global%verbLevel > verbose_none ) THEN
597  WRITE(stdout,'(A,3X,A)') solver_name,'General information...'
598  END IF ! global%verbLevel
599 
600  READ(ifile,*) gridvgridns%nBTris,dummystring,gridvgridns%nPatches, &
601  dummyinteger
602  READ(ifile,'(A)') dummystring
603 
604 ! ==============================================================================
605 ! Boundary faces
606 ! ==============================================================================
607 
608  IF ( global%verbLevel > verbose_none ) THEN
609  WRITE(stdout,'(A,3X,A)') solver_name,'Boundary faces...'
610  END IF ! global%verbLevel
611 
612  ALLOCATE(gridvgridns%bTri2p(gridvgridns%nBTris),stat=errorflag)
613  global%error = errorflag
614  IF ( global%error /= err_none ) THEN
615  CALL errorstop(global,err_allocate,__line__,'gridVGRIDns%bTri2p')
616  END IF ! global%error
617 
618  ALLOCATE(gridvgridns%bTri2v(3,gridvgridns%nBTris),stat=errorflag)
619  global%error = errorflag
620  IF ( global%error /= err_none ) THEN
621  CALL errorstop(global,err_allocate,__line__,'gridVGRIDns%bTri2v')
622  END IF ! global%error
623 
624  DO it = 1,gridvgridns%nBTris
625  READ(ifile,*) dummyinteger,gridvgridns%bTri2p(it), &
626  (gridvgridns%bTri2v(iv,it),iv=1,3)
627  END DO ! it
628 
629  CLOSE(ifile,iostat=errorflag)
630  global%error = errorflag
631  IF ( global%error /= err_none ) THEN
632  CALL errorstop(global,err_file_close,__line__,ifilename)
633  END IF ! global%error
634 
635  IF ( global%verbLevel > verbose_none ) THEN
636  WRITE(stdout,'(A,1X,A)') solver_name,'File read successfully.'
637  END IF ! global%verbLevel
638 
639 ! ******************************************************************************
640 ! Read connectivity and coordinate file
641 ! ******************************************************************************
642 
643  IF ( global%verbLevel > verbose_none ) THEN
644  WRITE(stdout,'(A,1X,A)') solver_name,'Reading VGRIDns .cogsg file...'
645  END IF ! global%verbLevel
646 
647  ifile = if_grid
648 
649  CALL buildfilenameplain(global,filedest_indir,'.cogsg',ifilename)
650 
651  OPEN(ifile,file=ifilename,form="UNFORMATTED",status="OLD",iostat=errorflag)
652  global%error = errorflag
653  IF ( global%error /= err_none ) THEN
654  CALL errorstop(global,err_file_open,__line__,ifilename)
655  END IF ! global%error
656 
657 ! ==============================================================================
658 ! Connectivity
659 ! ==============================================================================
660 
661  pgrid => pregion%grid
662 
663  IF ( global%verbLevel > verbose_none ) THEN
664  WRITE(stdout,'(A,3X,A)') solver_name,'Header...'
665  END IF ! global%verbLevel
666 
667  READ(ifile) dummyinteger,pgrid%nTetsTot,pgrid%nVertTot
668  rewind(ifile)
669 
670  pgrid%nTetsMax = rflu_setmaxdimension(global,pgrid%nTetsTot)
671  pgrid%nVertMax = rflu_setmaxdimension(global,pgrid%nVertTot)
672 
673 ! ==============================================================================
674 ! Connectivity
675 ! ==============================================================================
676 
677  IF ( global%verbLevel > verbose_none ) THEN
678  WRITE(stdout,'(A,3X,A)') solver_name,'Connectivity...'
679  END IF ! global%verbLevel
680 
681  ALLOCATE(pgrid%tet2v(4,pgrid%nTetsMax),stat=errorflag)
682  global%error = errorflag
683  IF ( global%error /= err_none ) THEN
684  CALL errorstop(global,err_allocate,__line__,'pGrid%tet2v')
685  END IF ! global%error
686 
687  READ(ifile) dummyinteger,dummyinteger,dummyinteger, &
688  dummyinteger,dummyinteger,dummyinteger, &
689  dummyreal,((pgrid%tet2v(iv,ic),ic=1,pgrid%nTetsTot),iv=1,4)
690 
691  pgrid%nCellsTot = pgrid%nTetsTot
692  pgrid%nCellsMax = rflu_setmaxdimension(global,pgrid%nCellsTot)
693 
694 ! ------------------------------------------------------------------------------
695 ! Checking - only valid for tetrahedral grids, cf. RFLU_ReadGridCENTAUR.F90
696 ! ------------------------------------------------------------------------------
697 
698  IF ( global%checkLevel > check_none ) THEN
699  IF ( global%verbLevel > verbose_none ) THEN
700  WRITE(stdout,'(A,3X,A)') solver_name, &
701  'Checking face connectivity array entries...'
702  END IF ! global%verbLevel
703 
704  cvmin = minval(gridvgridns%bTri2v(1:3,1:gridvgridns%nBTris))
705  cvmax = maxval(gridvgridns%bTri2v(1:3,1:gridvgridns%nBTris))
706 
707  IF ( cvmin < 1 .OR. cvmax > pgrid%nVertTot ) THEN
708  IF ( global%verbLevel > verbose_none ) THEN
709  WRITE(stdout,'(A,5X,A)') solver_name,'Check failed.'
710  END IF ! global%verbLevel
711  CALL errorstop(global,err_vertex_number,__line__)
712  END IF ! cvmin
713 
714  IF ( global%verbLevel > verbose_none ) THEN
715  WRITE(stdout,'(A,3X,A)') solver_name, &
716  'Checking face connectivity array entries done.'
717  END IF ! global%verbLevel
718 
719  IF ( global%verbLevel > verbose_none ) THEN
720  WRITE(stdout,'(A,3X,A)') solver_name, &
721  'Checking cell connectivity array entries...'
722  END IF ! global%verbLevel
723 
724  cvmin = minval(pgrid%tet2v(1:4,1:pgrid%nTetsTot))
725  cvmax = maxval(pgrid%tet2v(1:4,1:pgrid%nTetsTot))
726 
727  IF ( cvmin /= 1 .OR. cvmax /= pgrid%nVertTot ) THEN
728  IF ( global%verbLevel > verbose_none ) THEN
729  WRITE(stdout,'(A,5X,A)') solver_name,'CHECK failed.'
730  END IF ! global%verbLevel
731  CALL errorstop(global,err_vertex_number,__line__)
732  END IF ! cvmin
733 
734  IF ( global%verbLevel > verbose_none ) THEN
735  WRITE(stdout,'(A,3X,A)') solver_name, &
736  'Checking cell connectivity array entries done.'
737  END IF ! global%verbLevel
738  END IF ! global%checkLevel
739 
740 ! ==============================================================================
741 ! Coordinates
742 ! ==============================================================================
743 
744  IF ( global%verbLevel > verbose_none ) THEN
745  WRITE(stdout,'(A,3X,A)') solver_name,'Coordinates...'
746  END IF ! global%verbLevel
747 
748  ALLOCATE(pgrid%xyz(3,pgrid%nVertMax),stat=errorflag)
749  global%error = errorflag
750  IF ( global%error /= err_none ) THEN
751  CALL errorstop(global,err_allocate,__line__,'pGrid%xyz')
752  END IF ! global%error
753 
754  READ(ifile) ((pgrid%xyz(i,iv),iv=1,pgrid%nVertTot),i=1,3)
755 
756  CLOSE(ifile,iostat=errorflag)
757  global%error = errorflag
758  IF ( global%error /= err_none ) THEN
759  CALL errorstop(global,err_file_close,__line__,ifilename)
760  END IF ! global%error
761 
762 ! ******************************************************************************
763 ! Set grid size variables
764 ! ******************************************************************************
765 
766  pgrid%nVert = pgrid%nVertTot
767  pgrid%nCells = pgrid%nCellsTot
768  pgrid%nTets = pgrid%nTetsTot
769 
770 ! ******************************************************************************
771 ! Print grid statistics
772 ! ******************************************************************************
773 
774  IF ( global%verbLevel > verbose_none ) THEN
775  WRITE(stdout,'(A,3X,A)') solver_name,'Grid Statistics:'
776  WRITE(stdout,'(A,5X,A,2X,I9)') solver_name,'Vertices: ', &
777  pgrid%nVertTot
778  WRITE(stdout,'(A,5X,A,2X,I9)') solver_name,'Tetrahedra: ', &
779  pgrid%nTetsTot
780  WRITE(stdout,'(A,5X,A,2X,I9)') solver_name,'Boundary triangles: ', &
781  gridvgridns%nBTris
782  END IF ! global%verbLevel
783 
784 ! ******************************************************************************
785 ! End
786 ! ******************************************************************************
787 
788  IF ( global%verbLevel > verbose_none ) THEN
789  WRITE(stdout,'(A,1X,A)') solver_name,'Reading VGRIDns grid file done.'
790  END IF ! global%verbLevel
791 
792  CALL deregisterfunction(global)
793 
794  END SUBROUTINE rflu_readgridvgridns
795 
796 
797 
798 
799 
800 
801 
802 ! ******************************************************************************
803 ! End
804 ! ******************************************************************************
805 
806 
807 END MODULE rflu_modvgridns
808 
809 ! ******************************************************************************
810 !
811 ! RCS Revision history:
812 !
813 ! $Log: RFLU_ModVGRIDns.F90,v $
814 ! Revision 1.5 2008/12/06 08:45:03 mtcampbe
815 ! Updated license.
816 !
817 ! Revision 1.4 2008/11/19 22:18:14 mtcampbe
818 ! Added Illinois Open Source License/Copyright
819 !
820 ! Revision 1.3 2006/04/18 21:02:38 haselbac
821 ! Fixed checks; bug arose bcos of max-dimensioned arrays for sype
822 !
823 ! Revision 1.2 2006/03/25 22:04:29 haselbac
824 ! Changes because of sype patches
825 !
826 ! Revision 1.1 2005/04/15 15:09:14 haselbac
827 ! Initial revision
828 !
829 ! Revision 1.4 2005/01/20 14:54:56 haselbac
830 ! Added setting of nBFaces and nBFacesTot
831 !
832 ! Revision 1.3 2004/11/03 17:09:24 haselbac
833 ! Removed setting of vertex and cell flags
834 !
835 ! Revision 1.2 2004/10/19 19:31:15 haselbac
836 ! Removed renumbering of bface lists
837 !
838 ! Revision 1.1 2004/07/06 15:15:50 haselbac
839 ! Initial revision
840 !
841 ! ******************************************************************************
842 
843 
844 
845 
846 
847 
848 
849 
850 
851 
852 
subroutine, public rflu_readgridvgridns(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, public rflu_convvgridns2rocflu(pRegion)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469