Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModENSIGHTUtils.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 utility routines for writing ENSIGHT files.
26 !
27 ! Description: None.
28 !
29 ! Input: None.
30 !
31 ! Output: None.
32 !
33 ! Notes: None.
34 !
35 ! ******************************************************************************
36 !
37 ! $Id: RFLU_ModENSIGHTUtils.F90,v 1.4 2008/12/06 08:45:06 mtcampbe Exp $
38 !
39 ! Copyright: (c) 2005 by the University of Illinois
40 !
41 ! ******************************************************************************
42 
44 
45  USE moddatatypes
46  USE modparameters
47  USE moderror
48  USE modglobal, ONLY: t_global
49  USE modgrid, ONLY: t_grid
50  USE modbndpatch, ONLY: t_patch
51  USE moddatastruct, ONLY: t_region
52 
53  IMPLICIT NONE
54 
55 ! ******************************************************************************
56 ! Definitions and declarations
57 ! ******************************************************************************
58 
59 ! ==============================================================================
60 ! Private data
61 ! ==============================================================================
62 
63  CHARACTER(CHRLEN), PARAMETER, PRIVATE :: &
64  RCSIdentString = '$RCSfile: RFLU_ModENSIGHTUtils.F90,v $ $Revision: 1.4 $'
65 
66 ! ==============================================================================
67 ! Public functions
68 ! ==============================================================================
69 
70  PUBLIC :: rflu_ens_writegrid, &
73 
74 
75 ! ******************************************************************************
76 ! Subroutines and functions
77 ! ******************************************************************************
78 
79  CONTAINS
80 
81 
82 
83 
84 
85 ! ******************************************************************************
86 !
87 ! Purpose: Write grid to ENSIGHT geometry file.
88 !
89 ! Description: None.
90 !
91 ! Input:
92 ! pRegion Pointer to region
93 ! emptyPartFlag Flag indicating whether part should be empty
94 !
95 ! Output: None.
96 !
97 ! Notes: None.
98 !
99 ! ******************************************************************************
100 
101 SUBROUTINE rflu_ens_writegrid(pRegion,emptyPartFlag)
102 
106 
107 ! ******************************************************************************
108 ! Declarations and definitions
109 ! ******************************************************************************
110 
111 ! ==============================================================================
112 ! Arguments
113 ! ==============================================================================
114 
115  LOGICAL, INTENT(IN) :: emptypartflag
116  TYPE(t_region), POINTER :: pregion
117 
118 ! ==============================================================================
119 ! Locals
120 ! ==============================================================================
121 
122  CHARACTER(80) :: dummystring
123  INTEGER :: errorflag,i,icl,ifl,ipatch,ivg,ivl,nbvert,nbvertest
124  INTEGER, DIMENSION(:), ALLOCATABLE :: vlist
125  TYPE(t_global), POINTER :: global
126  TYPE(t_grid), POINTER :: pgrid
127  TYPE(t_patch), POINTER :: ppatch
128 
129 ! ******************************************************************************
130 ! Start
131 ! ******************************************************************************
132 
133  global => pregion%global
134 
135  CALL registerfunction(global,'RFLU_ENS_WriteGrid', &
136  'RFLU_ModENSIGHTUtils.F90')
137 
138  pgrid => pregion%grid
139 
140  global%postPartNumber = global%postPartNumber + 1
141 
142 ! ******************************************************************************
143 ! Volume grid
144 ! ******************************************************************************
145 
146  dummystring = 'part'
147  WRITE(if_ens_geometry) dummystring
148  WRITE(if_ens_geometry) global%postPartNumber
149 
150  WRITE(dummystring,'(A,I5.5)') 'VOL_',pregion%iRegionGlobal
151  WRITE(if_ens_geometry) dummystring
152 
153  IF ( emptypartflag .EQV. .false. ) THEN
154 
155 ! ==============================================================================
156 ! Coordinates
157 ! ==============================================================================
158 
159  dummystring = 'coordinates'
160  WRITE(if_ens_geometry) dummystring
161  WRITE(if_ens_geometry) pgrid%nVertTot
162  WRITE(if_ens_geometry) (REAL(pGrid%xyz(XCOORD,ivg),KIND=SPREAL), &
163  ivg=1,pgrid%nverttot)
164  WRITE(if_ens_geometry) (REAL(pGrid%xyz(YCOORD,ivg),KIND=SPREAL), &
165  ivg=1,pgrid%nverttot)
166  WRITE(if_ens_geometry) (REAL(pGrid%xyz(ZCOORD,ivg),KIND=SPREAL), &
167  ivg=1,pgrid%nverttot)
168 
169 ! ==============================================================================
170 ! Cell connectivity
171 ! ==============================================================================
172 
173 ! ------------------------------------------------------------------------------
174 ! Tetrahedra
175 ! ------------------------------------------------------------------------------
176 
177  IF ( pgrid%nTets > 0 ) THEN
178  dummystring = 'tetra4'
179  WRITE(if_ens_geometry) dummystring
180  WRITE(if_ens_geometry) pgrid%nTets
181  WRITE(if_ens_geometry) ((pgrid%tet2v(ivl,icl),ivl=1,4),icl=1,pgrid%nTets)
182  END IF ! pGrid%nTets
183 
184  IF ( pgrid%nTetsTot > pgrid%nTets ) THEN
185  dummystring = 'g_tetra4'
186  WRITE(if_ens_geometry) dummystring
187  WRITE(if_ens_geometry) pgrid%nTetsTot-pgrid%nTets
188  WRITE(if_ens_geometry) ((pgrid%tet2v(ivl,icl),ivl=1,4), &
189  icl=pgrid%nTets+1,pgrid%nTetsTot)
190  END IF ! pGrid%nTetsTot
191 
192 ! ------------------------------------------------------------------------------
193 ! Hexahedra
194 ! ------------------------------------------------------------------------------
195 
196  IF ( pgrid%nHexs > 0 ) THEN
197  dummystring = 'hexa8'
198  WRITE(if_ens_geometry) dummystring
199  WRITE(if_ens_geometry) pgrid%nHexs
200  WRITE(if_ens_geometry) ((pgrid%hex2v(ivl,icl),ivl=1,8),icl=1,pgrid%nHexs)
201  END IF ! pGrid%nHexs
202 
203  IF ( pgrid%nHexsTot > pgrid%nHexs ) THEN
204  dummystring = 'g_hexa8'
205  WRITE(if_ens_geometry) dummystring
206  WRITE(if_ens_geometry) pgrid%nHexsTot-pgrid%nHexs
207  WRITE(if_ens_geometry) ((pgrid%hex2v(ivl,icl),ivl=1,8), &
208  icl=pgrid%nHexs+1,pgrid%nHexsTot)
209  END IF ! pGrid%nHexsTot
210 
211 ! ------------------------------------------------------------------------------
212 ! Prisms
213 ! ------------------------------------------------------------------------------
214 
215  IF ( pgrid%nPris > 0 ) THEN
216  dummystring = 'penta6'
217  WRITE(if_ens_geometry) dummystring
218  WRITE(if_ens_geometry) pgrid%nPris
219  WRITE(if_ens_geometry) ((pgrid%pri2v(ivl,icl),ivl=1,6),icl=1,pgrid%nPris)
220  END IF ! pGrid%nPris
221 
222  IF ( pgrid%nPrisTot > pgrid%nPris ) THEN
223  dummystring = 'g_penta6'
224  WRITE(if_ens_geometry) dummystring
225  WRITE(if_ens_geometry) pgrid%nPrisTot-pgrid%nPris
226  WRITE(if_ens_geometry) ((pgrid%pri2v(ivl,icl),ivl=1,6) , &
227  icl=pgrid%nPris+1,pgrid%nPrisTot)
228  END IF ! pGrid%nPrisTot
229 
230 ! ------------------------------------------------------------------------------
231 ! Pyramids
232 ! ------------------------------------------------------------------------------
233 
234  IF ( pgrid%nPyrs > 0 ) THEN
235  dummystring = 'pyramid5'
236  WRITE(if_ens_geometry) dummystring
237  WRITE(if_ens_geometry) pgrid%nPyrs
238  WRITE(if_ens_geometry) ((pgrid%pyr2v(ivl,icl),ivl=1,5),icl=1,pgrid%nPyrs)
239  END IF ! pGrid%nPyrs
240 
241  IF ( pgrid%nPyrsTot > pgrid%nPyrs ) THEN
242  dummystring = 'g_pyramid5'
243  WRITE(if_ens_geometry) dummystring
244  WRITE(if_ens_geometry) pgrid%nPyrsTot-pgrid%nPyrs
245  WRITE(if_ens_geometry) ((pgrid%pyr2v(ivl,icl),ivl=1,5), &
246  icl=pgrid%nPyrs+1,pgrid%nPyrsTot)
247  END IF ! pGrid%nPyrsTot
248  END IF ! emptyPartFlag
249 
250 ! ******************************************************************************
251 ! Surface grid
252 ! ******************************************************************************
253 
254  DO ipatch = 1,pgrid%nPatches
255  ppatch => pregion%patches(ipatch)
256 
257 ! ==============================================================================
258 ! Triangles
259 ! ==============================================================================
260 
261 ! ------------------------------------------------------------------------------
262 ! Actual triangles
263 ! ------------------------------------------------------------------------------
264 
265  IF ( ppatch%nBTris > 0 ) THEN
266  global%postPartNumber = global%postPartNumber + 1
267 
268  dummystring = 'part'
269  WRITE(if_ens_geometry) dummystring
270  WRITE(if_ens_geometry) global%postPartNumber
271  WRITE(dummystring,'(A,I3.3,A,I5.5)') 'PAT_',ipatch,'_TRI-A_', &
272  pregion%iRegionGlobal
273  WRITE(if_ens_geometry) dummystring
274 
275  IF ( emptypartflag .EQV. .false. ) THEN
276 
277 ! ----- Build list of vertices -------------------------------------------------
278 
279  nbvertest = 3*ppatch%nBTris
280 
281  ALLOCATE(vlist(nbvertest),stat=errorflag)
282  global%error = errorflag
283  IF ( global%error /= err_none ) THEN
284  CALL errorstop(global,err_allocate,__line__,'vList')
285  END IF ! global%error
286 
287  CALL rflu_buildconnvertlist(global,ppatch%bTri2v(1:3,1:ppatch%nBTris), &
288  3,ppatch%nBTris,vlist,nbvertest,nbvert)
289 
290 ! ----- Write coordinates ------------------------------------------------------
291 
292  dummystring = 'coordinates'
293  WRITE(if_ens_geometry) dummystring
294  WRITE(if_ens_geometry) nbvert
295  WRITE(if_ens_geometry) (REAL(pGrid%xyz(XCOORD,vList(ivl)), & KIND=SPREAL),ivl=1,nbvert)
296  WRITE(if_ens_geometry) (REAL(pGrid%xyz(YCOORD,vList(ivl)), & KIND=SPREAL),ivl=1,nbvert)
297  WRITE(if_ens_geometry) (REAL(pGrid%xyz(ZCOORD,vList(ivl)), & KIND=SPREAL),ivl=1,nbvert)
298 
299 ! ----- Write renumbered connectivity ------------------------------------------
300 
301  dummystring = 'tria3'
302  WRITE(if_ens_geometry) dummystring
303  WRITE(if_ens_geometry) ppatch%nBTris
304 
305  CALL rflu_renumberlist(global,3,ppatch%nBTris, &
306  ppatch%bTri2v(1:3,1:ppatch%nBTris),nbvert, &
307  vlist(1:nbvert))
308 
309  WRITE(if_ens_geometry) ((ppatch%bTri2v(ivl,ifl),ivl=1,3), &
310  ifl=1,ppatch%nBTris)
311 
312  CALL rflu_denumberlist(global,3,ppatch%nBTris, &
313  ppatch%bTri2v(1:3,1:ppatch%nBTris),nbvert, &
314  vlist(1:nbvert))
315 
316 ! ----- Destroy list of vertices -----------------------------------------------
317 
318  DEALLOCATE(vlist,stat=errorflag)
319  global%error = errorflag
320  IF ( global%error /= err_none ) THEN
321  CALL errorstop(global,err_deallocate,__line__,'vList')
322  END IF ! global%error
323  END IF ! emptyPartFlag
324  END IF ! pPatch%nBTris
325 
326 ! ------------------------------------------------------------------------------
327 ! Virtual triangles
328 ! ------------------------------------------------------------------------------
329 
330  IF ( ppatch%nBTrisTot > ppatch%nBTris ) THEN
331  global%postPartNumber = global%postPartNumber + 1
332 
333  dummystring = 'part'
334  WRITE(if_ens_geometry) dummystring
335  WRITE(if_ens_geometry) global%postPartNumber
336  WRITE(dummystring,'(A,I3.3,A,I5.5)') 'PAT_',ipatch,'_TRI-V_', &
337  pregion%iRegionGlobal
338  WRITE(if_ens_geometry) dummystring
339 
340  IF ( emptypartflag .EQV. .false. ) THEN
341 
342 ! ----- Build list of vertices -------------------------------------------------
343 
344  nbvertest = 3*(ppatch%nBTrisTot-ppatch%nBTris)
345 
346  ALLOCATE(vlist(nbvertest),stat=errorflag)
347  global%error = errorflag
348  IF ( global%error /= err_none ) THEN
349  CALL errorstop(global,err_allocate,__line__,'vList')
350  END IF ! global%error
351 
352  CALL rflu_buildconnvertlist(global, &
353  ppatch%bTri2v(1:3,ppatch%nBTris+1:ppatch%nBTrisTot), &
354  3,ppatch%nBTrisTot-ppatch%nBTris,vlist,nbvertest,nbvert)
355 
356 ! ----- Write coordinates ------------------------------------------------------
357 
358  dummystring = 'coordinates'
359  WRITE(if_ens_geometry) dummystring
360  WRITE(if_ens_geometry) nbvert
361  WRITE(if_ens_geometry) (REAL(pGrid%xyz(XCOORD,vList(ivl)), & KIND=SPREAL),ivl=1,nbvert)
362  WRITE(if_ens_geometry) (REAL(pGrid%xyz(YCOORD,vList(ivl)), & KIND=SPREAL),ivl=1,nbvert)
363  WRITE(if_ens_geometry) (REAL(pGrid%xyz(ZCOORD,vList(ivl)), & KIND=SPREAL),ivl=1,nbvert)
364 
365 ! ----- Write coordinates ------------------------------------------------------
366 
367  dummystring = 'g_tria3'
368  WRITE(if_ens_geometry) dummystring
369  WRITE(if_ens_geometry) ppatch%nBTrisTot-ppatch%nBTris
370 
371  CALL rflu_renumberlist(global,3,ppatch%nBTrisTot-ppatch%nBTris, &
372  ppatch%bTri2v(1:3,ppatch%nBTris+1:ppatch%nBTrisTot),nbvert, &
373  vlist(1:nbvert))
374 
375  WRITE(if_ens_geometry) ((ppatch%bTri2v(ivl,ifl),ivl=1,3), &
376  ifl=ppatch%nBTris+1,ppatch%nBTrisTot)
377 
378  CALL rflu_denumberlist(global,3,ppatch%nBTrisTot-ppatch%nBTris, &
379  ppatch%bTri2v(1:3,ppatch%nBTris+1:ppatch%nBTrisTot),nbvert, &
380  vlist(1:nbvert))
381 
382 ! ----- Destroy list of vertices -----------------------------------------------
383 
384  DEALLOCATE(vlist,stat=errorflag)
385  global%error = errorflag
386  IF ( global%error /= err_none ) THEN
387  CALL errorstop(global,err_deallocate,__line__,'vList')
388  END IF ! global%error
389  END IF ! emptyPartFlag
390  END IF ! pPatch%nBTrisTot
391 
392 ! ==============================================================================
393 ! Quadrilaterals
394 ! ==============================================================================
395 
396 ! ------------------------------------------------------------------------------
397 ! Actual quadrilaterals
398 ! ------------------------------------------------------------------------------
399 
400  IF ( ppatch%nBQuads > 0 ) THEN
401  global%postPartNumber = global%postPartNumber + 1
402 
403  dummystring = 'part'
404  WRITE(if_ens_geometry) dummystring
405  WRITE(if_ens_geometry) global%postPartNumber
406  WRITE(dummystring,'(A,I3.3,A,I5.5)') 'PAT_',ipatch,'_QUAD-A_', &
407  pregion%iRegionGlobal
408  WRITE(if_ens_geometry) dummystring
409 
410  IF ( emptypartflag .EQV. .false. ) THEN
411 
412 ! ----- Build list of vertices -------------------------------------------------
413 
414  nbvertest = 4*ppatch%nBQuads
415 
416  ALLOCATE(vlist(nbvertest),stat=errorflag)
417  global%error = errorflag
418  IF ( global%error /= err_none ) THEN
419  CALL errorstop(global,err_allocate,__line__,'vList')
420  END IF ! global%error
421 
422  CALL rflu_buildconnvertlist(global, &
423  ppatch%bQuad2v(1:4,1:ppatch%nBQuads), &
424  4,ppatch%nBQuads,vlist,nbvertest,nbvert)
425 
426 ! ----- Write coordinates ------------------------------------------------------
427 
428  dummystring = 'coordinates'
429  WRITE(if_ens_geometry) dummystring
430  WRITE(if_ens_geometry) nbvert
431  WRITE(if_ens_geometry) (REAL(pGrid%xyz(XCOORD,vList(ivl)), & KIND=SPREAL),ivl=1,nbvert)
432  WRITE(if_ens_geometry) (REAL(pGrid%xyz(YCOORD,vList(ivl)), & KIND=SPREAL),ivl=1,nbvert)
433  WRITE(if_ens_geometry) (REAL(pGrid%xyz(ZCOORD,vList(ivl)), & KIND=SPREAL),ivl=1,nbvert)
434 
435 ! ----- Write coordinates
436 
437  dummystring = 'quad4'
438  WRITE(if_ens_geometry) dummystring
439  WRITE(if_ens_geometry) ppatch%nBQuads
440 
441  CALL rflu_renumberlist(global,4,ppatch%nBQuads, &
442  ppatch%bQuad2v(1:4,1:ppatch%nBQuads),nbvert, &
443  vlist(1:nbvert))
444 
445  WRITE(if_ens_geometry) ((ppatch%bQuad2v(ivl,ifl),ivl=1,4) , &
446  ifl=1,ppatch%nBQuads)
447 
448  CALL rflu_denumberlist(global,4,ppatch%nBQuads, &
449  ppatch%bQuad2v(1:4,1:ppatch%nBQuads),nbvert, &
450  vlist(1:nbvert))
451 
452 ! ----- Destroy list of vertices -----------------------------------------------
453 
454  DEALLOCATE(vlist,stat=errorflag)
455  global%error = errorflag
456  IF ( global%error /= err_none ) THEN
457  CALL errorstop(global,err_deallocate,__line__,'vList')
458  END IF ! global%error
459  END IF ! emptyPartFlag
460  END IF ! pPatch%nBQuads
461 
462 ! ------------------------------------------------------------------------------
463 ! Virtual quadrilaterals
464 ! ------------------------------------------------------------------------------
465 
466  IF ( ppatch%nBQuadsTot > ppatch%nBQuads ) THEN
467  global%postPartNumber = global%postPartNumber + 1
468 
469  dummystring = 'part'
470  WRITE(if_ens_geometry) dummystring
471  WRITE(if_ens_geometry) global%postPartNumber
472  WRITE(dummystring,'(A,I3.3,A,I5.5)') 'PAT_',ipatch,'_QUAD-V_', &
473  pregion%iRegionGlobal
474  WRITE(if_ens_geometry) dummystring
475 
476  IF ( emptypartflag .EQV. .false. ) THEN
477 
478 ! ----- Build list of vertices -------------------------------------------------
479 
480  nbvertest = 4*(ppatch%nBQuadsTot-ppatch%nBQuads)
481 
482  ALLOCATE(vlist(nbvertest),stat=errorflag)
483  global%error = errorflag
484  IF ( global%error /= err_none ) THEN
485  CALL errorstop(global,err_allocate,__line__,'vList')
486  END IF ! global%error
487 
488  CALL rflu_buildconnvertlist(global, &
489  ppatch%bQuad2v(1:4,ppatch%nBQuads+1:ppatch%nBQuadsTot), &
490  4,ppatch%nBQuadsTot-ppatch%nBQuads,vlist,nbvertest,nbvert)
491 
492 ! ----- Write coordinates ------------------------------------------------------
493 
494  dummystring = 'coordinates'
495  WRITE(if_ens_geometry) dummystring
496  WRITE(if_ens_geometry) nbvert
497  WRITE(if_ens_geometry) (REAL(pGrid%xyz(XCOORD,vList(ivl)), & KIND=SPREAL),ivl=1,nbvert)
498  WRITE(if_ens_geometry) (REAL(pGrid%xyz(YCOORD,vList(ivl)), & KIND=SPREAL),ivl=1,nbvert)
499  WRITE(if_ens_geometry) (REAL(pGrid%xyz(ZCOORD,vList(ivl)), & KIND=SPREAL),ivl=1,nbvert)
500 
501 ! ----- Write coordinates
502 
503  dummystring = 'g_quad4'
504  WRITE(if_ens_geometry) dummystring
505  WRITE(if_ens_geometry) ppatch%nBQuadsTot-ppatch%nBQuads
506 
507  CALL rflu_renumberlist(global,4,ppatch%nBQuadsTot-ppatch%nBQuads, &
508  ppatch%bQuad2v(1:4,ppatch%nBQuads+1:ppatch%nBQuadsTot), &
509  nbvert,vlist(1:nbvert))
510 
511  WRITE(if_ens_geometry) ((ppatch%bQuad2v(ivl,ifl),ivl=1,4), &
512  ifl=ppatch%nBQuads+1,ppatch%nBQuadsTot)
513 
514  CALL rflu_denumberlist(global,4,ppatch%nBQuadsTot-ppatch%nBQuads, &
515  ppatch%bQuad2v(1:4,ppatch%nBQuads+1:ppatch%nBQuadsTot), &
516  nbvert,vlist(1:nbvert))
517 
518 ! ----- Destroy list of vertices -----------------------------------------------
519 
520  DEALLOCATE(vlist,stat=errorflag)
521  global%error = errorflag
522  IF ( global%error /= err_none ) THEN
523  CALL errorstop(global,err_deallocate,__line__,'vList')
524  END IF ! global%error
525  END IF ! emptyPartFlag
526  END IF ! pPatch%nBQuadsTot
527  END DO ! iPatch
528 
529 ! ******************************************************************************
530 ! End
531 ! ******************************************************************************
532 
533  CALL deregisterfunction(global)
534 
535 END SUBROUTINE rflu_ens_writegrid
536 
537 
538 
539 
540 
541 
542 
543 
544 ! ******************************************************************************
545 !
546 ! Purpose: Write scalar variable to ENSIGHT file.
547 !
548 ! Description: None.
549 !
550 ! Input:
551 ! pRegion Pointer to region
552 ! var Pointer to scalar
553 ! iFile File index
554 ! emptyPartFlag Flag indicating whether part should be empty
555 !
556 ! Output: None.
557 !
558 ! Notes: None.
559 !
560 ! ******************************************************************************
561 
562 SUBROUTINE rflu_ens_writescalar(pRegion,var,iFile,emptyPartFlag)
563 
564 ! ******************************************************************************
565 ! Declarations and definitions
566 ! ******************************************************************************
567 
568 ! ==============================================================================
569 ! Arguments
570 ! ==============================================================================
571 
572  LOGICAL, INTENT(IN) :: emptypartflag
573  INTEGER, INTENT(IN) :: ifile
574  REAL(RFREAL), DIMENSION(:), POINTER :: var
575  TYPE(t_region), POINTER :: pregion
576 
577 ! ==============================================================================
578 ! Locals
579 ! ==============================================================================
580 
581  CHARACTER(80) :: dummystring
582  INTEGER :: errorflag,icl,ifl,ipatch,offs
583  TYPE(t_global), POINTER :: global
584  TYPE(t_grid), POINTER :: pgrid
585  TYPE(t_patch), POINTER :: ppatch
586 
587 ! ******************************************************************************
588 ! Start
589 ! ******************************************************************************
590 
591  global => pregion%global
592 
593  CALL registerfunction(global,'RFLU_ENS_WriteScalar', &
594  'RFLU_ModENSIGHTUtils.F90')
595 
596  pgrid => pregion%grid
597 
598  global%postPartNumber = global%postPartNumber + 1
599 
600 ! ******************************************************************************
601 ! Volume data
602 ! ******************************************************************************
603 
604  dummystring = 'part'
605  WRITE(ifile) dummystring
606  WRITE(ifile) global%postPartNumber
607 
608  IF ( emptypartflag .EQV. .false. ) THEN
609 
610 ! ==============================================================================
611 ! Tetrahedra
612 ! ==============================================================================
613 
614  IF ( pgrid%nTets > 0 ) THEN
615  dummystring = 'tetra4'
616  WRITE(ifile) dummystring
617  WRITE(ifile) (REAL(var(pGrid%tet2CellGlob(icl)),KIND=SPREAL), &
618  icl=1,pgrid%ntets)
619  END IF ! pGrid%nTets
620 
621  IF ( pgrid%nTetsTot > pgrid%nTets ) THEN
622  dummystring = 'g_tetra4'
623  WRITE(ifile) dummystring
624  WRITE(ifile) (REAL(var(pGrid%tet2CellGlob(icl)),KIND=SPREAL), &
625  icl=pgrid%ntets+1,pgrid%ntetstot)
626  END IF ! pGrid%nTetsTot
627 
628 ! ==============================================================================
629 ! Hexahedra
630 ! ==============================================================================
631 
632  IF ( pgrid%nHexs > 0 ) THEN
633  dummystring = 'hexa8'
634  WRITE(ifile) dummystring
635  WRITE(ifile) (REAL(var(pGrid%hex2CellGlob(icl)),KIND=SPREAL), &
636  icl=1,pgrid%nhexs)
637  END IF ! pGrid%nHexs
638 
639  IF ( pgrid%nHexsTot > pgrid%nHexs ) THEN
640  dummystring = 'g_hexa8'
641  WRITE(ifile) dummystring
642  WRITE(ifile) (REAL(var(pGrid%hex2CellGlob(icl)),KIND=SPREAL), &
643  icl=pgrid%nhexs+1,pgrid%nhexstot)
644  END IF ! pGrid%nHexsTot
645 
646 ! ==============================================================================
647 ! Prisms
648 ! ==============================================================================
649 
650  IF ( pgrid%nPris > 0 ) THEN
651  dummystring = 'penta6'
652  WRITE(ifile) dummystring
653  WRITE(ifile) (REAL(var(pGrid%pri2CellGlob(icl)),KIND=SPREAL), &
654  icl=1,pgrid%npris)
655  END IF ! pGrid%nPris
656 
657  IF ( pgrid%nPrisTot > pgrid%nPris ) THEN
658  dummystring = 'g_penta6'
659  WRITE(ifile) dummystring
660  WRITE(ifile) (REAL(var(pGrid%pri2CellGlob(icl)),KIND=SPREAL), &
661  icl=pgrid%npris+1,pgrid%npristot)
662  END IF ! pGrid%nPrisTot
663 
664 ! ==============================================================================
665 ! Pyramids
666 ! ==============================================================================
667 
668  IF ( pgrid%nPyrs > 0 ) THEN
669  dummystring = 'pyramid5'
670  WRITE(ifile) dummystring
671  WRITE(ifile) (REAL(var(pGrid%pyr2CellGlob(icl)),KIND=SPREAL), &
672  icl=1,pgrid%npyrs)
673  END IF ! pGrid%nPyrs
674 
675  IF ( pgrid%nPyrsTot > pgrid%nPyrs ) THEN
676  dummystring = 'g_pyramid5'
677  WRITE(ifile) dummystring
678  WRITE(ifile) (REAL(var(pGrid%pyr2CellGlob(icl)),KIND=SPREAL), &
679  icl=pgrid%npyrs+1,pgrid%npyrstot)
680  END IF ! pGrid%nPyrsTot
681  END IF ! emptyPartFlag
682 
683 ! ******************************************************************************
684 ! Patch data
685 ! ******************************************************************************
686 
687  DO ipatch = 1,pgrid%nPatches
688  ppatch => pregion%patches(ipatch)
689 
690 ! ==============================================================================
691 ! Triangles
692 ! ==============================================================================
693 
694 ! ------------------------------------------------------------------------------
695 ! Actual triangles
696 ! ------------------------------------------------------------------------------
697 
698  IF ( ppatch%nBTris > 0 ) THEN
699  global%postPartNumber = global%postPartNumber + 1
700 
701  dummystring = 'part'
702  WRITE(ifile) dummystring
703  WRITE(ifile) global%postPartNumber
704 
705  IF ( emptypartflag .EQV. .false. ) THEN
706  dummystring = 'tria3'
707  WRITE(ifile) dummystring
708  WRITE(ifile) (REAL(var(pPatch%bf2c(ifl)),KIND=SPREAL), &
709  ifl=1,ppatch%nbtris)
710  END IF ! emptyPartFlag
711  END IF ! pPatch%nBTris
712 
713 ! ------------------------------------------------------------------------------
714 ! Virtual triangles
715 ! ------------------------------------------------------------------------------
716 
717  IF ( ppatch%nBTrisTot > ppatch%nBTris ) THEN
718  global%postPartNumber = global%postPartNumber + 1
719 
720  dummystring = 'part'
721  WRITE(ifile) dummystring
722  WRITE(ifile) global%postPartNumber
723 
724  offs = ppatch%nBTris + ppatch%nBQuads
725 
726  IF ( emptypartflag .EQV. .false. ) THEN
727  dummystring = 'g_tria3'
728  WRITE(ifile) dummystring
729  WRITE(ifile) (REAL(var(pPatch%bf2c(ifl+offs)),KIND=SPREAL), &
730  ifl=1,ppatch%nbtristot-ppatch%nbtris)
731  END IF ! emptyPartFlag
732  END IF ! pPatch%nBTrisTot
733 
734 ! ==============================================================================
735 ! Quadrilaterals
736 ! ==============================================================================
737 
738 ! ------------------------------------------------------------------------------
739 ! Actual quadrilaterals
740 ! ------------------------------------------------------------------------------
741 
742  IF ( ppatch%nBQuads > 0 ) THEN
743  global%postPartNumber = global%postPartNumber + 1
744 
745  dummystring = 'part'
746  WRITE(ifile) dummystring
747  WRITE(ifile) global%postPartNumber
748 
749  offs = ppatch%nBTris
750 
751  IF ( emptypartflag .EQV. .false. ) THEN
752  dummystring = 'quad4'
753  WRITE(ifile) dummystring
754  WRITE(ifile) (REAL(var(pPatch%bf2c(ifl+offs)),KIND=SPREAL), &
755  ifl=1,ppatch%nbquads)
756  END IF ! emptyPartFlag
757  END IF ! pPatch%nBQuads
758 
759 ! ------------------------------------------------------------------------------
760 ! Virtual quadrilaterals
761 ! ------------------------------------------------------------------------------
762 
763  IF ( ppatch%nBQuadsTot > ppatch%nBQuads ) THEN
764  global%postPartNumber = global%postPartNumber + 1
765 
766  dummystring = 'part'
767  WRITE(ifile) dummystring
768  WRITE(ifile) global%postPartNumber
769 
770  offs = ppatch%nBTrisTot + ppatch%nBQuads
771 
772  IF ( emptypartflag .EQV. .false. ) THEN
773  dummystring = 'g_quad4'
774  WRITE(ifile) dummystring
775  WRITE(ifile) (REAL(var(pPatch%bf2c(ifl+offs)),KIND=SPREAL), &
776  ifl=1,ppatch%nbquadstot-ppatch%nbquads)
777  END IF ! emptyPartFlag
778  END IF ! pPatch%nBQuads
779  END DO ! iPatch
780 
781 ! ******************************************************************************
782 ! End
783 ! ******************************************************************************
784 
785  CALL deregisterfunction(global)
786 
787 END SUBROUTINE rflu_ens_writescalar
788 
789 
790 
791 
792 
793 
794 
795 
796 ! ******************************************************************************
797 !
798 ! Purpose: Write vector variable to ENSIGHT file.
799 !
800 ! Description: None.
801 !
802 ! Input:
803 ! pRegion Pointer to region
804 ! var Pointer to vector
805 ! iFile File index
806 ! emptyPartFlag Flag indicating whether part should be empty
807 !
808 ! Output: None.
809 !
810 ! Notes: None.
811 !
812 ! ******************************************************************************
813 
814 SUBROUTINE rflu_ens_writevector(pRegion,var,iFile,emptyPartFlag)
815 
816 ! ******************************************************************************
817 ! Declarations and definitions
818 ! ******************************************************************************
819 
820 ! ==============================================================================
821 ! Arguments
822 ! ==============================================================================
823 
824  LOGICAL, INTENT(IN) :: emptypartflag
825  INTEGER, INTENT(IN) :: ifile
826  REAL(RFREAL), DIMENSION(:,:), POINTER :: var
827  TYPE(t_region), POINTER :: pregion
828 
829 ! ==============================================================================
830 ! Locals
831 ! ==============================================================================
832 
833  CHARACTER(80) :: dummystring
834  INTEGER :: errorflag,icl,ifl,ipatch,offs
835  TYPE(t_global), POINTER :: global
836  TYPE(t_grid), POINTER :: pgrid
837  TYPE(t_patch), POINTER :: ppatch
838 
839 ! ******************************************************************************
840 ! Start
841 ! ******************************************************************************
842 
843  global => pregion%global
844 
845  CALL registerfunction(global,'RFLU_ENS_WriteVector', &
846  'RFLU_ModENSIGHTUtils.F90')
847 
848  pgrid => pregion%grid
849 
850  global%postPartNumber = global%postPartNumber + 1
851 
852 ! ******************************************************************************
853 ! Volume data
854 ! ******************************************************************************
855 
856  dummystring = 'part'
857  WRITE(ifile) dummystring
858  WRITE(ifile) global%postPartNumber
859 
860  IF ( emptypartflag .EQV. .false. ) THEN
861 
862 ! ==============================================================================
863 ! Tetrahedra
864 ! ==============================================================================
865 
866  IF ( pgrid%nTets > 0 ) THEN
867  dummystring = 'tetra4'
868  WRITE(ifile) dummystring
869  WRITE(ifile) (REAL(var(1,pGrid%tet2CellGlob(icl)),KIND=SPREAL), &
870  icl=1,pgrid%ntets)
871  WRITE(ifile) (REAL(var(2,pGrid%tet2CellGlob(icl)),KIND=SPREAL), &
872  icl=1,pgrid%ntets)
873  WRITE(ifile) (REAL(var(3,pGrid%tet2CellGlob(icl)),KIND=SPREAL), &
874  icl=1,pgrid%ntets)
875  END IF ! pGrid%nTets
876 
877  IF ( pgrid%nTetsTot > pgrid%nTets ) THEN
878  dummystring = 'g_tetra4'
879  WRITE(ifile) dummystring
880  WRITE(ifile) (REAL(var(1,pGrid%tet2CellGlob(icl)),KIND=SPREAL), &
881  icl=pgrid%ntets+1,pgrid%ntetstot)
882  WRITE(ifile) (REAL(var(2,pGrid%tet2CellGlob(icl)),KIND=SPREAL), &
883  icl=pgrid%ntets+1,pgrid%ntetstot)
884  WRITE(ifile) (REAL(var(3,pGrid%tet2CellGlob(icl)),KIND=SPREAL), &
885  icl=pgrid%ntets+1,pgrid%ntetstot)
886  END IF ! pGrid%nTetsTot
887 
888 ! ==============================================================================
889 ! Hexahedra
890 ! ==============================================================================
891 
892  IF ( pgrid%nHexs > 0 ) THEN
893  dummystring = 'hexa8'
894  WRITE(ifile) dummystring
895  WRITE(ifile) (REAL(var(1,pGrid%hex2CellGlob(icl)),KIND=SPREAL), &
896  icl=1,pgrid%nhexs)
897  WRITE(ifile) (REAL(var(2,pGrid%hex2CellGlob(icl)),KIND=SPREAL), &
898  icl=1,pgrid%nhexs)
899  WRITE(ifile) (REAL(var(3,pGrid%hex2CellGlob(icl)),KIND=SPREAL), &
900  icl=1,pgrid%nhexs)
901  END IF ! pGrid%nHexs
902 
903  IF ( pgrid%nHexsTot > pgrid%nHexs ) THEN
904  dummystring = 'g_hexa8'
905  WRITE(ifile) dummystring
906  WRITE(ifile) (REAL(var(1,pGrid%hex2CellGlob(icl)),KIND=SPREAL), &
907  icl=pgrid%nhexs+1,pgrid%nhexstot)
908  WRITE(ifile) (REAL(var(2,pGrid%hex2CellGlob(icl)),KIND=SPREAL), &
909  icl=pgrid%nhexs+1,pgrid%nhexstot)
910  WRITE(ifile) (REAL(var(3,pGrid%hex2CellGlob(icl)),KIND=SPREAL), &
911  icl=pgrid%nhexs+1,pgrid%nhexstot)
912  END IF ! pGrid%nHexsTot
913 
914 ! ==============================================================================
915 ! Prisms
916 ! ==============================================================================
917 
918  IF ( pgrid%nPris > 0 ) THEN
919  dummystring = 'penta6'
920  WRITE(ifile) dummystring
921  WRITE(ifile) (REAL(var(1,pGrid%pri2CellGlob(icl)),KIND=SPREAL), &
922  icl=1,pgrid%npris)
923  WRITE(ifile) (REAL(var(2,pGrid%pri2CellGlob(icl)),KIND=SPREAL), &
924  icl=1,pgrid%npris)
925  WRITE(ifile) (REAL(var(3,pGrid%pri2CellGlob(icl)),KIND=SPREAL), &
926  icl=1,pgrid%npris)
927  END IF ! pGrid%nPris
928 
929  IF ( pgrid%nPrisTot > pgrid%nPris ) THEN
930  dummystring = 'g_penta6'
931  WRITE(ifile) dummystring
932  WRITE(ifile) (REAL(var(1,pGrid%pri2CellGlob(icl)),KIND=SPREAL), &
933  icl=pgrid%npris+1,pgrid%npristot)
934  WRITE(ifile) (REAL(var(2,pGrid%pri2CellGlob(icl)),KIND=SPREAL), &
935  icl=pgrid%npris+1,pgrid%npristot)
936  WRITE(ifile) (REAL(var(3,pGrid%pri2CellGlob(icl)),KIND=SPREAL), &
937  icl=pgrid%npris+1,pgrid%npristot)
938  END IF ! pGrid%nPrisTot
939 
940 ! ==============================================================================
941 ! Pyramids
942 ! ==============================================================================
943 
944  IF ( pgrid%nPyrs > 0 ) THEN
945  dummystring = 'pyramid5'
946  WRITE(ifile) dummystring
947  WRITE(ifile) (REAL(var(1,pGrid%pyr2CellGlob(icl)),KIND=SPREAL), &
948  icl=1,pgrid%npyrs)
949  WRITE(ifile) (REAL(var(2,pGrid%pyr2CellGlob(icl)),KIND=SPREAL), &
950  icl=1,pgrid%npyrs)
951  WRITE(ifile) (REAL(var(3,pGrid%pyr2CellGlob(icl)),KIND=SPREAL), &
952  icl=1,pgrid%npyrs)
953  END IF ! pGrid%nPyrs
954 
955  IF ( pgrid%nPyrsTot > pgrid%nPyrs ) THEN
956  dummystring = 'g_pyramid5'
957  WRITE(ifile) dummystring
958  WRITE(ifile) (REAL(var(1,pGrid%pyr2CellGlob(icl)),KIND=SPREAL), &
959  icl=pgrid%npyrs+1,pgrid%npyrstot)
960  WRITE(ifile) (REAL(var(2,pGrid%pyr2CellGlob(icl)),KIND=SPREAL), &
961  icl=pgrid%npyrs+1,pgrid%npyrstot)
962  WRITE(ifile) (REAL(var(3,pGrid%pyr2CellGlob(icl)),KIND=SPREAL), &
963  icl=pgrid%npyrs+1,pgrid%npyrstot)
964  END IF ! pGrid%nPyrsTot
965  END IF ! emptyPatchFlag
966 
967 ! ******************************************************************************
968 ! Patch data
969 ! ******************************************************************************
970 
971  DO ipatch = 1,pgrid%nPatches
972  ppatch => pregion%patches(ipatch)
973 
974 ! ==============================================================================
975 ! Triangles
976 ! ==============================================================================
977 
978 ! ------------------------------------------------------------------------------
979 ! Actual triangles
980 ! ------------------------------------------------------------------------------
981 
982  IF ( ppatch%nBTris > 0 ) THEN
983  global%postPartNumber = global%postPartNumber + 1
984 
985  dummystring = 'part'
986  WRITE(ifile) dummystring
987  WRITE(ifile) global%postPartNumber
988 
989  IF ( emptypartflag .EQV. .false. ) THEN
990  dummystring = 'tria3'
991  WRITE(ifile) dummystring
992  WRITE(ifile) (REAL(var(1,pPatch%bf2c(ifl)),KIND=SPREAL), &
993  ifl=1,ppatch%nbtris)
994  WRITE(ifile) (REAL(var(2,pPatch%bf2c(ifl)),KIND=SPREAL), &
995  ifl=1,ppatch%nbtris)
996  WRITE(ifile) (REAL(var(3,pPatch%bf2c(ifl)),KIND=SPREAL), &
997  ifl=1,ppatch%nbtris)
998  END IF ! emptyPartFlag
999  END IF ! pPatch%nBTris
1000 
1001 ! ------------------------------------------------------------------------------
1002 ! Virtual triangles
1003 ! ------------------------------------------------------------------------------
1004 
1005  IF ( ppatch%nBTrisTot > ppatch%nBTris ) THEN
1006  global%postPartNumber = global%postPartNumber + 1
1007 
1008  dummystring = 'part'
1009  WRITE(ifile) dummystring
1010  WRITE(ifile) global%postPartNumber
1011 
1012  offs = ppatch%nBTris + ppatch%nBQuads
1013 
1014  IF ( emptypartflag .EQV. .false. ) THEN
1015  dummystring = 'g_tria3'
1016  WRITE(ifile) dummystring
1017  WRITE(ifile) (REAL(var(1,pPatch%bf2c(ifl+offs)),KIND=SPREAL), &
1018  ifl=1,ppatch%nbtristot-ppatch%nbtris)
1019  WRITE(ifile) (REAL(var(2,pPatch%bf2c(ifl+offs)),KIND=SPREAL), &
1020  ifl=1,ppatch%nbtristot-ppatch%nbtris)
1021  WRITE(ifile) (REAL(var(3,pPatch%bf2c(ifl+offs)),KIND=SPREAL), &
1022  ifl=1,ppatch%nbtristot-ppatch%nbtris)
1023  END IF ! emptyPartFlag
1024  END IF ! pPatch%nBTrisTot
1025 
1026 ! ==============================================================================
1027 ! Quadrilaterals
1028 ! ==============================================================================
1029 
1030 ! ------------------------------------------------------------------------------
1031 ! Actual quadrilaterals
1032 ! ------------------------------------------------------------------------------
1033 
1034  IF ( ppatch%nBQuads > 0 ) THEN
1035  global%postPartNumber = global%postPartNumber + 1
1036 
1037  dummystring = 'part'
1038  WRITE(ifile) dummystring
1039  WRITE(ifile) global%postPartNumber
1040 
1041  offs = ppatch%nBTris
1042 
1043  IF ( emptypartflag .EQV. .false. ) THEN
1044  dummystring = 'quad4'
1045  WRITE(ifile) dummystring
1046  WRITE(ifile) (REAL(var(1,pPatch%bf2c(ifl+offs)),KIND=SPREAL), &
1047  ifl=1,ppatch%nbquads)
1048  WRITE(ifile) (REAL(var(2,pPatch%bf2c(ifl+offs)),KIND=SPREAL), &
1049  ifl=1,ppatch%nbquads)
1050  WRITE(ifile) (REAL(var(3,pPatch%bf2c(ifl+offs)),KIND=SPREAL), &
1051  ifl=1,ppatch%nbquads)
1052  END IF ! emptyPartFlag
1053  END IF ! pPatch%nBQuads
1054 
1055 ! ------------------------------------------------------------------------------
1056 ! Virtual quadrilaterals
1057 ! ------------------------------------------------------------------------------
1058 
1059  IF ( ppatch%nBQuadsTot > ppatch%nBQuads ) THEN
1060  global%postPartNumber = global%postPartNumber + 1
1061 
1062  dummystring = 'part'
1063  WRITE(ifile) dummystring
1064  WRITE(ifile) global%postPartNumber
1065 
1066  offs = ppatch%nBTrisTot + ppatch%nBQuads
1067 
1068  IF ( emptypartflag .EQV. .false. ) THEN
1069  dummystring = 'g_quad4'
1070  WRITE(ifile) dummystring
1071  WRITE(ifile) (REAL(var(1,pPatch%bf2c(ifl+offs)),KIND=SPREAL), &
1072  ifl=1,ppatch%nbquadstot-ppatch%nbquads)
1073  WRITE(ifile) (REAL(var(2,pPatch%bf2c(ifl+offs)),KIND=SPREAL), &
1074  ifl=1,ppatch%nbquadstot-ppatch%nbquads)
1075  WRITE(ifile) (REAL(var(3,pPatch%bf2c(ifl+offs)),KIND=SPREAL), &
1076  ifl=1,ppatch%nbquadstot-ppatch%nbquads)
1077  END IF ! emptyPartFlag
1078  END IF ! pPatch%nBQuads
1079  END DO ! iPatch
1080 
1081 ! ******************************************************************************
1082 ! End
1083 ! ******************************************************************************
1084 
1085  CALL deregisterfunction(global)
1086 
1087 END SUBROUTINE rflu_ens_writevector
1088 
1089 
1090 
1091 
1092 
1093 
1094 
1095 END MODULE rflu_modensightutils
1096 
1097 ! ******************************************************************************
1098 !
1099 ! RCS Revision history:
1100 !
1101 ! $Log: RFLU_ModENSIGHTUtils.F90,v $
1102 ! Revision 1.4 2008/12/06 08:45:06 mtcampbe
1103 ! Updated license.
1104 !
1105 ! Revision 1.3 2008/11/19 22:18:16 mtcampbe
1106 ! Added Illinois Open Source License/Copyright
1107 !
1108 ! Revision 1.2 2006/04/07 15:19:26 haselbac
1109 ! Removed tabs
1110 !
1111 ! Revision 1.1 2005/10/05 20:23:34 haselbac
1112 ! Initial revision
1113 !
1114 ! ******************************************************************************
1115 
1116 
1117 
1118 
1119 
1120 
1121 
1122 
1123 
1124 
subroutine, public rflu_buildconnvertlist(global, connList, connListDim1, connListDim2, vList, vListDimMax, vListDim)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine, public rflu_denumberlist(global, listDim1, listDim2, list, keyDim, key)
blockLoc i
Definition: read.cpp:79
subroutine, public rflu_ens_writevector(pRegion, var, iFile, emptyPartFlag)
subroutine, public rflu_ens_writegrid(pRegion, emptyPartFlag)
subroutine, public rflu_renumberlist(global, listDim1, listDim2, list, keyDim, key)
subroutine, public rflu_ens_writescalar(pRegion, var, iFile, emptyPartFlag)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469