MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_data_output.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
2!>
3!! @file
4!! @brief Contains module m_data_output
5
6!> @brief Writes post-processed grid and flow-variable data to Silo-HDF5 or binary database files
8
12 use m_mpi_proxy
14 use m_helper
17
18 implicit none
19
26
27 ! Include Silo-HDF5 interface library
28 include 'silo_f9x.inc'
29
30 !> Output workspace: flow variable buffers, VisIt extents/offsets, directory paths, file handles, and variable count.
32
33 ! Generic error flag for Silo-HDF5 and Binary I/O operations
34 integer, private :: err
35
36contains
37
38 !> Allocate storage arrays, configure output directories, and count flow variables for formatted database output.
40
41 character(LEN=len_trim(case_dir) + 2*name_len) :: file_loc
42 logical :: dir_check
43 integer :: i
44
45 allocate (out%q_sf(-offset_x%beg:m + offset_x%end,-offset_y%beg:n + offset_y%end,-offset_z%beg:p + offset_z%end))
46 if (grid_geometry == 3) then
47 allocate (out%cyl_q_sf(-offset_y%beg:n + offset_y%end,-offset_z%beg:p + offset_z%end,-offset_x%beg:m + offset_x%end))
48 end if
49
50 if (precision == precision_single) then
51 allocate (out%q_sf_s(-offset_x%beg:m + offset_x%end,-offset_y%beg:n + offset_y%end,-offset_z%beg:p + offset_z%end))
52 if (grid_geometry == 3) then
53 allocate (out%cyl_q_sf_s(-offset_y%beg:n + offset_y%end,-offset_z%beg:p + offset_z%end, &
54 & -offset_x%beg:m + offset_x%end))
55 end if
56 end if
57
58 if (n == 0) then
59 allocate (out%q_root_sf(0:m_root,0:0,0:0))
60 if (precision == precision_single) then
61 allocate (out%q_root_sf_s(0:m_root,0:0,0:0))
62 end if
63 end if
64
65 ! Allocating the spatial and data extents and also the variables for the offsets and the one bookkeeping the number of
66 ! cell-boundaries in each active coordinate direction. Note that all these variables are only needed by the Silo-HDF5 format
67 ! for multidimensional data.
68 if (format == format_silo) then
69 allocate (out%data_extents(1:2,0:num_procs - 1))
70
71 if (p > 0) then
72 allocate (out%spatial_extents(1:6,0:num_procs - 1))
73 allocate (out%lo_offset(1:3))
74 allocate (out%hi_offset(1:3))
75 allocate (out%dims(1:3))
76 else if (n > 0) then
77 allocate (out%spatial_extents(1:4,0:num_procs - 1))
78 allocate (out%lo_offset(1:2))
79 allocate (out%hi_offset(1:2))
80 allocate (out%dims(1:2))
81 else
82 allocate (out%spatial_extents(1:2,0:num_procs - 1))
83 allocate (out%lo_offset(1:1))
84 allocate (out%hi_offset(1:1))
85 allocate (out%dims(1:1))
86 end if
87 end if
88
89 ! The size of the ghost zone layer in each of the active coordinate directions was set in the module m_mpi_proxy.f90. The
90 ! results are now transferred to the local variables of this module when they are required by the Silo-HDF5 format, for
91 ! multidimensional data sets. With the same, latter, requirements, the variables bookkeeping the number of cell-boundaries
92 ! in each active coordinate direction are also set here.
93 if (format == format_silo) then
94 if (p > 0) then
95 if (grid_geometry == 3) then
96 out%lo_offset(:) = (/offset_y%beg, offset_z%beg, offset_x%beg/)
97 out%hi_offset(:) = (/offset_y%end, offset_z%end, offset_x%end/)
98 else
99 out%lo_offset(:) = (/offset_x%beg, offset_y%beg, offset_z%beg/)
100 out%hi_offset(:) = (/offset_x%end, offset_y%end, offset_z%end/)
101 end if
102
103 if (grid_geometry == 3) then
104 out%dims(:) = (/n + offset_y%beg + offset_y%end + 2, p + offset_z%beg + offset_z%end + 2, &
105 & m + offset_x%beg + offset_x%end + 2/)
106 else
107 out%dims(:) = (/m + offset_x%beg + offset_x%end + 2, n + offset_y%beg + offset_y%end + 2, &
108 & p + offset_z%beg + offset_z%end + 2/)
109 end if
110 else if (n > 0) then
111 out%lo_offset(:) = (/offset_x%beg, offset_y%beg/)
112 out%hi_offset(:) = (/offset_x%end, offset_y%end/)
113
114 out%dims(:) = (/m + offset_x%beg + offset_x%end + 2, n + offset_y%beg + offset_y%end + 2/)
115 else
116 out%lo_offset(:) = (/offset_x%beg/)
117 out%hi_offset(:) = (/offset_x%end/)
118 out%dims(:) = (/m + offset_x%beg + offset_x%end + 2/)
119 end if
120 end if
121
122 if (format == format_silo) then
123 out%dbdir = trim(case_dir) // '/silo_hdf5'
124
125 write (out%proc_rank_dir, '(A,I0)') '/p', proc_rank
126
127 out%proc_rank_dir = trim(out%dbdir) // trim(out%proc_rank_dir)
128
129 file_loc = trim(out%proc_rank_dir) // '/.'
130
131 call my_inquire(file_loc, dir_check)
132 if (dir_check .neqv. .true.) then
133 call s_create_directory(trim(out%proc_rank_dir))
134 end if
135
136 if (proc_rank == 0) then
137 out%rootdir = trim(out%dbdir) // '/root'
138
139 file_loc = trim(out%rootdir) // '/.'
140
141 call my_inquire(file_loc, dir_check)
142 if (dir_check .neqv. .true.) then
143 call s_create_directory(trim(out%rootdir))
144 end if
145 end if
146 else
147 out%dbdir = trim(case_dir) // '/binary'
148
149 write (out%proc_rank_dir, '(A,I0)') '/p', proc_rank
150
151 out%proc_rank_dir = trim(out%dbdir) // trim(out%proc_rank_dir)
152
153 file_loc = trim(out%proc_rank_dir) // '/.'
154
155 call my_inquire(file_loc, dir_check)
156
157 if (dir_check .neqv. .true.) then
158 call s_create_directory(trim(out%proc_rank_dir))
159 end if
160
161 if (n == 0 .and. proc_rank == 0) then
162 out%rootdir = trim(out%dbdir) // '/root'
163
164 file_loc = trim(out%rootdir) // '/.'
165
166 call my_inquire(file_loc, dir_check)
167
168 if (dir_check .neqv. .true.) then
169 call s_create_directory(trim(out%rootdir))
170 end if
171 end if
172 end if
173
174 if (bubbles_lagrange) then ! Lagrangian solver
175 if (lag_txt_wrt) then
176 out%dbdir = trim(case_dir) // '/lag_bubbles_post_process'
177 file_loc = trim(out%dbdir) // '/.'
178 call my_inquire(file_loc, dir_check)
179
180 if (dir_check .neqv. .true.) then
181 call s_create_directory(trim(out%dbdir))
182 end if
183 end if
184 end if
185
186 ! Contrary to the Silo-HDF5 database format, handles of the Binary database master/root and slave/local process files are
187 ! perfectly static throughout post-process. Hence, they are set here so that they do not have to be repetitively computed in
188 ! later procedures.
189 if (format == format_binary) then
190 if (n == 0 .and. proc_rank == 0) out%dbroot = 2
191 out%dbfile = 1
192 end if
193
194 if (format == format_binary) then
195 out%dbvars = 0
196
197 if ((model_eqns == model_eqns_5eq) .or. (model_eqns == model_eqns_6eq)) then
198 do i = 1, num_fluids
199 if (alpha_rho_wrt(i) .or. (cons_vars_wrt .or. prim_vars_wrt)) then
200 out%dbvars = out%dbvars + 1
201 end if
202 end do
203 end if
204
205 if ((rho_wrt .or. (model_eqns == model_eqns_gamma_law .and. (cons_vars_wrt .or. prim_vars_wrt))) &
206 & .and. (.not. relativity)) then
207 out%dbvars = out%dbvars + 1
208 end if
209
210 if (relativity .and. (rho_wrt .or. prim_vars_wrt)) out%dbvars = out%dbvars + 1
211 if (relativity .and. (rho_wrt .or. cons_vars_wrt)) out%dbvars = out%dbvars + 1
212
213 do i = 1, eqn_idx%E - eqn_idx%mom%beg
214 if (mom_wrt(i) .or. cons_vars_wrt) out%dbvars = out%dbvars + 1
215 end do
216
217 do i = 1, eqn_idx%E - eqn_idx%mom%beg
218 if (vel_wrt(i) .or. prim_vars_wrt) out%dbvars = out%dbvars + 1
219 end do
220
221 do i = 1, eqn_idx%E - eqn_idx%mom%beg
222 if (flux_wrt(i)) out%dbvars = out%dbvars + 1
223 end do
224
225 if (e_wrt .or. cons_vars_wrt) out%dbvars = out%dbvars + 1
226 if (pres_wrt .or. prim_vars_wrt) out%dbvars = out%dbvars + 1
227 if (hypoelasticity) out%dbvars = out%dbvars + (num_dims*(num_dims + 1))/2
228 if (cont_damage) out%dbvars = out%dbvars + 1
229 if (hyper_cleaning) out%dbvars = out%dbvars + 1
230
231 if (mhd) then
232 if (n == 0) then
233 out%dbvars = out%dbvars + 2
234 else
235 out%dbvars = out%dbvars + 3
236 end if
237 end if
238
239 if ((model_eqns == model_eqns_5eq) .or. (model_eqns == model_eqns_6eq)) then
240 do i = 1, num_fluids - 1
241 if (alpha_wrt(i) .or. (cons_vars_wrt .or. prim_vars_wrt)) then
242 out%dbvars = out%dbvars + 1
243 end if
244 end do
245
246 if (alpha_wrt(num_fluids) .or. (cons_vars_wrt .or. prim_vars_wrt)) then
247 out%dbvars = out%dbvars + 1
248 end if
249 end if
250
251 if (gamma_wrt .or. (model_eqns == model_eqns_gamma_law .and. (cons_vars_wrt .or. prim_vars_wrt))) then
252 out%dbvars = out%dbvars + 1
253 end if
254
255 if (heat_ratio_wrt) out%dbvars = out%dbvars + 1
256
257 if (pi_inf_wrt .or. (model_eqns == model_eqns_gamma_law .and. (cons_vars_wrt .or. prim_vars_wrt))) then
258 out%dbvars = out%dbvars + 1
259 end if
260
261 if (pres_inf_wrt) out%dbvars = out%dbvars + 1
262 if (c_wrt) out%dbvars = out%dbvars + 1
263
264 if (p > 0) then
265 do i = 1, num_vels
266 if (omega_wrt(i)) out%dbvars = out%dbvars + 1
267 end do
268 else if (n > 0) then
269 do i = 1, num_vels
270 if (omega_wrt(i)) out%dbvars = out%dbvars + 1
271 end do
272 end if
273
274 if (schlieren_wrt) out%dbvars = out%dbvars + 1
275 end if
276
278
279 !> Compute the cell-index bounds for the user-specified partial output domain in each coordinate direction.
280 impure subroutine s_define_output_region
281
282 integer :: i
283 integer :: lower_bound, upper_bound
284
285# 285 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
286 if (m == 0) return ! Early return for y or z if simulation is 1D or 2D
287
288 lower_bound = -offset_x%beg
289 upper_bound = m + offset_x%end
290
291 do i = lower_bound, upper_bound
292 if (x_cc(i) > x_output%beg) then
293 x_output_idx%beg = i + offset_x%beg
294 exit
295 end if
296 end do
297
298 do i = upper_bound, lower_bound, -1
299 if (x_cc(i) < x_output%end) then
300 x_output_idx%end = i + offset_x%beg
301 exit
302 end if
303 end do
304
305 ! If no grid points are within the output region
306 if ((x_cc(lower_bound) > x_output%end) .or. (x_cc(upper_bound) < x_output%beg)) then
307 x_output_idx%beg = 0
308 x_output_idx%end = 0
309 end if
310# 285 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
311 if (n == 0) return ! Early return for y or z if simulation is 1D or 2D
312
313 lower_bound = -offset_y%beg
314 upper_bound = n + offset_y%end
315
316 do i = lower_bound, upper_bound
317 if (y_cc(i) > y_output%beg) then
318 y_output_idx%beg = i + offset_y%beg
319 exit
320 end if
321 end do
322
323 do i = upper_bound, lower_bound, -1
324 if (y_cc(i) < y_output%end) then
325 y_output_idx%end = i + offset_y%beg
326 exit
327 end if
328 end do
329
330 ! If no grid points are within the output region
331 if ((y_cc(lower_bound) > y_output%end) .or. (y_cc(upper_bound) < y_output%beg)) then
332 y_output_idx%beg = 0
333 y_output_idx%end = 0
334 end if
335# 285 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
336 if (p == 0) return ! Early return for y or z if simulation is 1D or 2D
337
338 lower_bound = -offset_z%beg
339 upper_bound = p + offset_z%end
340
341 do i = lower_bound, upper_bound
342 if (z_cc(i) > z_output%beg) then
343 z_output_idx%beg = i + offset_z%beg
344 exit
345 end if
346 end do
347
348 do i = upper_bound, lower_bound, -1
349 if (z_cc(i) < z_output%end) then
350 z_output_idx%end = i + offset_z%beg
351 exit
352 end if
353 end do
354
355 ! If no grid points are within the output region
356 if ((z_cc(lower_bound) > z_output%end) .or. (z_cc(upper_bound) < z_output%beg)) then
357 z_output_idx%beg = 0
358 z_output_idx%end = 0
359 end if
360# 310 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
361
362 end subroutine s_define_output_region
363
364 !> Open (or create) the Silo-HDF5 or Binary formatted database slave and master files for a given time step.
365 impure subroutine s_open_formatted_database_file(t_step)
366
367 integer, intent(in) :: t_step
368 character(LEN=len_trim(case_dir) + 3*name_len) :: file_loc
369 integer :: ierr
370
371 if (format == format_silo) then
372 write (file_loc, '(A,I0,A)') '/', t_step, '.silo'
373 file_loc = trim(out%proc_rank_dir) // trim(file_loc)
374
375 ierr = dbcreate(trim(file_loc), len_trim(file_loc), db_clobber, db_local, 'MFC v3.0', 8, db_hdf5, out%dbfile)
376
377 if (out%dbfile == -1) then
378 call s_mpi_abort('Unable to create Silo-HDF5 database ' // 'slave file ' // trim(file_loc) // '. ' // 'Exiting.')
379 end if
380
381 if (proc_rank == 0) then
382 write (file_loc, '(A,I0,A)') '/collection_', t_step, '.silo'
383 file_loc = trim(out%rootdir) // trim(file_loc)
384
385 ierr = dbcreate(trim(file_loc), len_trim(file_loc), db_clobber, db_local, 'MFC v3.0', 8, db_hdf5, out%dbroot)
386
387 if (out%dbroot == -1) then
388 call s_mpi_abort('Unable to create Silo-HDF5 database ' // 'master file ' // trim(file_loc) // '. ' &
389 & // 'Exiting.')
390 end if
391 end if
392 else
393 write (file_loc, '(A,I0,A)') '/', t_step, '.dat'
394 file_loc = trim(out%proc_rank_dir) // trim(file_loc)
395
396 open (out%dbfile, iostat=err, file=trim(file_loc), form='unformatted', status='replace')
397
398 if (err /= 0) then
399 call s_mpi_abort('Unable to create Binary database slave ' // 'file ' // trim(file_loc) // '. Exiting.')
400 end if
401
402 if (output_partial_domain) then
403 write (out%dbfile) x_output_idx%end - x_output_idx%beg, y_output_idx%end - y_output_idx%beg, &
404 & z_output_idx%end - z_output_idx%beg, out%dbvars
405 else
406 write (out%dbfile) m, n, p, out%dbvars
407 end if
408
409 if (n == 0 .and. proc_rank == 0) then
410 write (file_loc, '(A,I0,A)') '/', t_step, '.dat'
411 file_loc = trim(out%rootdir) // trim(file_loc)
412
413 open (out%dbroot, iostat=err, file=trim(file_loc), form='unformatted', status='replace')
414
415 if (err /= 0) then
416 call s_mpi_abort('Unable to create Binary database ' // 'master file ' // trim(file_loc) // '. Exiting.')
417 end if
418
419 if (output_partial_domain) then
420 write (out%dbroot) x_output_idx%end - x_output_idx%beg, 0, 0, out%dbvars
421 else
422 write (out%dbroot) m_root, 0, 0, out%dbvars
423 end if
424 end if
425 end if
426
427 end subroutine s_open_formatted_database_file
428
429 !> Open the interface data file for appending extracted interface coordinates.
430 impure subroutine s_open_intf_data_file()
431
432 character(LEN=path_len + 3*name_len) :: file_path
433
434 write (file_path, '(A)') '/intf_data.dat'
435 file_path = trim(case_dir) // trim(file_path)
436
437 open (211, file=trim(file_path), form='formatted', position='append', status='unknown')
438
439 end subroutine s_open_intf_data_file
440
441 !> Open the energy data file for appending volume-integrated energy budget quantities.
442 impure subroutine s_open_energy_data_file()
443
444 character(LEN=path_len + 3*name_len) :: file_path
445
446 write (file_path, '(A)') '/eng_data.dat'
447 file_path = trim(case_dir) // trim(file_path)
448
449 open (251, file=trim(file_path), form='formatted', position='append', status='unknown')
450
451 end subroutine s_open_energy_data_file
452
453 !> Write the computational grid (cell-boundary coordinates) to the formatted database slave and master files.
455
456 integer, intent(in) :: t_step
457
458 ! NAG compiler requires these to be statically sized
459 character(LEN=4*name_len), dimension(num_procs) :: meshnames
460 integer, dimension(num_procs) :: meshtypes
461 integer :: i
462 integer :: ierr
463
464 if (format == format_silo) then
465 ! For multidimensional data sets, the spatial extents of all of the grid(s) handled by the local processor(s) are
466 ! recorded so that they may be written, by root processor, to the formatted database master file.
467 if (num_procs > 1) then
468 call s_mpi_gather_spatial_extents(out%spatial_extents)
469 else if (p > 0) then
470 if (grid_geometry == 3) then
471 out%spatial_extents(:,0) = (/minval(y_cb), minval(z_cb), minval(x_cb), maxval(y_cb), maxval(z_cb), &
472 & maxval(x_cb)/)
473 else
474 out%spatial_extents(:,0) = (/minval(x_cb), minval(y_cb), minval(z_cb), maxval(x_cb), maxval(y_cb), &
475 & maxval(z_cb)/)
476 end if
477 else if (n > 0) then
478 out%spatial_extents(:,0) = (/minval(x_cb), minval(y_cb), maxval(x_cb), maxval(y_cb)/)
479 else
480 out%spatial_extents(:,0) = (/minval(x_cb), maxval(x_cb)/)
481 end if
482
483 ! Next, the root processor proceeds to record all of the spatial extents in the formatted database master file. In
484 ! addition, it also records a sub-domain connectivity map so that the entire grid may be reassembled by looking at the
485 ! master file.
486 if (proc_rank == 0) then
487 do i = 1, num_procs
488 write (meshnames(i), '(A,I0,A,I0,A)') '../p', i - 1, '/', t_step, '.silo:rectilinear_grid'
489 end do
490
491 meshtypes = db_quad_rect
492
493 err = dbset2dstrlen(len(meshnames(1)))
494 err = dbmkoptlist(2, out%optlist)
495 err = dbaddiopt(out%optlist, dbopt_extents_size, size(out%spatial_extents, 1))
496 err = dbadddopt(out%optlist, dbopt_extents, out%spatial_extents)
497 err = dbputmmesh(out%dbroot, 'rectilinear_grid', 16, num_procs, meshnames, len_trim(meshnames), meshtypes, &
498 & out%optlist, ierr)
499 err = dbfreeoptlist(out%optlist)
500 end if
501
502 ! Finally, the local quadrilateral mesh, either 2D or 3D, along with its offsets that indicate the presence and size of
503 ! ghost zone layer(s), are put in the formatted database slave file.
504
505 if (p > 0) then
506 err = dbmkoptlist(2, out%optlist)
507 err = dbaddiaopt(out%optlist, dbopt_lo_offset, size(out%lo_offset), out%lo_offset)
508 err = dbaddiaopt(out%optlist, dbopt_hi_offset, size(out%hi_offset), out%hi_offset)
509 if (grid_geometry == 3) then
510 err = dbputqm(out%dbfile, 'rectilinear_grid', 16, 'x', 1, 'y', 1, 'z', 1, y_cb, z_cb, x_cb, out%dims, 3, &
511 & db_double, db_collinear, out%optlist, ierr)
512 else
513 err = dbputqm(out%dbfile, 'rectilinear_grid', 16, 'x', 1, 'y', 1, 'z', 1, x_cb, y_cb, z_cb, out%dims, 3, &
514 & db_double, db_collinear, out%optlist, ierr)
515 end if
516 err = dbfreeoptlist(out%optlist)
517 else if (n > 0) then
518 err = dbmkoptlist(2, out%optlist)
519 err = dbaddiaopt(out%optlist, dbopt_lo_offset, size(out%lo_offset), out%lo_offset)
520 err = dbaddiaopt(out%optlist, dbopt_hi_offset, size(out%hi_offset), out%hi_offset)
521 err = dbputqm(out%dbfile, 'rectilinear_grid', 16, 'x', 1, 'y', 1, 'z', 1, x_cb, y_cb, db_f77null, out%dims, 2, &
522 & db_double, db_collinear, out%optlist, ierr)
523 err = dbfreeoptlist(out%optlist)
524 else
525 err = dbmkoptlist(2, out%optlist)
526 err = dbaddiaopt(out%optlist, dbopt_lo_offset, size(out%lo_offset), out%lo_offset)
527 err = dbaddiaopt(out%optlist, dbopt_hi_offset, size(out%hi_offset), out%hi_offset)
528 err = dbputqm(out%dbfile, 'rectilinear_grid', 16, 'x', 1, 'y', 1, 'z', 1, x_cb, db_f77null, db_f77null, out%dims, &
529 & 1, db_double, db_collinear, out%optlist, ierr)
530 err = dbfreeoptlist(out%optlist)
531 end if
532 else if (format == format_binary) then
533 ! Multidimensional local grid data is written to the formatted database slave file. Recall that no master file to
534 ! maintained in multidimensions.
535 if (p > 0) then
536 if (precision == precision_single) then
537 write (out%dbfile) real(x_cb, sp), real(y_cb, sp), real(z_cb, sp)
538 else
539 if (output_partial_domain) then
540 write (out%dbfile) x_cb(x_output_idx%beg - 1:x_output_idx%end), &
541 & y_cb(y_output_idx%beg - 1:y_output_idx%end), z_cb(z_output_idx%beg - 1:z_output_idx%end)
542 else
543 write (out%dbfile) x_cb, y_cb, z_cb
544 end if
545 end if
546 else if (n > 0) then
547 if (precision == precision_single) then
548 write (out%dbfile) real(x_cb, sp), real(y_cb, sp)
549 else
550 if (output_partial_domain) then
551 write (out%dbfile) x_cb(x_output_idx%beg - 1:x_output_idx%end), y_cb(y_output_idx%beg - 1:y_output_idx%end)
552 else
553 write (out%dbfile) x_cb, y_cb
554 end if
555 end if
556
557 ! One-dimensional local grid data is written to the formatted database slave file. In addition, the local grid data
558 ! is put together by the root process and written to the master file.
559 else
560 if (precision == precision_single) then
561 write (out%dbfile) real(x_cb, sp)
562 else
563 if (output_partial_domain) then
564 write (out%dbfile) x_cb(x_output_idx%beg - 1:x_output_idx%end)
565 else
566 write (out%dbfile) x_cb
567 end if
568 end if
569
570 if (num_procs > 1) then
572 else
573 x_root_cb(:) = x_cb(:)
574 end if
575
576 if (proc_rank == 0) then
577 if (precision == precision_single) then
578 write (out%dbroot) real(x_root_cb, wp)
579 else
580 if (output_partial_domain) then
581 write (out%dbroot) x_root_cb(x_output_idx%beg - 1:x_output_idx%end)
582 else
583 write (out%dbroot) x_root_cb
584 end if
585 end if
586 end if
587 end if
588 end if
589
591
592 !> Write a single flow variable field to the formatted database slave and master files for a given time step.
593 impure subroutine s_write_variable_to_formatted_database_file(varname, t_step)
594
595 character(LEN=*), intent(in) :: varname
596 integer, intent(in) :: t_step
597
598 ! NAG compiler requires these to be statically sized
599 character(LEN=4*name_len), dimension(num_procs) :: varnames
600 integer, dimension(num_procs) :: vartypes
601 integer :: i, j, k
602 integer :: ierr
603
604 if (format == format_silo) then
605 ! Determining the extents of the flow variable on each local process and gathering all this information on root process
606 if (num_procs > 1) then
607 call s_mpi_gather_data_extents(out%q_sf, out%data_extents)
608 else
609 out%data_extents(:,0) = (/minval(out%q_sf), maxval(out%q_sf)/)
610 end if
611
612 if (proc_rank == 0) then
613 do i = 1, num_procs
614 write (varnames(i), '(A,I0,A,I0,A)') '../p', i - 1, '/', t_step, '.silo:' // trim(varname)
615 end do
616
617 vartypes = db_quadvar
618
619 err = dbset2dstrlen(len(varnames(1)))
620 err = dbmkoptlist(2, out%optlist)
621 err = dbaddiopt(out%optlist, dbopt_extents_size, 2)
622 err = dbadddopt(out%optlist, dbopt_extents, out%data_extents)
623 err = dbputmvar(out%dbroot, trim(varname), len_trim(varname), num_procs, varnames, len_trim(varnames), vartypes, &
624 & out%optlist, ierr)
625 err = dbfreeoptlist(out%optlist)
626 end if
627
628 if (wp == dp) then
629 if (precision == precision_single) then
630 do i = -offset_x%beg, m + offset_x%end
631 do j = -offset_y%beg, n + offset_y%end
632 do k = -offset_z%beg, p + offset_z%end
633 out%q_sf_s(i, j, k) = real(out%q_sf(i, j, k), sp)
634 end do
635 end do
636 end do
637 if (grid_geometry == 3) then
638 do i = -offset_x%beg, m + offset_x%end
639 do j = -offset_y%beg, n + offset_y%end
640 do k = -offset_z%beg, p + offset_z%end
641 out%cyl_q_sf_s(j, k, i) = out%q_sf_s(i, j, k)
642 end do
643 end do
644 end do
645 end if
646 else
647 if (grid_geometry == 3) then
648 do i = -offset_x%beg, m + offset_x%end
649 do j = -offset_y%beg, n + offset_y%end
650 do k = -offset_z%beg, p + offset_z%end
651 out%cyl_q_sf(j, k, i) = out%q_sf(i, j, k)
652 end do
653 end do
654 end do
655 end if
656 end if
657 else if (wp == sp) then
658 do i = -offset_x%beg, m + offset_x%end
659 do j = -offset_y%beg, n + offset_y%end
660 do k = -offset_z%beg, p + offset_z%end
661 out%q_sf_s(i, j, k) = out%q_sf(i, j, k)
662 end do
663 end do
664 end do
665 if (grid_geometry == 3) then
666 do i = -offset_x%beg, m + offset_x%end
667 do j = -offset_y%beg, n + offset_y%end
668 do k = -offset_z%beg, p + offset_z%end
669 out%cyl_q_sf_s(j, k, i) = out%q_sf_s(i, j, k)
670 end do
671 end do
672 end do
673 end if
674 end if
675
676# 626 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
677 if (precision == 1) then
678 if (p > 0) then
679 if (grid_geometry == 3) then
680 err = dbputqv1(out%dbfile, trim(varname), len_trim(varname), 'rectilinear_grid', 16, &
681 & out%cyl_q_sf_s, out%dims - 1, 3, db_f77null, 0, db_float, db_zonecent, &
682 & db_f77null, ierr)
683 else
684 err = dbputqv1(out%dbfile, trim(varname), len_trim(varname), 'rectilinear_grid', 16, out%q_sf_s, &
685 & out%dims - 1, 3, db_f77null, 0, db_float, db_zonecent, db_f77null, ierr)
686 end if
687 else if (n > 0) then
688 err = dbputqv1(out%dbfile, trim(varname), len_trim(varname), 'rectilinear_grid', 16, out%q_sf_s, &
689 & out%dims - 1, 2, db_f77null, 0, db_float, db_zonecent, db_f77null, ierr)
690 else
691 err = dbputqv1(out%dbfile, trim(varname), len_trim(varname), 'rectilinear_grid', 16, out%q_sf_s, &
692 & out%dims - 1, 1, db_f77null, 0, db_float, db_zonecent, db_f77null, ierr)
693 end if
694 end if
695# 626 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
696 if (precision == 2) then
697 if (p > 0) then
698 if (grid_geometry == 3) then
699 err = dbputqv1(out%dbfile, trim(varname), len_trim(varname), 'rectilinear_grid', 16, &
700 & out%cyl_q_sf, out%dims - 1, 3, db_f77null, 0, db_double, db_zonecent, &
701 & db_f77null, ierr)
702 else
703 err = dbputqv1(out%dbfile, trim(varname), len_trim(varname), 'rectilinear_grid', 16, out%q_sf, &
704 & out%dims - 1, 3, db_f77null, 0, db_double, db_zonecent, db_f77null, ierr)
705 end if
706 else if (n > 0) then
707 err = dbputqv1(out%dbfile, trim(varname), len_trim(varname), 'rectilinear_grid', 16, out%q_sf, &
708 & out%dims - 1, 2, db_f77null, 0, db_double, db_zonecent, db_f77null, ierr)
709 else
710 err = dbputqv1(out%dbfile, trim(varname), len_trim(varname), 'rectilinear_grid', 16, out%q_sf, &
711 & out%dims - 1, 1, db_f77null, 0, db_double, db_zonecent, db_f77null, ierr)
712 end if
713 end if
714# 645 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
715 else
716 ! Writing the name of the flow variable and its data, associated with the local processor, to the formatted database
717 ! slave file
718 if (precision == precision_single) then
719 write (out%dbfile) varname, real(out%q_sf, wp)
720 else
721 write (out%dbfile) varname, out%q_sf
722 end if
723
724 ! In 1D, the root process also takes care of gathering the flow variable data from all of the local processor(s) and
725 ! writes it to the formatted database master file.
726 if (n == 0) then
727 if (num_procs > 1) then
728 call s_mpi_defragment_1d_flow_variable(out%q_sf, out%q_root_sf)
729 else
730 out%q_root_sf(:,:,:) = out%q_sf(:,:,:)
731 end if
732
733 if (proc_rank == 0) then
734 if (precision == precision_single) then
735 write (out%dbroot) varname, real(out%q_root_sf, wp)
736 else
737 write (out%dbroot) varname, out%q_root_sf
738 end if
739 end if
740 end if
741 end if
742
744
745 !> Write the post-processed results in the folder 'lag_bubbles_data'
746 impure subroutine s_write_lag_bubbles_results_to_text(t_step)
747
748 integer, intent(in) :: t_step
749 character(len=len_trim(case_dir) + 3*name_len) :: file_loc
750 integer :: id
751
752#ifdef MFC_MPI
753 real(wp), dimension(20) :: inputvals
754 real(wp) :: time_real
755 integer, dimension(MPI_STATUS_SIZE) :: status
756 integer(KIND=MPI_OFFSET_KIND) :: disp
757 integer :: view
758 logical :: file_exist
759 integer, dimension(2) :: gsizes, lsizes, start_idx_part
760 integer :: ifile
761 integer :: ierr
762 real(wp) :: file_time, file_dt
763 integer :: file_num_procs, file_tot_part
764 integer :: i
765 integer, dimension(:), allocatable :: proc_bubble_counts
766 real(wp), dimension(1:1,1:lag_io_vars) :: lag_io_null
767
768 lag_io_null = 0._wp
769
770 ! Construct file path
771 write (file_loc, '(A,I0,A)') 'lag_bubbles_', t_step, '.dat'
772 file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // trim(file_loc)
773
774 ! Check if file exists
775 inquire (file=trim(file_loc), exist=file_exist)
776 if (.not. file_exist) then
777 call s_mpi_abort('Restart file ' // trim(file_loc) // ' does not exist!')
778 end if
779
780 if (.not. parallel_io) return
781
782 if (proc_rank == 0) then
783 call mpi_file_open(mpi_comm_self, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
784
785 call mpi_file_read(ifile, file_tot_part, 1, mpi_integer, status, ierr)
786 call mpi_file_read(ifile, file_time, 1, mpi_p, status, ierr)
787 call mpi_file_read(ifile, file_dt, 1, mpi_p, status, ierr)
788 call mpi_file_read(ifile, file_num_procs, 1, mpi_integer, status, ierr)
789
790 call mpi_file_close(ifile, ierr)
791 end if
792
793 call mpi_bcast(file_tot_part, 1, mpi_integer, 0, mpi_comm_world, ierr)
794 call mpi_bcast(file_time, 1, mpi_p, 0, mpi_comm_world, ierr)
795 call mpi_bcast(file_dt, 1, mpi_p, 0, mpi_comm_world, ierr)
796 call mpi_bcast(file_num_procs, 1, mpi_integer, 0, mpi_comm_world, ierr)
797 time_real = file_time
798
799 allocate (proc_bubble_counts(file_num_procs))
800
801 if (proc_rank == 0) then
802 call mpi_file_open(mpi_comm_self, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
803
804 ! Skip to processor counts position
805 disp = int(sizeof(file_tot_part) + 2*sizeof(file_time) + sizeof(file_num_procs), mpi_offset_kind)
806 call mpi_file_seek(ifile, disp, mpi_seek_set, ierr)
807 call mpi_file_read(ifile, proc_bubble_counts, file_num_procs, mpi_integer, status, ierr)
808
809 call mpi_file_close(ifile, ierr)
810 end if
811
812 call mpi_bcast(proc_bubble_counts, file_num_procs, mpi_integer, 0, mpi_comm_world, ierr)
813
814 gsizes(1) = file_tot_part
815 gsizes(2) = lag_io_vars
816 lsizes(1) = file_tot_part
817 lsizes(2) = lag_io_vars
818 start_idx_part(1) = 0
819 start_idx_part(2) = 0
820
821 call mpi_type_create_subarray(2, gsizes, lsizes, start_idx_part, mpi_order_fortran, mpi_p, view, ierr)
822 call mpi_type_commit(view, ierr)
823
824 call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
825
826 disp = int(sizeof(file_tot_part) + 2*sizeof(file_time) + sizeof(file_num_procs) &
827 & + file_num_procs*sizeof(proc_bubble_counts(1)), mpi_offset_kind)
828 call mpi_file_set_view(ifile, disp, mpi_p, view, 'native', mpi_info_null, ierr)
829
830 allocate (mpi_io_data_lg_bubbles(file_tot_part,1:lag_io_vars))
831
832 call mpi_file_read_all(ifile, mpi_io_data_lg_bubbles, lag_io_vars*file_tot_part, mpi_p, status, ierr)
833
834 write (file_loc, '(A,I0,A)') 'lag_bubbles_post_process_', t_step, '.dat'
835 file_loc = trim(case_dir) // '/lag_bubbles_post_process/' // trim(file_loc)
836
837 if (proc_rank == 0) then
838 open (unit=29, file=file_loc, form='formatted', position='rewind')
839
840 if (lag_header) then
841 write (29, '(A)', advance='no')
842 if (lag_id_wrt) write (29, '(A8)', advance='no') 'id, '
843 if (lag_pos_wrt) write (29, '(3(A17))', advance='no') 'px, ', 'py, ', 'pz, '
844 if (lag_pos_prev_wrt) write (29, '(3(A17))', advance='no') 'pvx, ', 'pvy, ', 'pvz, '
845 if (lag_vel_wrt) write (29, '(3(A17))', advance='no') 'vx, ', 'vy, ', 'vz, '
846 if (lag_rad_wrt) write (29, '(A17)', advance='no') 'radius, '
847 if (lag_rvel_wrt) write (29, '(A17)', advance='no') 'rvel, '
848 if (lag_r0_wrt) write (29, '(A17)', advance='no') 'r0, '
849 if (lag_rmax_wrt) write (29, '(A17)', advance='no') 'rmax, '
850 if (lag_rmin_wrt) write (29, '(A17)', advance='no') 'rmin, '
851 if (lag_dphidt_wrt) write (29, '(A17)', advance='no') 'dphidt, '
852 if (lag_pres_wrt) write (29, '(A17)', advance='no') 'pressure, '
853 if (lag_mv_wrt) write (29, '(A17)', advance='no') 'mv, '
854 if (lag_mg_wrt) write (29, '(A17)', advance='no') 'mg, '
855 if (lag_betat_wrt) write (29, '(A17)', advance='no') 'betaT, '
856 if (lag_betac_wrt) write (29, '(A17)', advance='no') 'betaC, '
857 write (29, '(A15)') 'time'
858 end if
859
860 do i = 1, file_tot_part
861 id = int(mpi_io_data_lg_bubbles(i, 1))
862 inputvals(1:20) = mpi_io_data_lg_bubbles(i,2:21)
863 if (id > 0) then
864 write (29, '(100(A))', advance='no') ''
865 if (lag_id_wrt) write (29, '(I6, A)', advance='no') id, ', '
866 if (lag_pos_wrt) write (29, '(3(E15.7, A))', advance='no') inputvals(1), ', ', inputvals(2), ', ', &
867 & inputvals(3), ', '
868 if (lag_pos_prev_wrt) write (29, '(3(E15.7, A))', advance='no') inputvals(4), ', ', inputvals(5), ', ', &
869 & inputvals(6), ', '
870 if (lag_vel_wrt) write (29, '(3(E15.7, A))', advance='no') inputvals(7), ', ', inputvals(8), ', ', &
871 & inputvals(9), ', '
872 if (lag_rad_wrt) write (29, '(E15.7, A)', advance='no') inputvals(10), ', '
873 if (lag_rvel_wrt) write (29, '(E15.7, A)', advance='no') inputvals(11), ', '
874 if (lag_r0_wrt) write (29, '(E15.7, A)', advance='no') inputvals(12), ', '
875 if (lag_rmax_wrt) write (29, '(E15.7, A)', advance='no') inputvals(13), ', '
876 if (lag_rmin_wrt) write (29, '(E15.7, A)', advance='no') inputvals(14), ', '
877 if (lag_dphidt_wrt) write (29, '(E15.7, A)', advance='no') inputvals(15), ', '
878 if (lag_pres_wrt) write (29, '(E15.7, A)', advance='no') inputvals(16), ', '
879 if (lag_mv_wrt) write (29, '(E15.7, A)', advance='no') inputvals(17), ', '
880 if (lag_mg_wrt) write (29, '(E15.7, A)', advance='no') inputvals(18), ', '
881 if (lag_betat_wrt) write (29, '(E15.7, A)', advance='no') inputvals(19), ', '
882 if (lag_betac_wrt) write (29, '(E15.7, A)', advance='no') inputvals(20), ', '
883 write (29, '(E15.7)') time_real
884 end if
885 end do
886 close (29)
887 end if
888
889 deallocate (mpi_io_data_lg_bubbles)
890
891 call s_mpi_barrier()
892
893 call mpi_file_close(ifile, ierr)
894#endif
895
897
898 !> Read Lagrangian bubble restart data and write bubble positions and scalar fields to the Silo database.
900
901 integer, intent(in) :: t_step
902 character(len=len_trim(case_dir) + 3*name_len) :: file_loc
903 integer :: id
904
905#ifdef MFC_MPI
906 real(wp) :: time_real
907 integer, dimension(MPI_STATUS_SIZE) :: status
908 integer(KIND=MPI_OFFSET_KIND) :: disp
909 integer :: view
910 logical :: file_exist
911 integer, dimension(2) :: gsizes, lsizes, start_idx_part
912 integer :: ifile, ierr, nbub
913 real(wp) :: file_time, file_dt
914 integer :: file_num_procs, file_tot_part
915 integer, dimension(:), allocatable :: proc_bubble_counts
916 real(wp), dimension(1:1,1:lag_io_vars) :: dummy
917 character(LEN=4*name_len), dimension(num_procs) :: meshnames
918 integer, dimension(num_procs) :: meshtypes
919 real(wp) :: dummy_data
920 integer :: i
921 real(wp), dimension(:), allocatable :: bub_id
922 real(wp), dimension(:), allocatable :: px, py, pz, ppx, ppy, ppz, vx, vy, vz
923 real(wp), dimension(:), allocatable :: radius, rvel, rnot, rmax, rmin, dphidt
924 real(wp), dimension(:), allocatable :: pressure, mv, mg, betat, betac
925
926 dummy = 0._wp
927 dummy_data = 0._wp
928
929 ! Construct file path
930 write (file_loc, '(A,I0,A)') 'lag_bubbles_', t_step, '.dat'
931 file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // trim(file_loc)
932
933 ! Check if file exists
934 inquire (file=trim(file_loc), exist=file_exist)
935 if (.not. file_exist) then
936 call s_mpi_abort('Restart file ' // trim(file_loc) // ' does not exist!')
937 end if
938
939 if (.not. parallel_io) return
940
941 if (proc_rank == 0) then
942 call mpi_file_open(mpi_comm_self, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
943
944 call mpi_file_read(ifile, file_tot_part, 1, mpi_integer, status, ierr)
945 call mpi_file_read(ifile, file_time, 1, mpi_p, status, ierr)
946 call mpi_file_read(ifile, file_dt, 1, mpi_p, status, ierr)
947 call mpi_file_read(ifile, file_num_procs, 1, mpi_integer, status, ierr)
948
949 call mpi_file_close(ifile, ierr)
950 end if
951
952 call mpi_bcast(file_tot_part, 1, mpi_integer, 0, mpi_comm_world, ierr)
953 call mpi_bcast(file_time, 1, mpi_p, 0, mpi_comm_world, ierr)
954 call mpi_bcast(file_dt, 1, mpi_p, 0, mpi_comm_world, ierr)
955 call mpi_bcast(file_num_procs, 1, mpi_integer, 0, mpi_comm_world, ierr)
956 time_real = file_time
957
958 allocate (proc_bubble_counts(file_num_procs))
959
960 if (proc_rank == 0) then
961 call mpi_file_open(mpi_comm_self, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
962
963 ! Skip to processor counts position
964 disp = int(sizeof(file_tot_part) + 2*sizeof(file_time) + sizeof(file_num_procs), mpi_offset_kind)
965 call mpi_file_seek(ifile, disp, mpi_seek_set, ierr)
966 call mpi_file_read(ifile, proc_bubble_counts, file_num_procs, mpi_integer, status, ierr)
967
968 call mpi_file_close(ifile, ierr)
969 end if
970
971 call mpi_bcast(proc_bubble_counts, file_num_procs, mpi_integer, 0, mpi_comm_world, ierr)
972
973 ! Set time variables from file
974
975 nbub = proc_bubble_counts(proc_rank + 1)
976
977 start_idx_part(1) = 0
978 do i = 1, proc_rank
979 start_idx_part(1) = start_idx_part(1) + proc_bubble_counts(i)
980 end do
981
982 start_idx_part(2) = 0
983 lsizes(1) = nbub
984 lsizes(2) = lag_io_vars
985
986 gsizes(1) = file_tot_part
987 gsizes(2) = lag_io_vars
988
989 if (nbub > 0) then
990# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
991 allocate (bub_id(nbub))
992# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
993 allocate (px(nbub))
994# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
995 allocate (py(nbub))
996# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
997 allocate (pz(nbub))
998# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
999 allocate (ppx(nbub))
1000# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1001 allocate (ppy(nbub))
1002# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1003 allocate (ppz(nbub))
1004# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1005 allocate (vx(nbub))
1006# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1007 allocate (vy(nbub))
1008# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1009 allocate (vz(nbub))
1010# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1011 allocate (radius(nbub))
1012# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1013 allocate (rvel(nbub))
1014# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1015 allocate (rnot(nbub))
1016# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1017 allocate (rmax(nbub))
1018# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1019 allocate (rmin(nbub))
1020# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1021 allocate (dphidt(nbub))
1022# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1023 allocate (pressure(nbub))
1024# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1025 allocate (mv(nbub))
1026# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1027 allocate (mg(nbub))
1028# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1029 allocate (betat(nbub))
1030# 923 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1031 allocate (betac(nbub))
1032# 925 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1033 allocate (mpi_io_data_lg_bubbles(nbub,1:lag_io_vars))
1034
1035 call mpi_type_create_subarray(2, gsizes, lsizes, start_idx_part, mpi_order_fortran, mpi_p, view, ierr)
1036 call mpi_type_commit(view, ierr)
1037
1038 call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
1039
1040 ! Skip extended header
1041 disp = int(sizeof(file_tot_part) + 2*sizeof(file_time) + sizeof(file_num_procs) &
1042 & + file_num_procs*sizeof(proc_bubble_counts(1)), mpi_offset_kind)
1043 call mpi_file_set_view(ifile, disp, mpi_p, view, 'native', mpi_info_int, ierr)
1044
1045 call mpi_file_read_all(ifile, mpi_io_data_lg_bubbles, lag_io_vars*nbub, mpi_p, status, ierr)
1046
1047 call mpi_file_close(ifile, ierr)
1048 call mpi_type_free(view, ierr)
1049
1050 ! Extract data from MPI_IO_DATA_lg_bubbles array Adjust these indices based on your actual data layout
1051# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1052 bub_id(:) = mpi_io_data_lg_bubbles(:,1)
1053# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1054 px(:) = mpi_io_data_lg_bubbles(:,2)
1055# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1056 py(:) = mpi_io_data_lg_bubbles(:,3)
1057# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1058 pz(:) = mpi_io_data_lg_bubbles(:,4)
1059# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1060 ppx(:) = mpi_io_data_lg_bubbles(:,5)
1061# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1062 ppy(:) = mpi_io_data_lg_bubbles(:,6)
1063# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1064 ppz(:) = mpi_io_data_lg_bubbles(:,7)
1065# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1066 vx(:) = mpi_io_data_lg_bubbles(:,8)
1067# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1068 vy(:) = mpi_io_data_lg_bubbles(:,9)
1069# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1070 vz(:) = mpi_io_data_lg_bubbles(:,10)
1071# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1072 radius(:) = mpi_io_data_lg_bubbles(:,11)
1073# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1074 rvel(:) = mpi_io_data_lg_bubbles(:,12)
1075# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1076 rnot(:) = mpi_io_data_lg_bubbles(:,13)
1077# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1078 rmax(:) = mpi_io_data_lg_bubbles(:,14)
1079# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1080 rmin(:) = mpi_io_data_lg_bubbles(:,15)
1081# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1082 dphidt(:) = mpi_io_data_lg_bubbles(:,16)
1083# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1084 pressure(:) = mpi_io_data_lg_bubbles(:,17)
1085# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1086 mv(:) = mpi_io_data_lg_bubbles(:,18)
1087# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1088 mg(:) = mpi_io_data_lg_bubbles(:,19)
1089# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1090 betat(:) = mpi_io_data_lg_bubbles(:,20)
1091# 947 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1092 betac(:) = mpi_io_data_lg_bubbles(:,21)
1093# 949 "/home/runner/work/MFC/MFC/src/post_process/m_data_output.fpp"
1094
1095 ! Next, the root processor proceeds to record all of the spatial extents in the formatted database master file. In
1096 ! addition, it also records a sub-domain connectivity map so that the entire grid may be reassembled by looking at the
1097 ! master file.
1098 if (proc_rank == 0) then
1099 do i = 1, num_procs
1100 write (meshnames(i), '(A,I0,A,I0,A)') '../p', i - 1, '/', t_step, '.silo:lag_bubbles'
1101 meshtypes(i) = db_pointmesh
1102 end do
1103 err = dbset2dstrlen(len(meshnames(1)))
1104 err = dbputmmesh(out%dbroot, 'lag_bubbles', 16, num_procs, meshnames, len_trim(meshnames), meshtypes, db_f77null, &
1105 & ierr)
1106 end if
1107
1108 err = dbputpm(out%dbfile, 'lag_bubbles', 11, 3, px, py, pz, nbub, db_double, db_f77null, ierr)
1109
1110 if (lag_id_wrt) call s_write_lag_variable_to_formatted_database_file('part_id', t_step, bub_id, nbub)
1111 if (lag_vel_wrt) then
1112 call s_write_lag_variable_to_formatted_database_file('part_vel1', t_step, vx, nbub)
1113 call s_write_lag_variable_to_formatted_database_file('part_vel2', t_step, vy, nbub)
1114 if (p > 0) call s_write_lag_variable_to_formatted_database_file('part_vel3', t_step, vz, nbub)
1115 end if
1116 if (lag_rad_wrt) call s_write_lag_variable_to_formatted_database_file('part_radius', t_step, radius, nbub)
1117 if (lag_rvel_wrt) call s_write_lag_variable_to_formatted_database_file('part_rdot', t_step, rvel, nbub)
1118 if (lag_r0_wrt) call s_write_lag_variable_to_formatted_database_file('part_r0', t_step, rnot, nbub)
1119 if (lag_rmax_wrt) call s_write_lag_variable_to_formatted_database_file('part_rmax', t_step, rmax, nbub)
1120 if (lag_rmin_wrt) call s_write_lag_variable_to_formatted_database_file('part_rmin', t_step, rmin, nbub)
1121 if (lag_dphidt_wrt) call s_write_lag_variable_to_formatted_database_file('part_dphidt', t_step, dphidt, nbub)
1122 if (lag_pres_wrt) call s_write_lag_variable_to_formatted_database_file('part_pressure', t_step, pressure, nbub)
1123 if (lag_mv_wrt) call s_write_lag_variable_to_formatted_database_file('part_mv', t_step, mv, nbub)
1124 if (lag_mg_wrt) call s_write_lag_variable_to_formatted_database_file('part_mg', t_step, mg, nbub)
1125 if (lag_betat_wrt) call s_write_lag_variable_to_formatted_database_file('part_betaT', t_step, betat, nbub)
1126 if (lag_betac_wrt) call s_write_lag_variable_to_formatted_database_file('part_betaC', t_step, betac, nbub)
1127
1128 deallocate (bub_id, px, py, pz, ppx, ppy, ppz, vx, vy, vz, radius, rvel, rnot, rmax, rmin, dphidt, pressure, mv, mg, &
1129 & betat, betac)
1130 deallocate (mpi_io_data_lg_bubbles)
1131 else
1132 call mpi_type_contiguous(0, mpi_p, view, ierr)
1133 call mpi_type_commit(view, ierr)
1134
1135 call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
1136
1137 ! Skip extended header
1138 disp = int(sizeof(file_tot_part) + 2*sizeof(file_time) + sizeof(file_num_procs) &
1139 & + file_num_procs*sizeof(proc_bubble_counts(1)), mpi_offset_kind)
1140 call mpi_file_set_view(ifile, disp, mpi_p, view, 'native', mpi_info_int, ierr)
1141
1142 call mpi_file_read_all(ifile, dummy, 0, mpi_p, status, ierr)
1143
1144 call mpi_file_close(ifile, ierr)
1145 call mpi_type_free(view, ierr)
1146
1147 if (proc_rank == 0) then
1148 do i = 1, num_procs
1149 write (meshnames(i), '(A,I0,A,I0,A)') '../p', i - 1, '/', t_step, '.silo:lag_bubbles'
1150 meshtypes(i) = db_pointmesh
1151 end do
1152 err = dbset2dstrlen(len(meshnames(1)))
1153 err = dbputmmesh(out%dbroot, 'lag_bubbles', 16, num_procs, meshnames, len_trim(meshnames), meshtypes, db_f77null, &
1154 & ierr)
1155 end if
1156
1157 err = dbsetemptyok(1)
1158 err = dbputpm(out%dbfile, 'lag_bubbles', 11, 3, dummy_data, dummy_data, dummy_data, 0, db_double, db_f77null, ierr)
1159
1160 if (lag_id_wrt) call s_write_lag_variable_to_formatted_database_file('part_id', t_step)
1161 if (lag_vel_wrt) then
1162 call s_write_lag_variable_to_formatted_database_file('part_vel1', t_step)
1163 call s_write_lag_variable_to_formatted_database_file('part_vel2', t_step)
1164 if (p > 0) call s_write_lag_variable_to_formatted_database_file('part_vel3', t_step)
1165 end if
1166 if (lag_rad_wrt) call s_write_lag_variable_to_formatted_database_file('part_radius', t_step)
1167 if (lag_rvel_wrt) call s_write_lag_variable_to_formatted_database_file('part_rdot', t_step)
1168 if (lag_r0_wrt) call s_write_lag_variable_to_formatted_database_file('part_r0', t_step)
1169 if (lag_rmax_wrt) call s_write_lag_variable_to_formatted_database_file('part_rmax', t_step)
1170 if (lag_rmin_wrt) call s_write_lag_variable_to_formatted_database_file('part_rmin', t_step)
1171 if (lag_dphidt_wrt) call s_write_lag_variable_to_formatted_database_file('part_dphidt', t_step)
1172 if (lag_pres_wrt) call s_write_lag_variable_to_formatted_database_file('part_pressure', t_step)
1173 if (lag_mv_wrt) call s_write_lag_variable_to_formatted_database_file('part_mv', t_step)
1174 if (lag_mg_wrt) call s_write_lag_variable_to_formatted_database_file('part_mg', t_step)
1175 if (lag_betat_wrt) call s_write_lag_variable_to_formatted_database_file('part_betaT', t_step)
1176 if (lag_betac_wrt) call s_write_lag_variable_to_formatted_database_file('part_betaC', t_step)
1177 end if
1178#endif
1179
1181
1182 !> Write a single Lagrangian bubble point-variable to the Silo database slave and master files.
1183 subroutine s_write_lag_variable_to_formatted_database_file(varname, t_step, data, nBubs)
1184
1185 character(len=*), intent(in) :: varname
1186 integer, intent(in) :: t_step
1187 real(wp), dimension(1:), intent(in), optional :: data
1188 integer, intent(in), optional :: nBubs
1189 character(len=64), dimension(num_procs) :: var_names
1190 integer, dimension(num_procs) :: var_types
1191 real(wp) :: dummy_data
1192 integer :: ierr
1193 integer :: i
1194
1195 dummy_data = 0._wp
1196
1197 if (present(nbubs) .and. present(data)) then
1198 if (proc_rank == 0) then
1199 do i = 1, num_procs
1200 write (var_names(i), '(A,I0,A,I0,A)') '../p', i - 1, '/', t_step, '.silo:' // trim(varname)
1201 var_types(i) = db_pointvar
1202 end do
1203 err = dbset2dstrlen(len(var_names(1)))
1204 err = dbputmvar(out%dbroot, trim(varname), len_trim(varname), num_procs, var_names, len_trim(var_names), &
1205 & var_types, db_f77null, ierr)
1206 end if
1207
1208 err = dbputpv1(out%dbfile, trim(varname), len_trim(varname), 'lag_bubbles', 11, data, nbubs, db_double, db_f77null, &
1209 & ierr)
1210 else
1211 if (proc_rank == 0) then
1212 do i = 1, num_procs
1213 write (var_names(i), '(A,I0,A,I0,A)') '../p', i - 1, '/', t_step, '.silo:' // trim(varname)
1214 var_types(i) = db_pointvar
1215 end do
1216 err = dbset2dstrlen(len(var_names(1)))
1217 err = dbsetemptyok(1)
1218 err = dbputmvar(out%dbroot, trim(varname), len_trim(varname), num_procs, var_names, len_trim(var_names), &
1219 & var_types, db_f77null, ierr)
1220 end if
1221
1222 err = dbsetemptyok(1)
1223 err = dbputpv1(out%dbfile, trim(varname), len_trim(varname), 'lag_bubbles', 11, dummy_data, 0, db_double, db_f77null, &
1224 & ierr)
1225 end if
1226
1228
1229 !> Convert the binary immersed-boundary state file to per-body formatted text files
1230 impure subroutine s_write_ib_state_files()
1231
1232 character(len=len_trim(case_dir) + 4*name_len) :: in_file, out_file, file_loc
1233 integer :: iu_in, ios, i, rec_id
1234 integer, allocatable, dimension(:) :: iu_out
1235 real(wp) :: rec_time
1236 real(wp), dimension(3) :: rec_force, rec_torque
1237 real(wp), dimension(3) :: rec_vel, rec_angular_vel
1238 real(wp), dimension(3) :: rec_angles, rec_centroid
1239
1240 file_loc = trim(case_dir) // '/D'
1241
1242 in_file = trim(file_loc) // '/ib_state.dat'
1243 open (newunit=iu_in, file=trim(in_file), form='unformatted', access='stream', status='old', action='read', iostat=ios)
1244 if (ios /= 0) then
1245 call s_mpi_abort('Cannot open IB state input file: ' // trim(in_file))
1246 end if
1247
1248 allocate (iu_out(num_ibs))
1249 do i = 1, num_ibs
1250 write (out_file, '(A,I0,A)') trim(file_loc) // '/ib_', i, '.txt'
1251 open (newunit=iu_out(i), file=trim(out_file), form='formatted', status='replace', action='write', iostat=ios)
1252 if (ios /= 0) then
1253 call s_mpi_abort('Cannot open IB state output file: ' // trim(out_file))
1254 end if
1255 write (iu_out(i), &
1256 & '(A)') 'mytime fx fy fz Tau_x Tau_y Tau_z vx vy vz omega_x omega_y omega_z angle_x angle_y angle_z x_c y_c z_c'
1257 end do
1258
1259 do
1260 read (iu_in, iostat=ios) rec_time, rec_id, rec_force, rec_torque, rec_vel, rec_angular_vel, rec_angles, &
1261 & rec_centroid(1), rec_centroid(2), rec_centroid(3)
1262 if (ios /= 0) exit
1263
1264 if (rec_id >= 1 .and. rec_id <= num_ibs) then
1265 write (iu_out(rec_id), '(19(ES24.16E3,1X))') rec_time, rec_force(1), rec_force(2), rec_force(3), rec_torque(1), &
1266 & rec_torque(2), rec_torque(3), rec_vel(1), rec_vel(2), rec_vel(3), rec_angular_vel(1), &
1267 & rec_angular_vel(2), rec_angular_vel(3), rec_angles(1), rec_angles(2), rec_angles(3), rec_centroid(1), &
1268 & rec_centroid(2), rec_centroid(3)
1269 end if
1270 end do
1271
1272 close (iu_in)
1273 do i = 1, num_ibs
1274 close (iu_out(i))
1275 end do
1276 deallocate (iu_out)
1277
1278 end subroutine s_write_ib_state_files
1279
1280 !> Extract the volume-fraction interface contour from primitive fields and write the coordinates to the interface data file.
1281 impure subroutine s_write_intf_data_file(q_prim_vf)
1282
1283 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1284 integer :: i, j, k, l, cent
1285 integer :: counter, root !< number of data points extracted to fit shape to SH perturbations
1286 real(wp), allocatable :: x_td(:), y_td(:), x_d1(:), y_d1(:), y_d(:), x_d(:)
1287 real(wp) :: axp, axm, ayp, aym, tgp, euc_d, thres, maxalph_loc, maxalph_glb
1288
1289 allocate (x_d1(m*n))
1290 allocate (y_d1(m*n))
1291 counter = 0
1292 maxalph_loc = 0._wp
1293 do k = 0, p
1294 do j = 0, n
1295 do i = 0, m
1296 if (q_prim_vf(eqn_idx%E + 2)%sf(i, j, k) > maxalph_loc) then
1297 maxalph_loc = q_prim_vf(eqn_idx%E + 2)%sf(i, j, k)
1298 end if
1299 end do
1300 end do
1301 end do
1302
1303 call s_mpi_allreduce_max(maxalph_loc, maxalph_glb)
1304 if (p > 0) then
1305 do l = 0, p
1306 if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then
1307 cent = l
1308 end if
1309 end do
1310 else
1311 cent = 0
1312 end if
1313
1314 thres = 0.9_wp*maxalph_glb
1315 do k = 0, n
1316 do j = 0, m
1317 axp = q_prim_vf(eqn_idx%E + 2)%sf(j + 1, k, cent)
1318 axm = q_prim_vf(eqn_idx%E + 2)%sf(j, k, cent)
1319 ayp = q_prim_vf(eqn_idx%E + 2)%sf(j, k + 1, cent)
1320 aym = q_prim_vf(eqn_idx%E + 2)%sf(j, k, cent)
1321 if ((axp > thres .and. axm < thres) .or. (axp < thres .and. axm > thres) .or. (ayp > thres .and. aym < thres) &
1322 & .or. (ayp < thres .and. aym > thres)) then
1323 if (counter == 0) then
1324 counter = counter + 1
1325 x_d1(counter) = x_cc(j)
1326 y_d1(counter) = y_cc(k)
1327 else
1328 tgp = sqrt(dx(j)**2 + dy(k)**2)
1329 do i = 1, counter
1330 euc_d = sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2)
1331 if (euc_d < tgp) then
1332 exit
1333 else if (i == counter) then
1334 counter = counter + 1
1335 x_d1(counter) = x_cc(j)
1336 y_d1(counter) = y_cc(k)
1337 end if
1338 end do
1339 end if
1340 end if
1341 end do
1342 end do
1343
1344 allocate (x_d(counter), y_d(counter))
1345
1346 do i = 1, counter
1347 y_d(i) = y_d1(i)
1348 x_d(i) = x_d1(i)
1349 end do
1350 root = 0
1351
1352 call s_mpi_gather_data(x_d, counter, x_td, root)
1353 call s_mpi_gather_data(y_d, counter, y_td, root)
1354 if (proc_rank == 0) then
1355 do i = 1, size(x_td)
1356 if (i == size(x_td)) then
1357 write (211, '(F12.9,1X,F12.9,1X,I4)') x_td(i), y_td(i), size(x_td)
1358 else
1359 write (211, '(F12.9,1X,F12.9,1X,F3.1)') x_td(i), y_td(i), 0._wp
1360 end if
1361 end do
1362 end if
1363
1364 end subroutine s_write_intf_data_file
1365
1366 !> Compute volume-integrated kinetic, potential, and internal energies and write the energy budget to the energy data file.
1367 impure subroutine s_write_energy_data_file(q_prim_vf, q_cons_vf)
1368
1369 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf, q_cons_vf
1370 real(wp) :: elk, egk, elp, egint, vb, vl, pres_av, et
1371 real(wp) :: rho, pres, dv, tmp, gamma, pi_inf, maxma, maxma_glb, maxvel, c, ma, h, qv
1372 real(wp), dimension(num_vels) :: vel
1373 real(wp), dimension(num_fluids) :: adv
1374 integer :: i, j, k, l, s !< looping indices
1375
1376 egk = 0._wp
1377 elp = 0._wp
1378 egint = 0._wp
1379 vb = 0._wp
1380 maxvel = 0._wp
1381 maxma = 0._wp
1382 vl = 0._wp
1383 elk = 0._wp
1384 et = 0._wp
1385 vb = 0._wp
1386 dv = 0._wp
1387 pres_av = 0._wp
1388 pres = 0._wp
1389 c = 0._wp
1390
1391 do k = 0, p
1392 do j = 0, n
1393 do i = 0, m
1394 pres = 0._wp
1395 dv = dx(i)*dy(j)*dz(k)
1396 rho = 0._wp
1397 gamma = 0._wp
1398 pi_inf = 0._wp
1399 qv = 0._wp
1400 pres = q_prim_vf(eqn_idx%E)%sf(i, j, k)
1401 egint = egint + q_prim_vf(eqn_idx%E + 2)%sf(i, j, k)*(gammas(2)*pres)*dv
1402 do s = 1, num_vels
1403 vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k)
1404 egk = egk + 0.5_wp*q_prim_vf(eqn_idx%E + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dv
1405 elk = elk + 0.5_wp*q_prim_vf(eqn_idx%E + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dv
1406 if (abs(vel(s)) > maxvel) then
1407 maxvel = abs(vel(s))
1408 end if
1409 end do
1410 do l = 1, eqn_idx%adv%end - eqn_idx%E
1411 adv(l) = q_prim_vf(eqn_idx%E + l)%sf(i, j, k)
1412 gamma = gamma + adv(l)*gammas(l)
1413 pi_inf = pi_inf + adv(l)*pi_infs(l)
1414 rho = rho + adv(l)*q_prim_vf(l)%sf(i, j, k)
1415 qv = qv + adv(l)*q_prim_vf(l)%sf(i, j, k)*qvs(l)
1416 end do
1417
1418 h = ((gamma + 1._wp)*pres + pi_inf + qv)/rho
1419
1420 call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, h, adv, 0._wp, 0._wp, c, qv)
1421
1422 ma = maxvel/c
1423 if (ma > maxma .and. (adv(1) > (1.0_wp - 1.0e-10_wp))) then
1424 maxma = ma
1425 end if
1426 vl = vl + adv(1)*dv
1427 vb = vb + adv(2)*dv
1428 pres_av = pres_av + adv(1)*pres*dv
1429 et = et + q_cons_vf(eqn_idx%E)%sf(i, j, k)*dv
1430 end do
1431 end do
1432 end do
1433
1434 tmp = pres_av
1435 call s_mpi_allreduce_sum(tmp, pres_av)
1436 tmp = vl
1437 call s_mpi_allreduce_sum(tmp, vl)
1438
1439 call s_mpi_allreduce_max(maxma, maxma_glb)
1440 tmp = elk
1441 call s_mpi_allreduce_sum(tmp, elk)
1442 tmp = egint
1443 call s_mpi_allreduce_sum(tmp, egint)
1444 tmp = egk
1445 call s_mpi_allreduce_sum(tmp, egk)
1446 tmp = vb
1447 call s_mpi_allreduce_sum(tmp, vb)
1448 tmp = et
1449 call s_mpi_allreduce_sum(tmp, et)
1450
1451 elp = pres_av/vl*vb
1452 if (proc_rank == 0) then
1453 write (251, '(10X, 8F24.8)') elp, egint, elk, egk, et, vb, vl, maxma_glb
1454 end if
1455
1456 end subroutine s_write_energy_data_file
1457
1458 !> Read IB state and write a Silo point mesh with per-body scalar fields.
1460
1461 integer, intent(in) :: t_step
1462 character(len=len_trim(case_dir) + 3*name_len) :: file_loc
1463
1464#ifdef MFC_MPI
1465 integer, parameter :: nfields_per_ib = 20
1466 real(wp) :: ib_buf(nfields_per_ib)
1467 real(wp), dimension(:,:), allocatable :: ib_data
1468 logical :: file_exist
1469 character(LEN=4*name_len), dimension(num_procs) :: meshnames
1470 integer, dimension(num_procs) :: meshtypes
1471 integer :: i, ios, file_unit
1472 integer :: ierr, nbodies
1473 integer :: r, nlocal, gbl_id
1474 character(len=10) :: t_step_string
1475 real(wp), dimension(:), allocatable :: px, py, pz
1476 real(wp), dimension(:), allocatable :: force_x, force_y, force_z
1477 real(wp), dimension(:), allocatable :: torque_x, torque_y, torque_z
1478 real(wp), dimension(:), allocatable :: vel_x, vel_y, vel_z
1479 real(wp), dimension(:), allocatable :: omega_x, omega_y, omega_z
1480 real(wp), dimension(:), allocatable :: angle_x, angle_y, angle_z
1481 real(wp), dimension(:), allocatable :: ib_diameter
1482
1483 if (proc_rank == 0) then
1484 nbodies = num_ibs
1485
1486 if (nbodies > 0) then
1487 allocate (ib_data(nbodies, nfields_per_ib))
1488 allocate (px(nbodies), py(nbodies), pz(nbodies))
1489 allocate (force_x(nbodies), force_y(nbodies), force_z(nbodies))
1490 allocate (torque_x(nbodies), torque_y(nbodies), torque_z(nbodies))
1491 allocate (vel_x(nbodies), vel_y(nbodies), vel_z(nbodies))
1492 allocate (omega_x(nbodies), omega_y(nbodies), omega_z(nbodies))
1493 allocate (angle_x(nbodies), angle_y(nbodies), angle_z(nbodies))
1494 allocate (ib_diameter(nbodies))
1495
1496 if (file_per_process) then
1497 call s_int_to_str(t_step, t_step_string)
1498 ib_data = 0._wp
1499 do r = 0, num_procs - 1
1500 write (file_loc, '(A,I0,A,i7.7,A)') 'ib_state_', t_step, '_', r, '.dat'
1501 file_loc = trim(case_dir) // '/restart_data/lustre_' // trim(t_step_string) // '/' // trim(file_loc)
1502
1503 inquire (file=trim(file_loc), exist=file_exist)
1504 if (.not. file_exist) call s_mpi_abort('Restart file ' // trim(file_loc) // ' does not exist!')
1505
1506 open (newunit=file_unit, file=trim(file_loc), form='unformatted', access='stream', status='old', iostat=ios)
1507 if (ios /= 0) call s_mpi_abort('Cannot open IB state file: ' // trim(file_loc))
1508
1509 read (file_unit, iostat=ios) nlocal
1510 if (ios /= 0) call s_mpi_abort('Error reading IB state file header: ' // trim(file_loc))
1511
1512 do i = 1, nlocal
1513 read (file_unit, iostat=ios) gbl_id
1514 if (ios /= 0) call s_mpi_abort('Error reading IB patch ID: ' // trim(file_loc))
1515 read (file_unit, iostat=ios) ib_buf
1516 if (ios /= 0) call s_mpi_abort('Error reading IB state data: ' // trim(file_loc))
1517 ib_data(gbl_id,:) = ib_buf(:)
1518 end do
1519
1520 close (file_unit)
1521 end do
1522 else
1523 ! Build path to per-timestep IB state file
1524 write (file_loc, '(A,I0,A)') '/restart_data/ib_state_', t_step, '.dat'
1525 file_loc = trim(case_dir) // trim(file_loc)
1526
1527 inquire (file=trim(file_loc), exist=file_exist)
1528 if (.not. file_exist) call s_mpi_abort('Restart file ' // trim(file_loc) // ' does not exist!')
1529
1530 open (newunit=file_unit, file=trim(file_loc), form='unformatted', access='stream', status='old', iostat=ios)
1531 if (ios /= 0) call s_mpi_abort('Cannot open IB state file: ' // trim(file_loc))
1532
1533 do i = 1, nbodies
1534 read (file_unit, iostat=ios) ib_buf
1535 if (ios /= 0) call s_mpi_abort('Error reading IB state file')
1536 ib_data(i,:) = ib_buf(:)
1537 end do
1538
1539 close (file_unit)
1540 end if
1541
1542 do i = 1, nbodies
1543 force_x(i) = ib_data(i, 2); force_y(i) = ib_data(i, 3); force_z(i) = ib_data(i, 4)
1544 torque_x(i) = ib_data(i, 5); torque_y(i) = ib_data(i, 6); torque_z(i) = ib_data(i, 7)
1545 vel_x(i) = ib_data(i, 8); vel_y(i) = ib_data(i, 9); vel_z(i) = ib_data(i, 10)
1546 omega_x(i) = ib_data(i, 11); omega_y(i) = ib_data(i, 12); omega_z(i) = ib_data(i, 13)
1547 angle_x(i) = ib_data(i, 14); angle_y(i) = ib_data(i, 15); angle_z(i) = ib_data(i, 16)
1548 px(i) = ib_data(i, 17); py(i) = ib_data(i, 18); pz(i) = ib_data(i, 19)
1549 ib_diameter(i) = ib_data(i, 20)*2.0_wp
1550 end do
1551
1552 write (meshnames(1), '(A,I0,A)') '../p0/', t_step, '.silo:ib_bodies'
1553 meshtypes(1) = db_pointmesh
1554 err = dbset2dstrlen(len(meshnames(1)))
1555 err = dbputmmesh(out%dbroot, 'ib_bodies', 16, 1, meshnames, len_trim(meshnames), meshtypes, db_f77null, ierr)
1556
1557 err = dbputpm(out%dbfile, 'ib_bodies', 9, 3, px, py, pz, nbodies, db_double, db_f77null, ierr)
1558
1559 call s_write_ib_variable('ib_force_x', t_step, force_x, nbodies)
1560 call s_write_ib_variable('ib_force_y', t_step, force_y, nbodies)
1561 call s_write_ib_variable('ib_force_z', t_step, force_z, nbodies)
1562 call s_write_ib_variable('ib_torque_x', t_step, torque_x, nbodies)
1563 call s_write_ib_variable('ib_torque_y', t_step, torque_y, nbodies)
1564 call s_write_ib_variable('ib_torque_z', t_step, torque_z, nbodies)
1565 call s_write_ib_variable('ib_vel_x', t_step, vel_x, nbodies)
1566 call s_write_ib_variable('ib_vel_y', t_step, vel_y, nbodies)
1567 call s_write_ib_variable('ib_vel_z', t_step, vel_z, nbodies)
1568 call s_write_ib_variable('ib_omega_x', t_step, omega_x, nbodies)
1569 call s_write_ib_variable('ib_omega_y', t_step, omega_y, nbodies)
1570 call s_write_ib_variable('ib_omega_z', t_step, omega_z, nbodies)
1571 call s_write_ib_variable('ib_angle_x', t_step, angle_x, nbodies)
1572 call s_write_ib_variable('ib_angle_y', t_step, angle_y, nbodies)
1573 call s_write_ib_variable('ib_angle_z', t_step, angle_z, nbodies)
1574 call s_write_ib_variable('ib_diameter', t_step, ib_diameter, nbodies)
1575
1576 deallocate (ib_data, px, py, pz, force_x, force_y, force_z)
1577 deallocate (torque_x, torque_y, torque_z, vel_x, vel_y, vel_z)
1578 deallocate (omega_x, omega_y, omega_z, angle_x, angle_y, angle_z)
1579 deallocate (ib_diameter)
1580 end if
1581 end if
1582#endif
1583
1585
1586 !> Write a single IB point-variable to the Silo database slave and master files.
1587 subroutine s_write_ib_variable(varname, t_step, data, nBodies)
1588
1589 character(len=*), intent(in) :: varname
1590 integer, intent(in) :: t_step
1591 real(wp), dimension(:), intent(in) :: data
1592 integer, intent(in) :: nBodies
1593 character(len=4*name_len) :: var_name_entry
1594 integer :: var_type_entry, ierr
1595
1596 write (var_name_entry, '(A,I0,A)') '../p0/', t_step, '.silo:' // trim(varname)
1597 var_type_entry = db_pointvar
1598 err = dbset2dstrlen(len(var_name_entry))
1599 err = dbputmvar(out%dbroot, trim(varname), len_trim(varname), 1, var_name_entry, len_trim(var_name_entry), &
1600 & var_type_entry, db_f77null, ierr)
1601
1602 err = dbputpv1(out%dbfile, trim(varname), len_trim(varname), 'ib_bodies', 9, data, nbodies, db_double, db_f77null, ierr)
1603
1604 end subroutine s_write_ib_variable
1605
1606 !> Close the formatted database slave file and, for the root process, the master file.
1608
1609 integer :: ierr
1610
1611 if (format == format_silo) then
1612 ierr = dbclose(out%dbfile)
1613 if (proc_rank == 0) ierr = dbclose(out%dbroot)
1614 else
1615 close (out%dbfile)
1616 if (n == 0 .and. proc_rank == 0) close (out%dbroot)
1617 end if
1618
1619 end subroutine s_close_formatted_database_file
1620
1621 !> Close the interface data file.
1622 impure subroutine s_close_intf_data_file()
1623
1624 close (211)
1625
1626 end subroutine s_close_intf_data_file
1627
1628 !> Close the energy data file.
1629 impure subroutine s_close_energy_data_file()
1630
1631 close (251)
1632
1633 end subroutine s_close_energy_data_file
1634
1635 !> Deallocate module arrays and release all data-output resources.
1637
1638 deallocate (out%q_sf)
1639 if (n == 0) deallocate (out%q_root_sf)
1640 if (grid_geometry == 3) then
1641 deallocate (out%cyl_q_sf)
1642 end if
1643
1644 ! Deallocating spatial and data extents and also the variables for the offsets and the one bookkeeping the number of
1645 ! cell-boundaries in each active coordinate direction. Note that all these variables were only needed by Silo-HDF5 format
1646 ! for multidimensional data.
1647 if (format == format_silo) then
1648 deallocate (out%spatial_extents)
1649 deallocate (out%data_extents)
1650 deallocate (out%lo_offset)
1651 deallocate (out%hi_offset)
1652 deallocate (out%dims)
1653 end if
1654
1655 end subroutine s_finalize_data_output_module
1656
1657end module m_data_output
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
integer, intent(in) k
integer, intent(in) j
integer, intent(in) l
Platform-specific file and directory operations: create, delete, inquire, getcwd, and basename.
impure subroutine my_inquire(fileloc, dircheck)
Inquires on the existence of a directory.
impure subroutine s_create_directory(dir_name)
Create a directory and all its parents if it does not exist.
Compile-time constant parameters: default values, tolerances, and physical constants.
integer, parameter lag_io_vars
Number of variables per particle for MPI_IO.
integer, parameter model_eqns_5eq
integer, parameter format_silo
integer, parameter format_binary
integer, parameter precision_single
integer, parameter model_eqns_6eq
integer, parameter model_eqns_gamma_law
Writes post-processed grid and flow-variable data to Silo-HDF5 or binary database files.
impure subroutine, public s_write_grid_to_formatted_database_file(t_step)
Write the computational grid (cell-boundary coordinates) to the formatted database slave and master f...
impure subroutine, public s_write_variable_to_formatted_database_file(varname, t_step)
Write a single flow variable field to the formatted database slave and master files for a given time ...
impure subroutine, public s_open_energy_data_file()
Open the energy data file for appending volume-integrated energy budget quantities.
impure subroutine, public s_open_intf_data_file()
Open the interface data file for appending extracted interface coordinates.
impure subroutine, public s_write_ib_state_files()
Convert the binary immersed-boundary state file to per-body formatted text files.
impure subroutine, public s_write_energy_data_file(q_prim_vf, q_cons_vf)
Compute volume-integrated kinetic, potential, and internal energies and write the energy budget to th...
impure subroutine, public s_write_lag_bubbles_to_formatted_database_file(t_step)
Read Lagrangian bubble restart data and write bubble positions and scalar fields to the Silo database...
impure subroutine, public s_write_intf_data_file(q_prim_vf)
Extract the volume-fraction interface contour from primitive fields and write the coordinates to the ...
subroutine s_write_ib_variable(varname, t_step, data, nbodies)
Write a single IB point-variable to the Silo database slave and master files.
impure subroutine, public s_initialize_data_output_module()
Allocate storage arrays, configure output directories, and count flow variables for formatted databas...
impure subroutine, public s_close_energy_data_file()
Close the energy data file.
impure subroutine, public s_close_formatted_database_file()
Close the formatted database slave file and, for the root process, the master file.
impure subroutine, public s_open_formatted_database_file(t_step)
Open (or create) the Silo-HDF5 or Binary formatted database slave and master files for a given time s...
impure subroutine, public s_close_intf_data_file()
Close the interface data file.
impure subroutine, public s_write_lag_bubbles_results_to_text(t_step)
Write the post-processed results in the folder 'lag_bubbles_data'.
impure subroutine, public s_finalize_data_output_module()
Deallocate module arrays and release all data-output resources.
integer, private err
impure subroutine, public s_define_output_region
Compute the cell-index bounds for the user-specified partial output domain in each coordinate directi...
impure subroutine, public s_write_ib_bodies_to_formatted_database_file(t_step)
Read IB state and write a Silo point mesh with per-body scalar fields.
type(output_context), public out
Output workspace: flow variable buffers, VisIt extents/offsets, directory paths, file handles,...
subroutine s_write_lag_variable_to_formatted_database_file(varname, t_step, data, nbubs)
Write a single Lagrangian bubble point-variable to the Silo database slave and master files.
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Computes derived flow quantities (sound speed, vorticity, Schlieren, etc.) from conservative and prim...
Global parameters for the post-process: domain geometry, equation of state, and output database setti...
type(int_bounds_info) offset_y
real(wp), dimension(:,:), allocatable, public mpi_io_data_lg_bubbles
real(wp), dimension(:), allocatable y_cc
integer proc_rank
Rank of the local processor.
real(wp), dimension(:), allocatable adv
Advection variables.
type(int_bounds_info) z_output_idx
Indices of domain to output for post-processing.
real(wp), dimension(:), allocatable y_cb
real(wp), dimension(:), allocatable dz
real(wp), dimension(:), allocatable x_root_cb
real(wp), dimension(:), allocatable z_cb
type(bounds_info) z_output
Portion of domain to output for post-processing.
type(int_bounds_info) x_output_idx
real(wp), dimension(:), allocatable x_cc
real(wp), dimension(:), allocatable x_cb
real(wp), dimension(:), allocatable dy
type(int_bounds_info) offset_x
real(wp), dimension(:), allocatable z_cc
integer num_procs
Number of processors.
type(int_bounds_info) y_output_idx
type(int_bounds_info) offset_z
real(wp), dimension(:), allocatable dx
Cell-width distributions in the x-, y- and z-coordinate directions.
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
elemental subroutine, public s_int_to_str(i, res)
Convert an integer to its trimmed string representation.
MPI gather and scatter operations for distributing post-process grid and flow-variable data.
impure subroutine s_mpi_defragment_1d_grid_variable
Collect the sub-domain cell-boundary or cell-center location data from all processors and put back to...
impure subroutine s_mpi_defragment_1d_flow_variable(q_sf, q_root_sf)
Gather the sub-domain flow variable data from all processors and reassemble it for the entire computa...
impure subroutine s_mpi_gather_spatial_extents(spatial_extents)
Gather spatial extents from all ranks for Silo database metadata.
impure subroutine s_mpi_gather_data_extents(q_sf, data_extents)
Gather the Silo database metadata for the flow variable's extents to boost performance of the multidi...
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
real(wp), dimension(:), allocatable, public gammas
subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, h, adv, vel_sum, c_c, c, qv)
Compute the speed of sound from thermodynamic state variables, supporting multiple equation-of-state ...
real(wp), dimension(:), allocatable, public qvs
real(wp), dimension(:), allocatable, public pi_infs
Output workspace for post_process: flow variable buffers, VisIt extents/offsets, directory paths,...
Derived type annexing a scalar field (SF).