File: /nfs/home/0/users/jenkins/mfix.git/model/cartesian_grid/vtk_out.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15 SUBROUTINE WRITE_VTU_FILE(LCV)
16
17 USE compar
18 USE constant
19 USE cutcell
20 USE discretelement, Only : DISCRETE_ELEMENT
21 USE fldvar
22 USE functions
23 USE geometry
24 USE indices
25 USE mfix_pic
26 USE mpi_utility
27 USE output
28 USE parallel
29 USE parallel_mpi
30 USE param
31 USE param1
32 USE pgcor
33 USE pgcor
34 USE physprop
35 USE pscor
36 USE quadric
37 USE run
38 USE rxns
39 USE scalars
40 USE sendrecv
41 USE stl
42 USE toleranc
43 USE visc_s
44 USE vtk
45 USE vtp
46
47 IMPLICIT NONE
48 INTEGER :: I,J,K,L,M,N,R,IJK,LCV
49
50 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: FACET_COUNT_DES, NEIGHBORING_FACET
51
52 INTEGER :: SPECIES_COUNTER,LT
53
54 CHARACTER (LEN=32) :: SUBM,SUBN,SUBR
55 CHARACTER (LEN=64) :: VAR_NAME
56
57 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: DP_BC_ID, IJK_ARRAY
58
59 INTEGER :: PASS
60 INTEGER :: WRITE_HEADER = 1
61 INTEGER :: WRITE_DATA = 2
62
63
64 = LCV
65 IF(.NOT.VTK_DEFINED(VTK_REGION)) RETURN
66 IF(VTK_DATA(LCV)/='C') RETURN
67
68
69 IF (DO_I) THEN
70 XG_E(1) = ZERO
71 DO I = IMIN1, IMAX2
72 XG_E(I) = XG_E(I-1) + DX(I)
73 END DO
74 ENDIF
75
76
77 IF (DO_J) THEN
78 YG_N(1) = ZERO
79 DO J = JMIN1, JMAX2
80 YG_N(J) = YG_N(J-1) + DY(J)
81 END DO
82 ENDIF
83
84
85 IF (DO_K) THEN
86 ZG_T(1) = ZERO
87 DO K = KMIN1, KMAX2
88 ZG_T(K) = ZG_T(K-1) + DZ(K)
89 END DO
90 ELSE
91 ZG_T = ZERO
92 ENDIF
93
94
95 CALL SETUP_VTK_REGION
96
97 CALL OPEN_VTU_FILE_BIN
98
99 CALL OPEN_PVD_FILE
100
101 CALL CLEAN_GEOMETRY
102
103 DO PASS=WRITE_HEADER,WRITE_DATA
104
105
106 CALL WRITE_GEOMETRY_IN_VTU_BIN(PASS)
107
108 IF(VTK_EP_g(VTK_REGION)) &
109 CALL WRITE_SCALAR_IN_VTU_BIN('EP_G',EP_G,PASS)
110
111 IF(VTK_P_g(VTK_REGION)) &
112 CALL WRITE_SCALAR_IN_VTU_BIN('P_G',P_G,PASS)
113
114 IF(VTK_P_star(VTK_REGION)) &
115 CALL WRITE_SCALAR_IN_VTU_BIN('P_S',P_S,PASS)
116
117 IF(VTK_VEL_g(VTK_REGION)) &
118 CALL WRITE_VECTOR_IN_VTU_BIN('Gas_Velocity',U_G,V_G,W_G,PASS)
119
120 IF(VTK_U_g(VTK_REGION)) &
121 CALL WRITE_SCALAR_IN_VTU_BIN('U_G',P_G,PASS)
122
123 IF(VTK_V_g(VTK_REGION)) &
124 CALL WRITE_SCALAR_IN_VTU_BIN('V_G',P_G,PASS)
125
126 IF(VTK_W_g(VTK_REGION)) &
127 CALL WRITE_SCALAR_IN_VTU_BIN('W_G',P_G,PASS)
128
129 DO M = 1,MMAX
130 IF(VTK_VEL_s(VTK_REGION,M)) THEN
131 WRITE(SUBM,*)M
132 CALL WRITE_VECTOR_IN_VTU_BIN('Solids_Velocity_'//ADJUSTL(SUBM),U_S(:,M),V_S(:,M),W_S(:,M),PASS)
133 ENDIF
134 IF(VTK_U_s(VTK_REGION,M)) THEN
135 WRITE(SUBM,*)M
136 CALL WRITE_SCALAR_IN_VTU_BIN('U_s_'//ADJUSTL(SUBM),U_S(:,M),PASS)
137 ENDIF
138 IF(VTK_V_s(VTK_REGION,M)) THEN
139 WRITE(SUBM,*)M
140 CALL WRITE_SCALAR_IN_VTU_BIN('V_s_'//ADJUSTL(SUBM),V_S(:,M),PASS)
141 ENDIF
142 IF(VTK_W_s(VTK_REGION,M)) THEN
143 WRITE(SUBM,*)M
144 CALL WRITE_SCALAR_IN_VTU_BIN('W_s_'//ADJUSTL(SUBM),W_S(:,M),PASS)
145 ENDIF
146 END DO
147
148 DO M = 1,MMAX
149 IF(VTK_ROP_s(VTK_REGION,M)) THEN
150 WRITE(SUBM,*)M
151 CALL WRITE_SCALAR_IN_VTU_BIN('Solids_density_'//ADJUSTL(SUBM),ROP_S(:,M),PASS)
152 ENDIF
153 END DO
154
155 IF(VTK_T_g(VTK_REGION)) &
156 CALL WRITE_SCALAR_IN_VTU_BIN('Gas_temperature',T_g,PASS)
157
158 DO M = 1,MMAX
159 IF(VTK_T_s(VTK_REGION,M)) THEN
160 WRITE(SUBM,*)M
161 CALL WRITE_SCALAR_IN_VTU_BIN('Solids_temperature_'//ADJUSTL(SUBM),T_S(:,M),PASS)
162 ENDIF
163 END DO
164
165
166 SPECIES_COUNTER = 0
167 DO N = 1,NMAX(0)
168 IF(VTK_X_g(VTK_REGION,N)) THEN
169 WRITE(SUBN,*)N
170 IF(USE_RRATES) THEN
171 SPECIES_COUNTER = SPECIES_COUNTER + 1
172 VAR_NAME = ADJUSTL(SPECIES_NAME(SPECIES_COUNTER))
173 LT = LEN_TRIM(ADJUSTL(SPECIES_NAME(SPECIES_COUNTER)))
174 ELSE
175 VAR_NAME = ADJUSTL(SPECIES_ALIAS_g(N))
176 LT = LEN_TRIM(ADJUSTL(SPECIES_ALIAS_g(N)))
177 ENDIF
178 VAR_NAME = VAR_NAME(1:LT)//'_Gas_mass_fractions_'//ADJUSTL(SUBN)
179 CALL WRITE_SCALAR_IN_VTU_BIN(VAR_NAME,X_g(:,N),PASS)
180 ENDIF
181 END DO
182
183 DO M = 1, MMAX
184 WRITE(SUBM,*)M
185 DO N = 1,NMAX(M)
186 IF(VTK_X_s(VTK_REGION,M,N)) THEN
187 WRITE(SUBN,*)N
188 IF(USE_RRATES) THEN
189 SPECIES_COUNTER = SPECIES_COUNTER + 1
190 VAR_NAME = ADJUSTL(SPECIES_NAME(SPECIES_COUNTER))
191 LT = LEN_TRIM(ADJUSTL(SPECIES_NAME(SPECIES_COUNTER)))
192 ELSE
193 VAR_NAME = ADJUSTL(SPECIES_ALIAS_s(M,N))
194 LT = LEN_TRIM(ADJUSTL(SPECIES_ALIAS_s(M,N)))
195 ENDIF
196 VAR_NAME = VAR_NAME(1:LT)//'_Solids_mass_fractions_'//TRIM(ADJUSTL(SUBM))//'_'//ADJUSTL(SUBN)
197 CALL WRITE_SCALAR_IN_VTU_BIN(VAR_NAME,X_s(:,M,N),PASS)
198 ENDIF
199 END DO
200 END DO
201
202 DO M = 1,MMAX
203 IF(VTK_Theta_m(VTK_REGION,M)) THEN
204 WRITE(SUBM,*)M
205 CALL WRITE_SCALAR_IN_VTU_BIN('Granular_temperature_'//ADJUSTL(SUBM),Theta_m(:,M),PASS)
206 ENDIF
207 END DO
208
209 DO N = 1,NSCALAR
210 IF(VTK_Scalar(VTK_REGION,N)) THEN
211 WRITE(SUBN,*)N
212 VAR_NAME = 'Scalar_'//ADJUSTL(SUBN)
213 CALL WRITE_SCALAR_IN_VTU_BIN(VAR_NAME,Scalar(:,N),PASS)
214 ENDIF
215 END DO
216
217 DO R = 1,nRR
218 IF(VTK_RRate(VTK_REGION,R)) THEN
219 WRITE(SUBR,*)R
220 VAR_NAME = 'RRates_'//ADJUSTL(SUBR)
221 CALL WRITE_SCALAR_IN_VTU_BIN(VAR_NAME,ReactionRates(:, R),PASS)
222 ENDIF
223 END DO
224
225 IF(K_EPSILON) THEN
226 IF(VTK_K_Turb_G(VTK_REGION)) &
227 CALL WRITE_SCALAR_IN_VTU_BIN('K_Turb_G',K_Turb_G,PASS)
228 IF(VTK_E_Turb_G(VTK_REGION)) &
229 CALL WRITE_SCALAR_IN_VTU_BIN('E_Turb_G',E_Turb_G,PASS)
230 ENDIF
231
232
233 IF(VTK_VORTICITY(VTK_REGION).OR.VTK_LAMBDA_2(VTK_REGION)) THEN
234 CALL CALC_VORTICITY
235 ENDIF
236
237 IF(VTK_VORTICITY(VTK_REGION)) &
238 CALL WRITE_SCALAR_IN_VTU_BIN('VORTICITY_MAG',VORTICITY,PASS)
239 IF(VTK_LAMBDA_2(VTK_REGION)) &
240 CALL WRITE_SCALAR_IN_VTU_BIN('LAMBDA_2',LAMBDA2,PASS)
241
242
243 IF(VTK_PARTITION(VTK_REGION)) &
244 CALL WRITE_SCALAR_IN_VTU_BIN('PARTITION',PARTITION,PASS)
245
246
247 IF(VTK_BC_ID(VTK_REGION)) THEN
248 Allocate(DP_BC_ID(DIMENSION_3))
249 DP_BC_ID = DBLE(BC_ID)
250 CALL WRITE_SCALAR_IN_VTU_BIN('BC_ID',DP_BC_ID,PASS)
251 DeAllocate(DP_BC_ID)
252 ENDIF
253
254
255 IF(VTK_DWALL(VTK_REGION)) &
256 CALL WRITE_SCALAR_IN_VTU_BIN('DISTANCE_TO_WALL',DWALL,PASS)
257
258 IF(DISCRETE_ELEMENT.AND.USE_STL) THEN
259 IF(VTK_FACET_COUNT_DES(VTK_REGION)) THEN
260 ALLOCATE(FACET_COUNT_DES(DIMENSION_3))
261
262 DO IJK = IJKSTART3, IJKEND3
263 FACET_COUNT_DES(IJK) = LIST_FACET_AT_DES(IJK)%COUNT_FACETS
264 ENDDO
265
266 CALL WRITE_SCALAR_IN_VTU_BIN('FACET_COUNT', FACET_COUNT_DES,PASS)
267 DEALLOCATE(FACET_COUNT_DES)
268 ENDIF
269
270 IF(VTK_NB_FACET_DES(VTK_REGION)) THEN
271 ALLOCATE(NEIGHBORING_FACET(DIMENSION_3))
272
273 DO IJK = IJKSTART3, IJKEND3
274 NEIGHBORING_FACET(IJK) = 1.0
275 IF(NO_NEIGHBORING_FACET_DES(IJK)) NEIGHBORING_FACET(IJK) = 0.0
276 ENDDO
277
278 CALL WRITE_SCALAR_IN_VTU_BIN('NEIGH_FACET', NEIGHBORING_FACET,PASS)
279 DEALLOCATE(NEIGHBORING_FACET)
280 ENDIF
281 ENDIF
282
283
284 IF(VTK_IJK(VTK_REGION)) THEN
285 Allocate(IJK_ARRAY(DIMENSION_3))
286 DO IJK = IJKSTART3, IJKEND3
287 IJK_ARRAY(IJK) = DBLE(IJK)
288 ENDDO
289 CALL WRITE_SCALAR_IN_VTU_BIN('IJK',IJK_ARRAY,PASS)
290 DeAllocate(IJK_ARRAY)
291 ENDIF
292
293 IF(VTK_IJK(VTK_REGION)) &
294 CALL WRITE_VECTOR_IN_VTU_BIN('Scalar normal',NORMAL_S(:,1),NORMAL_S(:,2),NORMAL_S(:,3),PASS)
295
296 DO N=1,15
297 IF(VTK_DEBUG(VTK_REGION,N)) THEN
298 WRITE(SUBN,*)N
299 VAR_NAME = 'DEBUG_'//ADJUSTL(SUBN)
300 CALL WRITE_SCALAR_IN_VTU_BIN(VAR_NAME,DEBUG_CG(:,N),PASS)
301 ENDIF
302 ENDDO
303
304
305
306 ENDDO
307
308
309 CALL CLOSE_VTU_FILE_BIN
310 CALL UPDATE_AND_CLOSE_PVD_FILE
311
312 call MPI_barrier(MPI_COMM_WORLD,mpierr)
313
314
315 IF (myPE == PE_IO.AND.TIME_DEPENDENT_FILENAME) THEN
316 OPEN(UNIT = VTU_FRAME_UNIT, FILE = TRIM(VTU_FRAME_FILENAME))
317 DO L = 1, DIMENSION_VTK
318 IF(VTK_DEFINED(L)) WRITE(VTU_FRAME_UNIT,*) L,FRAME(L)
319 ENDDO
320 CLOSE(VTU_FRAME_UNIT)
321 ENDIF
322
323 IF (FULL_LOG.AND.myPE == PE_IO) WRITE(*,20)' DONE.'
324
325 20 FORMAT(A,1X/)
326 30 FORMAT(1X,A)
327 RETURN
328
329 END SUBROUTINE WRITE_VTU_FILE
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346 SUBROUTINE OPEN_VTU_FILE_BIN
347
348 USE compar
349 USE constant
350 USE cutcell
351 USE fldvar
352 USE functions
353 USE geometry
354 USE indices
355 USE mpi_utility
356 USE output
357 USE parallel
358 USE param
359 USE param1
360 USE quadric
361 USE run
362 USE sendrecv
363 USE toleranc
364 USE vtk
365 use cdist
366
367 IMPLICIT NONE
368 LOGICAL :: VTU_FRAME_FILE_EXISTS
369 INTEGER :: ISTAT,BUFF1,BUFF2,L
370
371
372 call MPI_barrier(MPI_COMM_WORLD,mpierr)
373
374
375 IF (myPE /= PE_IO.AND.(.NOT.BDIST_IO)) RETURN
376
377 IF(TIME_DEPENDENT_FILENAME) THEN
378 INQUIRE(FILE=VTU_FRAME_FILENAME,EXIST=VTU_FRAME_FILE_EXISTS)
379 IF(VTU_FRAME_FILE_EXISTS) THEN
380 OPEN(UNIT = VTU_FRAME_UNIT, FILE = TRIM(VTU_FRAME_FILENAME))
381 DO L = 1, DIMENSION_VTK
382 IF(VTK_DEFINED(L)) THEN
383 READ(VTU_FRAME_UNIT,*)BUFF1,BUFF2
384 FRAME(L)=BUFF2
385 ENDIF
386 ENDDO
387 CLOSE(VTU_FRAME_UNIT)
388 ENDIF
389 IF(RESET_FRAME_AT_TIME_ZERO.AND.TIME==ZERO) THEN
390 DO L = 1, DIMENSION_VTK
391 IF(L==VTK_REGION) FRAME(L)=-1
392 ENDDO
393 ENDIF
394 DO L = 1, DIMENSION_VTK
395 IF(L==VTK_REGION) FRAME(L) = FRAME(L) + 1
396 ENDDO
397 ENDIF
398
399 IF (BDIST_IO.AND.NUMBER_OF_VTK_CELLS>0) THEN
400
401
402
403 IF(TIME_DEPENDENT_FILENAME) THEN
404 WRITE(VTU_FILENAME,20) TRIM(VTK_FILEBASE(VTK_REGION)),FRAME(VTK_REGION),MYPE
405 ELSE
406 WRITE(VTU_FILENAME,25) TRIM(VTK_FILEBASE(VTK_REGION)),MYPE
407 ENDIF
408 ELSE
409 IF(MYPE.EQ.PE_IO) THEN
410 IF(TIME_DEPENDENT_FILENAME) THEN
411 WRITE(VTU_FILENAME,30) TRIM(VTK_FILEBASE(VTK_REGION)),FRAME(VTK_REGION)
412 ELSE
413 WRITE(VTU_FILENAME,35) TRIM(VTK_FILEBASE(VTK_REGION))
414 ENDIF
415 END IF
416 END IF
417
418
419
420 IF(TRIM(VTU_DIR)/='.') VTU_FILENAME='./'//TRIM(VTU_DIR)//'/'//VTU_FILENAME
421
422
423 IF (FULL_LOG) THEN
424 IF (.NOT.BDIST_IO) THEN
425 WRITE(*,10,ADVANCE='NO')' WRITING VTU FILE : ', TRIM(VTU_FILENAME),' .'
426 ELSE
427 IF(myPE==PE_IO) WRITE(*,15,ADVANCE='NO')' EACH PROCESOR IS WRITING ITS OWN VTU FILE.'
428 ENDIF
429 ENDIF
430
431
432
433
434
435 IF(NUMBER_OF_VTK_CELLS>0) THEN
436
437 OPEN(UNIT = VTU_UNIT, &
438 FILE = TRIM(VTU_FILENAME), &
439 FORM = 'UNFORMATTED', &
440
441 ACCESS = 'STREAM', &
442
443 ACTION = 'WRITE', &
444 IOSTAT=ISTAT)
445
446
447 IF (ISTAT /= 0) THEN
448 IF(DMP_LOG) WRITE(UNIT_LOG, 1001) VTU_FILENAME, VTU_UNIT,VTU_DIR
449 IF(FULL_LOG.AND.myPE == PE_IO) WRITE(*, 1001) VTU_FILENAME, VTU_UNIT,VTU_DIR
450 CALL MFIX_EXIT(myPE)
451 ENDIF
452
453
454 1001 FORMAT(/1X,70('*')//, ' From: OPEN_VTU_FILE',/,' Message: ', &
455 'Error opening vtu file. Terminating run.',/10X, &
456 'File name: ',A,/10X, &
457 'DES_UNIT : ',i4, /10X, &
458 'PLEASE VERIFY THAT VTU_DIR EXISTS: ', A, &
459 /1X,70('*')/)
460
461
462
463 ='<?xml version="1.0"?>'
464 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
465
466
467 WRITE(BUFFER,110)'<!-- Time =',TIME,' sec. -->'
468 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
469
470 BUFFER='<VTKFile type="UnstructuredGrid" version="0.1" byte_order="BigEndian">'
471 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
472
473 BUFFER=' <UnstructuredGrid>'
474 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
475
476 ENDIF
477
478
479
480 IF (myPE == PE_IO.AND.BDIST_IO) THEN
481
482 IF(TIME_DEPENDENT_FILENAME) THEN
483 WRITE(PVTU_FILENAME,40) TRIM(VTK_FILEBASE(VTK_REGION)),FRAME(VTK_REGION)
484 ELSE
485 WRITE(PVTU_FILENAME,45) TRIM(VTK_FILEBASE(VTK_REGION))
486 ENDIF
487
488 IF(TRIM(VTU_DIR)/='.') PVTU_FILENAME='./'//TRIM(VTU_DIR)//'/'//PVTU_FILENAME
489
490 OPEN(UNIT = PVTU_UNIT, FILE = TRIM(PVTU_FILENAME))
491
492 WRITE(PVTU_UNIT,100) '<?xml version="1.0"?>'
493 WRITE(PVTU_UNIT,110) '<!-- Time =',TIME,' sec. -->'
494 WRITE(PVTU_UNIT,120) '<VTKFile type="PUnstructuredGrid"',&
495 ' version="0.1" byte_order="BigEndian">'
496
497 WRITE(PVTU_UNIT,100) ' <PUnstructuredGrid GhostLevel="0">'
498 WRITE(PVTU_UNIT,100) ' <PPoints>'
499 WRITE(PVTU_UNIT,100) ' <PDataArray type="Float32" Name="coordinates" NumberOfComponents="3" &
500 &format="appended" offset=" 0" />'
501 WRITE(PVTU_UNIT,100) ' </PPoints>'
502 WRITE(PVTU_UNIT,100) ''
503 WRITE(PVTU_UNIT,100) ' <PCellData Scalars="scalars">'
504
505 ENDIF
506
507 100 FORMAT(A)
508 110 FORMAT(A,E14.7,A)
509 120 FORMAT(A,A)
510 10 FORMAT(/1X,3A)
511 15 FORMAT(/1X,A)
512 20 FORMAT(A,"_",I4.4,"_",I5.5,".vtu")
513 25 FORMAT(A,"_",I5.5,".vtu")
514 30 FORMAT(A,"_",I4.4,".vtu")
515 35 FORMAT(A,".vtu")
516 40 FORMAT(A,"_",I4.4,".pvtu")
517 45 FORMAT(A,".pvtu")
518
519 RETURN
520
521 END SUBROUTINE OPEN_VTU_FILE_BIN
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537 SUBROUTINE WRITE_GEOMETRY_IN_VTU_BIN(PASS)
538
539 USE, INTRINSIC :: iso_c_binding
540 USE param
541 USE param1
542 USE parallel
543 USE constant
544 USE run
545 USE toleranc
546 USE geometry
547 USE indices
548 USE compar
549 USE mpi_utility
550 USE sendrecv
551 USE quadric
552 USE cutcell
553 USE fldvar
554 USE vtk
555 USE cdist
556 USE functions
557
558 IMPLICIT NONE
559
560 INTEGER :: IJK,L
561 INTEGER :: OFFSET
562
563 INTEGER :: CELL_TYPE
564
565 REAL(c_float) :: float
566 INTEGER(c_int) :: int
567
568 INTEGER :: nbytes_xyz,nbytes_connectivity,nbytes_offset,nbytes_type
569 INTEGER :: offset_xyz,offset_connectivity,offset_offset,offset_type
570
571 INTEGER :: PASS
572 INTEGER :: WRITE_HEADER = 1
573 INTEGER :: WRITE_DATA = 2
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593 IF (myPE == PE_IO.AND.(.NOT.BDIST_IO)) THEN
594
595
596
597
598 = NUMBER_OF_POINTS * 3 * c_sizeof(float)
599
600 nbytes_connectivity = 0
601 DO IJK = 1,IJKMAX3
602 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) THEN
603 nbytes_connectivity = nbytes_connectivity + GLOBAL_NUMBER_OF_NODES(IJK)
604 ENDIF
605 END DO
606 nbytes_connectivity = nbytes_connectivity * c_sizeof(int)
607
608
609 nbytes_offset = NUMBER_OF_VTK_CELLS * c_sizeof(int)
610
611 nbytes_type = NUMBER_OF_VTK_CELLS * c_sizeof(int)
612
613
614
615 = 0
616 offset_connectivity = offset_xyz + c_sizeof(int) + nbytes_xyz
617 offset_offset = offset_connectivity + c_sizeof(int) + nbytes_connectivity
618 offset_type = offset_offset + c_sizeof(int) + nbytes_offset
619
620
621 IF(PASS==WRITE_HEADER) THEN
622
623 WRITE(BUFFER,100)' <Piece NumberOfPoints="',NUMBER_OF_POINTS,'" NumberOfCells="',NUMBER_OF_VTK_CELLS,'" >'
624 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
625
626 WRITE(BUFFER,110)' <Points>'
627 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
628
629 WRITE(BUFFER,100)' <DataArray type="Float32" Name="coordinates" NumberOfComponents="3" &
630 &format="appended" offset="',offset_xyz,'" />'
631 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
632
633 WRITE(BUFFER,110)' </Points>'
634 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
635
636 WRITE(BUFFER,110)' <Cells>'
637 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
638
639 WRITE(BUFFER,100)' <DataArray type="Int32" Name="connectivity" format="appended" offset="', &
640 offset_connectivity,'" />'
641 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
642
643 WRITE(BUFFER,100)' <DataArray type="Int32" Name="offsets" format="appended" offset="',offset_offset,'" />'
644 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
645
646 WRITE(BUFFER,100)' <DataArray type="Int32" Name="types" format="appended" offset="',offset_type,'" />'
647 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
648
649 WRITE(BUFFER,110)' </Cells>'
650 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
651
652 VTU_offset = offset_type + c_sizeof(int) + nbytes_type
653
654 WRITE(BUFFER,110)' <CellData>'
655 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
656
657
658
659
660 ELSEIF(PASS==WRITE_DATA) THEN
661
662 WRITE(BUFFER,110)' </CellData>'
663 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
664
665 WRITE(BUFFER,110)' </Piece>'
666 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
667
668
669 WRITE(BUFFER,110)' </UnstructuredGrid>'
670 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
671
672
673 WRITE(BUFFER,110)' <AppendedData encoding="raw">'
674 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
675
676
677
678
679 WRITE(BUFFER,110)'_'
680 WRITE(VTU_UNIT)TRIM(BUFFER)
681
682
683 WRITE(VTU_UNIT) nbytes_xyz, (GLOBAL_COORDS_OF_POINTS(1:3,L), L = 1,NUMBER_OF_POINTS)
684
685
686 WRITE(VTU_UNIT) nbytes_connectivity
687
688 DO IJK = 1,IJKMAX3
689 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) THEN
690 WRITE(VTU_UNIT) (GLOBAL_CLEANED_CONNECTIVITY(IJK,L)-1,L=1,GLOBAL_NUMBER_OF_NODES(IJK))
691 ENDIF
692 END DO
693
694
695 WRITE(VTU_UNIT) nbytes_offset
696
697 OFFSET = 0
698 DO IJK = 1,IJKMAX3
699 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) THEN
700 OFFSET = OFFSET + GLOBAL_NUMBER_OF_NODES(IJK)
701 WRITE(VTU_UNIT) OFFSET
702 ENDIF
703 END DO
704
705
706 WRITE(VTU_UNIT)nbytes_type
707
708 IF(NO_K) THEN
709 CELL_TYPE = 7
710 ELSE
711 CELL_TYPE = 41
712 ENDIF
713
714 DO IJK = 1,IJKMAX3
715 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) WRITE(VTU_UNIT) CELL_TYPE
716 END DO
717
718
719 ENDIF
720
721
722 ELSEIF(BDIST_IO) THEN
723
724
725
726
727
728
729
730
731 = NUMBER_OF_POINTS * 3 * c_sizeof(float)
732
733 nbytes_connectivity = 0
734 DO IJK = 1,IJKEND3
735 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) THEN
736 nbytes_connectivity = nbytes_connectivity + NUMBER_OF_NODES(IJK)
737 ENDIF
738 END DO
739 nbytes_connectivity = nbytes_connectivity * c_sizeof(int)
740
741
742 nbytes_offset = NUMBER_OF_VTK_CELLS * c_sizeof(int)
743
744 nbytes_type = NUMBER_OF_VTK_CELLS * c_sizeof(int)
745
746
747
748 = 0
749 offset_connectivity = offset_xyz + c_sizeof(int) + nbytes_xyz
750 offset_offset = offset_connectivity + c_sizeof(int) + nbytes_connectivity
751 offset_type = offset_offset + c_sizeof(int) + nbytes_offset
752
753
754 IF(PASS==WRITE_HEADER) THEN
755
756 WRITE(BUFFER,100)' <Piece NumberOfPoints="',NUMBER_OF_POINTS,'" NumberOfCells="',NUMBER_OF_VTK_CELLS,'" >'
757 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
758
759 WRITE(BUFFER,110)' <Points>'
760 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
761
762 WRITE(BUFFER,100)' <DataArray type="Float32" Name="coordinates" NumberOfComponents="3" &
763 &format="appended" offset="',offset_xyz,'" />'
764 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
765
766 WRITE(BUFFER,110)' </Points>'
767 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
768
769 WRITE(BUFFER,110)' <Cells>'
770 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
771
772 WRITE(BUFFER,100)' <DataArray type="Int32" Name="connectivity" format="appended" offset="', &
773 offset_connectivity,'" />'
774 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
775
776 WRITE(BUFFER,100)' <DataArray type="Int32" Name="offsets" format="appended" offset="',offset_offset,'" />'
777 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
778
779 WRITE(BUFFER,100)' <DataArray type="Int32" Name="types" format="appended" offset="',offset_type,'" />'
780 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
781
782 WRITE(BUFFER,110)' </Cells>'
783 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
784
785 VTU_offset = offset_type + c_sizeof(int) + nbytes_type
786
787 WRITE(BUFFER,110)' <CellData>'
788 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
789
790
791
792
793 ELSEIF(PASS==WRITE_DATA) THEN
794
795 WRITE(BUFFER,110)' </CellData>'
796 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
797
798 WRITE(BUFFER,110)' </Piece>'
799 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
800
801
802 WRITE(BUFFER,110)' </UnstructuredGrid>'
803 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
804
805
806 WRITE(BUFFER,110)' <AppendedData encoding="raw">'
807 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
808
809
810
811
812 WRITE(BUFFER,110)'_'
813 WRITE(VTU_UNIT)TRIM(BUFFER)
814
815
816 WRITE(VTU_UNIT) nbytes_xyz, (COORDS_OF_POINTS(L,1:3), L = 1,NUMBER_OF_POINTS)
817
818
819 WRITE(VTU_UNIT) nbytes_connectivity
820
821 DO IJK = 1,IJKEND3
822 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) THEN
823 WRITE(VTU_UNIT) (CLEANED_CONNECTIVITY(IJK,L)-1,L=1,NUMBER_OF_NODES(IJK))
824 ENDIF
825 END DO
826
827
828 WRITE(VTU_UNIT) nbytes_offset
829
830 OFFSET = 0
831 DO IJK = 1,IJKEND3
832 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) THEN
833 OFFSET = OFFSET + NUMBER_OF_NODES(IJK)
834 WRITE(VTU_UNIT) OFFSET
835 ENDIF
836 END DO
837
838
839 WRITE(VTU_UNIT)nbytes_type
840
841 IF(NO_K) THEN
842 CELL_TYPE = 7
843 ELSE
844 CELL_TYPE = 41
845 ENDIF
846
847 DO IJK = 1,IJKEND3
848 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) WRITE(VTU_UNIT) CELL_TYPE
849 END DO
850
851
852 ENDIF
853
854
855 ENDIF
856
857
858 100 FORMAT(A,I12,A,I12,A)
859 110 FORMAT(A)
860
861 RETURN
862
863 END SUBROUTINE WRITE_GEOMETRY_IN_VTU_BIN
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880 SUBROUTINE WRITE_SCALAR_IN_VTU_BIN(VAR_NAME,VAR,PASS)
881
882 USE, INTRINSIC :: iso_c_binding
883 USE param
884 USE param1
885 USE parallel
886 USE constant
887 USE run
888 USE toleranc
889 USE geometry
890 USE indices
891 USE compar
892 USE mpi_utility
893 USE sendrecv
894 USE quadric
895 USE cutcell
896 USE fldvar
897 USE vtk
898 USE cdist
899 USE output
900 USE functions
901
902 IMPLICIT NONE
903 INTEGER :: I,IJK
904
905 CHARACTER (*) :: VAR_NAME
906 DOUBLE PRECISION, DIMENSION(DIMENSION_3) :: VAR
907 DOUBLE PRECISION, ALLOCATABLE :: GLOBAL_VAR(:)
908 DOUBLE PRECISION, DIMENSION(DIMENSION_3) :: TMP_VAR
909
910 REAL(c_float) :: float
911
912 INTEGER :: nbytes_scalar
913
914 INTEGER :: PASS
915 INTEGER :: WRITE_HEADER = 1
916 INTEGER :: WRITE_DATA = 2
917
918 IF (.NOT.BDIST_IO) THEN
919
920
921
922 = NUMBER_OF_VTK_CELLS * c_sizeof(float)
923
924 IF(PASS==WRITE_HEADER) THEN
925
926
927 DO I = 1,LEN_TRIM(VAR_NAME)
928 IF(VAR_NAME(I:I) == ' ') VAR_NAME(I:I) = '_'
929 ENDDO
930
931 WRITE(BUFFER,90)' <DataArray type="Float32" Name="', &
932 TRIM(VAR_NAME),'" format="appended" offset="',VTU_offset,'" />'
933 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
934
935 VTU_offset = VTU_offset + c_sizeof(float) + nbytes_scalar
936
937
938 ELSEIF(PASS==WRITE_DATA) THEN
939
940
941 IF (myPE == PE_IO) THEN
942 allocate (GLOBAL_VAR(ijkmax3))
943 ELSE
944 allocate (GLOBAL_VAR(1))
945 ENDIF
946
947 IF(RE_INDEXING) THEN
948 CALL UNSHIFT_DP_ARRAY(VAR,TMP_VAR)
949 CALL gather (TMP_VAR,GLOBAL_VAR,root)
950 ELSE
951 CALL gather (VAR,GLOBAL_VAR,root)
952 ENDIF
953
954 IF (myPE /= PE_IO) RETURN
955
956
957 WRITE(VTU_UNIT) nbytes_scalar
958
959 DO IJK = 1,IJKMAX3
960 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) WRITE(VTU_UNIT) REAL(GLOBAL_VAR(IJK))
961 ENDDO
962
963
964 Deallocate (GLOBAL_VAR)
965
966 ENDIF
967
968
969 ELSE
970
971
972 = NUMBER_OF_VTK_CELLS * c_sizeof(float)
973
974 IF(PASS==WRITE_HEADER) THEN
975
976
977 DO I = 1,LEN_TRIM(VAR_NAME)
978 IF(VAR_NAME(I:I) == ' ') VAR_NAME(I:I) = '_'
979 ENDDO
980
981 WRITE(BUFFER,90)' <DataArray type="Float32" Name="', &
982 TRIM(VAR_NAME),'" format="appended" offset="',VTU_offset,'" />'
983 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
984
985
986 VTU_offset = VTU_offset + c_sizeof(float) + nbytes_scalar
987
988
989 ELSEIF(PASS==WRITE_DATA) THEN
990
991
992 WRITE(VTU_UNIT) nbytes_scalar
993
994 DO IJK = 1,IJKEND3
995 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) WRITE(VTU_UNIT) REAL(VAR(IJK))
996 ENDDO
997
998 ENDIF
999
1000
1001 IF (myPE == PE_IO) THEN
1002 WRITE(PVTU_UNIT,90) ' <DataArray type="Float32" Name="', &
1003 TRIM(VAR_NAME),'" format="appended" offset="',VTU_offset,'" />'
1004 ENDIF
1005
1006
1007 ENDIF
1008
1009
1010 IF (PASS==WRITE_DATA.AND.FULL_LOG.AND.myPE == PE_IO) WRITE(*,10,ADVANCE='NO')'.'
1011
1012 10 FORMAT(A)
1013 90 FORMAT(A,A,A,I12,A)
1014
1015 RETURN
1016
1017 END SUBROUTINE WRITE_SCALAR_IN_VTU_BIN
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033 SUBROUTINE WRITE_VECTOR_IN_VTU_BIN(VAR_NAME,VARX,VARY,VARZ,PASS)
1034
1035 USE, INTRINSIC :: iso_c_binding
1036 USE param
1037 USE param1
1038 USE parallel
1039 USE constant
1040 USE run
1041 USE toleranc
1042 USE geometry
1043 USE indices
1044 USE compar
1045 USE mpi_utility
1046 USE sendrecv
1047 USE quadric
1048 USE cutcell
1049 USE fldvar
1050 USE vtk
1051 USE cdist
1052 USE output
1053 USE functions
1054
1055 IMPLICIT NONE
1056 INTEGER :: IJK
1057
1058 CHARACTER (*) :: VAR_NAME
1059 DOUBLE PRECISION, DIMENSION(DIMENSION_3) :: VARX,VARY,VARZ
1060 DOUBLE PRECISION, ALLOCATABLE :: GLOBAL_VARX(:),GLOBAL_VARY(:),GLOBAL_VARZ(:)
1061 DOUBLE PRECISION, DIMENSION(DIMENSION_3) :: TMP_VAR
1062
1063 REAL(c_float) :: float
1064
1065 INTEGER :: nbytes_vector
1066
1067 INTEGER :: PASS
1068 INTEGER :: WRITE_HEADER = 1
1069 INTEGER :: WRITE_DATA = 2
1070
1071 IF (.NOT.BDIST_IO) THEN
1072
1073 nbytes_vector = NUMBER_OF_VTK_CELLS * 3 * c_sizeof(float)
1074
1075 IF(PASS==WRITE_HEADER) THEN
1076
1077
1078 WRITE(BUFFER,90)' <DataArray type="Float32" Name="', &
1079 TRIM(VAR_NAME),'" NumberOfComponents="3" format="appended" offset="',VTU_offset,'" />'
1080 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
1081
1082
1083 VTU_offset = VTU_offset + c_sizeof(float) + nbytes_vector
1084
1085
1086 ELSEIF(PASS==WRITE_DATA) THEN
1087
1088
1089 IF (myPE == PE_IO) THEN
1090 allocate (GLOBAL_VARX(ijkmax3))
1091 allocate (GLOBAL_VARY(ijkmax3))
1092 allocate (GLOBAL_VARZ(ijkmax3))
1093 ELSE
1094 allocate (GLOBAL_VARX(1))
1095 allocate (GLOBAL_VARY(1))
1096 allocate (GLOBAL_VARZ(1))
1097 ENDIF
1098
1099 IF(RE_INDEXING) THEN
1100 CALL UNSHIFT_DP_ARRAY(VARX,TMP_VAR)
1101 call gather (TMP_VAR,GLOBAL_VARX,root)
1102
1103 CALL UNSHIFT_DP_ARRAY(VARY,TMP_VAR)
1104 call gather (TMP_VAR,GLOBAL_VARY,root)
1105
1106 CALL UNSHIFT_DP_ARRAY(VARZ,TMP_VAR)
1107 call gather (TMP_VAR,GLOBAL_VARZ,root)
1108
1109 ELSE
1110 call gather (VARX,GLOBAL_VARX,root)
1111 call gather (VARY,GLOBAL_VARY,root)
1112 call gather (VARZ,GLOBAL_VARZ,root)
1113 ENDIF
1114
1115
1116 IF (myPE /= PE_IO) RETURN
1117
1118
1119 WRITE(VTU_UNIT) nbytes_vector
1120
1121 DO IJK = 1,IJKMAX3
1122 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) THEN
1123 WRITE(VTU_UNIT) REAL(GLOBAL_VARX(IJK)),REAL(GLOBAL_VARY(IJK)),REAL(GLOBAL_VARZ(IJK))
1124 ENDIF
1125 ENDDO
1126
1127
1128 Deallocate (GLOBAL_VARX)
1129 Deallocate (GLOBAL_VARY)
1130 Deallocate (GLOBAL_VARZ)
1131
1132 ENDIF
1133
1134
1135 ELSE
1136
1137
1138 = NUMBER_OF_VTK_CELLS * 3 * c_sizeof(float)
1139
1140 IF(PASS==WRITE_HEADER) THEN
1141
1142
1143
1144 WRITE(BUFFER,90)' <DataArray type="Float32" Name="', &
1145 TRIM(VAR_NAME),'" NumberOfComponents="3" format="appended" offset="',VTU_offset,'" />'
1146 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
1147
1148
1149 VTU_offset = VTU_offset + c_sizeof(float) + nbytes_vector
1150
1151
1152 ELSEIF(PASS==WRITE_DATA) THEN
1153
1154
1155 WRITE(VTU_UNIT) nbytes_vector
1156
1157 DO IJK = 1,IJKEND3
1158 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) THEN
1159 WRITE(VTU_UNIT) REAL(VARX(IJK)),REAL(VARY(IJK)),REAL(VARZ(IJK))
1160 ENDIF
1161 ENDDO
1162
1163 ENDIF
1164
1165
1166 IF (myPE == PE_IO) THEN
1167 WRITE(PVTU_UNIT,90)' <DataArray type="Float32" Name="', &
1168 TRIM(VAR_NAME),'" NumberOfComponents="3" format="appended" offset="',VTU_offset,'" />'
1169 ENDIF
1170
1171 ENDIF
1172
1173
1174 IF (PASS==WRITE_DATA.AND.FULL_LOG.AND.myPE == PE_IO) WRITE(*,10,ADVANCE='NO')'.'
1175
1176 10 FORMAT(A)
1177 90 FORMAT(A,A,A,I12,A)
1178
1179 RETURN
1180
1181 END SUBROUTINE WRITE_VECTOR_IN_VTU_BIN
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197 SUBROUTINE CLOSE_VTU_FILE_BIN
1198
1199 USE compar
1200 Use run
1201 USE vtk
1202 use cdist
1203 USE mpi_utility
1204
1205 IMPLICIT NONE
1206
1207 INTEGER:: N
1208 CHARACTER (LEN=32) :: VTU_NAME
1209 INTEGER, DIMENSION(0:numPEs-1) :: ALL_VTK_CELL_COUNT
1210 INTEGER :: IERR
1211
1212 IF (myPE /= PE_IO.AND.(.NOT.BDIST_IO)) RETURN
1213
1214 IF(NUMBER_OF_VTK_CELLS>0) THEN
1215
1216
1217 WRITE(BUFFER,110)' </AppendedData>'
1218 WRITE(VTU_UNIT)END_REC//TRIM(BUFFER)//END_REC
1219
1220 WRITE(BUFFER,110)'</VTKFile>'
1221 WRITE(VTU_UNIT)TRIM(BUFFER)//END_REC
1222
1223 CLOSE(VTU_UNIT)
1224
1225 ENDIF
1226
1227
1228
1229 IF(BDIST_IO) CALL allgather_1i (NUMBER_OF_VTK_CELLS,ALL_VTK_CELL_COUNT,IERR)
1230
1231 IF (myPE == PE_IO.AND.BDIST_IO) THEN
1232 WRITE(PVTU_UNIT,100) ' </PCellData>'
1233
1234 DO N = 0,NumPEs-1
1235 IF(ALL_VTK_CELL_COUNT(N)>0) THEN
1236 IF(TIME_DEPENDENT_FILENAME) THEN
1237 WRITE(VTU_NAME,20) TRIM(VTK_FILEBASE(VTK_REGION)),FRAME(VTK_REGION),N
1238 ELSE
1239 WRITE(VTU_NAME,25) TRIM(VTK_FILEBASE(VTK_REGION)),N
1240 ENDIF
1241
1242 WRITE(PVTU_UNIT,110) ' <Piece Source="',TRIM(VTU_NAME),'"/>'
1243 ENDIF
1244 ENDDO
1245
1246
1247 WRITE(PVTU_UNIT,100) ' </PUnstructuredGrid>'
1248 WRITE(PVTU_UNIT,100) '</VTKFile>'
1249 CLOSE(PVTU_UNIT)
1250 ENDIF
1251
1252
1253 20 FORMAT(A,"_",I4.4,"_",I5.5,".vtu")
1254 25 FORMAT(A,"_",I5.5,".vtu")
1255
1256 100 FORMAT(A)
1257 110 FORMAT(A,A,A)
1258
1259 RETURN
1260
1261 END SUBROUTINE CLOSE_VTU_FILE_BIN
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281 SUBROUTINE OPEN_PVD_FILE
1282
1283 USE param
1284 USE param1
1285 USE parallel
1286 USE constant
1287 USE run
1288 USE toleranc
1289 USE geometry
1290 USE indices
1291 USE compar
1292 USE sendrecv
1293 USE output
1294 USE quadric
1295 USE cutcell
1296 USE fldvar
1297 USE vtk
1298 USE functions
1299
1300 IMPLICIT NONE
1301 LOGICAL :: PVD_EXISTS
1302
1303 IF (myPE /= PE_IO) RETURN
1304
1305 PVD_FILENAME = TRIM(VTK_FILEBASE(VTK_REGION)) // '.pvd'
1306
1307
1308
1309 INQUIRE(FILE=PVD_FILENAME,EXIST=PVD_EXISTS)
1310
1311
1312
1313 IF(.NOT.PVD_FILE_INITIALIZED(VTK_REGION)) THEN
1314
1315 IF(RUN_TYPE == 'NEW'.OR.RUN_TYPE=='RESTART_2')THEN
1316
1317 IF (.NOT.PVD_EXISTS) THEN
1318 OPEN(UNIT = PVD_UNIT, FILE = TRIM(PVD_FILENAME))
1319 WRITE(PVD_UNIT,100) '<?xml version="1.0"?>'
1320 WRITE(PVD_UNIT,100) '<VTKFile type="Collection" version="0.1" byte_order="LittleEndian">'
1321 WRITE(PVD_UNIT,100) '<Collection>'
1322
1323 (VTK_REGION)=.TRUE.
1324 ELSE
1325 WRITE(*,1002) TRIM(PVD_FILENAME)
1326 WRITE(UNIT_LOG, 1002) TRIM(PVD_FILENAME)
1327 CALL MFIX_EXIT(myPE)
1328 ENDIF
1329 ELSE
1330
1331 IF (.NOT.PVD_EXISTS) THEN
1332
1333 WRITE(*,1003) TRIM(PVD_FILENAME)
1334 WRITE(UNIT_LOG, 1003) TRIM(PVD_FILENAME)
1335 CALL MFIX_EXIT(myPE)
1336 ELSE
1337
1338 OPEN(UNIT=PVD_UNIT,FILE = TRIM(PVD_FILENAME),POSITION="APPEND",STATUS='OLD')
1339 BACKSPACE(PVD_UNIT)
1340 BACKSPACE(PVD_UNIT)
1341 PVD_FILE_INITIALIZED(VTK_REGION)=.TRUE.
1342 ENDIF
1343 ENDIF
1344 ELSE
1345
1346
1347 OPEN(UNIT=PVD_UNIT,FILE = TRIM(PVD_FILENAME),POSITION="APPEND",STATUS='OLD')
1348 BACKSPACE(PVD_UNIT)
1349 BACKSPACE(PVD_UNIT)
1350 ENDIF
1351
1352
1353 100 FORMAT(A)
1354
1355 1002 FORMAT(/1X,70('*')/,' From: OPEN_PVD_FILE',/,' Message: ', &
1356 A,' already exists in the run directory.',/10X, &
1357 'This is not allowed for a new run.',/10X, &
1358 'Terminating run.',/1X,70('*')/)
1359
1360 1003 FORMAT(/1X,70('*')/,' From: OPEN_PVD_FILE',/,' Message: ', &
1361 A,' is missing from the the run directory,',/10X, &
1362 ' and must be present for a restart run.',/10X, &
1363 'Terminating run.',/1X,70('*')/)
1364
1365 RETURN
1366
1367 END SUBROUTINE OPEN_PVD_FILE
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384 SUBROUTINE UPDATE_AND_CLOSE_PVD_FILE
1385
1386 USE compar
1387 use cdist
1388 USE run
1389 USE vtk
1390
1391 IMPLICIT NONE
1392
1393 CHARACTER (LEN=32) :: FILENAME
1394 CHARACTER (LEN=5) :: EXT
1395
1396 IF (myPE /= PE_IO) RETURN
1397
1398 IF(VTK_DATA(VTK_REGION)=='C') THEN
1399 EXT = '.pvtu'
1400 ELSEIF(VTK_DATA(VTK_REGION)=='P') THEN
1401 EXT = '.pvtp'
1402 ENDIF
1403
1404
1405 IF(.NOT.BDIST_IO) THEN
1406 FILENAME=VTU_FILENAME
1407 ELSE
1408 IF(TIME_DEPENDENT_FILENAME) THEN
1409 WRITE(FILENAME,40) TRIM(VTK_FILEBASE(VTK_REGION)),FRAME(VTK_REGION),EXT
1410 ELSE
1411 WRITE(FILENAME,45) TRIM(VTK_FILEBASE(VTK_REGION)),EXT
1412 ENDIF
1413 IF(TRIM(VTU_DIR)/='.') FILENAME='./'//TRIM(VTU_DIR)//'/'//FILENAME
1414 ENDIF
1415
1416
1417
1418 WRITE(PVD_UNIT,100)&
1419 '<DataSet timestep="',TIME,'" ',&
1420 'group="" part="0" ',&
1421 'file="',TRIM(FILENAME),'"/>'
1422
1423
1424 WRITE(PVD_UNIT,110)'</Collection>'
1425 WRITE(PVD_UNIT,110)'</VTKFile>'
1426
1427 CLOSE(PVD_UNIT)
1428
1429
1430
1431
1432 FORMAT(A,"_",I4.4,A5)
1433 45 FORMAT(A,A5)
1434 100 FORMAT(6X,A,E14.7,5A)
1435 110 FORMAT(A)
1436
1437
1438 RETURN
1439
1440 END SUBROUTINE UPDATE_AND_CLOSE_PVD_FILE
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460 SUBROUTINE WRITE_CUT_SURFACE_VTK
1461
1462 USE param
1463 USE param1
1464 USE parallel
1465 USE constant
1466 USE run
1467 USE toleranc
1468 USE geometry
1469 USE indices
1470 USE compar
1471 USE sendrecv
1472 USE quadric
1473 USE cutcell
1474 USE fldvar
1475 USE vtk
1476 USE polygon
1477 USE stl
1478 USE functions
1479
1480 IMPLICIT NONE
1481
1482 INTEGER :: L,IJK,NODE
1483 INTEGER :: POINT_ID,POLY_COUNT,FACE_ID,Q_ID
1484 INTEGER :: N_CUT_FACE_NODES
1485
1486 INTEGER NUMBER_OF_FACES
1487 INTEGER NUMBER_OF_SURFACE_POINTS
1488
1489 DOUBLE PRECISION, DIMENSION(3,15) :: COORD_CUT_FACE_NODES
1490 DOUBLE PRECISION, DIMENSION(3) :: NORMAL
1491
1492 INTEGER, DIMENSION(DIMENSION_MAX_CUT_CELL,6) :: FACE_CONNECTIVITY
1493 INTEGER, DIMENSION(DIMENSION_MAX_CUT_CELL) :: NUMBER_OF_CUT_FACE_POINTS
1494
1495 DOUBLE PRECISION, DIMENSION(DIMENSION_MAX_CUT_CELL) :: X_FACE_POINT
1496 DOUBLE PRECISION, DIMENSION(DIMENSION_MAX_CUT_CELL) :: Y_FACE_POINT
1497 DOUBLE PRECISION, DIMENSION(DIMENSION_MAX_CUT_CELL) :: Z_FACE_POINT
1498
1499 DOUBLE PRECISION :: X_COPY,Y_COPY,Z_COPY,F_COPY
1500
1501 LOGICAL :: CLIP_FLAG
1502
1503 CHARACTER (LEN=32) :: FILENAME
1504
1505 LOGICAL :: CORNER_POINT
1506 INTEGER :: NODE_OF_CORNER, IERROR
1507
1508 IF(myPE/=0) RETURN
1509
1510
1511
1512
1513
1514 = 0
1515
1516 NUMBER_OF_SURFACE_POINTS = 0
1517
1518 NUMBER_OF_FACES = 0
1519
1520 DO IJK = 1,IJKMAX3
1521
1522 IF(GLOBAL_CUT_CELL_AT(IJK)) THEN
1523
1524
1525
1526
1527
1528
1529 = NUMBER_OF_FACES + 1
1530
1531 N_CUT_FACE_NODES = 0
1532
1533 CALL GET_GLOBAL_CELL_NODE_COORDINATES(IJK,'SCALAR')
1534
1535 DO L = 1, GLOBAL_NUMBER_OF_NODES(IJK)
1536 IF(GLOBAL_CONNECTIVITY(IJK,L)>IJKMAX3) THEN
1537 = GLOBAL_X_NEW_POINT(GLOBAL_CONNECTIVITY(IJK,L)-IJKMAX3)
1538 Y_COPY = GLOBAL_Y_NEW_POINT(GLOBAL_CONNECTIVITY(IJK,L)-IJKMAX3)
1539 Z_COPY = GLOBAL_Z_NEW_POINT(GLOBAL_CONNECTIVITY(IJK,L)-IJKMAX3)
1540 CORNER_POINT = .FALSE.
1541 ELSE
1542 DO NODE = 1,8
1543 CORNER_POINT = .TRUE.
1544 IF(GLOBAL_CONNECTIVITY(IJK,L) == IJK_OF_NODE(NODE)) THEN
1545 NODE_OF_CORNER = NODE
1546 X_COPY = X_NODE(NODE)
1547 Y_COPY = Y_NODE(NODE)
1548 Z_COPY = Z_NODE(NODE)
1549
1550 IF (GLOBAL_SNAP(IJK_OF_NODE(NODE))) THEN
1551 = N_CUT_FACE_NODES + 1
1552 COORD_CUT_FACE_NODES(1,N_CUT_FACE_NODES) = X_COPY
1553 COORD_CUT_FACE_NODES(2,N_CUT_FACE_NODES) = Y_COPY
1554 COORD_CUT_FACE_NODES(3,N_CUT_FACE_NODES) = Z_COPY
1555 ENDIF
1556 ENDIF
1557 END DO
1558
1559 ENDIF
1560
1561 IF(CORNER_POINT) THEN
1562 Q_ID = 1
1563
1564 CALL EVAL_F('QUADRIC',X_COPY,Y_COPY,Z_COPY,Q_ID,F_COPY,CLIP_FLAG)
1565
1566 CALL EVAL_F('POLYGON',X_COPY,Y_COPY,Z_COPY,N_POLYGON,F_COPY,CLIP_FLAG)
1567
1568 CALL EVAL_F('USR_DEF',X_COPY,Y_COPY,Z_COPY,N_USR_DEF,F_COPY,CLIP_FLAG)
1569
1570 IF(USE_STL.OR.USE_MSH) F_COPY = GLOBAL_F_AT(IJK_OF_NODE(NODE_OF_CORNER))
1571
1572
1573 ELSE
1574 F_COPY = ZERO
1575 ENDIF
1576
1577 IF (ABS(F_COPY) < TOL_F ) THEN
1578 = N_CUT_FACE_NODES + 1
1579 COORD_CUT_FACE_NODES(1,N_CUT_FACE_NODES) = X_COPY
1580 COORD_CUT_FACE_NODES(2,N_CUT_FACE_NODES) = Y_COPY
1581 COORD_CUT_FACE_NODES(3,N_CUT_FACE_NODES) = Z_COPY
1582 ENDIF
1583
1584 END DO
1585
1586 CALL REORDER_POLYGON(N_CUT_FACE_NODES,COORD_CUT_FACE_NODES,NORMAL,IERROR)
1587
1588 NUMBER_OF_CUT_FACE_POINTS(NUMBER_OF_FACES) = N_CUT_FACE_NODES
1589 POLY_COUNT = POLY_COUNT + N_CUT_FACE_NODES + 1
1590 DO NODE = 1,N_CUT_FACE_NODES
1591 NUMBER_OF_SURFACE_POINTS = NUMBER_OF_SURFACE_POINTS + 1
1592
1593 IF(NUMBER_OF_SURFACE_POINTS>=DIMENSION_MAX_CUT_CELL) THEN
1594 WRITE(*,3000) 'ERROR IN SUBROUTINE WRITE_3DCUT_SURFACE_VTK:'
1595 WRITE(*,3000) 'NUMBER_OF_SURFACE_POINTS>=DIMENSION_MAX_CUT_CELL:'
1596 WRITE(*,3000) 'INCREASE VALUE OF FAC_DIM_MAX_CUT_CELL.'
1597 WRITE(*,3010) 'CURRENT VALUE OF FAC_DIM_MAX_CUT_CELL =',FAC_DIM_MAX_CUT_CELL
1598 WRITE(*,3020) 'CURRENT VALUE OF DIMENSION_MAX_CUT_CELL =',DIMENSION_MAX_CUT_CELL
1599 WRITE(*,3000) 'MFiX will exit now.'
1600 CALL MFIX_EXIT(myPE)
1601 ENDIF
1602
1603 X_FACE_POINT(NUMBER_OF_SURFACE_POINTS) = COORD_CUT_FACE_NODES(1,NODE)
1604 Y_FACE_POINT(NUMBER_OF_SURFACE_POINTS) = COORD_CUT_FACE_NODES(2,NODE)
1605 Z_FACE_POINT(NUMBER_OF_SURFACE_POINTS) = COORD_CUT_FACE_NODES(3,NODE)
1606 FACE_CONNECTIVITY(NUMBER_OF_FACES,NODE) = NUMBER_OF_SURFACE_POINTS
1607 ENDDO
1608
1609 ENDIF
1610
1611 END DO
1612
1613 FILENAME= TRIM(RUN_NAME) // '_boundary.vtk'
1614 FILENAME = TRIM(FILENAME)
1615 OPEN(UNIT = 123, FILE = FILENAME)
1616 WRITE(123,1001)'# vtk DataFile Version 2.0'
1617 WRITE(123,1001)'3D CUT-CELL SURFACE'
1618 WRITE(123,1001)'ASCII'
1619
1620 IF(NO_K) THEN
1621 WRITE(123,1001)'DATASET UNSTRUCTURED_GRID'
1622 ELSE
1623 WRITE(123,1001)'DATASET POLYDATA'
1624 ENDIF
1625
1626 WRITE(123,1010)'POINTS ',NUMBER_OF_SURFACE_POINTS,' float'
1627
1628 DO POINT_ID = 1,NUMBER_OF_SURFACE_POINTS
1629 WRITE(123,1020) X_FACE_POINT(POINT_ID),Y_FACE_POINT(POINT_ID),Z_FACE_POINT(POINT_ID)
1630 ENDDO
1631
1632 IF(NO_K) THEN
1633
1634 WRITE(123,1030)'CELLS ',NUMBER_OF_FACES,POLY_COUNT
1635 DO FACE_ID = 1 , NUMBER_OF_FACES
1636 WRITE(123,1040) NUMBER_OF_CUT_FACE_POINTS(FACE_ID),(FACE_CONNECTIVITY(FACE_ID,L)-1,&
1637 L=1,NUMBER_OF_CUT_FACE_POINTS(FACE_ID))
1638 ENDDO
1639 WRITE(123,1030)'CELL_TYPES ',NUMBER_OF_FACES
1640 DO FACE_ID = 1 , NUMBER_OF_FACES
1641 WRITE(123,1040) 3
1642 ENDDO
1643
1644 ELSE
1645
1646 WRITE(123,1030)'POLYGONS ',NUMBER_OF_FACES,POLY_COUNT
1647 DO FACE_ID = 1 , NUMBER_OF_FACES
1648 WRITE(123,1040) NUMBER_OF_CUT_FACE_POINTS(FACE_ID),(FACE_CONNECTIVITY(FACE_ID,L)-1,&
1649 L=1,NUMBER_OF_CUT_FACE_POINTS(FACE_ID))
1650 ENDDO
1651
1652 ENDIF
1653
1654 1001 FORMAT(A)
1655 1010 FORMAT(A,I8,A)
1656 1020 FORMAT(3(E16.8,2X))
1657 1030 FORMAT(A,2(I8,2X))
1658 1040 FORMAT(20(I8,2X))
1659 3000 FORMAT(1X,A)
1660 3010 FORMAT(1X,A,F8.4)
1661 3020 FORMAT(1X,A,I8)
1662 3030 FORMAT(1X,A,A)
1663 CLOSE (123)
1664
1665
1666 WRITE(*,3030)'WROTE BOUNDARY IN VTK FILE : ',FILENAME
1667 RETURN
1668
1669
1670 END SUBROUTINE WRITE_CUT_SURFACE_VTK
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688 SUBROUTINE GATHER_DATA
1689
1690 USE param
1691 USE param1
1692 USE parallel
1693 USE constant
1694 USE run
1695 USE toleranc
1696 USE geometry
1697 USE indices
1698 USE compar
1699 USE mpi_utility
1700 USE sendrecv
1701 USE quadric
1702 USE cutcell
1703 USE fldvar
1704 USE vtk
1705 USE functions
1706
1707 IMPLICIT NONE
1708
1709 INTEGER :: IJK,I,J,K,L
1710 INTEGER :: IJK_OFFSET
1711
1712 INTEGER :: iproc,IERR
1713 INTEGER, DIMENSION(0:numPEs-1) :: disp,rcount
1714 INTEGER, DIMENSION(:,:), ALLOCATABLE :: SHIFTED_CONNECTIVITY
1715
1716
1717
1718
1719
1720 CALL allgather_1i (NUMBER_OF_NEW_POINTS,rcount,IERR)
1721
1722 IF (myPE == 0) THEN
1723 IJK_OFFSET = 0
1724 ELSE
1725 IJK_OFFSET = 0
1726 DO iproc=0,myPE-1
1727 IJK_OFFSET = IJK_OFFSET + rcount(iproc)
1728 ENDDO
1729 ENDIF
1730
1731 CALL allgather_1i (IJK_OFFSET,disp,IERR)
1732
1733 IF(.NOT.GLOBAL_VAR_ALLOCATED) THEN
1734
1735 IF (myPE == PE_IO) THEN
1736 allocate (GLOBAL_I_OF(ijkmax3))
1737 allocate (GLOBAL_J_OF(ijkmax3))
1738 allocate (GLOBAL_K_OF(ijkmax3))
1739 allocate (GLOBAL_CONNECTIVITY(ijkmax3,15))
1740 allocate (GLOBAL_NUMBER_OF_NODES(ijkmax3))
1741 allocate (GLOBAL_INTERIOR_CELL_AT(ijkmax3))
1742 allocate (GLOBAL_BLOCKED_CELL_AT(ijkmax3))
1743 allocate (GLOBAL_STANDARD_CELL_AT(ijkmax3))
1744 allocate (GLOBAL_CUT_CELL_AT(ijkmax3))
1745 allocate (GLOBAL_SNAP(ijkmax3))
1746 allocate (GLOBAL_X_NEW_POINT(ijkmax3))
1747 allocate (GLOBAL_Y_NEW_POINT(ijkmax3))
1748 allocate (GLOBAL_Z_NEW_POINT(ijkmax3))
1749 allocate (GLOBAL_F_AT(ijkmax3))
1750
1751 ELSE
1752 allocate (GLOBAL_I_OF(1))
1753 allocate (GLOBAL_J_OF(1))
1754 allocate (GLOBAL_K_OF(1))
1755 allocate (GLOBAL_CONNECTIVITY(1,15))
1756 allocate (GLOBAL_NUMBER_OF_NODES(1))
1757 allocate (GLOBAL_INTERIOR_CELL_AT(1))
1758 allocate (GLOBAL_BLOCKED_CELL_AT(1))
1759 allocate (GLOBAL_STANDARD_CELL_AT(1))
1760 allocate (GLOBAL_CUT_CELL_AT(1))
1761 allocate (GLOBAL_SNAP(1))
1762 allocate (GLOBAL_X_NEW_POINT(1))
1763 allocate (GLOBAL_Y_NEW_POINT(1))
1764 allocate (GLOBAL_Z_NEW_POINT(1))
1765 allocate (GLOBAL_F_AT(1))
1766 ENDIF
1767
1768 GLOBAL_VAR_ALLOCATED = .TRUE.
1769
1770 ENDIF
1771
1772 IF(numPEs==1) THEN
1773 (1:NUMBER_OF_NEW_POINTS) = X_NEW_POINT(1:NUMBER_OF_NEW_POINTS)
1774 GLOBAL_Y_NEW_POINT(1:NUMBER_OF_NEW_POINTS) = Y_NEW_POINT(1:NUMBER_OF_NEW_POINTS)
1775 IF(DO_K) GLOBAL_Z_NEW_POINT(1:NUMBER_OF_NEW_POINTS) = Z_NEW_POINT(1:NUMBER_OF_NEW_POINTS)
1776 ELSE
1777 call gatherv_1d( X_NEW_POINT, NUMBER_OF_NEW_POINTS, GLOBAL_X_NEW_POINT, rcount, disp, PE_IO, ierr )
1778 call gatherv_1d( Y_NEW_POINT, NUMBER_OF_NEW_POINTS, GLOBAL_Y_NEW_POINT, rcount, disp, PE_IO, ierr )
1779 call gatherv_1d( Z_NEW_POINT, NUMBER_OF_NEW_POINTS, GLOBAL_Z_NEW_POINT, rcount, disp, PE_IO, ierr )
1780 ENDIF
1781
1782 call global_sum(NUMBER_OF_NEW_POINTS, GLOBAL_NUMBER_OF_NEW_POINTS, PE_IO, ierr )
1783
1784 Allocate( SHIFTED_CONNECTIVITY (DIMENSION_3,15) )
1785
1786 SHIFTED_CONNECTIVITY = CONNECTIVITY
1787
1788 WHERE (SHIFTED_CONNECTIVITY > IJKEND3)
1789 SHIFTED_CONNECTIVITY = SHIFTED_CONNECTIVITY - IJKEND3 + IJKMAX3 + disp(myPE)
1790 END WHERE
1791
1792 DO IJK = IJKSTART3,IJKEND3
1793 DO L=1,NUMBER_OF_NODES(IJK)
1794 IF(CONNECTIVITY(IJK,L) <= IJKEND3) THEN
1795 I = I_OF(CONNECTIVITY(IJK,L))
1796 J = J_OF(CONNECTIVITY(IJK,L))
1797 K = K_OF(CONNECTIVITY(IJK,L))
1798 SHIFTED_CONNECTIVITY(IJK,L) = funijk_gl(I,J,K)
1799 ENDIF
1800 ENDDO
1801 ENDDO
1802
1803
1804 GLOBAL_INTERIOR_CELL_AT = .FALSE.
1805 GLOBAL_BLOCKED_CELL_AT = .FALSE.
1806 GLOBAL_CUT_CELL_AT = .FALSE.
1807 call gather (I_OF,GLOBAL_I_OF,root)
1808 call gather (J_OF,GLOBAL_J_OF,root)
1809 call gather (K_OF,GLOBAL_K_OF,root)
1810 call gather (SHIFTED_CONNECTIVITY,GLOBAL_CONNECTIVITY,root)
1811 call gather (NUMBER_OF_NODES,GLOBAL_NUMBER_OF_NODES,root)
1812 call gather (INTERIOR_CELL_AT,GLOBAL_INTERIOR_CELL_AT,root)
1813 call gather (BLOCKED_CELL_AT,GLOBAL_BLOCKED_CELL_AT,root)
1814 call gather (STANDARD_CELL_AT,GLOBAL_STANDARD_CELL_AT,root)
1815 call gather (CUT_CELL_AT,GLOBAL_CUT_CELL_AT,root)
1816 call gather (SNAP,GLOBAL_SNAP,root)
1817 call gather (F_AT,GLOBAL_F_AT,root)
1818
1819 Deallocate( SHIFTED_CONNECTIVITY )
1820
1821 IF (myPE == PE_IO) THEN
1822
1823 POLY_COUNTER = 0
1824
1825 NUMBER_OF_CELLS = 0
1826
1827 NUMBER_OF_CUT_CELLS = 0
1828
1829 NUMBER_OF_BLOCKED_CELLS = 0
1830
1831 NUMBER_OF_STANDARD_CELLS = 0
1832
1833 DO IJK = 1, IJKMAX3
1834
1835 IF (GLOBAL_INTERIOR_CELL_AT(IJK)) THEN
1836
1837 NUMBER_OF_CELLS = NUMBER_OF_CELLS + 1
1838
1839 IF (GLOBAL_BLOCKED_CELL_AT(IJK)) NUMBER_OF_BLOCKED_CELLS = NUMBER_OF_BLOCKED_CELLS + 1
1840 IF (GLOBAL_STANDARD_CELL_AT(IJK)) NUMBER_OF_STANDARD_CELLS = NUMBER_OF_STANDARD_CELLS + 1
1841 IF (GLOBAL_CUT_CELL_AT(IJK)) NUMBER_OF_CUT_CELLS = NUMBER_OF_CUT_CELLS + 1
1842
1843 IF (.NOT.GLOBAL_BLOCKED_CELL_AT(IJK)) POLY_COUNTER = POLY_COUNTER + GLOBAL_NUMBER_OF_NODES(IJK) + 1
1844
1845 ENDIF
1846
1847 END DO
1848
1849
1850 NUMBER_OF_POINTS = IJKMAX3 + GLOBAL_NUMBER_OF_NEW_POINTS
1851
1852 ENDIF
1853
1854 RETURN
1855
1856
1857 END SUBROUTINE GATHER_DATA
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875 SUBROUTINE SETUP_VTK_NO_CUTCELL
1876
1877 USE param
1878 USE param1
1879 USE parallel
1880 USE constant
1881 USE run
1882 USE toleranc
1883 USE geometry
1884 USE indices
1885 USE compar
1886 USE mpi_utility
1887 USE sendrecv
1888 USE quadric
1889 USE cutcell
1890 USE fldvar
1891 USE vtk
1892 USE functions
1893
1894 IMPLICIT NONE
1895
1896 INTEGER :: IJK,I,J,K,L,NODE
1897
1898 INTEGER, DIMENSION(:,:), ALLOCATABLE :: SHIFTED_CONNECTIVITY
1899
1900
1901
1902 IF(.NOT.ALLOCATED(XG_E)) Allocate( XG_E(0:DIMENSION_I) )
1903 IF(.NOT.ALLOCATED(YG_N)) Allocate( YG_N(0:DIMENSION_J) )
1904 IF(.NOT.ALLOCATED(ZG_T)) Allocate( ZG_T(0:DIMENSION_K) )
1905
1906 IF(.NOT.ALLOCATED(INTERIOR_CELL_AT)) THEN
1907 Allocate( INTERIOR_CELL_AT (DIMENSION_3) )
1908 INTERIOR_CELL_AT = .FALSE.
1909 ENDIF
1910
1911 IF(.NOT.ALLOCATED(BLOCKED_CELL_AT)) THEN
1912 Allocate( BLOCKED_CELL_AT (DIMENSION_3) )
1913 BLOCKED_CELL_AT = .FALSE.
1914 ENDIF
1915
1916 IF(.NOT.ALLOCATED(STANDARD_CELL_AT)) THEN
1917 Allocate( STANDARD_CELL_AT (DIMENSION_3) )
1918 STANDARD_CELL_AT = .TRUE.
1919 ENDIF
1920
1921 IF(.NOT.ALLOCATED(CUT_CELL_AT)) THEN
1922 Allocate( CUT_CELL_AT (DIMENSION_3) )
1923 CUT_CELL_AT = .FALSE.
1924 ENDIF
1925
1926 IF(.NOT.ALLOCATED(NUMBER_OF_NODES)) Allocate( NUMBER_OF_NODES (DIMENSION_3) )
1927 NUMBER_OF_NODES= 0
1928
1929 IF(.NOT.ALLOCATED(CONNECTIVITY)) Allocate( CONNECTIVITY (DIMENSION_3,15) )
1930
1931
1932
1933 DO IJK = IJKSTART3, IJKEND3
1934
1935
1936
1937
1938
1939 CALL GET_CELL_NODE_COORDINATES(IJK,'SCALAR')
1940
1941 I = I_OF(IJK)
1942 J = J_OF(IJK)
1943 K = K_OF(IJK)
1944
1945 IF(NO_K) THEN
1946
1947 (IJK) = ( (I >= ISTART1 ).AND.(I <= IEND1 ) &
1948 .AND.(J >= JSTART1 ).AND.(J <= JEND1 ) )
1949
1950 ELSE
1951
1952 (IJK) = ( (I >= ISTART1 ).AND.(I <= IEND1 ) &
1953 .AND.(J >= JSTART1 ).AND.(J <= JEND1 ) &
1954 .AND.(K >= KSTART1 ).AND.(K <= KEND1 ) )
1955
1956 ENDIF
1957
1958
1959 IF(INTERIOR_CELL_AT(IJK)) THEN
1960
1961
1962 IF(NO_K) THEN
1963 NUMBER_OF_NODES(IJK) = 4
1964 CONNECTIVITY(IJK,1) = IJK_OF_NODE(5)
1965 CONNECTIVITY(IJK,2) = IJK_OF_NODE(6)
1966 CONNECTIVITY(IJK,3) = IJK_OF_NODE(8)
1967 CONNECTIVITY(IJK,4) = IJK_OF_NODE(7)
1968 ELSE
1969 NUMBER_OF_NODES(IJK) = 8
1970 DO NODE = 1,8
1971 CONNECTIVITY(IJK,NODE) = IJK_OF_NODE(NODE)
1972 END DO
1973 ENDIF
1974
1975
1976
1977 IF(WALL_AT(IJK)) THEN
1978 BLOCKED_CELL_AT(IJK) = .TRUE.
1979 CUT_CELL_AT(IJK) = .FALSE.
1980 STANDARD_CELL_AT(IJK) = .FALSE.
1981 ENDIF
1982
1983 ENDIF
1984
1985 ENDDO
1986
1987
1988
1989
1990
1991 call SEND_RECEIVE_1D_LOGICAL(STANDARD_CELL_AT,2)
1992 call SEND_RECEIVE_1D_LOGICAL(BLOCKED_CELL_AT,2)
1993 call SEND_RECEIVE_1D_LOGICAL(CUT_CELL_AT,2)
1994
1995 Allocate( SHIFTED_CONNECTIVITY (DIMENSION_3,15) )
1996
1997 SHIFTED_CONNECTIVITY = CONNECTIVITY
1998
1999
2000 DO IJK = IJKSTART3,IJKEND3
2001 DO L=1,NUMBER_OF_NODES(IJK)
2002 IF(CONNECTIVITY(IJK,L) <= IJKEND3) THEN
2003 I = I_OF(CONNECTIVITY(IJK,L))
2004 J = J_OF(CONNECTIVITY(IJK,L))
2005 K = K_OF(CONNECTIVITY(IJK,L))
2006 SHIFTED_CONNECTIVITY(IJK,L) = funijk_gl(I,J,K)
2007 ENDIF
2008 ENDDO
2009 ENDDO
2010
2011
2012 IF(.NOT.GLOBAL_VAR_ALLOCATED) THEN
2013
2014 IF (myPE == PE_IO) THEN
2015 allocate (GLOBAL_I_OF(ijkmax3))
2016 allocate (GLOBAL_J_OF(ijkmax3))
2017 allocate (GLOBAL_K_OF(ijkmax3))
2018 allocate (GLOBAL_CONNECTIVITY(ijkmax3,15))
2019 allocate (GLOBAL_NUMBER_OF_NODES(ijkmax3))
2020 allocate (GLOBAL_INTERIOR_CELL_AT(ijkmax3))
2021 allocate (GLOBAL_BLOCKED_CELL_AT(ijkmax3))
2022 allocate (GLOBAL_STANDARD_CELL_AT(ijkmax3))
2023 allocate (GLOBAL_CUT_CELL_AT(ijkmax3))
2024
2025 ELSE
2026 allocate (GLOBAL_I_OF(1))
2027 allocate (GLOBAL_J_OF(1))
2028 allocate (GLOBAL_K_OF(1))
2029 allocate (GLOBAL_CONNECTIVITY(1,15))
2030 allocate (GLOBAL_NUMBER_OF_NODES(1))
2031 allocate (GLOBAL_INTERIOR_CELL_AT(1))
2032 allocate (GLOBAL_BLOCKED_CELL_AT(1))
2033 allocate (GLOBAL_STANDARD_CELL_AT(1))
2034 allocate (GLOBAL_CUT_CELL_AT(1))
2035 ENDIF
2036
2037 GLOBAL_VAR_ALLOCATED = .TRUE.
2038
2039 ENDIF
2040
2041
2042 GLOBAL_INTERIOR_CELL_AT = .FALSE.
2043 GLOBAL_BLOCKED_CELL_AT = .FALSE.
2044 GLOBAL_CUT_CELL_AT = .FALSE.
2045 GLOBAL_STANDARD_CELL_AT = .TRUE.
2046
2047 call gather (I_OF,GLOBAL_I_OF,root)
2048 call gather (J_OF,GLOBAL_J_OF,root)
2049 call gather (K_OF,GLOBAL_K_OF,root)
2050 call gather (SHIFTED_CONNECTIVITY,GLOBAL_CONNECTIVITY,root)
2051 call gather (NUMBER_OF_NODES,GLOBAL_NUMBER_OF_NODES,root)
2052 call gather (INTERIOR_CELL_AT,GLOBAL_INTERIOR_CELL_AT,root)
2053 call gather (BLOCKED_CELL_AT,GLOBAL_BLOCKED_CELL_AT,root)
2054 call gather (STANDARD_CELL_AT,GLOBAL_STANDARD_CELL_AT,root)
2055 call gather (CUT_CELL_AT,GLOBAL_CUT_CELL_AT,root)
2056
2057 deAllocate( SHIFTED_CONNECTIVITY )
2058
2059
2060
2061
2062 = 0
2063
2064 IF (myPE == PE_IO) THEN
2065
2066 POLY_COUNTER = 0
2067
2068 NUMBER_OF_CELLS = 0
2069
2070 NUMBER_OF_CUT_CELLS = 0
2071
2072 NUMBER_OF_BLOCKED_CELLS = 0
2073
2074 NUMBER_OF_STANDARD_CELLS = 0
2075
2076 DO IJK = 1, IJKMAX3
2077
2078 IF (GLOBAL_INTERIOR_CELL_AT(IJK)) THEN
2079
2080 NUMBER_OF_CELLS = NUMBER_OF_CELLS + 1
2081
2082 IF (GLOBAL_BLOCKED_CELL_AT(IJK)) NUMBER_OF_BLOCKED_CELLS = NUMBER_OF_BLOCKED_CELLS + 1
2083 IF (GLOBAL_STANDARD_CELL_AT(IJK)) NUMBER_OF_STANDARD_CELLS = NUMBER_OF_STANDARD_CELLS + 1
2084 IF (GLOBAL_CUT_CELL_AT(IJK)) NUMBER_OF_CUT_CELLS = NUMBER_OF_CUT_CELLS + 1
2085
2086 IF (.NOT.GLOBAL_BLOCKED_CELL_AT(IJK)) POLY_COUNTER = POLY_COUNTER + GLOBAL_NUMBER_OF_NODES(IJK) + 1
2087
2088 ENDIF
2089
2090 END DO
2091
2092
2093 = IJKMAX3
2094
2095 ENDIF
2096
2097 RETURN
2098
2099
2100 END SUBROUTINE SETUP_VTK_NO_CUTCELL
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117 SUBROUTINE PRINT_GRID_STATISTICS
2118
2119 USE param
2120 USE param1
2121 USE parallel
2122 USE constant
2123 USE run
2124 USE toleranc
2125 USE geometry
2126 USE indices
2127 USE compar
2128 USE mpi_utility
2129 USE sendrecv
2130 USE quadric
2131 USE cutcell
2132 USE fldvar
2133 USE vtk
2134 USE functions
2135
2136 IMPLICIT NONE
2137
2138 INTEGER :: IJK
2139
2140 INTEGER :: IERR
2141
2142 DOUBLE PRECISION :: MIN_VOL, MAX_VOL, GLOBAL_MIN_VOL,GLOBAL_MAX_VOL
2143 DOUBLE PRECISION :: MIN_AYZ, MAX_AYZ, GLOBAL_MIN_AYZ,GLOBAL_MAX_AYZ
2144 DOUBLE PRECISION :: MIN_AXZ, MAX_AXZ, GLOBAL_MIN_AXZ,GLOBAL_MAX_AXZ
2145 DOUBLE PRECISION :: MIN_AXY, MAX_AXY, GLOBAL_MIN_AXY,GLOBAL_MAX_AXY
2146 DOUBLE PRECISION :: MIN_CUT, MAX_CUT, GLOBAL_MIN_CUT,GLOBAL_MAX_CUT
2147 DOUBLE PRECISION :: LOCAL_MIN_Q,LOCAL_MAX_Q, GLOBAL_MIN_Q,GLOBAL_MAX_Q
2148
2149 IF (myPE == PE_IO) THEN
2150
2151 IF(.NOT.GRID_INFO_PRINTED_ON_SCREEN) THEN
2152 WRITE(*,5) 'GRID STATISTICS:'
2153 WRITE(*,5) 'NUMBER OF CELLS = ', NUMBER_OF_CELLS
2154 WRITE(*,10)'NUMBER OF STANDARD CELLS = ', &
2155 NUMBER_OF_STANDARD_CELLS,DBLE(NUMBER_OF_STANDARD_CELLS) / DBLE(NUMBER_OF_CELLS) * 100.0D0
2156 WRITE(*,10)'NUMBER OF CUT CELLS = ', &
2157 NUMBER_OF_CUT_CELLS,DBLE(NUMBER_OF_CUT_CELLS) / DBLE(NUMBER_OF_CELLS) * 100.0D0
2158 WRITE(*,10)'NUMBER OF BLOCKED CELLS = ', &
2159 NUMBER_OF_BLOCKED_CELLS,DBLE(NUMBER_OF_BLOCKED_CELLS) / DBLE(NUMBER_OF_CELLS) * 100.0D0
2160
2161 5 FORMAT(1X,A,I8)
2162 10 FORMAT(1X,A,I8,' (',F6.2,' % of Total)')
2163
2164 ENDIF
2165
2166 GRID_INFO_PRINTED_ON_SCREEN = .TRUE.
2167
2168 ENDIF
2169
2170
2171
2172
2173
2174
2175 = LARGE_NUMBER
2176 MAX_VOL = - LARGE_NUMBER
2177 MIN_AYZ = LARGE_NUMBER
2178 MAX_AYZ = - LARGE_NUMBER
2179 MIN_AXZ = LARGE_NUMBER
2180 MAX_AXZ = - LARGE_NUMBER
2181 MIN_AXY = LARGE_NUMBER
2182 MAX_AXY = - LARGE_NUMBER
2183
2184 DO IJK = IJKSTART3, IJKEND3
2185 IF(STANDARD_CELL_AT(IJK)) THEN
2186
2187 = DMIN1(MIN_VOL,VOL(IJK))
2188 MAX_VOL = DMAX1(MAX_VOL,VOL(IJK))
2189 MIN_AYZ = DMIN1(MIN_AYZ,AYZ(IJK))
2190 MAX_AYZ = DMAX1(MAX_AYZ,AYZ(IJK))
2191 MIN_AXZ = DMIN1(MIN_AXZ,AXZ(IJK))
2192 MAX_AXZ = DMAX1(MAX_AXZ,AXZ(IJK))
2193 MIN_AXY = DMIN1(MIN_AXY,AXY(IJK))
2194 MAX_AXY = DMAX1(MAX_AXY,AXY(IJK))
2195
2196 ENDIF
2197 END DO
2198
2199 call global_min(MIN_VOL, GLOBAL_MIN_VOL, PE_IO, ierr )
2200 call global_max(MAX_VOL, GLOBAL_MAX_VOL, PE_IO, ierr )
2201 call global_min(MIN_AYZ, GLOBAL_MIN_AYZ, PE_IO, ierr )
2202 call global_max(MAX_AYZ, GLOBAL_MAX_AYZ, PE_IO, ierr )
2203 call global_min(MIN_AXZ, GLOBAL_MIN_AXZ, PE_IO, ierr )
2204 call global_max(MAX_AXZ, GLOBAL_MAX_AXZ, PE_IO, ierr )
2205 call global_min(MIN_AXY, GLOBAL_MIN_AXY, PE_IO, ierr )
2206 call global_max(MAX_AXY, GLOBAL_MAX_AXY, PE_IO, ierr )
2207
2208 IF (myPE == PE_IO) THEN
2209 WRITE(UNIT_CUT_CELL_LOG,1000) '################################################################'
2210 WRITE(UNIT_CUT_CELL_LOG,1000) ' CELLS STATISTICS '
2211 WRITE(UNIT_CUT_CELL_LOG,1000) '################################################################'
2212 WRITE(UNIT_CUT_CELL_LOG,1000) 'SCALAR STANDARD CELLS:'
2213 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXY = ', GLOBAL_MIN_AXY,GLOBAL_MAX_AXY
2214 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXZ = ', GLOBAL_MIN_AXZ,GLOBAL_MAX_AXZ
2215 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AYZ = ', GLOBAL_MIN_AYZ,GLOBAL_MAX_AYZ
2216 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF VOLUME = ', GLOBAL_MIN_VOL,GLOBAL_MAX_VOL
2217 ENDIF
2218
2219
2220 MIN_VOL = LARGE_NUMBER
2221 MAX_VOL = - LARGE_NUMBER
2222 MIN_AYZ = LARGE_NUMBER
2223 MAX_AYZ = - LARGE_NUMBER
2224 MIN_AXZ = LARGE_NUMBER
2225 MAX_AXZ = - LARGE_NUMBER
2226 MIN_AXY = LARGE_NUMBER
2227 MAX_AXY = - LARGE_NUMBER
2228
2229 DO IJK = IJKSTART3, IJKEND3
2230 IF(CUT_CELL_AT(IJK)) THEN
2231
2232 = DMIN1(MIN_VOL,VOL(IJK))
2233 MAX_VOL = DMAX1(MAX_VOL,VOL(IJK))
2234 MIN_AYZ = DMIN1(MIN_AYZ,AYZ(IJK))
2235 MAX_AYZ = DMAX1(MAX_AYZ,AYZ(IJK))
2236 MIN_AXZ = DMIN1(MIN_AXZ,AXZ(IJK))
2237 MAX_AXZ = DMAX1(MAX_AXZ,AXZ(IJK))
2238 MIN_AXY = DMIN1(MIN_AXY,AXY(IJK))
2239 MAX_AXY = DMAX1(MAX_AXY,AXY(IJK))
2240
2241 ENDIF
2242 END DO
2243
2244 call global_min(MIN_VOL, GLOBAL_MIN_VOL, PE_IO, ierr )
2245 call global_max(MAX_VOL, GLOBAL_MAX_VOL, PE_IO, ierr )
2246 call global_min(MIN_AYZ, GLOBAL_MIN_AYZ, PE_IO, ierr )
2247 call global_max(MAX_AYZ, GLOBAL_MAX_AYZ, PE_IO, ierr )
2248 call global_min(MIN_AXZ, GLOBAL_MIN_AXZ, PE_IO, ierr )
2249 call global_max(MAX_AXZ, GLOBAL_MAX_AXZ, PE_IO, ierr )
2250 call global_min(MIN_AXY, GLOBAL_MIN_AXY, PE_IO, ierr )
2251 call global_max(MAX_AXY, GLOBAL_MAX_AXY, PE_IO, ierr )
2252
2253 IF (myPE == PE_IO) THEN
2254 WRITE(UNIT_CUT_CELL_LOG,1000) 'SCALAR CUT CELLS:'
2255 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXY = ', GLOBAL_MIN_AXY,GLOBAL_MAX_AXY
2256 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXZ = ', GLOBAL_MIN_AXZ,GLOBAL_MAX_AXZ
2257 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AYZ = ', GLOBAL_MIN_AYZ,GLOBAL_MAX_AYZ
2258 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF VOLUME = ', GLOBAL_MIN_VOL,GLOBAL_MAX_VOL
2259 WRITE(UNIT_CUT_CELL_LOG,1010) 'NUMBER OF SMALL SCALAR CELLS = ', NUMBER_OF_SMALL_CELLS
2260 WRITE(UNIT_CUT_CELL_LOG,1000) '################################################################'
2261 ENDIF
2262
2263 1000 FORMAT(A,E14.7,2X,E14.7)
2264 1010 FORMAT(A,I8)
2265
2266
2267
2268
2269
2270 = LARGE_NUMBER
2271 MAX_VOL = - LARGE_NUMBER
2272 MIN_AYZ = LARGE_NUMBER
2273 MAX_AYZ = - LARGE_NUMBER
2274 MIN_AXZ = LARGE_NUMBER
2275 MAX_AXZ = - LARGE_NUMBER
2276 MIN_AXY = LARGE_NUMBER
2277 MAX_AXY = - LARGE_NUMBER
2278
2279 DO IJK = IJKSTART3, IJKEND3
2280 IF(STANDARD_U_CELL_AT(IJK)) THEN
2281
2282 = DMIN1(MIN_VOL,VOL_U(IJK))
2283 MAX_VOL = DMAX1(MAX_VOL,VOL_U(IJK))
2284 MIN_AYZ = DMIN1(MIN_AYZ,AYZ_U(IJK))
2285 MAX_AYZ = DMAX1(MAX_AYZ,AYZ_U(IJK))
2286 MIN_AXZ = DMIN1(MIN_AXZ,AXZ_U(IJK))
2287 MAX_AXZ = DMAX1(MAX_AXZ,AXZ_U(IJK))
2288 MIN_AXY = DMIN1(MIN_AXY,AXY_U(IJK))
2289 MAX_AXY = DMAX1(MAX_AXY,AXY_U(IJK))
2290
2291 ENDIF
2292 END DO
2293
2294 call global_min(MIN_VOL, GLOBAL_MIN_VOL, PE_IO, ierr )
2295 call global_max(MAX_VOL, GLOBAL_MAX_VOL, PE_IO, ierr )
2296 call global_min(MIN_AYZ, GLOBAL_MIN_AYZ, PE_IO, ierr )
2297 call global_max(MAX_AYZ, GLOBAL_MAX_AYZ, PE_IO, ierr )
2298 call global_min(MIN_AXZ, GLOBAL_MIN_AXZ, PE_IO, ierr )
2299 call global_max(MAX_AXZ, GLOBAL_MAX_AXZ, PE_IO, ierr )
2300 call global_min(MIN_AXY, GLOBAL_MIN_AXY, PE_IO, ierr )
2301 call global_max(MAX_AXY, GLOBAL_MAX_AXY, PE_IO, ierr )
2302
2303 IF (myPE == PE_IO) THEN
2304 WRITE(UNIT_CUT_CELL_LOG,1000) 'U-MOMENTUM STANDARD CELLS:'
2305 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXY = ', GLOBAL_MIN_AXY,GLOBAL_MAX_AXY
2306 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXZ = ', GLOBAL_MIN_AXZ,GLOBAL_MAX_AXZ
2307 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AYZ = ', GLOBAL_MIN_AYZ,GLOBAL_MAX_AYZ
2308 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF VOLUME = ', GLOBAL_MIN_VOL,GLOBAL_MAX_VOL
2309 ENDIF
2310
2311 MIN_VOL = LARGE_NUMBER
2312 MAX_VOL = - LARGE_NUMBER
2313 MIN_AYZ = LARGE_NUMBER
2314 MAX_AYZ = - LARGE_NUMBER
2315 MIN_AXZ = LARGE_NUMBER
2316 MAX_AXZ = - LARGE_NUMBER
2317 MIN_AXY = LARGE_NUMBER
2318 MAX_AXY = - LARGE_NUMBER
2319 MIN_CUT = LARGE_NUMBER
2320 MAX_CUT = - LARGE_NUMBER
2321
2322 DO IJK = IJKSTART3, IJKEND3
2323 IF(CUT_U_CELL_AT(IJK).AND.(.NOT.WALL_U_AT(IJK))) THEN
2324
2325 = DMIN1(MIN_VOL,VOL_U(IJK))
2326 MAX_VOL = DMAX1(MAX_VOL,VOL_U(IJK))
2327 MIN_AYZ = DMIN1(MIN_AYZ,AYZ_U(IJK))
2328 MAX_AYZ = DMAX1(MAX_AYZ,AYZ_U(IJK))
2329 MIN_AXZ = DMIN1(MIN_AXZ,AXZ_U(IJK))
2330 MAX_AXZ = DMAX1(MAX_AXZ,AXZ_U(IJK))
2331 MIN_AXY = DMIN1(MIN_AXY,AXY_U(IJK))
2332 MAX_AXY = DMAX1(MAX_AXY,AXY_U(IJK))
2333 MIN_CUT = DMIN1(MIN_CUT,AREA_U_CUT(IJK))
2334 MAX_CUT = DMAX1(MAX_CUT,AREA_U_CUT(IJK))
2335
2336 ENDIF
2337 END DO
2338
2339 call global_min(MIN_VOL, GLOBAL_MIN_VOL, PE_IO, ierr )
2340 call global_max(MAX_VOL, GLOBAL_MAX_VOL, PE_IO, ierr )
2341 call global_min(MIN_AYZ, GLOBAL_MIN_AYZ, PE_IO, ierr )
2342 call global_max(MAX_AYZ, GLOBAL_MAX_AYZ, PE_IO, ierr )
2343 call global_min(MIN_AXZ, GLOBAL_MIN_AXZ, PE_IO, ierr )
2344 call global_max(MAX_AXZ, GLOBAL_MAX_AXZ, PE_IO, ierr )
2345 call global_min(MIN_AXY, GLOBAL_MIN_AXY, PE_IO, ierr )
2346 call global_max(MAX_AXY, GLOBAL_MAX_AXY, PE_IO, ierr )
2347 call global_min(MIN_CUT, GLOBAL_MIN_CUT, PE_IO, ierr )
2348 call global_max(MAX_CUT, GLOBAL_MAX_CUT, PE_IO, ierr )
2349
2350 IF (myPE == PE_IO) THEN
2351 WRITE(UNIT_CUT_CELL_LOG,1000) 'U-MOMENTUM CUT CELLS:'
2352 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXY = ', GLOBAL_MIN_AXY,GLOBAL_MAX_AXY
2353 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXZ = ', GLOBAL_MIN_AXZ,GLOBAL_MAX_AXZ
2354 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AYZ = ', GLOBAL_MIN_AYZ,GLOBAL_MAX_AYZ
2355 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF CUT AREA = ', GLOBAL_MIN_CUT,GLOBAL_MAX_CUT
2356 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF VOLUME = ', GLOBAL_MIN_VOL,GLOBAL_MAX_VOL
2357 WRITE(UNIT_CUT_CELL_LOG,1010) 'NUMBER OF U WALL CELLS = ', NUMBER_OF_U_WALL_CELLS
2358 WRITE(UNIT_CUT_CELL_LOG,1000) '################################################################'
2359 ENDIF
2360
2361
2362
2363
2364
2365 = LARGE_NUMBER
2366 MAX_VOL = - LARGE_NUMBER
2367 MIN_AYZ = LARGE_NUMBER
2368 MAX_AYZ = - LARGE_NUMBER
2369 MIN_AXZ = LARGE_NUMBER
2370 MAX_AXZ = - LARGE_NUMBER
2371 MIN_AXY = LARGE_NUMBER
2372 MAX_AXY = - LARGE_NUMBER
2373
2374 DO IJK = IJKSTART3, IJKEND3
2375 IF(STANDARD_V_CELL_AT(IJK)) THEN
2376
2377 = DMIN1(MIN_VOL,VOL_V(IJK))
2378 MAX_VOL = DMAX1(MAX_VOL,VOL_V(IJK))
2379 MIN_AYZ = DMIN1(MIN_AYZ,AYZ_V(IJK))
2380 MAX_AYZ = DMAX1(MAX_AYZ,AYZ_V(IJK))
2381 MIN_AXZ = DMIN1(MIN_AXZ,AXZ_V(IJK))
2382 MAX_AXZ = DMAX1(MAX_AXZ,AXZ_V(IJK))
2383 MIN_AXY = DMIN1(MIN_AXY,AXY_V(IJK))
2384 MAX_AXY = DMAX1(MAX_AXY,AXY_V(IJK))
2385
2386 ENDIF
2387 END DO
2388
2389 call global_min(MIN_VOL, GLOBAL_MIN_VOL, PE_IO, ierr )
2390 call global_max(MAX_VOL, GLOBAL_MAX_VOL, PE_IO, ierr )
2391 call global_min(MIN_AYZ, GLOBAL_MIN_AYZ, PE_IO, ierr )
2392 call global_max(MAX_AYZ, GLOBAL_MAX_AYZ, PE_IO, ierr )
2393 call global_min(MIN_AXZ, GLOBAL_MIN_AXZ, PE_IO, ierr )
2394 call global_max(MAX_AXZ, GLOBAL_MAX_AXZ, PE_IO, ierr )
2395 call global_min(MIN_AXY, GLOBAL_MIN_AXY, PE_IO, ierr )
2396 call global_max(MAX_AXY, GLOBAL_MAX_AXY, PE_IO, ierr )
2397
2398 IF (myPE == PE_IO) THEN
2399 WRITE(UNIT_CUT_CELL_LOG,1000) 'V-MOMENTUM STANDARD CELLS:'
2400 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXY = ', GLOBAL_MIN_AXY,GLOBAL_MAX_AXY
2401 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXZ = ', GLOBAL_MIN_AXZ,GLOBAL_MAX_AXZ
2402 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AYZ = ', GLOBAL_MIN_AYZ,GLOBAL_MAX_AYZ
2403 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF VOLUME = ', GLOBAL_MIN_VOL,GLOBAL_MAX_VOL
2404 ENDIF
2405
2406 MIN_VOL = LARGE_NUMBER
2407 MAX_VOL = - LARGE_NUMBER
2408 MIN_AYZ = LARGE_NUMBER
2409 MAX_AYZ = - LARGE_NUMBER
2410 MIN_AXZ = LARGE_NUMBER
2411 MAX_AXZ = - LARGE_NUMBER
2412 MIN_AXY = LARGE_NUMBER
2413 MAX_AXY = - LARGE_NUMBER
2414 MIN_CUT = LARGE_NUMBER
2415 MAX_CUT = - LARGE_NUMBER
2416
2417 DO IJK = IJKSTART3, IJKEND3
2418 IF(CUT_V_CELL_AT(IJK).AND.(.NOT.WALL_V_AT(IJK))) THEN
2419
2420 = DMIN1(MIN_VOL,VOL_V(IJK))
2421 MAX_VOL = DMAX1(MAX_VOL,VOL_V(IJK))
2422 MIN_AYZ = DMIN1(MIN_AYZ,AYZ_V(IJK))
2423 MAX_AYZ = DMAX1(MAX_AYZ,AYZ_V(IJK))
2424 MIN_AXZ = DMIN1(MIN_AXZ,AXZ_V(IJK))
2425 MAX_AXZ = DMAX1(MAX_AXZ,AXZ_V(IJK))
2426 MIN_AXY = DMIN1(MIN_AXY,AXY_V(IJK))
2427 MAX_AXY = DMAX1(MAX_AXY,AXY_V(IJK))
2428 MIN_CUT = DMIN1(MIN_CUT,AREA_V_CUT(IJK))
2429 MAX_CUT = DMAX1(MAX_CUT,AREA_V_CUT(IJK))
2430
2431 ENDIF
2432 END DO
2433
2434 call global_min(MIN_VOL, GLOBAL_MIN_VOL, PE_IO, ierr )
2435 call global_max(MAX_VOL, GLOBAL_MAX_VOL, PE_IO, ierr )
2436 call global_min(MIN_AYZ, GLOBAL_MIN_AYZ, PE_IO, ierr )
2437 call global_max(MAX_AYZ, GLOBAL_MAX_AYZ, PE_IO, ierr )
2438 call global_min(MIN_AXZ, GLOBAL_MIN_AXZ, PE_IO, ierr )
2439 call global_max(MAX_AXZ, GLOBAL_MAX_AXZ, PE_IO, ierr )
2440 call global_min(MIN_AXY, GLOBAL_MIN_AXY, PE_IO, ierr )
2441 call global_max(MAX_AXY, GLOBAL_MAX_AXY, PE_IO, ierr )
2442 call global_min(MIN_CUT, GLOBAL_MIN_CUT, PE_IO, ierr )
2443 call global_max(MAX_CUT, GLOBAL_MAX_CUT, PE_IO, ierr )
2444
2445 IF (myPE == PE_IO) THEN
2446 WRITE(UNIT_CUT_CELL_LOG,1000) 'V-MOMENTUM CUT CELLS:'
2447 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXY = ', GLOBAL_MIN_AXY,GLOBAL_MAX_AXY
2448 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXZ = ', GLOBAL_MIN_AXZ,GLOBAL_MAX_AXZ
2449 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AYZ = ', GLOBAL_MIN_AYZ,GLOBAL_MAX_AYZ
2450 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF CUT AREA = ', GLOBAL_MIN_CUT,GLOBAL_MAX_CUT
2451 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF VOLUME = ', GLOBAL_MIN_VOL,GLOBAL_MAX_VOL
2452 WRITE(UNIT_CUT_CELL_LOG,1010) 'NUMBER OF V WALL CELLS = ', NUMBER_OF_V_WALL_CELLS
2453 WRITE(UNIT_CUT_CELL_LOG,1000) '################################################################'
2454 ENDIF
2455
2456
2457
2458
2459
2460
2461 IF(DO_K) THEN
2462
2463 MIN_VOL = LARGE_NUMBER
2464 MAX_VOL = - LARGE_NUMBER
2465 MIN_AYZ = LARGE_NUMBER
2466 MAX_AYZ = - LARGE_NUMBER
2467 MIN_AXZ = LARGE_NUMBER
2468 MAX_AXZ = - LARGE_NUMBER
2469 MIN_AXY = LARGE_NUMBER
2470 MAX_AXY = - LARGE_NUMBER
2471
2472 DO IJK = IJKSTART3, IJKEND3
2473 IF(STANDARD_W_CELL_AT(IJK)) THEN
2474
2475 = DMIN1(MIN_VOL,VOL_W(IJK))
2476 MAX_VOL = DMAX1(MAX_VOL,VOL_W(IJK))
2477 MIN_AYZ = DMIN1(MIN_AYZ,AYZ_W(IJK))
2478 MAX_AYZ = DMAX1(MAX_AYZ,AYZ_W(IJK))
2479 MIN_AXZ = DMIN1(MIN_AXZ,AXZ_W(IJK))
2480 MAX_AXZ = DMAX1(MAX_AXZ,AXZ_W(IJK))
2481 MIN_AXY = DMIN1(MIN_AXY,AXY_W(IJK))
2482 MAX_AXY = DMAX1(MAX_AXY,AXY_W(IJK))
2483
2484 ENDIF
2485 END DO
2486
2487 call global_min(MIN_VOL, GLOBAL_MIN_VOL, PE_IO, ierr )
2488 call global_max(MAX_VOL, GLOBAL_MAX_VOL, PE_IO, ierr )
2489 call global_min(MIN_AYZ, GLOBAL_MIN_AYZ, PE_IO, ierr )
2490 call global_max(MAX_AYZ, GLOBAL_MAX_AYZ, PE_IO, ierr )
2491 call global_min(MIN_AXZ, GLOBAL_MIN_AXZ, PE_IO, ierr )
2492 call global_max(MAX_AXZ, GLOBAL_MAX_AXZ, PE_IO, ierr )
2493 call global_min(MIN_AXY, GLOBAL_MIN_AXY, PE_IO, ierr )
2494 call global_max(MAX_AXY, GLOBAL_MAX_AXY, PE_IO, ierr )
2495
2496 IF (myPE == PE_IO) THEN
2497 WRITE(UNIT_CUT_CELL_LOG,1000) 'W-MOMENTUM STANDARD CELLS:'
2498 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXY = ', GLOBAL_MIN_AXY,GLOBAL_MAX_AXY
2499 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXZ = ', GLOBAL_MIN_AXZ,GLOBAL_MAX_AXZ
2500 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AYZ = ', GLOBAL_MIN_AYZ,GLOBAL_MAX_AYZ
2501 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF VOLUME = ', GLOBAL_MIN_VOL,GLOBAL_MAX_VOL
2502 ENDIF
2503
2504 MIN_VOL = LARGE_NUMBER
2505 MAX_VOL = - LARGE_NUMBER
2506 MIN_AYZ = LARGE_NUMBER
2507 MAX_AYZ = - LARGE_NUMBER
2508 MIN_AXZ = LARGE_NUMBER
2509 MAX_AXZ = - LARGE_NUMBER
2510 MIN_AXY = LARGE_NUMBER
2511 MAX_AXY = - LARGE_NUMBER
2512 MIN_CUT = LARGE_NUMBER
2513 MAX_CUT = - LARGE_NUMBER
2514
2515 DO IJK = IJKSTART3, IJKEND3
2516 IF(CUT_W_CELL_AT(IJK).AND.(.NOT.WALL_W_AT(IJK))) THEN
2517
2518 = DMIN1(MIN_VOL,VOL_W(IJK))
2519 MAX_VOL = DMAX1(MAX_VOL,VOL_W(IJK))
2520 MIN_AYZ = DMIN1(MIN_AYZ,AYZ_W(IJK))
2521 MAX_AYZ = DMAX1(MAX_AYZ,AYZ_W(IJK))
2522 MIN_AXZ = DMIN1(MIN_AXZ,AXZ_W(IJK))
2523 MAX_AXZ = DMAX1(MAX_AXZ,AXZ_W(IJK))
2524 MIN_AXY = DMIN1(MIN_AXY,AXY_W(IJK))
2525 MAX_AXY = DMAX1(MAX_AXY,AXY_W(IJK))
2526 MIN_CUT = DMIN1(MIN_CUT,AREA_W_CUT(IJK))
2527 MAX_CUT = DMAX1(MAX_CUT,AREA_W_CUT(IJK))
2528
2529 ENDIF
2530 END DO
2531
2532 call global_min(MIN_VOL, GLOBAL_MIN_VOL, PE_IO, ierr )
2533 call global_max(MAX_VOL, GLOBAL_MAX_VOL, PE_IO, ierr )
2534 call global_min(MIN_AYZ, GLOBAL_MIN_AYZ, PE_IO, ierr )
2535 call global_max(MAX_AYZ, GLOBAL_MAX_AYZ, PE_IO, ierr )
2536 call global_min(MIN_AXZ, GLOBAL_MIN_AXZ, PE_IO, ierr )
2537 call global_max(MAX_AXZ, GLOBAL_MAX_AXZ, PE_IO, ierr )
2538 call global_min(MIN_AXY, GLOBAL_MIN_AXY, PE_IO, ierr )
2539 call global_max(MAX_AXY, GLOBAL_MAX_AXY, PE_IO, ierr )
2540 call global_min(MIN_CUT, GLOBAL_MIN_CUT, PE_IO, ierr )
2541 call global_max(MAX_CUT, GLOBAL_MAX_CUT, PE_IO, ierr )
2542
2543 IF (myPE == PE_IO) THEN
2544 WRITE(UNIT_CUT_CELL_LOG,1000) 'W-MOMENTUM CUT CELLS:'
2545 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXY = ', GLOBAL_MIN_AXY,GLOBAL_MAX_AXY
2546 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AXZ = ', GLOBAL_MIN_AXZ,GLOBAL_MAX_AXZ
2547 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF AYZ = ', GLOBAL_MIN_AYZ,GLOBAL_MAX_AYZ
2548 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF CUT AREA = ', GLOBAL_MIN_CUT,GLOBAL_MAX_CUT
2549 WRITE(UNIT_CUT_CELL_LOG,1000) 'RANGE OF VOLUME = ', GLOBAL_MIN_VOL,GLOBAL_MAX_VOL
2550 WRITE(UNIT_CUT_CELL_LOG,1010) 'NUMBER OF W WALL CELLS = ', NUMBER_OF_W_WALL_CELLS
2551 WRITE(UNIT_CUT_CELL_LOG,1000) '################################################################'
2552 ENDIF
2553
2554 ENDIF
2555
2556
2557
2558 LOCAL_MIN_Q = MINVAL(Alpha_Ue_c)
2559 LOCAL_MAX_Q = MAXVAL(Alpha_Ue_c)
2560 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2561 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2562 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF U-MOMENTUM Alpha_Ue_c = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2563
2564 LOCAL_MIN_Q = MINVAL(Alpha_Un_c)
2565 LOCAL_MAX_Q = MAXVAL(Alpha_Un_c)
2566 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2567 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2568 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF U-MOMENTUM Alpha_Un_c = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2569
2570 LOCAL_MIN_Q = MINVAL(Alpha_Ut_c)
2571 LOCAL_MAX_Q = MAXVAL(Alpha_Ut_c)
2572 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2573 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2574 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF U-MOMENTUM Alpha_Ut_c = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2575 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000)
2576
2577 LOCAL_MIN_Q = MINVAL(Theta_Ue)
2578 LOCAL_MAX_Q = MAXVAL(Theta_Ue)
2579 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2580 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2581 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF U-MOMENTUM Theta_Ue = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2582
2583 LOCAL_MIN_Q = MINVAL(Theta_Un)
2584 LOCAL_MAX_Q = MAXVAL(Theta_Un)
2585 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2586 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2587 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF U-MOMENTUM Theta_Un = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2588
2589 LOCAL_MIN_Q = MINVAL(Theta_Ut)
2590 LOCAL_MAX_Q = MAXVAL(Theta_Ut)
2591 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2592 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2593 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF U-MOMENTUM Theta_Ut = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2594 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000)
2595
2596 LOCAL_MIN_Q = MINVAL(Theta_U_ne)
2597 LOCAL_MAX_Q = MAXVAL(Theta_U_ne)
2598 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2599 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2600 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF U-MOMENTUM Theta_U_ne = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2601
2602 LOCAL_MIN_Q = MINVAL(Theta_U_te)
2603 LOCAL_MAX_Q = MAXVAL(Theta_U_te)
2604 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2605 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2606 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF U-MOMENTUM Theta_U_te = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2607 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000)
2608
2609 LOCAL_MIN_Q = MINVAL(NOC_U_E)
2610 LOCAL_MAX_Q = MAXVAL(NOC_U_E)
2611 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2612 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2613 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF U-MOMENTUM NOC_U_E = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2614
2615 LOCAL_MIN_Q = MINVAL(NOC_U_N)
2616 LOCAL_MAX_Q = MAXVAL(NOC_U_N)
2617 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2618 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2619 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF U-MOMENTUM NOC_U_N = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2620
2621 LOCAL_MIN_Q = MINVAL(NOC_U_T)
2622 LOCAL_MAX_Q = MAXVAL(NOC_U_T)
2623 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2624 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2625 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF U-MOMENTUM NOC_U_T = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2626 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000)
2627
2628 LOCAL_MIN_Q = MINVAL(DELH_U)
2629 LOCAL_MAX_Q = MAXVAL(DELH_U)
2630 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2631 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2632 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF U-MOMENTUM DELH_U = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2633 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) '################################################################'
2634
2635
2636
2637 LOCAL_MIN_Q = MINVAL(Alpha_Ve_c)
2638 LOCAL_MAX_Q = MAXVAL(Alpha_Ve_c)
2639 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2640 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2641 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF V-MOMENTUM Alpha_Ve_c = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2642 LOCAL_MIN_Q = MINVAL(Alpha_Vn_c)
2643 LOCAL_MAX_Q = MAXVAL(Alpha_Vn_c)
2644 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2645 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2646 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF V-MOMENTUM Alpha_Vn_c = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2647 LOCAL_MIN_Q = MINVAL(Alpha_Vt_c)
2648 LOCAL_MAX_Q = MAXVAL(Alpha_Vt_c)
2649 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2650 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2651 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF V-MOMENTUM Alpha_Vt_c = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2652 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000)
2653 LOCAL_MIN_Q = MINVAL(Theta_Ve)
2654 LOCAL_MAX_Q = MAXVAL(Theta_Ve)
2655 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2656 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2657 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF V-MOMENTUM Theta_Ve = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2658 LOCAL_MIN_Q = MINVAL(Theta_Vn)
2659 LOCAL_MAX_Q = MAXVAL(Theta_Vn)
2660 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2661 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2662 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF V-MOMENTUM Theta_Vn = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2663 LOCAL_MIN_Q = MINVAL(Theta_Vt)
2664 LOCAL_MAX_Q = MAXVAL(Theta_Vt)
2665 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2666 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2667 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF V-MOMENTUM Theta_Vt = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2668 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000)
2669 LOCAL_MIN_Q = MINVAL(Theta_V_ne)
2670 LOCAL_MAX_Q = MAXVAL(Theta_V_ne)
2671 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2672 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2673 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF V-MOMENTUM Theta_V_ne = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2674 LOCAL_MIN_Q = MINVAL(Theta_V_nt)
2675 LOCAL_MAX_Q = MAXVAL(Theta_V_nt)
2676 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2677 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2678 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF V-MOMENTUM Theta_V_nt = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2679 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000)
2680 LOCAL_MIN_Q = MINVAL(NOC_V_E)
2681 LOCAL_MAX_Q = MAXVAL(NOC_V_E)
2682 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2683 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2684 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF V-MOMENTUM NOC_V_E = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2685 LOCAL_MIN_Q = MINVAL(NOC_V_N)
2686 LOCAL_MAX_Q = MAXVAL(NOC_V_N)
2687 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2688 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2689 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF V-MOMENTUM NOC_V_N = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2690 LOCAL_MIN_Q = MINVAL(NOC_V_T)
2691 LOCAL_MAX_Q = MAXVAL(NOC_V_T)
2692 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2693 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2694 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF V-MOMENTUM NOC_V_T = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2695 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000)
2696 LOCAL_MIN_Q = MINVAL(DELH_V)
2697 LOCAL_MAX_Q = MAXVAL(DELH_V)
2698 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2699 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2700 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF V-MOMENTUM DELH_V = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2701 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) '################################################################'
2702
2703
2704 IF(DO_K) THEN
2705
2706 LOCAL_MIN_Q = MINVAL(Alpha_We_c)
2707 LOCAL_MAX_Q = MAXVAL(Alpha_We_c)
2708 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2709 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2710 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF W-MOMENTUM Alpha_We_c = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2711 LOCAL_MIN_Q = MINVAL(Alpha_Wn_c)
2712 LOCAL_MAX_Q = MAXVAL(Alpha_Wn_c)
2713 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2714 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2715 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF W-MOMENTUM Alpha_Wn_c = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2716 LOCAL_MIN_Q = MINVAL(Alpha_Wt_c)
2717 LOCAL_MAX_Q = MAXVAL(Alpha_Wt_c)
2718 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2719 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2720 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF W-MOMENTUM Alpha_Wt_c = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2721 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000)
2722 LOCAL_MIN_Q = MINVAL(Theta_We)
2723 LOCAL_MAX_Q = MAXVAL(Theta_We)
2724 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2725 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2726 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF W-MOMENTUM Theta_We = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2727 LOCAL_MIN_Q = MINVAL(Theta_Wn)
2728 LOCAL_MAX_Q = MAXVAL(Theta_Wn)
2729 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2730 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2731 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF W-MOMENTUM Theta_Wn = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2732 LOCAL_MIN_Q = MINVAL(Theta_Wt)
2733 LOCAL_MAX_Q = MAXVAL(Theta_Wt)
2734 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2735 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2736 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF W-MOMENTUM Theta_Wt = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2737 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000)
2738 LOCAL_MIN_Q = MINVAL(Theta_W_te)
2739 LOCAL_MAX_Q = MAXVAL(Theta_W_te)
2740 call global_min(LOCAL_MAX_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2741 call global_max(LOCAL_MIN_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2742 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF W-MOMENTUM Theta_W_te = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2743 LOCAL_MIN_Q = MINVAL(Theta_W_tn)
2744 LOCAL_MAX_Q = MAXVAL(Theta_W_tn)
2745 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2746 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2747 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF W-MOMENTUM Theta_W_tn = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2748 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000)
2749 LOCAL_MIN_Q = MINVAL(NOC_W_E)
2750 LOCAL_MAX_Q = MAXVAL(NOC_W_E)
2751 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2752 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2753 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF W-MOMENTUM NOC_W_E = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2754 LOCAL_MIN_Q = MINVAL(NOC_W_N)
2755 LOCAL_MAX_Q = MAXVAL(NOC_W_N)
2756 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2757 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2758 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF W-MOMENTUM NOC_W_N = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2759 LOCAL_MIN_Q = MINVAL(NOC_W_T)
2760 LOCAL_MAX_Q = MAXVAL(NOC_W_T)
2761 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2762 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2763 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF W-MOMENTUM NOC_W_T = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2764 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000)
2765 LOCAL_MIN_Q = MINVAL(DELH_W)
2766 LOCAL_MAX_Q = MAXVAL(DELH_W)
2767 call global_min(LOCAL_MIN_Q, GLOBAL_MIN_Q, PE_IO, ierr )
2768 call global_max(LOCAL_MAX_Q, GLOBAL_MAX_Q, PE_IO, ierr )
2769 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) ' RANGE OF W-MOMENTUM DELH_W = ', GLOBAL_MIN_Q, GLOBAL_MAX_Q
2770 IF (myPE == PE_IO) WRITE(UNIT_CUT_CELL_LOG,1000) '################################################################'
2771
2772 ENDIF
2773
2774 RETURN
2775
2776 END SUBROUTINE PRINT_GRID_STATISTICS
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795 SUBROUTINE CLEAN_GEOMETRY
2796
2797 USE param
2798 USE param1
2799 USE parallel
2800 USE constant
2801 USE run
2802 USE toleranc
2803 USE geometry
2804 USE indices
2805 USE compar
2806 USE mpi_utility
2807 USE sendrecv
2808 USE quadric
2809 USE cutcell
2810 USE fldvar
2811 USE vtk
2812 USE cdist
2813 USE functions
2814
2815 IMPLICIT NONE
2816
2817 INTEGER :: IJK,L
2818
2819 INTEGER ::POINT_ID,IJKC
2820 INTEGER , ALLOCATABLE :: POINT_NEW_ID(:)
2821 INTEGER , ALLOCATABLE :: NEW_POINT_NEW_ID(:)
2822 LOGICAL , ALLOCATABLE :: KEEP_POINT(:)
2823 LOGICAL , ALLOCATABLE :: KEEP_NEW_POINT(:)
2824
2825
2826 IF (myPE == PE_IO.AND.(.NOT.BDIST_IO)) THEN
2827
2828 IF(ALLOCATED(GLOBAL_CLEANED_CONNECTIVITY)) DEALLOCATE(GLOBAL_CLEANED_CONNECTIVITY)
2829 IF(ALLOCATED(KEEP_NEW_POINT)) DEALLOCATE (KEEP_NEW_POINT)
2830 IF(ALLOCATED(POINT_NEW_ID)) DEALLOCATE (POINT_NEW_ID)
2831 IF(ALLOCATED(NEW_POINT_NEW_ID)) DEALLOCATE (NEW_POINT_NEW_ID)
2832 IF(ALLOCATED(KEEP_POINT)) DEALLOCATE (KEEP_POINT)
2833
2834 ALLOCATE (GLOBAL_CLEANED_CONNECTIVITY(ijkmax3,15))
2835 ALLOCATE (KEEP_NEW_POINT(GLOBAL_NUMBER_OF_NEW_POINTS))
2836
2837 ALLOCATE (POINT_NEW_ID(IJKMAX3))
2838 ALLOCATE (NEW_POINT_NEW_ID(IJKMAX3))
2839 ALLOCATE (KEEP_POINT(IJKMAX3))
2840
2841
2842
2843
2844
2845
2846
2847 = .FALSE.
2848 KEEP_NEW_POINT = .FALSE.
2849
2850 DO IJK = 1,IJKMAX3
2851 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) THEN
2852 DO L=1,GLOBAL_NUMBER_OF_NODES(IJK)
2853 IJKC = GLOBAL_CONNECTIVITY(IJK,L)
2854 IF(IJKC<=IJKMAX3) KEEP_POINT(IJKC) = .TRUE.
2855 IF(IJKC>IJKMAX3) KEEP_NEW_POINT(IJKC-IJKMAX3) = .TRUE.
2856 ENDDO
2857 ENDIF
2858 END DO
2859
2860
2861
2862 = -1
2863 NEW_POINT_NEW_ID = -1
2864 POINT_ID = 1
2865
2866 DO IJK = 1,IJKMAX3
2867 IF(KEEP_POINT(IJK)) THEN
2868 POINT_NEW_ID(IJK) = POINT_ID
2869 POINT_ID = POINT_ID + 1
2870 ENDIF
2871 END DO
2872
2873 DO IJK = 1,GLOBAL_NUMBER_OF_NEW_POINTS
2874 IF(KEEP_NEW_POINT(IJK)) THEN
2875 NEW_POINT_NEW_ID(IJK) = POINT_ID
2876 POINT_ID = POINT_ID + 1
2877 ENDIF
2878 END DO
2879
2880
2881 = POINT_ID - 1
2882
2883
2884 IF(ALLOCATED(GLOBAL_COORDS_OF_POINTS)) DEALLOCATE(GLOBAL_COORDS_OF_POINTS)
2885
2886 ALLOCATE(GLOBAL_COORDS_OF_POINTS(3,NUMBER_OF_POINTS))
2887
2888 POINT_ID = 1
2889
2890 DO IJK = 1,IJKMAX3
2891 IF(KEEP_POINT(IJK)) THEN
2892 GLOBAL_COORDS_OF_POINTS(1:3,POINT_ID) = &
2893 (/REAL(XG_E(GLOBAL_I_OF(IJK))),REAL(YG_N(GLOBAL_J_OF(IJK))),REAL(ZG_T(GLOBAL_K_OF(IJK)))/)
2894 POINT_ID = POINT_ID + 1
2895 ENDIF
2896 END DO
2897
2898 DO IJK = 1,GLOBAL_NUMBER_OF_NEW_POINTS
2899 IF(KEEP_NEW_POINT(IJK)) THEN
2900 NEW_POINT_NEW_ID(IJK) = POINT_ID
2901 GLOBAL_COORDS_OF_POINTS(1:3,POINT_ID) = &
2902 (/REAL(GLOBAL_X_NEW_POINT(IJK)),REAL(GLOBAL_Y_NEW_POINT(IJK)),REAL(GLOBAL_Z_NEW_POINT(IJK))/)
2903 POINT_ID = POINT_ID + 1
2904 ENDIF
2905 END DO
2906
2907
2908
2909 DO IJK = 1,IJKMAX3
2910 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) THEN
2911 DO L=1,GLOBAL_NUMBER_OF_NODES(IJK)
2912 IF(GLOBAL_CONNECTIVITY(IJK,L)<=IJKMAX3) THEN
2913 GLOBAL_CLEANED_CONNECTIVITY(IJK,L) = POINT_NEW_ID(GLOBAL_CONNECTIVITY(IJK,L))
2914 ELSE
2915 GLOBAL_CLEANED_CONNECTIVITY(IJK,L) = NEW_POINT_NEW_ID(GLOBAL_CONNECTIVITY(IJK,L)-IJKMAX3)
2916 ENDIF
2917 ENDDO
2918 ENDIF
2919 END DO
2920
2921
2922
2923 ELSEIF(BDIST_IO) THEN
2924
2925
2926 IF(ALLOCATED(CLEANED_CONNECTIVITY)) DEALLOCATE (CLEANED_CONNECTIVITY)
2927 IF(ALLOCATED(KEEP_NEW_POINT)) DEALLOCATE (KEEP_NEW_POINT)
2928 IF(ALLOCATED(POINT_NEW_ID)) DEALLOCATE (POINT_NEW_ID)
2929 IF(ALLOCATED(NEW_POINT_NEW_ID)) DEALLOCATE (NEW_POINT_NEW_ID)
2930 IF(ALLOCATED(KEEP_POINT)) DEALLOCATE (KEEP_POINT)
2931
2932 ALLOCATE (CLEANED_CONNECTIVITY(IJKEND3,15))
2933 ALLOCATE (KEEP_NEW_POINT(NUMBER_OF_NEW_POINTS))
2934
2935 ALLOCATE (POINT_NEW_ID(IJKEND3))
2936 ALLOCATE (NEW_POINT_NEW_ID(IJKEND3))
2937 ALLOCATE (KEEP_POINT(IJKEND3))
2938
2939
2940
2941
2942
2943
2944
2945 = .FALSE.
2946 KEEP_NEW_POINT = .FALSE.
2947
2948 DO IJK = 1,IJKEND3
2949 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) THEN
2950 DO L=1,NUMBER_OF_NODES(IJK)
2951 IJKC = CONNECTIVITY(IJK,L)
2952 IF(IJKC<=IJKEND3) KEEP_POINT(IJKC) = .TRUE.
2953 IF(IJKC>IJKEND3) KEEP_NEW_POINT(IJKC-IJKEND3) = .TRUE.
2954 ENDDO
2955 ENDIF
2956 END DO
2957
2958
2959
2960 = -1
2961 NEW_POINT_NEW_ID = -1
2962 POINT_ID = 1
2963
2964 DO IJK = 1,IJKEND3
2965 IF(KEEP_POINT(IJK)) THEN
2966 POINT_NEW_ID(IJK) = POINT_ID
2967 POINT_ID = POINT_ID + 1
2968 ENDIF
2969 END DO
2970
2971 DO IJK = 1,NUMBER_OF_NEW_POINTS
2972 IF(KEEP_NEW_POINT(IJK)) THEN
2973 NEW_POINT_NEW_ID(IJK) = POINT_ID
2974 POINT_ID = POINT_ID + 1
2975 ENDIF
2976 END DO
2977
2978
2979 = POINT_ID - 1
2980
2981
2982 IF(ALLOCATED(COORDS_OF_POINTS)) DEALLOCATE(COORDS_OF_POINTS)
2983
2984 ALLOCATE(COORDS_OF_POINTS(NUMBER_OF_POINTS,3))
2985
2986 POINT_ID = 1
2987
2988 DO IJK = 1,IJKEND3
2989 IF(KEEP_POINT(IJK)) THEN
2990 COORDS_OF_POINTS(POINT_ID,1:3) = &
2991 (/REAL(XG_E(I_OF(IJK))),REAL(YG_N(J_OF(IJK))),REAL(ZG_T(K_OF(IJK)))/)
2992 POINT_ID = POINT_ID + 1
2993 ENDIF
2994 END DO
2995
2996 DO IJK = 1,NUMBER_OF_NEW_POINTS
2997 IF(KEEP_NEW_POINT(IJK)) THEN
2998 NEW_POINT_NEW_ID(IJK) = POINT_ID
2999 COORDS_OF_POINTS(POINT_ID,1:3) = &
3000 (/REAL(X_NEW_POINT(IJK)),REAL(Y_NEW_POINT(IJK)),REAL(Z_NEW_POINT(IJK))/)
3001 POINT_ID = POINT_ID + 1
3002 ENDIF
3003 END DO
3004
3005
3006
3007 DO IJK = 1,IJKEND3
3008 IF (BELONGS_TO_VTK_SUBDOMAIN(IJK)) THEN
3009 DO L=1,NUMBER_OF_NODES(IJK)
3010 IF(CONNECTIVITY(IJK,L)<=IJKEND3) THEN
3011 CLEANED_CONNECTIVITY(IJK,L) = POINT_NEW_ID(CONNECTIVITY(IJK,L))
3012 ELSE
3013 CLEANED_CONNECTIVITY(IJK,L) = NEW_POINT_NEW_ID(CONNECTIVITY(IJK,L)-IJKEND3)
3014 ENDIF
3015 ENDDO
3016 ENDIF
3017 END DO
3018
3019 ENDIF
3020
3021
3022
3023 100 FORMAT(A,I12,A,I12,A)
3024 110 FORMAT(A)
3025
3026 RETURN
3027
3028 END SUBROUTINE CLEAN_GEOMETRY
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048 SUBROUTINE SETUP_VTK_REGION
3049
3050 USE param
3051 USE param1
3052 USE parallel
3053 USE constant
3054 USE run
3055 USE toleranc
3056 USE geometry
3057 USE indices
3058 USE compar
3059 USE mpi_utility
3060 USE sendrecv
3061 USE quadric
3062 USE cutcell
3063 USE fldvar
3064 USE vtk
3065 USE cdist
3066 USE functions
3067
3068 IMPLICIT NONE
3069
3070 INTEGER :: IJK,I,J,K,I_E,I_W,J_N,J_S,K_T,K_B
3071 INTEGER :: NXS,NYS,NZS,NS,I_TMP,J_TMP,K_TMP
3072 INTEGER :: I_SLICE(DIM_I),J_SLICE(DIM_J),K_SLICE(DIM_K)
3073 DOUBLE PRECISION :: XE,XW,YS,YN,ZB,ZT
3074 DOUBLE PRECISION :: XSLICE,YSLICE,ZSLICE
3075 LOGICAL :: KEEP_XDIR,KEEP_YDIR,KEEP_ZDIR
3076
3077
3078
3079 = VTK_X_E(VTK_REGION)
3080 XW = VTK_X_W(VTK_REGION)
3081 YS = VTK_Y_S(VTK_REGION)
3082 YN = VTK_Y_N(VTK_REGION)
3083 ZB = VTK_Z_B(VTK_REGION)
3084 ZT = VTK_Z_T(VTK_REGION)
3085
3086 NXS = VTK_NXS(VTK_REGION)
3087 NYS = VTK_NYS(VTK_REGION)
3088 NZS = VTK_NZS(VTK_REGION)
3089
3090 CALL CALC_CELL (XMIN, VTK_X_W(VTK_REGION), DX, IMAX, I_W)
3091 I_W = I_W
3092 CALL CALC_CELL (XMIN, VTK_X_E(VTK_REGION), DX, IMAX, I_E)
3093
3094
3095 CALL CALC_CELL (ZERO, VTK_Y_S(VTK_REGION), DY, JMAX, J_S)
3096 J_S = J_S
3097 CALL CALC_CELL (ZERO, VTK_Y_N(VTK_REGION), DY, JMAX, J_N)
3098
3099 IF (NO_K) THEN
3100 K_B = 1
3101 K_T = 1
3102 ELSE
3103 CALL CALC_CELL (ZERO, VTK_Z_B(VTK_REGION), DZ, KMAX, K_B)
3104 K_B = K_B
3105 CALL CALC_CELL (ZERO, VTK_Z_T(VTK_REGION), DZ, KMAX, K_T)
3106 ENDIF
3107
3108
3109 DO NS = 1,NXS
3110 XSLICE = XW + (XE-XW)/(NXS-1)*(NS-1)
3111 CALL CALC_CELL (XMIN, XSLICE, DX, IMAX, I_TMP)
3112 I_SLICE(NS) = MAX(MIN(I_TMP,IMAX1),IMIN1)
3113 ENDDO
3114
3115 DO NS = 1,NYS
3116 YSLICE = YS + (YN-YS)/(NYS-1)*(NS-1)
3117 CALL CALC_CELL (ZERO, YSLICE, DY, JMAX, J_TMP)
3118 J_SLICE(NS) = MAX(MIN(J_TMP,JMAX1),JMIN1)
3119 ENDDO
3120
3121 DO NS = 1,NZS
3122 ZSLICE = ZB + (ZT-ZB)/(NZS-1)*(NS-1)
3123 CALL CALC_CELL (ZERO, ZSLICE, DZ, KMAX, K_TMP)
3124 K_SLICE(NS) = MAX(MIN(K_TMP,KMAX1),KMIN1)
3125 ENDDO
3126
3127 IF (myPE == PE_IO.AND.(.NOT.BDIST_IO)) THEN
3128
3129 IF(ALLOCATED(BELONGS_TO_VTK_SUBDOMAIN)) DEALLOCATE(BELONGS_TO_VTK_SUBDOMAIN)
3130
3131 ALLOCATE (BELONGS_TO_VTK_SUBDOMAIN(ijkmax3))
3132
3133
3134
3135
3136 = .FALSE.
3137 NUMBER_OF_VTK_CELLS = 0
3138
3139 DO IJK = 1,IJKMAX3
3140 IF (GLOBAL_INTERIOR_CELL_AT(IJK)) THEN
3141 IF (.NOT.GLOBAL_BLOCKED_CELL_AT(IJK)) THEN
3142 I = GLOBAL_I_OF(IJK)
3143 J = GLOBAL_J_OF(IJK)
3144 K = GLOBAL_K_OF(IJK)
3145
3146
3147 =.FALSE.
3148 IF(NXS==0) THEN
3149 IF(I_W<=I.AND.I<=I_E) KEEP_XDIR=.TRUE.
3150 ELSE
3151 DO NS = 1,NXS
3152 IF(I==I_SLICE(NS)) KEEP_XDIR=.TRUE.
3153 ENDDO
3154 ENDIF
3155
3156
3157 =.FALSE.
3158 IF(NYS==0) THEN
3159 IF(J_S<=J.AND.J<=J_N) KEEP_YDIR=.TRUE.
3160 ELSE
3161 DO NS = 1,NYS
3162 IF(J==J_SLICE(NS)) KEEP_YDIR=.TRUE.
3163 ENDDO
3164 ENDIF
3165
3166
3167 =.FALSE.
3168 IF(NZS==0) THEN
3169 IF(K_B<=K.AND.K<=K_T) KEEP_ZDIR=.TRUE.
3170 ELSE
3171 DO NS = 1,NZS
3172 IF(K==K_SLICE(NS)) KEEP_ZDIR=.TRUE.
3173 ENDDO
3174 ENDIF
3175
3176
3177 IF(KEEP_XDIR.AND.KEEP_YDIR.AND.KEEP_ZDIR) THEN
3178 BELONGS_TO_VTK_SUBDOMAIN(IJK) = .TRUE.
3179 NUMBER_OF_VTK_CELLS = NUMBER_OF_VTK_CELLS + 1
3180 ENDIF
3181 ENDIF
3182 ENDIF
3183 END DO
3184
3185 ELSE
3186
3187
3188 IF(ALLOCATED(BELONGS_TO_VTK_SUBDOMAIN)) DEALLOCATE(BELONGS_TO_VTK_SUBDOMAIN)
3189
3190 ALLOCATE (BELONGS_TO_VTK_SUBDOMAIN(ijkend3))
3191
3192
3193
3194
3195 = .FALSE.
3196 NUMBER_OF_VTK_CELLS = 0
3197
3198 DO IJK = 1,IJKEND3
3199 IF (INTERIOR_CELL_AT(IJK)) THEN
3200 IF (.NOT.BLOCKED_CELL_AT(IJK)) THEN
3201 I = I_OF(IJK)
3202 J = J_OF(IJK)
3203 K = K_OF(IJK)
3204
3205
3206 =.FALSE.
3207 IF(NXS==0) THEN
3208 IF(I_W<=I.AND.I<=I_E) KEEP_XDIR=.TRUE.
3209 ELSE
3210 DO NS = 1,NXS
3211 IF(I==I_SLICE(NS)) KEEP_XDIR=.TRUE.
3212 ENDDO
3213 ENDIF
3214
3215
3216 =.FALSE.
3217 IF(NYS==0) THEN
3218 IF(J_S<=J.AND.J<=J_N) KEEP_YDIR=.TRUE.
3219 ELSE
3220 DO NS = 1,NYS
3221 IF(J==J_SLICE(NS)) KEEP_YDIR=.TRUE.
3222 ENDDO
3223 ENDIF
3224
3225
3226 =.FALSE.
3227 IF(NZS==0) THEN
3228 IF(K_B<=K.AND.K<=K_T) KEEP_ZDIR=.TRUE.
3229 ELSE
3230 DO NS = 1,NZS
3231 IF(K==K_SLICE(NS)) KEEP_ZDIR=.TRUE.
3232 ENDDO
3233 ENDIF
3234
3235
3236 IF(KEEP_XDIR.AND.KEEP_YDIR.AND.KEEP_ZDIR) THEN
3237 BELONGS_TO_VTK_SUBDOMAIN(IJK) = .TRUE.
3238 NUMBER_OF_VTK_CELLS = NUMBER_OF_VTK_CELLS + 1
3239 ENDIF
3240 ENDIF
3241 ENDIF
3242 END DO
3243
3244 ENDIF
3245
3246
3247 100 FORMAT(A,I12,A,I12,A)
3248 110 FORMAT(A)
3249
3250 RETURN
3251
3252 END SUBROUTINE SETUP_VTK_REGION
3253
3254