MFIX  2016-1
vtp_mod.f
Go to the documentation of this file.
1  MODULE vtp
2 
3  use mpi_utility
4  use cdist
5 
6  use desmpi
7  use mpi_comm_des
8  use error_manager
9 
10  IMPLICIT NONE
11 
12  INTEGER, PRIVATE :: global_cnt
13  INTEGER, PRIVATE :: local_cnt
14 
15  INTEGER :: des_unit = 2000
16 
17 ! file unit for ParaView *.pvd data
18  INTEGER, PARAMETER :: pvd_unit = 2050
19 
20 ! formatted file name
21  CHARACTER(LEN=511) :: fname_vtp
22 
23  INTERFACE vtp_write_data
24  MODULE PROCEDURE vtp_write_dp1
25  MODULE PROCEDURE vtp_write_dp2
26  MODULE PROCEDURE vtp_write_i1
27  END INTERFACE
28 
29  CONTAINS
30 
31 !``````````````````````````````````````````````````````````````````````!
32 ! Subroutine: VTP_WRITE_DP1 !
33 ! !
34 ! Purpose: Collect and write 1D double percision arrays to the VTP !
35 ! file. This routine is designed to collect the data for parallel and !
36 ! serial runs. This routine also manages the distribted IO case. !
37 !``````````````````````````````````````````````````````````````````````!
38  SUBROUTINE vtp_write_dp1(NAME, DATA)
39 
40  CHARACTER(len=*), INTENT(in) :: NAME
41  DOUBLE PRECISION, INTENT(in) :: DATA(:)
42 
43  INTEGER :: LC, PC
44 
45  IF(bdist_io) THEN
46 
47  WRITE(des_unit,1000) name
48 
49  pc = 1
50  DO lc = 1, max_pip
51  IF(pc > pip) EXIT
52  IF(is_nonexistent(lc)) cycle
53  pc = pc+1
54  IF(is_ghost(lc) .OR. is_entering_ghost(lc) .OR. is_exiting_ghost(lc)) cycle
55  WRITE(des_unit, 1001,advance="NO") real(data(lc))
56  ENDDO
57  WRITE(des_unit,1002)
58 
59  ELSE
60 
61  allocate (dprocbuf(local_cnt) )
62  allocate (drootbuf(global_cnt))
63 
64  CALL des_gather(data)
65 
66  IF(mype == pe_io) THEN
67  WRITE(des_unit,1000) name
68  DO lc=1, global_cnt
69  WRITE(des_unit,1001,advance="NO") real(drootbuf(lc))
70  ENDDO
71  WRITE(des_unit,1002)
72  ENDIF
73 
74  deallocate(dprocbuf, drootbuf)
75 
76  ENDIF
77 
78  1000 FORMAT('<DataArray type="Float32" Name="',a,'" format="ascii">')
79  1001 FORMAT(es14.6,1x)
80  1002 FORMAT('</DataArray>')
81 
82  END SUBROUTINE vtp_write_dp1
83 
84 !``````````````````````````````````````````````````````````````````````!
85 ! Subroutine: VTP_WRITE_DP2 !
86 ! !
87 ! Purpose: Collect and write 2D double percision arrays to the VTP !
88 ! file. This routine is designed to collect the data for parallel and !
89 ! serial runs. This routine also manages the distribted IO case. !
90 !``````````````````````````````````````````````````````````````````````!
91  SUBROUTINE vtp_write_dp2(NAME, DATA)
92 
93  CHARACTER(len=*), INTENT(in) :: NAME
94  DOUBLE PRECISION, INTENT(in) :: DATA(:,:)
95 
96  DOUBLE PRECISION, ALLOCATABLE :: ltemp_array(:,:)
97 
98  CHARACTER(len=16) :: NOC
99  INTEGER :: LB, UB
100  INTEGER :: PC, LC1, LC2
101 
102  lb = lbound(DATA,2)
103  ub = ubound(DATA,2)
104  noc=''; WRITE(noc,*) (ub-lb)+1
105 
106  IF(bdist_io) THEN
107 
108  WRITE(des_unit,1000) name, trim(adjustl(noc))
109 
110  pc = 1
111  DO lc1 = 1, max_pip
112  IF(pc > pip) EXIT
113  IF(is_nonexistent(lc1)) cycle
114  pc = pc+1
115  IF(is_ghost(lc1) .OR. is_entering_ghost(lc1) .OR. is_exiting_ghost(lc1)) cycle
116  DO lc2=lb, ub
117  WRITE(des_unit,1001,advance="NO") real(data(lc1,lc2))
118  ENDDO
119  ENDDO
120  WRITE(des_unit,1002)
121 
122  ELSE
123 
124  allocate (dprocbuf(local_cnt) )
125  allocate (drootbuf(global_cnt))
126  allocate (ltemp_array((ub-lb)+1,global_cnt))
127 
128  DO lc1 = lb, ub
129  CALL des_gather(DATA(:,lc1))
130  ltemp_array(lc1,:) = drootbuf(:)
131  ENDDO
132 
133  IF(mype == pe_io) THEN
134  WRITE(des_unit,1000) name, trim(adjustl(noc))
135  DO lc1=1, global_cnt
136  DO lc2=lb, ub
137  WRITE(des_unit,1001,advance="NO") &
138  real(ltemp_array(lc2,lc1))
139  ENDDO
140  ENDDO
141  WRITE(des_unit,1002)
142  ENDIF
143 
144  deallocate (dprocbuf, drootbuf, ltemp_array)
145 
146  ENDIF
147 
148 
149  1000 FORMAT('<DataArray type="Float32" Name="',a,'" NumberOf', &
150  'Components="',a,'" format="ascii">')
151  1001 FORMAT(es14.6,1x)
152  1002 FORMAT('</DataArray>')
153 
154  END SUBROUTINE vtp_write_dp2
155 
156 
157 
158 !``````````````````````````````````````````````````````````````````````!
159 ! Subroutine: VTP_WRITE_I1 !
160 ! !
161 ! Purpose: Collect and write 1D integer arrays to the VTP file. This !
162 ! routine is designed to collect the data for parallel and serial !
163 ! runs. This routine also manages the distribted IO case. !
164 !``````````````````````````````````````````````````````````````````````!
165  SUBROUTINE vtp_write_i1(NAME, DATA)
166 
167  CHARACTER(len=*), INTENT(in) :: NAME
168  INTEGER, INTENT(in) :: DATA(:)
169 
170  INTEGER :: LC, PC
171 
172  IF(bdist_io) THEN
173 
174  WRITE(des_unit,1000) name
175 
176  pc = 1
177  DO lc = 1, max_pip
178  IF(pc > pip) EXIT
179  IF(is_nonexistent(lc)) cycle
180  pc = pc+1
181  IF(is_ghost(lc) .OR. is_entering_ghost(lc) .OR. is_exiting_ghost(lc)) cycle
182  WRITE(des_unit, 1001,advance="NO") DATA(lc)
183  ENDDO
184  WRITE(des_unit,1002)
185 
186  ELSE
187 
188  allocate (iprocbuf(local_cnt) )
189  allocate (irootbuf(global_cnt))
190 
191  CALL des_gather(data)
192 
193  IF(mype == pe_io) THEN
194  WRITE(des_unit,1000) name
195  DO lc=1, global_cnt
196  WRITE(des_unit,1001,advance="NO") irootbuf(lc)
197  ENDDO
198  WRITE(des_unit,1002)
199  ENDIF
200 
201  deallocate(iprocbuf, irootbuf)
202 
203  ENDIF
204 
205  1000 FORMAT('<DataArray type="Float32" Name="',a,'" format="ascii">')
206  1001 FORMAT(i10,1x)
207  1002 FORMAT('</DataArray>')
208 
209  END SUBROUTINE vtp_write_i1
210 
211 
212 !``````````````````````````````````````````````````````````````````````!
213 ! Subroutine: VTP_WRITE_ELEMENT !
214 ! !
215 ! Purpose: Write a string to the VTP file. It masks the need to check !
216 ! the logical before flushing. !
217 !``````````````````````````````````````````````````````````````````````!
218  SUBROUTINE vtp_write_element(ELEMENT)
219 
220  CHARACTER(len=*), INTENT(in) :: ELEMENT
221 
222  IF(bdist_io .OR. mype == pe_io) &
223  WRITE(des_unit,"(A)") element
224 
225  RETURN
226  END SUBROUTINE vtp_write_element
227 
228 
229 
230 !``````````````````````````````````````````````````````````````````````!
231 ! Subroutine: VTP_OPEN_FILE !
232 ! !
233 ! Purpose: This routine opens the VTP file and calcualtes the offsets !
234 ! for dmp data collection. !
235 !``````````````````````````````````````````````````````````````````````!
236  SUBROUTINE vtp_open_file(NoPc)
237 
238 ! Modules
239 !-----------------------------------------------
240  use discretelement, only: vtp_dir
241  use run, only: run_type, run_name
242 
243  IMPLICIT NONE
244 
245  CHARACTER(len=*) :: NoPc
246 
247  INTEGER :: NumberOfPoints
248 
249 ! Variables related to gather
250  integer lgathercnts(0:numpes-1), lproc
251 
252 ! check whether an error occurs in opening a file
253  INTEGER :: IOS
254 ! Integer error flag.
255  INTEGER :: IER
256 
257 ! logical used for testing is the data file already exists
258  LOGICAL :: EXISTS_VTP
259 ! status of the vtp file to be written
260  CHARACTER(LEN=8) :: STATUS_VTP
261 
262  IF(trim(vtp_dir)/='.') CALL create_dir(trim(vtp_dir))
263 
264 ! Initial the global count.
265  global_cnt = 10
266 ! Calculate the number of 'real' particles on the local process.
267  local_cnt = pip - ighost_cnt
268 
269 ! Distributed IO
270  IF(bdist_io) THEN
271  numberofpoints = local_cnt
272  WRITE(nopc,"(I10.10)") numberofpoints
273 
274  IF(trim(vtp_dir)/='.') THEN
275  WRITE(fname_vtp,'(A,"/",A,"_DES",I4.4,"_",I5.5,".vtp")') &
276  trim(vtp_dir), trim(run_name), vtp_findex, mype
277  ELSE
278  WRITE(fname_vtp,'(A,"_DES",I4.4,"_",I5.5,".vtp")') &
279  trim(run_name), vtp_findex, mype
280  ENDIF
281 
282 ! Serial IO
283  ELSE
284 
285 ! Calculate the total number of particles system-wide.
286  call global_sum(local_cnt, global_cnt)
287  numberofpoints = global_cnt
288  WRITE(nopc,"(I10.10)") numberofpoints
289 
290 ! Set the send count from the local process.
291  igath_sendcnt = local_cnt
292 
293 ! Collect the number of particles on each rank.all ranks.
294  lgathercnts = 0
295  lgathercnts(mype) = local_cnt
296  call global_sum(lgathercnts,igathercnts)
297 
298 ! Calculate the rank displacements.
299  idispls(0) = 0
300  DO lproc = 1,numpes-1
301  idispls(lproc) = idispls(lproc-1) + igathercnts(lproc-1)
302  ENDDO
303 
304 ! set the file name and unit number and open file
305  IF(trim(vtp_dir)/='.') THEN
306  WRITE(fname_vtp,'(A,"/",A,"_DES_",I5.5,".vtp")') &
307  trim(vtp_dir),trim(run_name), vtp_findex
308  ELSE
309  WRITE(fname_vtp,'(A,"_DES_",I5.5,".vtp")') &
310  trim(run_name), vtp_findex
311  ENDIF
312  ENDIF
313 
314  ier = 0
315  IF(bdist_io .OR. mype == pe_io) THEN
316 
317 ! The file should be new but could exist due to restarting.
318  status_vtp = 'NEW'
319 ! Check to see if the file already exists.
320  INQUIRE(file=fname_vtp,exist=exists_vtp)
321 ! The given file should not exist if the run type is NEW.
322  IF(exists_vtp)THEN
323 ! The VTP should never exist for a NEW run.
324  IF(run_type == 'NEW')THEN
325  ier = 1
326 ! The file may exist during a RESTART.
327  ELSE
328  status_vtp = 'REPLACE'
329  ENDIF
330  ENDIF
331 
332 ! Open the file and record any erros.
333  IF(ier == 0) THEN
334  OPEN(convert='BIG_ENDIAN',unit=des_unit, file=fname_vtp, &
335  status=status_vtp, iostat=ios)
336  IF(ios /= 0) ier = 2
337  ENDIF
338  ENDIF
339 
340  CALL global_all_max(ier)
341 
342  IF(ier /= 0) THEN
343  CALL init_err_msg("VTP_MOD --> OPEN_VTP")
344  WRITE(err_msg, 1100) ier
345  CALL flush_err_msg(abort=.true.)
346  ENDIF
347 
348  1100 FORMAT('Error 1100: Unable to open VTP file. This could be ', &
349  'caused by a VTP',/'file with the same file name already ', &
350  'existing. or an error code',/' returned by the OPEN ', &
351  'function.'/'Error code: ',i2,4x,'Aborting.')
352 
353 
354  END SUBROUTINE vtp_open_file
355 
356 
357 
358 !......................................................................!
359 ! SUBROUTINE: VTP_CLOSE_FILE !
360 ! !
361 ! Purpose: This routine closes the vtp file. !
362 !``````````````````````````````````````````````````````````````````````!
363  SUBROUTINE vtp_close_file
364 
365 
366  vtp_findex=vtp_findex+1
367 
368  IF(bdist_io .OR. (mype .eq.pe_io)) CLOSE(des_unit)
369 
370 
371  END SUBROUTINE vtp_close_file
372 
373 
374 !......................................................................!
375 ! SUBROUTINE: ADD_VTP_TO_PVD !
376 ! !
377 ! Purpose: This routine opens the pvd file. !
378 !``````````````````````````````````````````````````````````````````````!
379  SUBROUTINE add_vtp_to_pvd
380 
381  use discretelement, only: vtp_dir
382  use run, only: run_type, run_name
383 
384 !-----------------------------------------------
385 ! Local Variables
386 !-----------------------------------------------
387 ! Index position of desired character
388  INTEGER IDX_f, IDX_b
389 ! logical used for testing is the data file already exists
390  LOGICAL :: EXISTS_PVD
391 ! Generic input limited to 256 characters
392  CHARACTER(LEN=256) INPUT
393 
394 ! formatted file name
395  CHARACTER(LEN=64) :: FNAME_PVD = ''
396 ! formatted time
397  CHARACTER(LEN=64) :: cTIME = ''
398 
399  LOGICAL, SAVE :: FIRST_PASS = .true.
400 
401 ! IO Status flag
402  INTEGER :: IOS
403 
404 ! Variables related to gather
405  integer :: IER
406 
407 !-----------------------------------------------
408 
409  CALL init_err_msg('VTP_MOD --> ADD_VTP_TO_PVD')
410 
411 ! Initialize the error flag.
412  ier = 0
413 
414 ! Obtain the file name and open the pvd file
415  fname_pvd = trim(run_name)//'_DES.pvd'
416 
417 ! The PVD file is only written by PE_IO with serial IO.
418  IF(mype == pe_io .AND. .NOT.bdist_io) THEN
419 
420 ! Check to see if the file already exists.
421  INQUIRE(file=fname_pvd,exist=exists_pvd)
422 
423  IF(first_pass) THEN
424 
425 ! Open the "NEW" file and write the necessary header information.
426  IF(run_type /= 'RESTART_1')THEN
427 
428 ! The file exists but first_pass is also true so most likely an existing
429 ! file from an earlier/other run is present in the directory. Exit to
430 ! prevent accidently overwriting the existing file.
431  IF(exists_pvd) THEN
432  ier = 1
433  ELSE
434  OPEN(unit=pvd_unit,file=fname_pvd,status='NEW')
435  WRITE(pvd_unit,"(A)")'<?xml version="1.0"?>'
436  WRITE(pvd_unit,"(A)")'<VTKFile type="Collection" &
437  &version="0.1" byte_order="LittleEndian">'
438  WRITE(pvd_unit,"(3X,'<Collection>')")
439  ENDIF
440 
441 ! This is the first pass of a restart run. Extra care is needed to make
442 ! sure that the pvd file is ready to accept new data.
443  ELSE ! a restart run
444  IF(exists_pvd) THEN
445 ! Open the file at the beginning.
446  OPEN(unit=pvd_unit,file=fname_pvd,&
447  position="REWIND",status='OLD',iostat=ios)
448  IF(ios /= 0) ier = 2
449  ELSE ! a pvd file does not exist
450  ier = 3
451  ENDIF
452 
453  IF(ier == 0) THEN
454 ! Loop over the entries in the PVD file, looking for a match to the
455 ! file that is being written. If no match is found, the data will be
456 ! appended to the end of the pvd file, otherwise, the old data will
457 ! be over-written.
458  DO
459 ! Read in the entires of the PVD file.
460  READ(pvd_unit,"(A)",iostat=ios)input
461  IF(ios > 0) THEN
462  ier = 4
463  EXIT
464  ELSEIF(ios<0)THEN
465 ! The end of the pvd file has been reached without finding an entry
466 ! matching the current record. Exit the loop.
467  backspace(pvd_unit)
468  EXIT
469  ENDIF
470 ! Find the first instances of file=" and "/> in the read data.
471  idx_f = index(input,'file="')
472  idx_b = index(input,'"/>')
473 ! Skip rows that do not contain file data
474  IF(idx_f == 0 .AND. idx_b == 0) cycle
475 ! Truncate the file name from the read data
476  WRITE (input,"(A)") input(idx_f+6:idx_b-1)
477 ! If the file name matches the current VTP record, break the loop to
478 ! over-write this record.
479  IF(trim(fname_vtp) == trim(input)) THEN
480  backspace(pvd_unit)
481  EXIT
482  ENDIF
483  ENDDO
484  ENDIF ! No errors
485  ENDIF ! run_type new or restart
486 
487  ELSE ! not FIRST_PASS
488  OPEN(unit=pvd_unit,file=fname_pvd,&
489  position="APPEND",status='OLD',iostat=ios)
490  IF (ios /= 0) ier = 2
491  ENDIF
492 
493  ENDIF ! if myPE == PE_IO and not distributed IO
494 
495 
496  CAlL global_all_sum(ier)
497  IF(ier /= 0) THEN
498  SELECT CASE(ier)
499  CASE(1); WRITE(err_msg,1101) trim(fname_pvd)
500  CASE(2); WRITE(err_msg,1102) trim(fname_pvd)
501  CASE(3); WRITE(err_msg,1103) trim(fname_pvd)
502  CASE(4); WRITE(err_msg,1104) trim(fname_pvd)
503  CASE DEFAULT; WRITE(err_msg,1105) trim(fname_pvd)
504  END SELECT
505  CALL flush_err_msg(abort=.true.)
506  ENDIF
507 
508  1101 FORMAT('Error 1101: A PVD file was detected in the run ', &
509  'directory which should',/'not exist for a NEW run.',/ &
510  'File: ',a)
511 
512  1102 FORMAT('Error 1102: Fatal error status returned while OPENING ', &
513  'PVD file.',/'File: ', a)
514 
515  1103 FORMAT('Error 1103: PVD file MISSING from run directory.',/ &
516  'File: ',a)
517 
518  1104 FORMAT('Error 1104: Fatal error status returned while READING ', &
519  'PVD file.',/'File: ', a)
520 
521  1105 FORMAT('Error 1105:: Fatal unclassified error when processing ', &
522  'PVD file.',/'File: ', a)
523 
524 
525 ! If there were no errors, updated the file.
526  IF(mype == pe_io .AND. .NOT.bdist_io) THEN
527 
528 ! Remove the last two lines written so that additional data can be added
529  IF(.NOT.first_pass) THEN
530  backspace(pvd_unit)
531  backspace(pvd_unit)
532  ENDIF
533 
534  WRITE(ctime,"(F12.6)") s_time
535 ! Write the data to the file
536  WRITE(pvd_unit,"(6X,A,A,A,A,A,A,A)")&
537  '<DataSet timestep="',trim(adjustl(ctime)),'" ',&
538  'group="" part="0" ',& ! necessary file data
539  'file="',trim(fname_vtp),'"/>' ! file name of vtp
540 
541 ! Write the closing tags
542  WRITE(pvd_unit,"(3X,A)")'</Collection>'
543  WRITE(pvd_unit,"(A)")'</VTKFile>'
544 
545  CLOSE(pvd_unit)
546  ENDIF
547 ! Identify that the files has been created and opened for next pass
548  first_pass = .false.
549 
550  CALL finl_err_msg
551 
552 ! Return to the calling routine
553  RETURN
554 
555  END SUBROUTINE add_vtp_to_pvd
556 
557 
558 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
559 ! C
560 ! Module name: WRITE_VTP_FILE C
561 ! Purpose: Writes particles data in VTK format (Polydata VTP) C
562 ! Binary format C
563 ! C
564 ! Author: Jeff Dietiker Date: 11-Feb-15 C
565 ! Reviewer: Date: C
566 ! C
567 ! Revision Number # Date: ##-###-## C
568 ! Author: # C
569 ! Purpose: # C
570 ! C
571 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
572  SUBROUTINE write_vtp_file(LCV,MODE)
573 
574  USE vtk, only: dimension_vtk, vtk_defined, frame
575  USE vtk, only: vtk_region,vtk_defined,vtk_data
576  USE vtk, only: vtk_part_diameter,vtk_part_vel,vtk_part_usr_var,vtk_part_temp
577  USE vtk, only: vtk_part_angular_vel,vtk_part_orientation
578  USE vtk, only: vtk_part_x_s, vtk_part_cohesion
579  USE vtk, only: time_dependent_filename,vtu_frame_unit,vtu_frame_filename
580  USE vtk, only: vtk_dbg_file
581  USE output, only: full_log
582  use des_thermo, only: des_t_s
583  IMPLICIT NONE
584  INTEGER :: L,N,LCV
585 
586  INTEGER :: PASS
587  INTEGER :: WRITE_HEADER = 1
588  INTEGER :: WRITE_DATA = 2
589  INTEGER :: MODE ! MODE = 0 : Write regular VTK region file
590  ! MODE = 1 : Write debug VTK region file (VTK_DBG_FILE = .TRUE.)
591 
592  vtk_region = lcv
593 ! There is nothing to write if we are not in a defined vtk region
594  IF(.NOT.vtk_defined(vtk_region)) RETURN
595 
596  IF(vtk_data(lcv)/='P') RETURN
597  IF(mode==0.AND.(vtk_dbg_file(lcv))) RETURN
598  IF(mode==1.AND.(.NOT.vtk_dbg_file(lcv))) RETURN
599 
600  CALL setup_vtk_region_particles
601 
602  CALL open_vtp_file_bin(mode)
603 
604 ! Only open pvd file when there are particles in vtk region
605  IF(global_cnt>0.AND.mode==0) CALL open_pvd_file
606 
607 ! First pass write the data header.
608 ! Second pass writes the data (appended binary format).
609 
610  DO pass=write_header,write_data
611 
612 
613  CALL write_geometry_in_vtp_bin(pass)
614 
615  IF(vtk_part_diameter(vtk_region)) &
616  CALL write_scalar_in_vtp_bin('Diameter',2.0d0*des_radius,pass)
617 
618  IF(vtk_part_vel(vtk_region)) &
619  CALL write_vector_in_vtp_bin('Velocity',des_vel_new,pass)
620 
621  IF(vtk_part_angular_vel(vtk_region)) &
622  CALL write_vector_in_vtp_bin('Angular_velocity', omega_new,pass)
623 
624  IF(particle_orientation) THEN
625  IF(vtk_part_orientation(vtk_region)) &
626  CALL write_vector_in_vtp_bin('Orientation', orientation,pass)
627  ENDIF
628 
629  DO n=1, des_usr_var_size
630  IF(vtk_part_usr_var(vtk_region,n)) &
631  CALL write_scalar_in_vtp_bin('User Defined Var '//trim(ival(n)),des_usr_var(n,:),pass)
632  ENDDO
633 
634  IF(energy_eq.AND.vtk_part_temp(vtk_region)) &
635  CALL write_scalar_in_vtp_bin('Temperature', des_t_s,pass)
636 
637  IF(any_species_eq) THEN
638  DO n=1, dimension_n_s
639  IF(vtk_part_x_s(vtk_region,n)) &
640  CALL write_scalar_in_vtp_bin(trim(ivar('X_s',n)), des_x_s(:,n),pass)
641  ENDDO
642  ENDIF
643 
644  IF(use_cohesion.AND.vtk_part_cohesion(vtk_region)) &
645  CALL write_scalar_in_vtp_bin('CohesiveForce', postcohesive,pass)
646 
647  ENDDO ! PASS LOOP, EITHER HEADER OR DATA
648 
649 
650  CALL close_vtp_file_bin(mode)
651 
652 ! Only update pvd file when there are particles in vtk region
653  IF(global_cnt>0.AND.mode==0) CALL update_and_close_pvd_file
654 
655 #ifdef MPI
656  call mpi_barrier(mpi_comm_world,mpierr)
657 #endif
658 
659 ! Update Frames
660  IF (mype == pe_io.AND.time_dependent_filename) THEN
661  OPEN(convert='BIG_ENDIAN',unit = vtu_frame_unit, file = trim(vtu_frame_filename))
662  DO l = 1, dimension_vtk
663  IF(vtk_defined(l)) WRITE(vtu_frame_unit,*) l,frame(l)
664  ENDDO
665  CLOSE(vtu_frame_unit)
666  ENDIF
667 
668  IF (full_log.AND.mype == pe_io) WRITE(*,20)' DONE.'
669 
670 20 FORMAT(a,1x/)
671  RETURN
672 
673  END SUBROUTINE write_vtp_file
674 
675 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
676 ! C
677 ! Module name: OPEN_VTP_FILE C
678 ! Purpose: Open a vtp file and writes the header C
679 ! Binary format C
680 ! C
681 ! Author: Jeff Dietiker Date: 11-Feb-15 C
682 ! Reviewer: Date: C
683 ! C
684 ! Revision Number # Date: ##-###-## C
685 ! Author: # C
686 ! Purpose: # C
687 ! C
688 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
689  SUBROUTINE open_vtp_file_bin(MODE)
690 
691  USE run, only: time
692  USE output, only: full_log
693  USE vtk, only: time_dependent_filename, vtu_frame_filename, vtu_frame_unit
694  USE vtk, only: reset_frame_at_time_zero,pvtu_filename,pvtu_unit,buffer,end_rec
695  USE vtk, only: dimension_vtk, vtk_defined, frame, vtk_region
696  USE vtk, only: vtu_filename, vtk_filebase, vtu_dir, vtu_unit
697  USE param1, only: zero
698 
699  IMPLICIT NONE
700  LOGICAL :: VTU_FRAME_FILE_EXISTS, NEED_TO_WRITE_VTP
701  INTEGER :: ISTAT,BUFF1,BUFF2,L
702  INTEGER :: MODE ! MODE = 0 : Write regular VTK region file
703  ! MODE = 1 : Write debug VTK region file (VTK_DBG_FILE = .TRUE.)
704 
705 
706  IF(bdist_io) THEN
707  need_to_write_vtp = (local_cnt>0)
708  ELSE
709  need_to_write_vtp = (mype==0.AND.global_cnt>0)
710  ENDIF
711 
712 ! Only open the file from head node when not using distributed I/O
713  IF (mype /= pe_io.AND.(.NOT.bdist_io)) RETURN
714 
715  IF(time_dependent_filename) THEN
716  INQUIRE(file=vtu_frame_filename,exist=vtu_frame_file_exists)
717  IF(vtu_frame_file_exists) THEN
718  OPEN(convert='BIG_ENDIAN',unit = vtu_frame_unit, file = trim(vtu_frame_filename))
719  DO l = 1, dimension_vtk
720  IF(vtk_defined(l)) THEN
721  READ(vtu_frame_unit,*)buff1,buff2
722  frame(l)=buff2
723  ENDIF
724  ENDDO
725  CLOSE(vtu_frame_unit)
726  ENDIF
727  IF(reset_frame_at_time_zero.AND.time==zero) THEN
728  DO l = 1, dimension_vtk
729  IF(l==vtk_region) frame(l)=-1
730  ENDDO
731  ENDIF
732  DO l = 1, dimension_vtk
733  IF(l==vtk_region) frame(l) = frame(l) + 1
734  ENDDO
735  ENDIF
736 
737 ! For distributed I/O, define the file name for each processor that owns particles
738  IF (bdist_io) THEN
739  IF (local_cnt>0) THEN
740  IF(time_dependent_filename.AND.mode==0) THEN
741  WRITE(vtu_filename,20) trim(vtk_filebase(vtk_region)),frame(vtk_region),mype
742  ELSE
743  WRITE(vtu_filename,25) trim(vtk_filebase(vtk_region)),mype
744  ENDIF
745  ENDIF
746  ELSE
747  IF(mype.EQ.pe_io) THEN
748  IF(time_dependent_filename.AND.mode==0) THEN
749  WRITE(vtu_filename,30) trim(vtk_filebase(vtk_region)),frame(vtk_region)
750  ELSE
751  WRITE(vtu_filename,35) trim(vtk_filebase(vtk_region))
752  ENDIF
753  END IF
754  END IF
755 
756 ! Add the VTU directory path if necessary
757 
758  IF (need_to_write_vtp) THEN
759  IF(trim(vtu_dir)/='.') vtu_filename='./'//trim(vtu_dir)//'/'//vtu_filename
760  ENDIF
761 
762 ! Echo
763  IF (full_log) THEN
764  IF (.NOT.bdist_io) THEN
765  WRITE(*,10,advance='NO')' WRITING VTP FILE : ', trim(vtu_filename),' .'
766  ELSE
767  IF(mype==pe_io) WRITE(*,15,advance='NO')' EACH PROCESOR IS WRITING ITS OWN VTP FILE.'
768  ENDIF
769  ENDIF
770 
771 ! Open File
772 
773  IF (need_to_write_vtp) THEN
774 
775  vtu_unit = 678
776  OPEN(convert='BIG_ENDIAN',unit = vtu_unit, &
777  file = trim(vtu_filename), &
778  form = 'UNFORMATTED', & ! works with gfortran 4.3.4 and ifort 10.1 but may not be supported by all compilers
779  ! use 'BINARY' if 'UNFORMATTED' is not supported
780  access = 'STREAM', & ! works with gfortran 4.3.4 and ifort 10.1 but may not be supported by all compilers
781  ! use 'SEQUENTIAL' if 'STREAM' is not supported
782  action = 'WRITE', &
783  iostat=istat)
784 
785 
786  IF (istat /= 0) THEN
787  IF(dmp_log) WRITE(unit_log, 1001) vtu_filename, vtu_unit,vtu_dir
788  IF(full_log.AND.mype == pe_io) WRITE(*, 1001) vtu_filename, vtu_unit,vtu_dir
789  CALL mfix_exit(mype)
790  ENDIF
791 
792 
793 1001 FORMAT(/1x,70('*')//, ' From: OPEN_VTP_FILE',/,' Message: ', &
794  'Error opening vtp file. Terminating run.',/10x, &
795  'File name: ',a,/10x, &
796  'VTP_UNIT : ',i4, /10x, &
797  'PLEASE VERIFY THAT VTU_DIR EXISTS: ', a, &
798  /1x,70('*')/)
799 
800 
801 ! Write file Header
802  buffer='<?xml version="1.0"?>'
803  WRITE(vtu_unit)trim(buffer)//end_rec
804 
805  WRITE(buffer,*)'<!-- Time =',time,' sec. -->'
806  WRITE(vtu_unit)trim(buffer)//end_rec
807 
808  buffer='<VTKFile type="PolyData" version="0.1" byte_order="BigEndian">'
809  WRITE(vtu_unit)trim(buffer)//end_rec
810 
811  buffer=' <PolyData>'
812  WRITE(vtu_unit)trim(buffer)//end_rec
813 
814 
815  ENDIF
816 ! For distributed I/O, open .p))vtp file that combines all *.vtp files for a given FRAME
817 ! this is a simple ASCII file
818 
819  IF (mype == pe_io.AND.bdist_io.AND.global_cnt>0) THEN
820 
821  IF(time_dependent_filename.AND.mode==0) THEN
822  WRITE(pvtu_filename,40) trim(vtk_filebase(vtk_region)),frame(vtk_region)
823  ELSE
824  WRITE(pvtu_filename,45) trim(vtk_filebase(vtk_region))
825  ENDIF
826 
827  IF(trim(vtu_dir)/='.') pvtu_filename='./'//trim(vtu_dir)//'/'//pvtu_filename
828 
829  OPEN(convert='BIG_ENDIAN',unit = pvtu_unit, file = trim(pvtu_filename))
830 
831  WRITE(pvtu_unit,100) '<?xml version="1.0"?>'
832  WRITE(pvtu_unit,110) '<!-- Time =',time,' sec. -->'
833  WRITE(pvtu_unit,120) '<VTKFile type="PPolyData"',&
834  ' version="0.1" byte_order="BigEndian">'
835 
836  WRITE(pvtu_unit,100) ' <PPolyData GhostLevel="0">'
837  WRITE(pvtu_unit,100) ' <PPoints>'
838  WRITE(pvtu_unit,100) ' <PDataArray type="Float32" Name="coordinates" NumberOfComponents="3" &
839  &format="appended" offset=" 0" />'
840  WRITE(pvtu_unit,100) ' </PPoints>'
841  WRITE(pvtu_unit,100) ''
842  WRITE(pvtu_unit,100) ' <PPointData Scalars="Diameter" Vectors="Velocity">'
843 
844  ENDIF
845 
846 100 FORMAT(a)
847 110 FORMAT(a,e14.7,a)
848 120 FORMAT(a,a)
849 10 FORMAT(/1x,3a)
850 15 FORMAT(/1x,a)
851 20 FORMAT(a,"_",i4.4,"_",i5.5,".vtp")
852 25 FORMAT(a,"_",i5.5,".vtp")
853 30 FORMAT(a,"_",i4.4,".vtp")
854 35 FORMAT(a,".vtp")
855 40 FORMAT(a,"_",i4.4,".pvtp")
856 45 FORMAT(a,".pvtp")
857 
858  RETURN
859 
860  END SUBROUTINE open_vtp_file_bin
861 
862 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
863 ! C
864 ! Module name: WRITE_GEOMETRY_IN_VTP_BIN C
865 ! Purpose: Write Geometry and connectivity in a vtu file C
866 ! Binary format C
867 ! C
868 ! Author: Jeff Dietiker Date: 21-Feb-08 C
869 ! Reviewer: Date: C
870 ! C
871 ! Revision Number # Date: ##-###-## C
872 ! Author: # C
873 ! Purpose: # C
874 ! C
875 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
876  SUBROUTINE write_geometry_in_vtp_bin(PASS)
877 
878  USE vtk, only: number_of_points,buffer, vtu_unit,end_rec,vtu_offset,belongs_to_vtk_subdomain
879 
880  IMPLICIT NONE
881 
882  REAL(c_float) :: float
883  INTEGER(c_int) :: int
884 
885  INTEGER :: nbytes_vector
886  INTEGER :: offset_xyz
887 
888  INTEGER :: PASS
889  INTEGER :: WRITE_HEADER = 1
890  INTEGER :: WRITE_DATA = 2
891 
892  DOUBLE PRECISION, ALLOCATABLE :: ltemp_array(:,:) ! local
893  DOUBLE PRECISION, ALLOCATABLE :: gtemp_array(:,:) ! global
894 
895  INTEGER :: LB, UB
896  INTEGER :: PC, LC1, LC2
897 
898 ! Loop through all particles and kee a list of particles belonging to a VTK region
899 
900 ! Since the data is appended (i.e., written after all tags), the
901 ! offset, in number of bytes must be specified. The offset includes
902 ! the size of the data for each field, plus the size of the integer
903 ! that stores the number of bytes. this is why the offset of a field
904 ! equals the offset of the previous field plus sizeof(int) plus the
905 ! number of bytes of the field.
906 
907 ! Next, the actual data is written for the geometry (PASS=WRITE_DATA)
908 ! The DATA is converted to single precision to save memory.
909 
910  IF (.NOT.bdist_io) THEN
911 ! The number of points in the pvd file is the global number of particles
912 ! computed from SETUP_VTK_REGION_PARTICLES
913 
914  number_of_points = global_cnt
915 
916 ! Number of bytes of position field (vector,3 components)
917  nbytes_vector = number_of_points * 3 * sizeof(float)
918 
919 ! Offset of each field
920  offset_xyz = 0
921 
922  IF(pass==write_header) THEN
923  IF(mype == pe_io) THEN
924 
925  WRITE(buffer,*)' <Piece NumberOfPoints="',number_of_points, &
926  '" NumberOfVerts="0" NumberOfLines ="0" NumberOfStrips="0" NumberOfPolys="0" >'
927  WRITE(vtu_unit)trim(buffer)//end_rec
928 
929  WRITE(buffer,*)' <Points>'
930  WRITE(vtu_unit)trim(buffer)//end_rec
931 
932  WRITE(buffer,*)' <DataArray type="Float32" Name="coordinates" NumberOfComponents="3" &
933  &format="appended" offset="',offset_xyz,'" />'
934  WRITE(vtu_unit)trim(buffer)//end_rec
935 
936  WRITE(buffer,*)' </Points>'
937  WRITE(vtu_unit)trim(buffer)//end_rec
938 
939  WRITE(buffer,*)'<PointData Scalars="Diameter" Vectors="Velocity"> '!preparing pointData
940  WRITE(vtu_unit)trim(buffer)//end_rec
941 
942 ! calculate offset for next field
943  vtu_offset = offset_xyz + sizeof(int) + nbytes_vector
944 
945  ENDIF
946 
947  ELSEIF(pass==write_data) THEN
948 
949  IF(mype == pe_io) THEN
950 
951  WRITE(buffer,*)' </PointData>'
952  WRITE(vtu_unit)trim(buffer)//end_rec
953 
954  WRITE(buffer,*)' <Verts> </Verts>'
955  WRITE(vtu_unit)trim(buffer)//end_rec
956 
957  WRITE(buffer,*)' <Lines> </Lines>'
958  WRITE(vtu_unit)trim(buffer)//end_rec
959 
960  WRITE(buffer,*)' <Strips> </Strips>'
961  WRITE(vtu_unit)trim(buffer)//end_rec
962 
963  WRITE(buffer,*)' <Polys> </Polys>'
964  WRITE(vtu_unit)trim(buffer)//end_rec
965 
966  WRITE(buffer,*)' </Piece>'
967  WRITE(vtu_unit)trim(buffer)//end_rec
968 
969  WRITE(buffer,*)' </PolyData>'
970  WRITE(vtu_unit)trim(buffer)//end_rec
971 
972  WRITE(buffer,*)' <AppendedData encoding="raw">'
973  WRITE(vtu_unit)trim(buffer)//end_rec
974 
975 
976 ! Starting raw binary data with an underscore
977 
978  WRITE(buffer,*)'_'
979  WRITE(vtu_unit)trim(buffer)
980 
981 ! Number of bytes for X,Y,Z coordinates
982  WRITE(vtu_unit) nbytes_vector
983 
984 
985  ENDIF
986 
987  lb = lbound(des_pos_new,2) ! This should always be 1
988  ub = ubound(des_pos_new,2) ! This should always be 2
989 
990  ALLOCATE (dprocbuf(local_cnt) )
991  ALLOCATE (drootbuf(global_cnt))
992  ALLOCATE (ltemp_array((ub-lb)+1,local_cnt))
993  ALLOCATE (gtemp_array((ub-lb)+1,global_cnt))
994 
995 ! Pack particle coordinates in a temporary local array
996  pc = 0
997  DO lc1 = 1, max_pip
998  IF(belongs_to_vtk_subdomain(lc1)) THEN
999  pc =pc + 1
1000  DO lc2=lb, ub
1001  ltemp_array(lc2,pc) = des_pos_new(lc1,lc2)
1002  ENDDO
1003  ENDIF
1004  IF(pc==local_cnt) EXIT
1005  ENDDO
1006 
1007 ! For each coordinate (x,y, and z), gather the local list to global temporary array
1008  DO lc1 = lb, ub
1009  dprocbuf(1:local_cnt)=ltemp_array(lc1,1:local_cnt)
1010  CALL desmpi_gatherv(ptype=2)
1011  gtemp_array(lc1,:) = drootbuf(:)
1012  ENDDO
1013 
1014 ! Write the list of coordinates
1015  IF(mype == pe_io) THEN
1016  DO lc1=1, global_cnt
1017  DO lc2=lb, ub
1018  WRITE(vtu_unit) real(gtemp_array(lc2,lc1))
1019  ENDDO
1020  ENDDO
1021  ENDIF
1022 
1023  deallocate (dprocbuf, drootbuf, ltemp_array,gtemp_array)
1024 
1025 
1026  ENDIF
1027 
1028 
1029  ELSEIF(bdist_io.AND.local_cnt>0) THEN
1030 
1031  IF(local_cnt==0) RETURN
1032 ! The number of points in the pvd file is the local number of particles
1033 ! computed from SETUP_VTK_REGION_PARTICLES
1034 
1035  number_of_points = local_cnt
1036 
1037 ! Number of bytes of position field (vector,3 components)
1038  nbytes_vector = number_of_points * 3 * sizeof(float)
1039 
1040 ! Offset of each field
1041  offset_xyz = 0
1042 
1043  IF(pass==write_header) THEN
1044 
1045  WRITE(buffer,*)' <Piece NumberOfPoints="',number_of_points, &
1046  '" NumberOfVerts="0" NumberOfLines ="0" NumberOfStrips="0" NumberOfPolys="0" >'
1047  WRITE(vtu_unit)trim(buffer)//end_rec
1048 
1049  WRITE(buffer,*)' <Points>'
1050  WRITE(vtu_unit)trim(buffer)//end_rec
1051 
1052  WRITE(buffer,*)' <DataArray type="Float32" Name="coordinates" NumberOfComponents="3" &
1053  &format="appended" offset="',offset_xyz,'" />'
1054  WRITE(vtu_unit)trim(buffer)//end_rec
1055 
1056  WRITE(buffer,*)' </Points>'
1057  WRITE(vtu_unit)trim(buffer)//end_rec
1058 
1059  WRITE(buffer,*)'<PointData Scalars="Diameter" Vectors="Velocity"> '!preparing pointData
1060  WRITE(vtu_unit)trim(buffer)//end_rec
1061 
1062 ! calculate offset for next field
1063  vtu_offset = offset_xyz + sizeof(int) + nbytes_vector
1064 
1065 
1066  ELSEIF(pass==write_data) THEN
1067 
1068  WRITE(buffer,*)' </PointData>'
1069  WRITE(vtu_unit)trim(buffer)//end_rec
1070 
1071  WRITE(buffer,*)' <Verts> </Verts>'
1072  WRITE(vtu_unit)trim(buffer)//end_rec
1073 
1074  WRITE(buffer,*)' <Lines> </Lines>'
1075  WRITE(vtu_unit)trim(buffer)//end_rec
1076 
1077  WRITE(buffer,*)' <Strips> </Strips>'
1078  WRITE(vtu_unit)trim(buffer)//end_rec
1079 
1080  WRITE(buffer,*)' <Polys> </Polys>'
1081  WRITE(vtu_unit)trim(buffer)//end_rec
1082 
1083  WRITE(buffer,*)' </Piece>'
1084  WRITE(vtu_unit)trim(buffer)//end_rec
1085 
1086  WRITE(buffer,*)' </PolyData>'
1087  WRITE(vtu_unit)trim(buffer)//end_rec
1088 
1089  WRITE(buffer,*)' <AppendedData encoding="raw">'
1090  WRITE(vtu_unit)trim(buffer)//end_rec
1091 
1092 ! Starting raw binary data with an underscore
1093 
1094  WRITE(buffer,*)'_'
1095  WRITE(vtu_unit)trim(buffer)
1096 
1097 ! Number of bytes for X,Y,Z coordinates
1098  WRITE(vtu_unit) nbytes_vector
1099 
1100  lb = lbound(des_pos_new,2) ! This should always be 1
1101  ub = ubound(des_pos_new,2) ! This should always be 2
1102 
1103  ALLOCATE (ltemp_array((ub-lb)+1,local_cnt))
1104 
1105 ! Pack particle coordinates in a temporary local array
1106  pc = 0
1107  DO lc1 = 1, max_pip
1108  IF(belongs_to_vtk_subdomain(lc1)) THEN
1109  pc =pc + 1
1110  DO lc2=lb, ub
1111  ltemp_array(lc2,pc) = des_pos_new(lc1,lc2)
1112  ENDDO
1113  ENDIF
1114  IF(pc==local_cnt) EXIT
1115  ENDDO
1116 
1117 
1118 ! Write the list of coordinates
1119  DO lc1=1, local_cnt
1120  DO lc2=lb, ub
1121  WRITE(vtu_unit) real(ltemp_array(lc2,lc1))
1122  ENDDO
1123  ENDDO
1124 
1125  deallocate (ltemp_array)
1126 
1127  ENDIF
1128 
1129  ENDIF
1130 
1131  RETURN
1132 
1133  END SUBROUTINE write_geometry_in_vtp_bin
1134 
1135 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
1136 ! C
1137 ! Module name: WRITE_SCALAR_IN_VTP_BIN C
1138 ! Purpose: Write Scalar variable in a vtp file C
1139 ! Binary format C
1140 ! C
1141 ! Author: Jeff Dietiker Date: 11-Feb-15 C
1142 ! Reviewer: Date: C
1143 ! C
1144 ! Revision Number # Date: ##-###-## C
1145 ! Author: # C
1146 ! Purpose: # C
1147 ! C
1148 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
1149  SUBROUTINE write_scalar_in_vtp_bin(VAR_NAME,VAR,PASS)
1150 
1151  USE vtk, only: buffer,vtu_offset,vtu_unit,pvtu_unit
1152  USE vtk, only: end_rec,belongs_to_vtk_subdomain
1153  USE output, only: full_log
1154 
1155  IMPLICIT NONE
1156  INTEGER :: I,LC1,PC
1157 
1158  CHARACTER (*) :: VAR_NAME
1159  DOUBLE PRECISION, INTENT(in) :: VAR(:)
1160 
1161  REAL(c_float) :: float
1162 
1163  INTEGER :: nbytes_scalar
1164 
1165  INTEGER :: PASS
1166  INTEGER :: WRITE_HEADER = 1
1167  INTEGER :: WRITE_DATA = 2
1168 
1169  IF (.NOT.bdist_io) THEN
1170 
1171 ! Number of bytes for each scalar field
1172  nbytes_scalar = global_cnt * sizeof(float)
1173 
1174  IF(pass==write_header) THEN
1175 
1176 ! Remove possible white space with underscore
1177  DO i = 1,len_trim(var_name)
1178  IF(var_name(i:i) == ' ') var_name(i:i) = '_'
1179  ENDDO
1180 
1181 ! For each scalar, write a tag, with corresponding offset
1182  WRITE(buffer,90)' <DataArray type="Float32" Name="', &
1183  trim(var_name),'" format="appended" offset="',vtu_offset,'" />'
1184  WRITE(vtu_unit)trim(buffer)//end_rec
1185 
1186 ! Prepare the offset for the next field
1187  vtu_offset = vtu_offset + sizeof(float) + nbytes_scalar
1188 
1189 
1190  ELSEIF(pass==write_data) THEN
1191 
1192  allocate (dprocbuf(local_cnt) )
1193  allocate (drootbuf(global_cnt))
1194 
1195 ! Pack scalar list in a local buffer before gathering to root
1196  pc = 0
1197  DO lc1 = 1, max_pip
1198  IF(belongs_to_vtk_subdomain(lc1)) THEN
1199  pc =pc + 1
1200  dprocbuf(pc) = var(lc1)
1201  ENDIF
1202  IF(pc==local_cnt) EXIT
1203  ENDDO
1204 
1205 ! Gather local buffer to root
1206  CALL desmpi_gatherv(ptype=2)
1207 
1208 ! Write the data, always preceded by its size in number of bytes
1209 ! Write root buffer to file
1210  WRITE(vtu_unit) nbytes_scalar
1211 
1212  IF(mype == pe_io) THEN
1213  DO lc1=1, global_cnt
1214  WRITE(vtu_unit) real(drootbuf(lc1))
1215  ENDDO
1216  ENDIF
1217 
1218  deallocate (dprocbuf, drootbuf)
1219 
1220 
1221  ENDIF
1222 
1223 
1224  ELSEIF(bdist_io.AND.local_cnt>0) THEN
1225 
1226 ! Number of bytes for each scalar field
1227  nbytes_scalar = local_cnt * sizeof(float)
1228 
1229 ! Remove possible white space with underscore
1230  DO i = 1,len_trim(var_name)
1231  IF(var_name(i:i) == ' ') var_name(i:i) = '_'
1232  ENDDO
1233 
1234  IF(pass==write_header) THEN
1235 
1236 ! For each scalar, write a tag, with corresponding offset
1237  WRITE(buffer,90)' <DataArray type="Float32" Name="', &
1238  trim(var_name),'" format="appended" offset="',vtu_offset,'" />'
1239  WRITE(vtu_unit)trim(buffer)//end_rec
1240 
1241 ! Prepare the offset for the next field
1242  vtu_offset = vtu_offset + sizeof(float) + nbytes_scalar
1243 
1244 
1245  ELSEIF(pass==write_data) THEN
1246 
1247  allocate (dprocbuf(local_cnt) )
1248 
1249 ! Pack scalar list in a local buffer before writing in file
1250  pc = 0
1251  DO lc1 = 1, max_pip
1252  IF(belongs_to_vtk_subdomain(lc1)) THEN
1253  pc =pc + 1
1254  dprocbuf(pc) = var(lc1)
1255  ENDIF
1256  IF(pc==local_cnt) EXIT
1257  ENDDO
1258 
1259 ! Write the data, always preceded by its size in number of bytes
1260 ! Write root buffer to file
1261  WRITE(vtu_unit) nbytes_scalar
1262 
1263  DO lc1=1, local_cnt
1264  WRITE(vtu_unit) real(dprocbuf(lc1))
1265  ENDDO
1266 
1267  deallocate (dprocbuf)
1268 
1269  IF (mype == pe_io) THEN ! Update pvtu file with variable name
1270  WRITE(pvtu_unit,90) ' <PointArray type="Float32" Name="', &
1271  trim(var_name),'" format="appended" offset="',vtu_offset,'" />'
1272  ENDIF
1273 
1274 
1275  ENDIF
1276 
1277 
1278  ENDIF
1279 
1280 
1281  IF (pass==write_data.AND.full_log.AND.mype == pe_io) WRITE(*,10,advance='NO')'.'
1282 
1283 10 FORMAT(a)
1284 90 FORMAT(a,a,a,i12,a)
1285 
1286  RETURN
1287 
1288  END SUBROUTINE write_scalar_in_vtp_bin
1289 
1290 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
1291 ! C
1292 ! Module name: WRITE_VECTOR_IN_VTP C
1293 ! Purpose: Write Vector variable in a vtp file C
1294 ! Binary format C
1295 ! C
1296 ! Author: Jeff Dietiker Date: 11-Feb-15 C
1297 ! Reviewer: Date: C
1298 ! C
1299 ! Revision Number # Date: ##-###-## C
1300 ! Author: # C
1301 ! Purpose: # C
1302 ! C
1303 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
1304  SUBROUTINE write_vector_in_vtp_bin(VAR_NAME,VAR,PASS)
1305 
1306  USE vtk, only: buffer,vtu_offset,vtu_unit,pvtu_unit
1307  USE vtk, only: end_rec,belongs_to_vtk_subdomain
1308  USE output, only: full_log
1309 
1310  IMPLICIT NONE
1311 
1312  CHARACTER (*) :: VAR_NAME
1313  DOUBLE PRECISION, INTENT(in) :: VAR(:,:)
1314 
1315  REAL(c_float) :: float
1316 
1317  INTEGER :: nbytes_vector
1318 
1319  INTEGER :: PASS
1320  INTEGER :: WRITE_HEADER = 1
1321  INTEGER :: WRITE_DATA = 2
1322 
1323  DOUBLE PRECISION, ALLOCATABLE :: ltemp_array(:,:) ! local
1324  DOUBLE PRECISION, ALLOCATABLE :: gtemp_array(:,:) ! global
1325 
1326  INTEGER :: LB, UB
1327  INTEGER :: PC, LC1, LC2
1328 
1329  IF (.NOT.bdist_io) THEN
1330 
1331 ! Number of bytes for each vector field
1332  nbytes_vector = global_cnt * 3 * sizeof(float)
1333 
1334  IF(pass==write_header) THEN
1335 ! For each vector, write a tag, with corresponding offset
1336 
1337  WRITE(buffer,90)' <DataArray type="Float32" Name="', &
1338  trim(var_name),'" NumberOfComponents="3" format="appended" offset="',vtu_offset,'" />'
1339  WRITE(vtu_unit)trim(buffer)//end_rec
1340 
1341 ! Prepare the offset for the next field
1342  vtu_offset = vtu_offset + sizeof(float) + nbytes_vector
1343 
1344 
1345  ELSEIF(pass==write_data) THEN
1346 
1347  lb = lbound(var,2) ! This should always be 1
1348  ub = ubound(var,2) ! This should always be 2
1349 
1350  ALLOCATE (dprocbuf(local_cnt) )
1351  ALLOCATE (drootbuf(global_cnt))
1352  ALLOCATE (ltemp_array((ub-lb)+1,local_cnt))
1353  ALLOCATE (gtemp_array((ub-lb)+1,global_cnt))
1354 
1355 ! For each vector component, pack component list in a local array
1356  pc = 0
1357  DO lc1 = 1, max_pip
1358  IF(belongs_to_vtk_subdomain(lc1)) THEN
1359  pc =pc + 1
1360  DO lc2=lb, ub
1361  ltemp_array(lc2,pc) = var(lc1,lc2)
1362  ENDDO
1363  ENDIF
1364  IF(pc==local_cnt) EXIT
1365  ENDDO
1366 
1367 
1368 ! For each component, gather the local list to global temporary array
1369  DO lc1 = lb, ub
1370  dprocbuf(1:local_cnt)=ltemp_array(lc1,1:local_cnt)
1371  CALL desmpi_gatherv(ptype=2)
1372  gtemp_array(lc1,:) = drootbuf(:)
1373  ENDDO
1374 
1375 ! Write the data, always preceded by its size in number of bytes
1376  IF(mype == pe_io) THEN
1377  WRITE(vtu_unit) nbytes_vector
1378  DO lc1=1, global_cnt
1379  DO lc2=lb, ub
1380  WRITE(vtu_unit) real(gtemp_array(lc2,lc1))
1381  ENDDO
1382  ENDDO
1383  ENDIF
1384 
1385  deallocate (dprocbuf, drootbuf, ltemp_array,gtemp_array)
1386 
1387 
1388 
1389  ENDIF
1390 
1391 
1392  ELSEIF(bdist_io.AND.local_cnt>0) THEN
1393 
1394 ! Number of bytes for each vector field
1395  nbytes_vector = local_cnt * 3 * sizeof(float)
1396 
1397  IF(pass==write_header) THEN
1398 ! For each vector, write a tag, with corresponding offset
1399 
1400  WRITE(buffer,90)' <DataArray type="Float32" Name="', &
1401  trim(var_name),'" NumberOfComponents="3" format="appended" offset="',vtu_offset,'" />'
1402  WRITE(vtu_unit)trim(buffer)//end_rec
1403 
1404 ! Prepare the offset for the next field
1405  vtu_offset = vtu_offset + sizeof(float) + nbytes_vector
1406 
1407 
1408  ELSEIF(pass==write_data) THEN
1409 
1410  lb = lbound(var,1) ! This should always be 1
1411  ub = ubound(var,1) ! This should always be 2
1412 
1413  ALLOCATE (ltemp_array((ub-lb)+1,local_cnt))
1414 
1415 ! For each vector component, pack component list in a local array
1416  pc = 0
1417  DO lc1 = 1, max_pip
1418  IF(belongs_to_vtk_subdomain(lc1)) THEN
1419  pc =pc + 1
1420  DO lc2=lb, ub
1421  ltemp_array(lc2,pc) = var(lc2,lc1)
1422  ENDDO
1423  ENDIF
1424  IF(pc==local_cnt) EXIT
1425  ENDDO
1426 
1427 
1428 ! Write the data, always preceded by its size in number of bytes
1429  WRITE(vtu_unit) nbytes_vector
1430  DO lc1=1, local_cnt
1431  DO lc2=lb, ub
1432  WRITE(vtu_unit) real(ltemp_array(lc2,lc1))
1433  ENDDO
1434  ENDDO
1435 
1436  deallocate (ltemp_array)
1437 
1438 
1439  IF (mype == pe_io) THEN ! Update pvtu file with variable name
1440  WRITE(pvtu_unit,90)' <PointArray type="Float32" Name="', &
1441  trim(var_name),'" NumberOfComponents="3" format="appended" offset="',vtu_offset,'" />'
1442  ENDIF
1443 
1444 
1445  ENDIF
1446 
1447  ENDIF
1448 
1449 
1450  IF (pass==write_data.AND.full_log.AND.mype == pe_io) WRITE(*,10,advance='NO')'.'
1451 
1452 10 FORMAT(a)
1453 90 FORMAT(a,a,a,i12,a)
1454 
1455  RETURN
1456 
1457  END SUBROUTINE write_vector_in_vtp_bin
1458 
1459 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
1460 ! C
1461 ! Module name: CLOSE_VTP_FILE_BIN C
1462 ! Purpose: Close a vtp file C
1463 ! Binary format C
1464 ! C
1465 ! Author: Jeff Dietiker Date: 11-Feb-15 C
1466 ! Reviewer: Date: C
1467 ! C
1468 ! Revision Number # Date: ##-###-## C
1469 ! Author: # C
1470 ! Purpose: # C
1471 ! C
1472 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
1473  SUBROUTINE close_vtp_file_bin(MODE)
1474 
1475  USE vtk, only: buffer,vtu_unit,end_rec,pvtu_unit,time_dependent_filename
1476  USE vtk, only: vtk_region,vtk_filebase,frame
1477 
1478  IMPLICIT NONE
1479 
1480  INTEGER:: N
1481  CHARACTER (LEN=32) :: VTU_NAME
1482  INTEGER, DIMENSION(0:numPEs-1) :: ALL_PART_CNT
1483  INTEGER :: IERR
1484  INTEGER :: MODE ! MODE = 0 : Write regular VTK region file
1485  ! MODE = 1 : Write debug VTK region file (VTK_DBG_FILE = .TRUE.)
1486 
1487 
1488  IF((mype == pe_io.AND.(.NOT.bdist_io)).OR.(bdist_io.AND.local_cnt>0)) THEN
1489 
1490 ! Write last tags and close the vtp file
1491  WRITE(buffer,110)' </AppendedData>'
1492  WRITE(vtu_unit)end_rec//trim(buffer)//end_rec
1493 
1494  WRITE(buffer,110)'</VTKFile>'
1495  WRITE(vtu_unit)trim(buffer)//end_rec
1496 
1497  CLOSE(vtu_unit)
1498 
1499  ENDIF
1500 
1501 ! Update pvtu file and close
1502 
1503  IF(bdist_io) THEN
1504  CALL allgather_1i (local_cnt,all_part_cnt,ierr)
1505 
1506  IF (mype == pe_io.AND.global_cnt>0) THEN
1507  WRITE(pvtu_unit,100) ' </PPointData>'
1508 
1509  DO n = 0,numpes-1
1510  IF(all_part_cnt(n)>0) THEN
1511  IF(time_dependent_filename.AND.mode==0) THEN
1512  WRITE(vtu_name,20) trim(vtk_filebase(vtk_region)),frame(vtk_region),n
1513  ELSE
1514  WRITE(vtu_name,25) trim(vtk_filebase(vtk_region)),n
1515  ENDIF
1516 
1517  WRITE(pvtu_unit,110) ' <Piece Source="',trim(vtu_name),'"/>'
1518  ENDIF
1519  ENDDO
1520 
1521 
1522  WRITE(pvtu_unit,100) ' </PPolyData>'
1523  WRITE(pvtu_unit,100) '</VTKFile>'
1524  CLOSE(pvtu_unit)
1525  ENDIF
1526  ENDIF
1527 
1528 20 FORMAT(a,"_",i4.4,"_",i5.5,".vtp")
1529 25 FORMAT(a,"_",i5.5,".vtp")
1530 
1531 100 FORMAT(a)
1532 110 FORMAT(a,a,a)
1533 
1534  RETURN
1535 
1536  END SUBROUTINE close_vtp_file_bin
1537 
1538 
1539 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
1540 ! C
1541 ! Module name: SETUP_VTK_REGION_PARTICLES C
1542 ! C
1543 ! Purpose: Filter the particles based on the VTK region bounds and C
1544 ! set the flag BELONGS_TO_VTK_SUBDOMAIN to .TRUE. C
1545 ! to keep the particle. C
1546 ! C
1547 ! Author: Jeff Dietiker Date: 11-Feb-15 C
1548 ! Reviewer: Date: C
1549 ! C
1550 ! Revision Number # Date: ##-###-## C
1551 ! Author: # C
1552 ! Purpose: # C
1553 ! C
1554 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
1555  SUBROUTINE setup_vtk_region_particles
1556 
1557  USE vtk, only: vtk_region
1558  USE vtk, only: vtk_x_e, vtk_x_w, vtk_y_s, vtk_y_n, vtk_z_b, vtk_z_t
1559  USE vtk, only: vtk_nxs, vtk_nys, vtk_nzs
1560  USE vtk, only: vtk_slice_tol, vtk_select_mode
1561  USE vtk, only: belongs_to_vtk_subdomain
1562  USE discretelement, only: max_pip,pip,des_pos_new
1563 
1564  IMPLICIT NONE
1565 
1566  INTEGER :: PC,LC1
1567  INTEGER :: NXS,NYS,NZS,NS
1568  INTEGER :: X_SLICE(dim_i),Y_SLICE(dim_j),Z_SLICE(dim_k)
1569  DOUBLE PRECISION :: XE,XW,YS,YN,ZB,ZT
1570  DOUBLE PRECISION :: XP,YP,ZP,XP1,YP1,ZP1,XP2,YP2,ZP2,R
1571 
1572  DOUBLE PRECISION :: SLICE_TOL
1573  LOGICAL :: KEEP_XDIR,KEEP_YDIR,KEEP_ZDIR
1574 
1575 ! Variables related to gather
1576  integer lgathercnts(0:numpes-1), lproc
1577 
1578  CHARACTER(LEN=1) :: SELECT_PARTICLE_BY
1579 
1580 ! Get VTK region bounds
1581  xe = vtk_x_e(vtk_region)
1582  xw = vtk_x_w(vtk_region)
1583  ys = vtk_y_s(vtk_region)
1584  yn = vtk_y_n(vtk_region)
1585  zb = vtk_z_b(vtk_region)
1586  zt = vtk_z_t(vtk_region)
1587 
1588  nxs = vtk_nxs(vtk_region)
1589  nys = vtk_nys(vtk_region)
1590  nzs = vtk_nzs(vtk_region)
1591 
1592  slice_tol = vtk_slice_tol(vtk_region)
1593 
1594  select_particle_by = vtk_select_mode(vtk_region)
1595 
1596 ! get slice(s) location
1597  DO ns = 1,nxs
1598  x_slice(ns) = xw + (xe-xw)/(nxs-1)*(ns-1)
1599  ENDDO
1600 
1601  DO ns = 1,nys
1602  y_slice(ns) = ys + (yn-ys)/(nys-1)*(ns-1)
1603  ENDDO
1604 
1605  DO ns = 1,nzs
1606  z_slice(ns) = zb + (zt-zb)/(nzs-1)*(ns-1)
1607  ENDDO
1608 
1609 
1610 
1611 ! Loop through all particles on local rank and keep a list of particles
1612 ! belonging to VTK region
1613 
1614  IF(ALLOCATED(belongs_to_vtk_subdomain)) DEALLOCATE(belongs_to_vtk_subdomain)
1615  ALLOCATE(belongs_to_vtk_subdomain(max_pip))
1616 
1617  belongs_to_vtk_subdomain = .false.
1618 
1619  local_cnt = 0
1620  pc = 1
1621  DO lc1 = 1, max_pip
1622  IF(pc > pip) EXIT
1623  IF(is_nonexistent(lc1)) cycle
1624  pc = pc+1
1625  IF(is_ghost(lc1) .OR. is_entering_ghost(lc1) .OR. is_exiting_ghost(lc1)) cycle
1626 
1627  SELECT CASE(select_particle_by)
1628  CASE('C') ! Particle center must be inside vtk region
1629 
1630  xp = des_pos_new(lc1,1)
1631  yp = des_pos_new(lc1,2)
1632  zp = des_pos_new(lc1,3)
1633 
1634 ! X-direction
1635  keep_xdir=.false.
1636  IF(nxs==0) THEN
1637  IF(xw<=xp.AND.xp<=xe) keep_xdir=.true.
1638  ELSE
1639  DO ns = 1,nxs
1640  IF((x_slice(ns)-slice_tol)<=xp.AND.xp<=(x_slice(ns)+slice_tol)) keep_xdir=.true.
1641  ENDDO
1642  ENDIF
1643 
1644 ! Y-direction
1645  keep_ydir=.false.
1646  IF(nys==0) THEN
1647  IF(ys<=yp.AND.yp<=yn) keep_ydir=.true.
1648  ELSE
1649  DO ns = 1,nys
1650  IF((y_slice(ns)-slice_tol)<=yp.AND.yp<=(y_slice(ns)+slice_tol)) keep_ydir=.true.
1651  ENDDO
1652  ENDIF
1653 
1654 ! Z-direction
1655  keep_zdir=.false.
1656  IF(nzs==0) THEN
1657  IF(zb<=zp.AND.zp<=zt) keep_zdir=.true.
1658  ELSE
1659  DO ns = 1,nzs
1660  IF((z_slice(ns)-slice_tol)<=zp.AND.zp<=(z_slice(ns)+slice_tol)) keep_zdir=.true.
1661  ENDDO
1662  ENDIF
1663 
1664 
1665  CASE('P') ! Entire particle must be inside vtk region
1666 
1667  r = des_radius(lc1)
1668 
1669  xp1 = des_pos_new(lc1,1) - r
1670  yp1 = des_pos_new(lc1,2) - r
1671  zp1 = des_pos_new(lc1,3) - r
1672 
1673  xp2 = des_pos_new(lc1,1) + r
1674  yp2 = des_pos_new(lc1,2) + r
1675  zp2 = des_pos_new(lc1,3) + r
1676 
1677 ! X-direction
1678  keep_xdir=.false.
1679  IF(nxs==0) THEN
1680  IF(xw<=xp1.AND.xp2<=xe) keep_xdir=.true.
1681  ELSE
1682  DO ns = 1,nxs
1683  IF((x_slice(ns)-slice_tol)<=xp1.AND.xp2<=(x_slice(ns)+slice_tol)) keep_xdir=.true.
1684  ENDDO
1685  ENDIF
1686 
1687 ! Y-direction
1688  keep_ydir=.false.
1689  IF(nys==0) THEN
1690  IF(ys<=yp1.AND.yp2<=yn) keep_ydir=.true.
1691  ELSE
1692  DO ns = 1,nys
1693  IF((y_slice(ns)-slice_tol)<=yp1.AND.yp2<=(y_slice(ns)+slice_tol)) keep_ydir=.true.
1694  ENDDO
1695  ENDIF
1696 
1697 ! Z-direction
1698  keep_zdir=.false.
1699  IF(nzs==0) THEN
1700  IF(zb<=zp1.AND.zp2<=zt) keep_zdir=.true.
1701  ELSE
1702  DO ns = 1,nzs
1703  IF((z_slice(ns)-slice_tol)<=zp1.AND.zp2<=(z_slice(ns)+slice_tol)) keep_zdir=.true.
1704  ENDDO
1705  ENDIF
1706 
1707 
1708  CASE('I') ! Particle must be inside or intersect the edge of the vtk region
1709 
1710  r = des_radius(lc1)
1711 
1712  xp1 = des_pos_new(lc1,1) - r
1713  yp1 = des_pos_new(lc1,2) - r
1714  zp1 = des_pos_new(lc1,3) - r
1715 
1716  xp2 = des_pos_new(lc1,1) + r
1717  yp2 = des_pos_new(lc1,2) + r
1718  zp2 = des_pos_new(lc1,3) + r
1719 
1720 ! X-direction
1721  keep_xdir=.false.
1722  IF(nxs==0) THEN
1723  IF(.NOT.(xe<=xp1.OR.xp2<=xw)) keep_xdir=.true.
1724  ELSE
1725  DO ns = 1,nxs
1726  IF(.NOT.((x_slice(ns)+slice_tol)<=xp1.OR.xp2<=(x_slice(ns)-slice_tol))) keep_xdir=.true.
1727  ENDDO
1728  ENDIF
1729 
1730 ! Y-direction
1731  keep_ydir=.false.
1732  IF(nys==0) THEN
1733  IF(.NOT.(yn<=yp1.OR.yp2<=ys)) keep_ydir=.true.
1734  ELSE
1735  DO ns = 1,nys
1736  IF(.NOT.((y_slice(ns)+slice_tol)<=yp1.OR.yp2<=(y_slice(ns)-slice_tol))) keep_ydir=.true.
1737  ENDDO
1738  ENDIF
1739 
1740 ! Z-direction
1741  keep_zdir=.false.
1742  IF(nzs==0) THEN
1743  IF(.NOT.(zt<=zp1.OR.zp2<=zb)) keep_zdir=.true.
1744  ELSE
1745  DO ns = 1,nzs
1746  IF(.NOT.((z_slice(ns)+slice_tol)<=zp1.OR.zp2<=(z_slice(ns)-slice_tol))) keep_zdir=.true.
1747  ENDDO
1748  ENDIF
1749 
1750 
1751  CASE DEFAULT
1752  print*,'should not be here'
1753  END SELECT
1754 
1755 ! Now combine
1756  IF(keep_xdir.AND.keep_ydir.AND.keep_zdir) THEN
1757  belongs_to_vtk_subdomain(lc1) = .true.
1758  local_cnt = local_cnt + 1
1759  ENDIF
1760  ENDDO ! particle loop
1761 
1762 
1763 ! Calculate the total number of particles system-wide.
1764  call global_sum(local_cnt, global_cnt)
1765 
1766 ! No need to set the send/reccv when using distributed IO
1767  IF (bdist_io) RETURN
1768 ! Set the send count from the local process.
1769  igath_sendcnt = local_cnt
1770 
1771 ! Collect the number of particles on each rank.all ranks.
1772  lgathercnts = 0
1773  lgathercnts(mype) = local_cnt
1774  call global_sum(lgathercnts,igathercnts)
1775 
1776 ! Calculate the rank displacements.
1777  idispls(0) = 0
1778  DO lproc = 1,numpes-1
1779  idispls(lproc) = idispls(lproc-1) + igathercnts(lproc-1)
1780  ENDDO
1781 
1782  RETURN
1783 
1784  END SUBROUTINE setup_vtk_region_particles
1785 
1786  END MODULE vtp
vtk::vtu_filename
character(len=255) vtu_filename
Definition: vtk_mod.f:28
mpi_utility
Definition: mpi_utility_mod.f:6
vtk::vtk_slice_tol
double precision, dimension(dimension_vtk) vtk_slice_tol
Definition: vtk_mod.f:138
vtp::vtp_write_i1
subroutine vtp_write_i1(NAME, DATA)
Definition: vtp_mod.f:166
vtk::vtk_defined
logical, dimension(dimension_vtk) vtk_defined
Definition: vtk_mod.f:108
vtk::vtk_part_vel
logical, dimension(dimension_vtk) vtk_part_vel
Definition: vtk_mod.f:249
desmpi::igathercnts
integer, dimension(:), allocatable igathercnts
Definition: desmpi_mod.f:48
vtk::vtu_dir
character(len=255) vtu_dir
Definition: vtk_mod.f:27
vtp::vtp_write_dp2
subroutine vtp_write_dp2(NAME, DATA)
Definition: vtp_mod.f:92
vtp::write_geometry_in_vtp_bin
subroutine write_geometry_in_vtp_bin(PASS)
Definition: vtp_mod.f:877
vtp::vtp_open_file
subroutine vtp_open_file(NoPc)
Definition: vtp_mod.f:237
error_manager::ivar
character(len=32) function ivar(VAR, i1, i2, i3)
Definition: error_manager_mod.f:558
vtk::time_dependent_filename
logical time_dependent_filename
Definition: vtk_mod.f:25
open_pvd_file
subroutine open_pvd_file
Definition: vtk_out.f:1299
cdist::bdist_io
logical bdist_io
Definition: cdist_mod.f:4
error_manager::finl_err_msg
subroutine finl_err_msg
Definition: error_manager_mod.f:216
vtp::write_scalar_in_vtp_bin
subroutine write_scalar_in_vtp_bin(VAR_NAME, VAR, PASS)
Definition: vtp_mod.f:1150
update_and_close_pvd_file
subroutine update_and_close_pvd_file
Definition: vtk_out.f:1403
des_thermo::des_t_s
double precision, dimension(:), allocatable des_t_s
Definition: des_thermo_mod.f:28
vtk::vtk_dbg_file
logical, dimension(dimension_vtk) vtk_dbg_file
Definition: vtk_mod.f:93
desmpi::dprocbuf
double precision, dimension(:), allocatable dprocbuf
Definition: desmpi_mod.f:42
mpi_comm_des::des_gather
Definition: mpi_comm_des_mod.f:42
vtp::write_vtp_file
subroutine write_vtp_file(LCV, MODE)
Definition: vtp_mod.f:573
vtk::pvtu_unit
integer pvtu_unit
Definition: vtk_mod.f:36
vtk::vtk_x_e
double precision, dimension(dimension_vtk) vtk_x_e
Definition: vtk_mod.f:114
vtk::reset_frame_at_time_zero
logical reset_frame_at_time_zero
Definition: vtk_mod.f:26
run::run_name
character(len=60) run_name
Definition: run_mod.f:24
vtk::vtk_part_orientation
logical, dimension(dimension_vtk) vtk_part_orientation
Definition: vtk_mod.f:255
error_manager::ival
Definition: error_manager_mod.f:17
vtk::vtk_select_mode
character(len=1), dimension(dimension_vtk) vtk_select_mode
Definition: vtk_mod.f:243
vtk::vtk_nxs
integer, dimension(dimension_vtk) vtk_nxs
Definition: vtk_mod.f:129
mpi_utility::allgather_1i
subroutine allgather_1i(lbuf, gbuf, idebug)
Definition: mpi_utility_mod.f:146
vtk
Definition: vtk_mod.f:1
output::full_log
logical full_log
Definition: output_mod.f:31
vtk::vtk_y_n
double precision, dimension(dimension_vtk) vtk_y_n
Definition: vtk_mod.f:120
vtk::vtk_part_diameter
logical, dimension(dimension_vtk) vtk_part_diameter
Definition: vtk_mod.f:246
mpi_comm_des::desmpi_gatherv
subroutine desmpi_gatherv(ptype, pdebug)
Definition: mpi_comm_des_mod.f:198
vtk::buffer
character(len=512) buffer
Definition: vtk_mod.f:30
desmpi::irootbuf
integer, dimension(:), allocatable irootbuf
Definition: desmpi_mod.f:43
vtp::vtp_close_file
subroutine vtp_close_file
Definition: vtp_mod.f:364
vtk::vtk_data
character(len=1), dimension(dimension_vtk) vtk_data
Definition: vtk_mod.f:99
error_manager::init_err_msg
subroutine init_err_msg(CALLER)
Definition: error_manager_mod.f:171
vtk::frame
integer, dimension(dimension_vtk) frame
Definition: vtk_mod.f:102
vtk::vtk_part_x_s
logical, dimension(dimension_vtk, 100) vtk_part_x_s
Definition: vtk_mod.f:264
vtp::fname_vtp
character(len=511) fname_vtp
Definition: vtp_mod.f:21
des_thermo
Definition: des_thermo_mod.f:9
mpi_utility::global_all_max
Definition: mpi_utility_mod.f:110
vtk::vtk_region
integer vtk_region
Definition: vtk_mod.f:86
cdist
Definition: cdist_mod.f:2
vtk::vtk_y_s
double precision, dimension(dimension_vtk) vtk_y_s
Definition: vtk_mod.f:117
vtk::vtu_offset
integer vtu_offset
Definition: vtk_mod.f:76
run::run_type
character(len=16) run_type
Definition: run_mod.f:33
desmpi::iprocbuf
integer, dimension(:), allocatable iprocbuf
Definition: desmpi_mod.f:44
vtk::vtk_part_cohesion
logical, dimension(dimension_vtk) vtk_part_cohesion
Definition: vtk_mod.f:267
vtk::vtk_part_temp
logical, dimension(dimension_vtk) vtk_part_temp
Definition: vtk_mod.f:261
mpi_utility::global_sum
Definition: mpi_utility_mod.f:60
vtk::vtk_part_angular_vel
logical, dimension(dimension_vtk) vtk_part_angular_vel
Definition: vtk_mod.f:252
vtk::end_rec
character(len=1), parameter end_rec
Definition: vtk_mod.f:32
mpi_utility::global_all_sum
Definition: mpi_utility_mod.f:66
run
Definition: run_mod.f:13
vtp
Definition: vtp_mod.f:1
vtk::vtk_part_usr_var
logical, dimension(dimension_vtk, 3) vtk_part_usr_var
Definition: vtk_mod.f:258
vtk::number_of_points
integer number_of_points
Definition: vtk_mod.f:41
vtp::vtp_write_data
Definition: vtp_mod.f:23
vtp::add_vtp_to_pvd
subroutine add_vtp_to_pvd
Definition: vtp_mod.f:380
desmpi::idispls
integer, dimension(:), allocatable idispls
Definition: desmpi_mod.f:46
desmpi::igath_sendcnt
integer igath_sendcnt
Definition: desmpi_mod.f:51
vtp::vtp_write_element
subroutine vtp_write_element(ELEMENT)
Definition: vtp_mod.f:219
vtk::vtk_z_b
double precision, dimension(dimension_vtk) vtk_z_b
Definition: vtk_mod.f:123
error_manager::err_msg
character(len=line_length), dimension(line_count) err_msg
Definition: error_manager_mod.f:29
vtk::vtk_nys
integer, dimension(dimension_vtk) vtk_nys
Definition: vtk_mod.f:132
vtp::open_vtp_file_bin
subroutine open_vtp_file_bin(MODE)
Definition: vtp_mod.f:690
vtp::vtp_write_dp1
subroutine vtp_write_dp1(NAME, DATA)
Definition: vtp_mod.f:39
mpi_comm_des
Definition: mpi_comm_des_mod.f:16
error_manager
Definition: error_manager_mod.f:8
vtp::des_unit
integer des_unit
Definition: vtp_mod.f:15
vtk::vtk_filebase
character(len=255), dimension(dimension_vtk) vtk_filebase
Definition: vtk_mod.f:144
vtk::vtu_frame_unit
integer vtu_frame_unit
Definition: vtk_mod.f:36
vtk::vtk_z_t
double precision, dimension(dimension_vtk) vtk_z_t
Definition: vtk_mod.f:126
vtk::belongs_to_vtk_subdomain
logical, dimension(:), allocatable belongs_to_vtk_subdomain
Definition: vtk_mod.f:78
desmpi::drootbuf
double precision, dimension(:), allocatable drootbuf
Definition: desmpi_mod.f:41
vtk::dimension_vtk
integer, parameter dimension_vtk
Definition: vtk_mod.f:81
vtp::close_vtp_file_bin
subroutine close_vtp_file_bin(MODE)
Definition: vtp_mod.f:1474
vtp::write_vector_in_vtp_bin
subroutine write_vector_in_vtp_bin(VAR_NAME, VAR, PASS)
Definition: vtp_mod.f:1305
run::time
double precision time
Definition: run_mod.f:45
vtp::pvd_unit
integer, parameter pvd_unit
Definition: vtp_mod.f:18
vtk::vtk_x_w
double precision, dimension(dimension_vtk) vtk_x_w
Definition: vtk_mod.f:111
vtp::setup_vtk_region_particles
subroutine setup_vtk_region_particles
Definition: vtp_mod.f:1556
param1::zero
double precision, parameter zero
Definition: param1_mod.f:27
error_manager::flush_err_msg
subroutine flush_err_msg(DEBUG, HEADER, FOOTER, ABORT, LOG, CALL_TREE)
Definition: error_manager_mod.f:305
vtk::vtk_nzs
integer, dimension(dimension_vtk) vtk_nzs
Definition: vtk_mod.f:135
vtk::vtu_frame_filename
character(len=255) vtu_frame_filename
Definition: vtk_mod.f:29
vtk::vtu_unit
integer vtu_unit
Definition: vtk_mod.f:35