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/simulation/m_data_output.fpp"
2!>
3!! @file
4!! @brief Contains module m_data_output
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
7# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
8# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
9# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
10# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
11# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
12# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
13# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
14
15# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
16# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
17# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
18
19# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20
21# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22
23# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24
25# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26
27# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28
29# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30
31# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32! New line at end of file is required for FYPP
33# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
34# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
35# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
36# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45
46# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49
50# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59! New line at end of file is required for FYPP
60# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
61
62# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
63# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
64# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
65# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
66# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
67
68# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
69
70# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
71
72# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
73
74# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75
76# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77
78# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138! New line at end of file is required for FYPP
139# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
140# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
141# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
142# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
143# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
144# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
145# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
146# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
147
148# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
149# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
150# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
151
152# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
153
154# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155
156# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157
158# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159
160# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161
162# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165! New line at end of file is required for FYPP
166# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
167
168# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
169
170# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
171
172# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
173
174# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
175
176# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
177
178# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
179
180# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
181
182# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223! New line at end of file is required for FYPP
224# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
225
226! GPU parallel region (scalar reductions, maxval/minval)
227# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
228
229! GPU parallel loop over threads (most common GPU macro)
230# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
231
232! Required closing for GPU_PARALLEL_LOOP
233# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
234
235! Mark routine for device compilation
236# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
237
238! Declare device-resident data
239# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
240
241! Inner loop within a GPU parallel region
242# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
243
244! Scoped GPU data region
245# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247! Host code with device pointers (for MPI with GPU buffers)
248# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250! Allocate device memory (unscoped)
251# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253! Free device memory
254# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256! Atomic operation on device
257# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259! End atomic capture block
260# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262! Copy data between host and device
263# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265! Synchronization barrier
266# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! Import GPU library module (openacc or omp_lib)
269# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Emit code only for AMD compiler
272# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Emit code for non-Cray compilers
275# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Emit code only for Cray compiler
278# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Emit code for non-NVIDIA compilers
281# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
284# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285! New line at end of file is required for FYPP
286# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
287
288# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
289
290! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
291! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
292! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
293# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
294
295! Allocate and create GPU device memory
296# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
297
298! Free GPU device memory and deallocate
299# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
300
301! Cray-specific GPU pointer setup for vector fields
302# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
303
304! Cray-specific GPU pointer setup for scalar fields
305# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
306
307! Cray-specific GPU pointer setup for acoustic source spatials
308# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
309
310# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
313! New line at end of file is required for FYPP
314# 6 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp" 2
315# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
316! This file exists so that Fypp can be run without generating case.fpp files for
317! each target. This is useful when generating documentation, for example. This
318! should also let MFC be built with CMake directly, without invoking mfc.sh.
319
320! For pre-process.
321# 9 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
322
323! For moving immersed boundaries in simulation
324# 14 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
325# 7 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp" 2
326
327!> @brief Writes solution data, run-time stability diagnostics (ICFL, VCFL, CCFL, Rc), and probe/center-of-mass files
328module m_data_output
329
330 use m_derived_types
331 use m_global_parameters
332 use m_mpi_proxy
333 use m_variables_conversion
334 use m_compile_specific
335 use m_helper
336 use m_helper_basic
337 use m_sim_helpers
338 use m_delay_file_access
339 use m_ibm
340 use m_boundary_common
341
342 implicit none
343
344 private
345 public :: s_initialize_data_output_module, s_open_run_time_information_file, s_open_com_files, s_open_probe_files, &
346 & s_write_run_time_information, s_write_data_files, s_write_serial_data_files, s_write_parallel_data_files, &
347 & s_write_ib_data_file, s_write_com_files, s_write_probe_files, s_write_ib_state_file, s_close_run_time_information_file, &
348 & s_close_com_files, s_close_probe_files, s_finalize_data_output_module
349
350 real(wp), allocatable, dimension(:,:,:) :: icfl_sf !< ICFL stability criterion
351 real(wp), allocatable, dimension(:,:,:) :: vcfl_sf !< VCFL stability criterion
352 real(wp), allocatable, dimension(:,:,:) :: rc_sf !< Rc stability criterion
353 real(wp), public, allocatable, dimension(:,:) :: c_mass
354
355# 35 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
356#if defined(MFC_OpenACC)
357# 35 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
358!$acc declare create(icfl_sf, vcfl_sf, Rc_sf, c_mass)
359# 35 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
360#elif defined(MFC_OpenMP)
361# 35 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
362!$omp declare target (icfl_sf, vcfl_sf, Rc_sf, c_mass)
363# 35 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
364#endif
365
366 real(wp) :: icfl_max_loc, icfl_max_glb !< ICFL stability extrema on local and global grids
367 real(wp) :: vcfl_max_loc, vcfl_max_glb !< VCFL stability extrema on local and global grids
368 real(wp) :: rc_min_loc, rc_min_glb !< Rc stability extrema on local and global grids
369
370# 40 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
371#if defined(MFC_OpenACC)
372# 40 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
373!$acc declare create(icfl_max_loc, icfl_max_glb, vcfl_max_loc, vcfl_max_glb)
374# 40 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
375#elif defined(MFC_OpenMP)
376# 40 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
377!$omp declare target (icfl_max_loc, icfl_max_glb, vcfl_max_loc, vcfl_max_glb)
378# 40 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
379#endif
380
381# 41 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
382#if defined(MFC_OpenACC)
383# 41 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
384!$acc declare create(Rc_min_loc, Rc_min_glb)
385# 41 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
386#elif defined(MFC_OpenMP)
387# 41 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
388!$omp declare target (Rc_min_loc, Rc_min_glb)
389# 41 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
390#endif
391
392 !> @name ICFL, VCFL, and Rc stability criteria extrema over all the time-steps
393 !> @{
394 real(wp) :: icfl_max !< ICFL criterion maximum
395 real(wp) :: vcfl_max !< VCFL criterion maximum
396 real(wp) :: rc_min !< Rc criterion maximum
397 !> @}
398
399 type(scalar_field), allocatable, dimension(:) :: q_cons_temp_ds
400
401contains
402
403 !> Write data files. Dispatch subroutine that replaces procedure pointer.
404 impure subroutine s_write_data_files(q_cons_vf, q_T_sf, q_prim_vf, t_step, bc_type, beta)
405
406 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
407 type(scalar_field), intent(inout) :: q_t_sf
408 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
409 integer, intent(in) :: t_step
410 type(scalar_field), intent(inout), optional :: beta
411 type(integer_field), dimension(1:num_dims,-1:1), intent(in) :: bc_type
412
413 if (.not. parallel_io) then
414 call s_write_serial_data_files(q_cons_vf, q_t_sf, q_prim_vf, t_step, bc_type, beta)
415 else
416 call s_write_parallel_data_files(q_cons_vf, t_step, bc_type, beta)
417 end if
418
419 end subroutine s_write_data_files
420
421 !> Open the run-time information file and write the stability criteria table header
422 impure subroutine s_open_run_time_information_file
423
424 character(LEN=name_len), parameter :: file_name = 'run_time.inf' !< Name of the run-time information file
425 character(LEN=path_len + name_len) :: file_path !< Relative path to a file in the case directory
426 character(LEN=8) :: file_date !< Creation date of the run-time information file
427
428 file_path = trim(case_dir) // '/' // trim(file_name)
429
430 open (3, file=trim(file_path), form='formatted', status='replace')
431
432 write (3, '(A)') 'Description: Stability information at ' // 'each time-step of the simulation. This'
433 write (3, '(13X,A)') 'data is composed of the inviscid ' // 'Courant-Friedrichs-Lewy (ICFL)'
434 write (3, '(13X,A)') 'number, the viscous CFL (VCFL) number, ' // 'the capillary CFL (CCFL)'
435 write (3, '(13X,A)') 'number and the cell Reynolds (Rc) ' // 'number. Please note that only'
436 write (3, '(13X,A)') 'those stability conditions pertinent ' // 'to the physics included in'
437 write (3, '(13X,A)') 'the current computation are displayed.'
438
439 call date_and_time(date=file_date)
440
441 write (3, '(A)') 'Date: ' // file_date(5:6) // '/' // file_date(7:8) // '/' // file_date(3:4)
442
443 write (3, '(A)') ''; write (3, '(A)') ''
444
445 write (3, '(13X,A9,13X,A10,13X,A10,13X,A10)', advance="no") trim('Time-step'), trim('dt'), trim('Time'), trim('ICFL Max')
446
447 if (viscous) then
448 write (3, '(13X,A10,13X,A16)', advance="no") trim('VCFL Max'), trim('Rc Min')
449 end if
450
451 write (3, *) ! new line
452
453 end subroutine s_open_run_time_information_file
454
455 !> Open center-of-mass data files for writing
456 impure subroutine s_open_com_files()
457
458 character(len=path_len + 3*name_len) :: file_path !< Relative path to the CoM file in the case directory
459 integer :: i !< Generic loop iterator
460
461 do i = 1, num_fluids
462 write (file_path, '(A,I0,A)') '/fluid', i, '_com.dat'
463 file_path = trim(case_dir) // trim(file_path)
464 open (i + 120, file=trim(file_path), form='formatted', position='append', status='unknown')
465 if (n == 0) then
466 write (i + 120, '(A)') ' Non-Dimensional Time ' // ' Total Mass ' // ' x-loc ' // ' Total Volume '
467 else if (p == 0) then
468 write (i + 120, &
469 & '(A)') ' Non-Dimensional Time ' // ' Total Mass ' // ' x-loc ' // ' y-loc ' &
470 & // ' Total Volume '
471 else
472 write (i + 120, &
473 & '(A)') ' Non-Dimensional Time ' // ' Total Mass ' // ' x-loc ' // ' y-loc ' // ' z-loc ' &
474 & // ' Total Volume '
475 end if
476 end do
477
478 end subroutine s_open_com_files
479
480 !> Open flow probe data files for writing
481 impure subroutine s_open_probe_files
482
483 character(LEN=path_len + 3*name_len) :: file_path !< Relative path to the probe data file in the case directory
484 integer :: i !< Generic loop iterator
485 logical :: file_exist
486
487 do i = 1, num_probes
488 write (file_path, '(A,I0,A)') '/D/probe', i, '_prim.dat'
489 file_path = trim(case_dir) // trim(file_path)
490
491 inquire (file=trim(file_path), exist=file_exist)
492
493 if (file_exist) then
494 open (i + 30, file=trim(file_path), form='formatted', status='old', position='append')
495 else
496 open (i + 30, file=trim(file_path), form='formatted', status='unknown')
497 end if
498 end do
499
500 if (integral_wrt) then
501 do i = 1, num_integrals
502 write (file_path, '(A,I0,A)') '/D/integral', i, '_prim.dat'
503 file_path = trim(case_dir) // trim(file_path)
504
505 open (i + 70, file=trim(file_path), form='formatted', position='append', status='unknown')
506 end do
507 end if
508
509 end subroutine s_open_probe_files
510
511 !> Write stability criteria extrema to the run-time information file at the given time step
512 impure subroutine s_write_run_time_information(q_prim_vf, t_step)
513
514 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
515 integer, intent(in) :: t_step
516 real(wp) :: rho !< Cell-avg. density
517
518# 173 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
519 real(wp), dimension(num_fluids) :: alpha !< Cell-avg. volume fraction
520 real(wp), dimension(num_vels) :: vel !< Cell-avg. velocity
521# 176 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
522 real(wp) :: vel_sum !< Cell-avg. velocity sum
523 real(wp) :: pres !< Cell-avg. pressure
524 real(wp) :: gamma !< Cell-avg. sp. heat ratio
525 real(wp) :: pi_inf !< Cell-avg. liquid stiffness function
526 real(wp) :: qv !< Cell-avg. internal energy reference value
527 real(wp) :: c !< Cell-avg. sound speed
528 real(wp) :: h !< Cell-avg. enthalpy
529 real(wp), dimension(2) :: re !< Cell-avg. Reynolds numbers
530 integer :: j, k, l
531
532 ! Computing Stability Criteria at Current Time-step
533
534
535# 188 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
536
537# 188 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
538#if defined(MFC_OpenACC)
539# 188 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
540!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l, vel, alpha, Re, rho, vel_sum, pres, gamma, pi_inf, c, H, qv)
541# 188 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
542#elif defined(MFC_OpenMP)
543# 188 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
544
545# 188 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
546
547# 188 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
548
549# 188 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
550!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(j, k, l, vel, alpha, Re, rho, vel_sum, pres, gamma, pi_inf, c, H, qv)
551# 188 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
552#endif
553 do l = 0, p
554 do k = 0, n
555 do j = 0, m
556 call s_compute_enthalpy(q_prim_vf, pres, rho, gamma, pi_inf, re, h, alpha, vel, vel_sum, qv, j, k, l)
557
558 call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, h, alpha, vel_sum, 0._wp, c, qv)
559
560 if (viscous) then
561 call s_compute_stability_from_dt(vel, c, rho, re, j, k, l, icfl_sf, vcfl_sf, rc_sf)
562 else
563 call s_compute_stability_from_dt(vel, c, rho, re, j, k, l, icfl_sf)
564 end if
565 end do
566 end do
567 end do
568
569# 204 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
570#if defined(MFC_OpenACC)
571# 204 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
572!$acc end parallel loop
573# 204 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
574#elif defined(MFC_OpenMP)
575# 204 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
576
577# 204 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
578!$omp end target teams loop
579# 204 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
580#endif
581
582#ifdef _CRAYFTN
583
584# 207 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
585#if defined(MFC_OpenACC)
586# 207 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
587!$acc update host(icfl_sf)
588# 207 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
589#elif defined(MFC_OpenMP)
590# 207 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
591!$omp target update from(icfl_sf)
592# 207 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
593#endif
594
595 if (viscous) then
596
597# 210 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
598#if defined(MFC_OpenACC)
599# 210 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
600!$acc update host(vcfl_sf, Rc_sf)
601# 210 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
602#elif defined(MFC_OpenMP)
603# 210 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
604!$omp target update from(vcfl_sf, Rc_sf)
605# 210 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
606#endif
607 end if
608
609 icfl_max_loc = maxval(icfl_sf)
610
611 if (viscous) then
612 vcfl_max_loc = maxval(vcfl_sf)
613 rc_min_loc = minval(rc_sf)
614 end if
615#else
616
617# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
618
619# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
620#if defined(MFC_OpenACC)
621# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
622!$acc parallel default(present) copyin(icfl_sf) copyout(icfl_max_loc)
623# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
624 icfl_max_loc = maxval(icfl_sf)
625# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
626!$acc end parallel
627# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
628#elif defined(MFC_OpenMP)
629# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
630
631# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
632
633# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
634!$omp target teams defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) map(to:icfl_sf) map(from:icfl_max_loc)
635# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
636 icfl_max_loc = maxval(icfl_sf)
637# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
638!$omp end target teams
639# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
640#else
641# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
642 icfl_max_loc = maxval(icfl_sf)
643# 220 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
644#endif
645# 223 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
646 if (viscous .or. dummy) then
647
648# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
649
650# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
651#if defined(MFC_OpenACC)
652# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
653!$acc parallel default(present) copyin(vcfl_sf, Rc_sf) copyout(vcfl_max_loc, Rc_min_loc)
654# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
655 vcfl_max_loc = maxval(vcfl_sf)
656# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
657 rc_min_loc = minval(rc_sf)
658# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
659!$acc end parallel
660# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
661#elif defined(MFC_OpenMP)
662# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
663
664# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
665
666# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
667!$omp target teams defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) map(to:vcfl_sf, Rc_sf) map(from:vcfl_max_loc, Rc_min_loc)
668# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
669 vcfl_max_loc = maxval(vcfl_sf)
670# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
671 rc_min_loc = minval(rc_sf)
672# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
673!$omp end target teams
674# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
675#else
676# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
677 vcfl_max_loc = maxval(vcfl_sf)
678# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
679 rc_min_loc = minval(rc_sf)
680# 224 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
681#endif
682# 228 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
683 end if
684#endif
685
686 if (num_procs > 1) then
687 call s_mpi_reduce_stability_criteria_extrema(icfl_max_loc, vcfl_max_loc, rc_min_loc, icfl_max_glb, vcfl_max_glb, &
688 & rc_min_glb)
689 else
690 icfl_max_glb = icfl_max_loc
691 if (viscous) vcfl_max_glb = vcfl_max_loc
692 if (viscous) rc_min_glb = rc_min_loc
693 end if
694
695 if (icfl_max_glb > icfl_max) icfl_max = icfl_max_glb
696
697 if (viscous) then
698 if (vcfl_max_glb > vcfl_max) vcfl_max = vcfl_max_glb
699 if (rc_min_glb < rc_min) rc_min = rc_min_glb
700 end if
701
702 if (proc_rank == 0) then
703 write (3, '(13X,I9,13X,F10.6,13X,F10.6,13X,F10.6)', advance="no") t_step, dt, mytime, icfl_max_glb
704
705 if (viscous) then
706 write (3, '(13X,F10.6,13X,ES16.6)', advance="no") vcfl_max_glb, rc_min_glb
707 end if
708
709 write (3, *) ! new line
710
711 if (.not. f_approx_equal(icfl_max_glb, icfl_max_glb)) then
712 call s_mpi_abort('ICFL is NaN. Exiting.')
713 else if (icfl_max_glb > 1._wp) then
714 print *, 'icfl', icfl_max_glb
715 call s_mpi_abort('ICFL is greater than 1.0. Exiting.')
716 end if
717
718 if (viscous) then
719 if (.not. f_approx_equal(vcfl_max_glb, vcfl_max_glb)) then
720 call s_mpi_abort('VCFL is NaN. Exiting.')
721 else if (vcfl_max_glb > 1._wp) then
722 print *, 'vcfl', vcfl_max_glb
723 call s_mpi_abort('VCFL is greater than 1.0. Exiting.')
724 end if
725 end if
726 end if
727
728 call s_mpi_barrier()
729
730 end subroutine s_write_run_time_information
731
732 !> Write grid and conservative variable data files in serial format
733 impure subroutine s_write_serial_data_files(q_cons_vf, q_T_sf, q_prim_vf, t_step, bc_type, beta)
734
735 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
736 type(scalar_field), intent(inout) :: q_t_sf
737 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
738 integer, intent(in) :: t_step
739 type(scalar_field), intent(inout), optional :: beta
740 type(integer_field), dimension(1:num_dims,-1:1), intent(in) :: bc_type
741 character(LEN=path_len + 2*name_len) :: t_step_dir !< Relative path to the current time-step directory
742 character(LEN=path_len + 3*name_len) :: file_path !< Relative path to the grid and conservative variables data files
743 logical :: file_exist !< Logical used to check existence of current time-step directory
744 character(LEN=15) :: fmt
745 integer :: i, j, k, l, r
746 real(wp) :: gamma, lit_gamma, pi_inf, qv !< Temporary EOS params
747
748 write (t_step_dir, '(A,I0,A,I0)') trim(case_dir) // '/p_all'
749 write (t_step_dir, '(a,i0,a,i0)') trim(case_dir) // '/p_all/p', proc_rank, '/', t_step
750
751 file_path = trim(t_step_dir) // '/.'
752 call my_inquire(file_path, file_exist)
753 if (file_exist) call s_delete_directory(trim(t_step_dir))
754 call s_create_directory(trim(t_step_dir))
755
756 file_path = trim(t_step_dir) // '/x_cb.dat'
757
758 open (2, file=trim(file_path), form='unformatted', status='new')
759 write (2) x_cb(-1:m); close (2)
760
761 if (n > 0) then
762 file_path = trim(t_step_dir) // '/y_cb.dat'
763
764 open (2, file=trim(file_path), form='unformatted', status='new')
765 write (2) y_cb(-1:n); close (2)
766
767 if (p > 0) then
768 file_path = trim(t_step_dir) // '/z_cb.dat'
769
770 open (2, file=trim(file_path), form='unformatted', status='new')
771 write (2) z_cb(-1:p); close (2)
772 end if
773 end if
774
775 do i = 1, sys_size
776 write (file_path, '(A,I0,A)') trim(t_step_dir) // '/q_cons_vf', i, '.dat'
777
778 open (2, file=trim(file_path), form='unformatted', status='new')
779
780 write (2) q_cons_vf(i)%sf(0:m,0:n,0:p); close (2)
781 end do
782
783 ! Lagrangian beta (void fraction) written as q_cons_vf(sys_size+1) to match the parallel I/O path and allow post_process to
784 ! read it.
785 if (bubbles_lagrange) then
786 write (file_path, '(A,I0,A)') trim(t_step_dir) // '/q_cons_vf', sys_size + 1, '.dat'
787
788 open (2, file=trim(file_path), form='unformatted', status='new')
789
790 write (2) beta%sf(0:m,0:n,0:p); close (2)
791 end if
792
793 if (qbmm .and. .not. polytropic) then
794 do i = 1, nb
795 do r = 1, nnode
796 write (file_path, '(A,I0,A)') trim(t_step_dir) // '/pb', sys_size + (i - 1)*nnode + r, '.dat'
797
798 open (2, file=trim(file_path), form='unformatted', status='new')
799
800 write (2) pb_ts(1)%sf(0:m,0:n,0:p,r, i); close (2)
801 end do
802 end do
803
804 do i = 1, nb
805 do r = 1, nnode
806 write (file_path, '(A,I0,A)') trim(t_step_dir) // '/mv', sys_size + (i - 1)*nnode + r, '.dat'
807
808 open (2, file=trim(file_path), form='unformatted', status='new')
809
810 write (2) mv_ts(1)%sf(0:m,0:n,0:p,r, i); close (2)
811 end do
812 end do
813 end if
814
815 ! Writing the IB markers
816 if (ib) then
817 call s_write_serial_ib_data(t_step)
818 end if
819
820 gamma = gammas(1)
821 lit_gamma = gs_min(1)
822 pi_inf = pi_infs(1)
823 qv = qvs(1)
824
825 if (precision == 1) then
826 fmt = "(2F30.3)"
827 else
828 fmt = "(2F40.14)"
829 end if
830
831 write (t_step_dir, '(A,I0,A,I0)') trim(case_dir) // '/D'
832 file_path = trim(t_step_dir) // '/.'
833
834 inquire (file=trim(file_path), exist=file_exist)
835
836 if (.not. file_exist) call s_create_directory(trim(t_step_dir))
837
838 if ((prim_vars_wrt .or. (n == 0 .and. p == 0)) .and. (.not. igr)) then
839 call s_convert_conservative_to_primitive_variables(q_cons_vf, q_t_sf, q_prim_vf, idwint)
840 do i = 1, sys_size
841
842# 386 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
843#if defined(MFC_OpenACC)
844# 386 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
845!$acc update host(q_prim_vf(i)%sf(:, :, :))
846# 386 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
847#elif defined(MFC_OpenMP)
848# 386 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
849!$omp target update from(q_prim_vf(i)%sf(:, :, :))
850# 386 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
851#endif
852 end do
853 ! q_prim_vf(eqn_idx%bub%beg) stores the value of nb needed in riemann solvers, so replace with true primitive value
854 ! (=1._wp)
855 if (qbmm) then
856 q_prim_vf(eqn_idx%bub%beg)%sf = 1._wp
857 end if
858 end if
859
860 if (n == 0 .and. p == 0) then
861 if (model_eqns == 2 .and. (.not. igr)) then
862 do i = 1, sys_size
863 write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/prim.', i, '.', proc_rank, '.', t_step, '.dat'
864
865 open (2, file=trim(file_path))
866 do j = 0, m
867 ! todo: revisit change here
868 if (((i >= eqn_idx%adv%beg) .and. (i <= eqn_idx%adv%end))) then
869 write (2, fmt) x_cb(j), q_cons_vf(i)%sf(j, 0, 0)
870 else
871 write (2, fmt) x_cb(j), q_prim_vf(i)%sf(j, 0, 0)
872 end if
873 end do
874 close (2)
875 end do
876 end if
877
878 do i = 1, sys_size
879 write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/cons.', i, '.', proc_rank, '.', t_step, '.dat'
880
881 open (2, file=trim(file_path))
882 do j = 0, m
883 write (2, fmt) x_cb(j), q_cons_vf(i)%sf(j, 0, 0)
884 end do
885 close (2)
886 end do
887
888 if (qbmm .and. .not. polytropic) then
889 do i = 1, nb
890 do r = 1, nnode
891 write (file_path, '(A,I0,A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/pres.', i, '.', r, '.', proc_rank, &
892 & '.', t_step, '.dat'
893
894 open (2, file=trim(file_path))
895 do j = 0, m
896 write (2, fmt) x_cb(j), pb_ts(1)%sf(j, 0, 0, r, i)
897 end do
898 close (2)
899 end do
900 end do
901 do i = 1, nb
902 do r = 1, nnode
903 write (file_path, '(A,I0,A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/mv.', i, '.', r, '.', proc_rank, &
904 & '.', t_step, '.dat'
905
906 open (2, file=trim(file_path))
907 do j = 0, m
908 write (2, fmt) x_cb(j), mv_ts(1)%sf(j, 0, 0, r, i)
909 end do
910 close (2)
911 end do
912 end do
913 end if
914 end if
915
916 if (precision == 1) then
917 fmt = "(3F30.7)"
918 else
919 fmt = "(3F40.14)"
920 end if
921
922 if ((n > 0) .and. (p == 0)) then
923 do i = 1, sys_size
924 write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/cons.', i, '.', proc_rank, '.', t_step, '.dat'
925 open (2, file=trim(file_path))
926 do j = 0, m
927 do k = 0, n
928 write (2, fmt) x_cb(j), y_cb(k), q_cons_vf(i)%sf(j, k, 0)
929 end do
930 write (2, *)
931 end do
932 close (2)
933 end do
934
935 if (present(beta)) then
936 write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/beta.', i, '.', proc_rank, '.', t_step, '.dat'
937 open (2, file=trim(file_path))
938 do j = 0, m
939 do k = 0, n
940 write (2, fmt) x_cb(j), y_cb(k), beta%sf(j, k, 0)
941 end do
942 write (2, *)
943 end do
944 close (2)
945 end if
946
947 if (qbmm .and. .not. polytropic) then
948 do i = 1, nb
949 do r = 1, nnode
950 write (file_path, '(A,I0,A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/pres.', i, '.', r, '.', proc_rank, &
951 & '.', t_step, '.dat'
952
953 open (2, file=trim(file_path))
954 do j = 0, m
955 do k = 0, n
956 write (2, fmt) x_cb(j), y_cb(k), pb_ts(1)%sf(j, k, 0, r, i)
957 end do
958 end do
959 close (2)
960 end do
961 end do
962 do i = 1, nb
963 do r = 1, nnode
964 write (file_path, '(A,I0,A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/mv.', i, '.', r, '.', proc_rank, &
965 & '.', t_step, '.dat'
966
967 open (2, file=trim(file_path))
968 do j = 0, m
969 do k = 0, n
970 write (2, fmt) x_cb(j), y_cb(k), mv_ts(1)%sf(j, k, 0, r, i)
971 end do
972 end do
973 close (2)
974 end do
975 end do
976 end if
977
978 if (prim_vars_wrt .and. (.not. igr)) then
979 do i = 1, sys_size
980 write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/prim.', i, '.', proc_rank, '.', t_step, '.dat'
981
982 open (2, file=trim(file_path))
983
984 do j = 0, m
985 do k = 0, n
986 if (((i >= eqn_idx%cont%beg) .and. (i <= eqn_idx%cont%end)) .or. ((i >= eqn_idx%adv%beg) &
987 & .and. (i <= eqn_idx%adv%end))) then
988 write (2, fmt) x_cb(j), y_cb(k), q_cons_vf(i)%sf(j, k, 0)
989 else
990 write (2, fmt) x_cb(j), y_cb(k), q_prim_vf(i)%sf(j, k, 0)
991 end if
992 end do
993 write (2, *)
994 end do
995 close (2)
996 end do
997 end if
998 end if
999
1000 if (precision == 1) then
1001 fmt = "(4F30.7)"
1002 else
1003 fmt = "(4F40.14)"
1004 end if
1005
1006 if (p > 0) then
1007 do i = 1, sys_size
1008 write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/cons.', i, '.', proc_rank, '.', t_step, '.dat'
1009 open (2, file=trim(file_path))
1010 do j = 0, m
1011 do k = 0, n
1012 do l = 0, p
1013 write (2, fmt) x_cb(j), y_cb(k), z_cb(l), q_cons_vf(i)%sf(j, k, l)
1014 end do
1015 write (2, *)
1016 end do
1017 write (2, *)
1018 end do
1019 close (2)
1020 end do
1021
1022 if (present(beta)) then
1023 write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/beta.', i, '.', proc_rank, '.', t_step, '.dat'
1024 open (2, file=trim(file_path))
1025 do j = 0, m
1026 do k = 0, n
1027 do l = 0, p
1028 write (2, fmt) x_cb(j), y_cb(k), z_cb(l), beta%sf(j, k, l)
1029 end do
1030 write (2, *)
1031 end do
1032 write (2, *)
1033 end do
1034 close (2)
1035 end if
1036
1037 if (qbmm .and. .not. polytropic) then
1038 do i = 1, nb
1039 do r = 1, nnode
1040 write (file_path, '(A,I0,A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/pres.', i, '.', r, '.', proc_rank, &
1041 & '.', t_step, '.dat'
1042
1043 open (2, file=trim(file_path))
1044 do j = 0, m
1045 do k = 0, n
1046 do l = 0, p
1047 write (2, fmt) x_cb(j), y_cb(k), z_cb(l), pb_ts(1)%sf(j, k, l, r, i)
1048 end do
1049 end do
1050 end do
1051 close (2)
1052 end do
1053 end do
1054 do i = 1, nb
1055 do r = 1, nnode
1056 write (file_path, '(A,I0,A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/mv.', i, '.', r, '.', proc_rank, &
1057 & '.', t_step, '.dat'
1058
1059 open (2, file=trim(file_path))
1060 do j = 0, m
1061 do k = 0, n
1062 do l = 0, p
1063 write (2, fmt) x_cb(j), y_cb(k), z_cb(l), mv_ts(1)%sf(j, k, l, r, i)
1064 end do
1065 end do
1066 end do
1067 close (2)
1068 end do
1069 end do
1070 end if
1071
1072 if (prim_vars_wrt .and. (.not. igr)) then
1073 do i = 1, sys_size
1074 write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/prim.', i, '.', proc_rank, '.', t_step, '.dat'
1075
1076 open (2, file=trim(file_path))
1077
1078 do j = 0, m
1079 do k = 0, n
1080 do l = 0, p
1081 if (((i >= eqn_idx%cont%beg) .and. (i <= eqn_idx%cont%end)) .or. ((i >= eqn_idx%adv%beg) &
1082 & .and. (i <= eqn_idx%adv%end)) .or. ((i >= eqn_idx%species%beg) &
1083 & .and. (i <= eqn_idx%species%end))) then
1084 write (2, fmt) x_cb(j), y_cb(k), z_cb(l), q_cons_vf(i)%sf(j, k, l)
1085 else
1086 write (2, fmt) x_cb(j), y_cb(k), z_cb(l), q_prim_vf(i)%sf(j, k, l)
1087 end if
1088 end do
1089 write (2, *)
1090 end do
1091 write (2, *)
1092 end do
1093 close (2)
1094 end do
1095 end if
1096 end if
1097
1098 end subroutine s_write_serial_data_files
1099
1100 !> Write grid and conservative variable data files in parallel via MPI I/O
1101 impure subroutine s_write_parallel_data_files(q_cons_vf, t_step, bc_type, beta, q_T_sf)
1102
1103 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
1104 integer, intent(in) :: t_step
1105 type(scalar_field), intent(inout), optional :: beta
1106 type(integer_field), dimension(1:num_dims,-1:1), intent(in) :: bc_type
1107 type(scalar_field), intent(inout), optional :: q_t_sf
1108
1109#ifdef MFC_MPI
1110 integer :: ifile, ierr, data_size
1111 integer, dimension(MPI_STATUS_SIZE) :: status
1112 integer(kind=MPI_OFFSET_kind) :: disp
1113 integer(kind=MPI_OFFSET_kind) :: m_mok, n_mok, p_mok
1114 integer(kind=MPI_OFFSET_kind) :: wp_mok, var_mok, str_mok
1115 integer(kind=MPI_OFFSET_kind) :: nvars_mok
1116 integer(kind=MPI_OFFSET_kind) :: mok
1117 character(LEN=path_len + 2*name_len) :: file_loc
1118 logical :: file_exist, dir_check
1119 character(len=10) :: t_step_string
1120 integer :: i !< Generic loop iterator
1121 integer :: alt_sys !< Altered system size for the lagrangian subgrid bubble model
1122 ! Down sampling variables
1123 integer :: m_ds, n_ds, p_ds
1124 integer :: m_glb_ds, n_glb_ds, p_glb_ds
1125 integer :: m_glb_save, n_glb_save, p_glb_save !< Global save size
1126
1127 if (down_sample) then
1128 call s_downsample_data(q_cons_vf, q_cons_temp_ds, m_ds, n_ds, p_ds, m_glb_ds, n_glb_ds, p_glb_ds)
1129 end if
1130
1131 if (present(beta)) then
1132 alt_sys = sys_size + 1
1133 else
1134 alt_sys = sys_size
1135 end if
1136
1137 if (file_per_process) then
1138 call s_int_to_str(t_step, t_step_string)
1139
1140 if (down_sample) then
1141 call s_initialize_mpi_data_ds(q_cons_temp_ds)
1142 else
1143 if (ib) then
1144 call s_initialize_mpi_data(q_cons_vf, ib_markers)
1145 else
1146 call s_initialize_mpi_data(q_cons_vf)
1147 end if
1148 end if
1149
1150 if (proc_rank == 0) then
1151 file_loc = trim(case_dir) // '/restart_data/lustre_' // trim(t_step_string)
1152 call my_inquire(file_loc, dir_check)
1153 if (dir_check .neqv. .true.) then
1154 call s_create_directory(trim(file_loc))
1155 end if
1156 call s_create_directory(trim(file_loc))
1157 end if
1158 call s_mpi_barrier()
1159 call delayfileaccess(proc_rank)
1160
1161 call s_initialize_mpi_data(q_cons_vf)
1162
1163 write (file_loc, '(I0,A,i7.7,A)') t_step, '_', proc_rank, '.dat'
1164 file_loc = trim(case_dir) // '/restart_data/lustre_' // trim(t_step_string) // trim(mpiiofs) // trim(file_loc)
1165 inquire (file=trim(file_loc), exist=file_exist)
1166 if (file_exist .and. proc_rank == 0) then
1167 call mpi_file_delete(file_loc, mpi_info_int, ierr)
1168 end if
1169 call mpi_file_open(mpi_comm_self, file_loc, ior(mpi_mode_wronly, mpi_mode_create), mpi_info_int, ifile, ierr)
1170
1171 if (down_sample) then
1172 data_size = (m_ds + 3)*(n_ds + 3)*(p_ds + 3)
1173 m_glb_save = m_glb_ds + 1
1174 n_glb_save = n_glb_ds + 1
1175 p_glb_save = p_glb_ds + 1
1176 else
1177 data_size = (m + 1)*(n + 1)*(p + 1)
1178 m_glb_save = m_glb + 1
1179 n_glb_save = n_glb + 1
1180 p_glb_save = p_glb + 1
1181 end if
1182
1183 m_mok = int(m_glb_save + 1, mpi_offset_kind)
1184 n_mok = int(n_glb_save + 1, mpi_offset_kind)
1185 p_mok = int(p_glb_save + 1, mpi_offset_kind)
1186 wp_mok = int(storage_size(0._stp)/8, mpi_offset_kind)
1187 mok = int(1._wp, mpi_offset_kind)
1188 str_mok = int(name_len, mpi_offset_kind)
1189 nvars_mok = int(sys_size, mpi_offset_kind)
1190
1191 if (bubbles_euler) then
1192 do i = 1, sys_size
1193 var_mok = int(i, mpi_offset_kind)
1194
1195 call mpi_file_write_all(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
1196 end do
1197 if (qbmm .and. .not. polytropic) then
1198 do i = sys_size + 1, sys_size + 2*nb*nnode
1199 var_mok = int(i, mpi_offset_kind)
1200
1201 call mpi_file_write_all(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
1202 end do
1203 end if
1204 else
1205 if (down_sample) then
1206 do i = 1, sys_size ! TODO: check if sys_size is correct
1207 var_mok = int(i, mpi_offset_kind)
1208
1209 call mpi_file_write_all(ifile, q_cons_temp_ds(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
1210 end do
1211 else
1212 do i = 1, sys_size ! TODO: check if sys_size is correct
1213 var_mok = int(i, mpi_offset_kind)
1214
1215 call mpi_file_write_all(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
1216 end do
1217 end if
1218 end if
1219
1220 call mpi_file_close(ifile, ierr)
1221 else
1222 if (ib) then
1223 call s_initialize_mpi_data(q_cons_vf, ib_markers)
1224 else if (present(beta)) then
1225 call s_initialize_mpi_data(q_cons_vf, beta=beta)
1226 else
1227 call s_initialize_mpi_data(q_cons_vf)
1228 end if
1229
1230 write (file_loc, '(I0,A)') t_step, '.dat'
1231 file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // trim(file_loc)
1232 inquire (file=trim(file_loc), exist=file_exist)
1233 if (file_exist .and. proc_rank == 0) then
1234 call mpi_file_delete(file_loc, mpi_info_int, ierr)
1235 end if
1236 call mpi_file_open(mpi_comm_world, file_loc, ior(mpi_mode_wronly, mpi_mode_create), mpi_info_int, ifile, ierr)
1237
1238 data_size = (m + 1)*(n + 1)*(p + 1)
1239
1240 m_mok = int(m_glb + 1, mpi_offset_kind)
1241 n_mok = int(n_glb + 1, mpi_offset_kind)
1242 p_mok = int(p_glb + 1, mpi_offset_kind)
1243 wp_mok = int(storage_size(0._stp)/8, mpi_offset_kind)
1244 mok = int(1._wp, mpi_offset_kind)
1245 str_mok = int(name_len, mpi_offset_kind)
1246 nvars_mok = int(alt_sys, mpi_offset_kind)
1247
1248 if (bubbles_euler) then
1249 do i = 1, sys_size
1250 var_mok = int(i, mpi_offset_kind)
1251
1252 disp = m_mok*max(mok, n_mok)*max(mok, p_mok)*wp_mok*(var_mok - 1)
1253
1254 call mpi_file_set_view(ifile, disp, mpi_p, mpi_io_data%view(i), 'native', mpi_info_int, ierr)
1255 call mpi_file_write_all(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
1256 end do
1257 if (qbmm .and. .not. polytropic) then
1258 do i = sys_size + 1, sys_size + 2*nb*nnode
1259 var_mok = int(i, mpi_offset_kind)
1260
1261 disp = m_mok*max(mok, n_mok)*max(mok, p_mok)*wp_mok*(var_mok - 1)
1262
1263 call mpi_file_set_view(ifile, disp, mpi_p, mpi_io_data%view(i), 'native', mpi_info_int, ierr)
1264 call mpi_file_write_all(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
1265 end do
1266 end if
1267 else
1268 do i = 1, sys_size ! TODO: check if sys_size is correct
1269 var_mok = int(i, mpi_offset_kind)
1270
1271 disp = m_mok*max(mok, n_mok)*max(mok, p_mok)*wp_mok*(var_mok - 1)
1272
1273 call mpi_file_set_view(ifile, disp, mpi_p, mpi_io_data%view(i), 'native', mpi_info_int, ierr)
1274 call mpi_file_write_all(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
1275 end do
1276 end if
1277
1278 if (present(beta)) then
1279 var_mok = int(sys_size + 1, mpi_offset_kind)
1280
1281 disp = m_mok*max(mok, n_mok)*max(mok, p_mok)*wp_mok*(var_mok - 1)
1282
1283 call mpi_file_set_view(ifile, disp, mpi_p, mpi_io_data%view(sys_size + 1), 'native', mpi_info_int, ierr)
1284 call mpi_file_write_all(ifile, mpi_io_data%var(sys_size + 1)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
1285 end if
1286
1287 call mpi_file_close(ifile, ierr)
1288
1289 if (ib) then
1290 call s_write_parallel_ib_data(t_step)
1291 end if
1292 end if
1293#endif
1294
1295 end subroutine s_write_parallel_data_files
1296
1297 !> Write immersed boundary marker data to a serial (per-processor) unformatted file
1298 subroutine s_write_serial_ib_data(time_step)
1299
1300 integer, intent(in) :: time_step
1301 character(LEN=path_len + 2*name_len) :: file_path
1302 character(LEN=path_len + 2*name_len) :: t_step_dir
1303
1304 write (t_step_dir, '(A,I0,A,I0)') trim(case_dir) // '/p_all'
1305 write (t_step_dir, '(a,i0,a,i0)') trim(case_dir) // '/p_all/p', proc_rank, '/', time_step
1306 write (file_path, '(A,I0,A)') trim(t_step_dir) // '/ib_data.dat'
1307
1308 open (2, file=trim(file_path), form='unformatted', status='new')
1309
1310
1311# 845 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1312#if defined(MFC_OpenACC)
1313# 845 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1314!$acc update host(ib_markers%sf)
1315# 845 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1316#elif defined(MFC_OpenMP)
1317# 845 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1318!$omp target update from(ib_markers%sf)
1319# 845 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1320#endif
1321 write (2) ib_markers%sf(0:m,0:n,0:p); close (2)
1322
1323 end subroutine s_write_serial_ib_data
1324
1325 !> Write immersed boundary marker data in parallel using MPI I/O
1326 subroutine s_write_parallel_ib_data(time_step)
1327
1328 integer, intent(in) :: time_step
1329
1330#ifdef MFC_MPI
1331 character(LEN=path_len + 2*name_len) :: file_loc
1332 integer(kind=MPI_OFFSET_kind) :: disp
1333 integer(kind=MPI_OFFSET_kind) :: m_MOK, n_MOK, p_MOK
1334 integer(kind=MPI_OFFSET_kind) :: WP_MOK, var_MOK, MOK
1335 integer :: ifile, ierr, data_size
1336 integer, dimension(MPI_STATUS_SIZE) :: status
1337
1338
1339# 863 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1340#if defined(MFC_OpenACC)
1341# 863 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1342!$acc update host(ib_markers%sf)
1343# 863 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1344#elif defined(MFC_OpenMP)
1345# 863 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1346!$omp target update from(ib_markers%sf)
1347# 863 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1348#endif
1349
1350 data_size = (m + 1)*(n + 1)*(p + 1)
1351 m_mok = int(m_glb + 1, mpi_offset_kind)
1352 n_mok = int(n_glb + 1, mpi_offset_kind)
1353 p_mok = int(p_glb + 1, mpi_offset_kind)
1354 wp_mok = int(storage_size(0._stp)/8, mpi_offset_kind)
1355 mok = int(1._wp, mpi_offset_kind)
1356
1357 write (file_loc, '(A)') 'ib.dat'
1358 file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // trim(file_loc)
1359 call mpi_file_open(mpi_comm_world, file_loc, ior(mpi_mode_wronly, mpi_mode_create), mpi_info_int, ifile, ierr)
1360
1361 var_mok = int(sys_size + 1, mpi_offset_kind)
1362 disp = m_mok*max(mok, n_mok)*max(mok, p_mok)*wp_mok*(var_mok - 1 + int(time_step/t_step_save))
1363 if (time_step == 0) disp = 0
1364
1365 call mpi_file_set_view(ifile, disp, mpi_integer, mpi_io_ib_data%view, 'native', mpi_info_int, ierr)
1366 call mpi_file_write_all(ifile, mpi_io_ib_data%var%sf, data_size, mpi_integer, status, ierr)
1367 call mpi_file_close(ifile, ierr)
1368#endif
1369
1370 end subroutine s_write_parallel_ib_data
1371
1372 !> Dispatch immersed boundary data output to the serial or parallel writer
1373 subroutine s_write_ib_data_file(time_step)
1374
1375 integer, intent(in) :: time_step
1376
1377 if (parallel_io) then
1378 call s_write_parallel_ib_data(time_step)
1379 else
1380 call s_write_serial_ib_data(time_step)
1381 end if
1382
1383 end subroutine s_write_ib_data_file
1384
1385 !> Writes the IB state information out to file
1386 subroutine s_write_parallel_ib_state(t_step)
1387
1388 integer, intent(in) :: t_step
1389
1390#ifdef MFC_MPI
1391 character(LEN=path_len + 2*name_len) :: file_loc
1392 integer(kind=MPI_OFFSET_KIND) :: disp
1393 integer(kind=MPI_OFFSET_KIND) :: WP_MOK
1394 integer :: ifile, ierr
1395 integer, dimension(MPI_STATUS_SIZE) :: status
1396 logical :: file_exist
1397 integer :: i
1398 integer, parameter :: NFIELDS_PER_IB = 20
1399 real(wp) :: ib_buf(NFIELDS_PER_IB)
1400
1401 ! Partition IBs across ranks round-robin style
1402 integer :: ib_start, ib_end, nibs_per_rank, remainder
1403
1404 wp_mok = int(storage_size(0._wp)/8, mpi_offset_kind)
1405
1406 if (proc_rank == 0) then
1407 call s_create_directory(trim(case_dir) // '/restart_data')
1408 end if
1409 call s_mpi_barrier()
1410
1411 ! Divide num_ibs across num_procs
1412 nibs_per_rank = num_ibs/num_procs
1413 remainder = mod(num_ibs, num_procs)
1414
1415 ! Ranks < remainder get one extra IB
1416 if (proc_rank < remainder) then
1417 ib_start = proc_rank*(nibs_per_rank + 1) + 1
1418 ib_end = ib_start + nibs_per_rank ! nibs_per_rank + 1 total
1419 else
1420 ib_start = remainder*(nibs_per_rank + 1) + (proc_rank - remainder)*nibs_per_rank + 1
1421 ib_end = ib_start + nibs_per_rank - 1
1422 end if
1423
1424 write (file_loc, '(A,I0,A)') '/restart_data/ib_state_', t_step, '.dat'
1425 file_loc = trim(case_dir) // trim(file_loc)
1426
1427 inquire (file=trim(file_loc), exist=file_exist)
1428 if (file_exist .and. proc_rank == 0) then
1429 call mpi_file_delete(file_loc, mpi_info_int, ierr)
1430 end if
1431 call s_mpi_barrier()
1432
1433 call mpi_file_open(mpi_comm_world, file_loc, ior(mpi_mode_wronly, mpi_mode_create), mpi_info_int, ifile, ierr)
1434
1435 do i = ib_start, ib_end
1436 ib_buf(1) = mytime
1437 ib_buf(2:4) = patch_ib(i)%force(1:3)
1438 ib_buf(5:7) = patch_ib(i)%torque(1:3)
1439 ib_buf(8:10) = patch_ib(i)%vel(1:3)
1440 ib_buf(11:13) = patch_ib(i)%angular_vel(1:3)
1441 ib_buf(14:16) = patch_ib(i)%angles(1:3)
1442 ib_buf(17) = patch_ib(i)%x_centroid
1443 ib_buf(18) = patch_ib(i)%y_centroid
1444 ib_buf(19) = patch_ib(i)%z_centroid
1445 ib_buf(20) = patch_ib(i)%radius
1446
1447 ! Global IB index (i) determines position in file
1448 disp = int(i - 1, mpi_offset_kind)*int(nfields_per_ib, mpi_offset_kind)*wp_mok
1449
1450 call mpi_file_write_at(ifile, disp, ib_buf, nfields_per_ib, mpi_p, status, ierr)
1451 end do
1452
1453 call mpi_file_close(ifile, ierr)
1454#endif
1455
1456 end subroutine s_write_parallel_ib_state
1457
1458 !> Write IB state data to a per-timestep serial (unformatted) file
1459 subroutine s_write_serial_ib_state(t_step)
1460
1461 integer, intent(in) :: t_step
1462 character(LEN=path_len + 2*name_len) :: file_loc
1463 integer :: i, ios, file_unit
1464 integer, parameter :: NFIELDS_PER_IB = 20
1465 real(wp) :: ib_buf(NFIELDS_PER_IB)
1466
1467 call s_create_directory(trim(case_dir) // '/restart_data')
1468
1469 write (file_loc, '(A,I0,A)') '/restart_data/ib_state_', t_step, '.dat'
1470 file_loc = trim(case_dir) // trim(file_loc)
1471
1472 open (newunit=file_unit, file=trim(file_loc), form='unformatted', access='stream', status='replace', iostat=ios)
1473 if (ios /= 0) call s_mpi_abort('Cannot open IB state output file: ' // trim(file_loc))
1474
1475 do i = 1, num_ibs
1476 ib_buf(1) = mytime
1477 ib_buf(2:4) = patch_ib(i)%force(1:3)
1478 ib_buf(5:7) = patch_ib(i)%torque(1:3)
1479 ib_buf(8:10) = patch_ib(i)%vel(1:3)
1480 ib_buf(11:13) = patch_ib(i)%angular_vel(1:3)
1481 ib_buf(14:16) = patch_ib(i)%angles(1:3)
1482 ib_buf(17) = patch_ib(i)%x_centroid
1483 ib_buf(18) = patch_ib(i)%y_centroid
1484 ib_buf(19) = patch_ib(i)%z_centroid
1485 ib_buf(20) = patch_ib(i)%radius
1486
1487 write (file_unit) ib_buf
1488 end do
1489
1490 close (file_unit)
1491
1492 end subroutine s_write_serial_ib_state
1493
1494 !> @brief Writes IB state records to restart_data/ib_state.dat. Must be called only on rank 0.
1495 impure subroutine s_write_ib_state_file(time_step)
1496
1497 integer, intent(in) :: time_step
1498
1499 if (parallel_io) then
1500 call s_write_parallel_ib_state(time_step)
1501 else
1502 call s_write_serial_ib_state(time_step)
1503 end if
1504
1505 end subroutine s_write_ib_state_file
1506
1507 !> Write center-of-mass data at the current time step
1508 impure subroutine s_write_com_files(t_step, c_mass_in)
1509
1510 integer, intent(in) :: t_step
1511 real(wp), dimension(num_fluids, 5), intent(in) :: c_mass_in
1512 integer :: i !< Generic loop iterator
1513 real(wp) :: nondim_time !< Non-dimensional time
1514
1515 if (t_step_old /= dflt_int) then
1516 nondim_time = real(t_step + t_step_old, wp)*dt
1517 else
1518 nondim_time = real(t_step, wp)*dt
1519 end if
1520
1521 if (proc_rank == 0) then
1522 if (n == 0) then
1523 do i = 1, num_fluids
1524 write (i + 120, '(6X,4F24.12)') nondim_time, c_mass_in(i, 1), c_mass_in(i, 2), c_mass_in(i, 5)
1525 end do
1526 else if (p == 0) then
1527 do i = 1, num_fluids
1528 write (i + 120, '(6X,5F24.12)') nondim_time, c_mass_in(i, 1), c_mass_in(i, 2), c_mass_in(i, 3), c_mass_in(i, 5)
1529 end do
1530 else
1531 do i = 1, num_fluids
1532 write (i + 120, '(6X,6F24.12)') nondim_time, c_mass_in(i, 1), c_mass_in(i, 2), c_mass_in(i, 3), c_mass_in(i, &
1533 & 4), c_mass_in(i, 5)
1534 end do
1535 end if
1536 end if
1537
1538 end subroutine s_write_com_files
1539
1540 !> Write flow probe data at the current time step
1541 impure subroutine s_write_probe_files(t_step, q_cons_vf, accel_mag)
1542
1543 integer, intent(in) :: t_step
1544 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
1545 real(wp), dimension(0:m,0:n,0:p), intent(in) :: accel_mag
1546 real(wp), dimension(-1:m) :: distx
1547 real(wp), dimension(-1:n) :: disty
1548 real(wp), dimension(-1:p) :: distz
1549
1550 ! The cell-averaged partial densities, density, velocity, pressure, volume fractions, specific heat ratio function, liquid
1551 ! stiffness function, and sound speed.
1552 real(wp) :: lit_gamma, nbub
1553 real(wp) :: rho
1554 real(wp), dimension(num_vels) :: vel
1555 real(wp) :: pres
1556 real(wp) :: ptilde
1557 real(wp) :: ptot
1558 real(wp) :: alf
1559 real(wp) :: alfgr
1560 real(wp), dimension(num_fluids) :: alpha
1561 real(wp) :: gamma
1562 real(wp) :: pi_inf
1563 real(wp) :: qv
1564 real(wp) :: c
1565 real(wp) :: m00, m10, m01, m20, m02
1566 real(wp) :: varr, varv
1567 real(wp), dimension(Nb) :: nr, r, nrdot, rdot
1568 real(wp) :: nr3
1569 real(wp) :: accel
1570 real(wp) :: int_pres
1571 real(wp) :: max_pres
1572 real(wp), dimension(2) :: re
1573 real(wp), dimension(6) :: tau_e
1574 real(wp) :: g_local
1575 real(wp) :: dyn_p, t
1576 real(wp) :: damage_state
1577 integer :: i, j, k, l, s, d !< Generic loop iterator
1578 real(wp) :: nondim_time !< Non-dimensional time
1579 real(wp) :: tmp !< Temporary variable to store quantity for mpi_allreduce
1580 integer :: npts !< Number of included integral points
1581 real(wp) :: rad, thickness !< For integral quantities
1582 logical :: trigger !< For integral quantities
1583 real(wp) :: rhoyks(1:num_species)
1584
1585 t = dflt_t_guess
1586
1587 if (time_stepper == 23) then
1588 nondim_time = mytime
1589 else
1590 if (t_step_old /= dflt_int) then
1591 nondim_time = real(t_step + t_step_old, wp)*dt
1592 else
1593 nondim_time = real(t_step, wp)*dt
1594 end if
1595 end if
1596
1597 do i = 1, num_probes
1598 rho = 0._wp
1599 do s = 1, num_vels
1600 vel(s) = 0._wp
1601 end do
1602 pres = 0._wp
1603 gamma = 0._wp
1604 pi_inf = 0._wp
1605 qv = 0._wp
1606 c = 0._wp
1607 accel = 0._wp
1608 nr = 0._wp; r = 0._wp
1609 nrdot = 0._wp; rdot = 0._wp
1610 nbub = 0._wp
1611 m00 = 0._wp
1612 m10 = 0._wp
1613 m01 = 0._wp
1614 m20 = 0._wp
1615 m02 = 0._wp
1616 varr = 0._wp; varv = 0._wp
1617 alf = 0._wp
1618 do s = 1, (num_dims*(num_dims + 1))/2
1619 tau_e(s) = 0._wp
1620 end do
1621 damage_state = 0._wp
1622
1623 if (n == 0) then
1624 if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then
1625 do s = -1, m
1626 distx(s) = x_cb(s) - probe(i)%x
1627 if (distx(s) < 0._wp) distx(s) = 1000._wp
1628 end do
1629 j = minloc(distx, 1)
1630 if (j == 1) j = 2 ! Pick first point if probe is at edge
1631 k = 0
1632 l = 0
1633
1634 if (chemistry) then
1635 do d = 1, num_species
1636 rhoyks(d) = q_cons_vf(eqn_idx%species%beg + d - 1)%sf(j - 2, k, l)
1637 end do
1638 end if
1639
1640 ! Computing/Sharing necessary state variables
1641 if (elasticity) then
1642 call s_convert_to_mixture_variables(q_cons_vf, j - 2, k, l, rho, gamma, pi_inf, qv, re, g_local, &
1643 & fluid_pp(:)%G)
1644 else
1645 call s_convert_to_mixture_variables(q_cons_vf, j - 2, k, l, rho, gamma, pi_inf, qv)
1646 end if
1647 do s = 1, num_vels
1648 vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j - 2, k, l)/rho
1649 end do
1650
1651 dyn_p = 0.5_wp*rho*dot_product(vel, vel)
1652
1653 if (elasticity) then
1654 if (cont_damage) then
1655 damage_state = q_cons_vf(eqn_idx%damage)%sf(j - 2, k, l)
1656 g_local = g_local*max((1._wp - damage_state), 0._wp)
1657 end if
1658
1659 call s_compute_pressure(q_cons_vf(1)%sf(j - 2, k, l), q_cons_vf(eqn_idx%alf)%sf(j - 2, k, l), dyn_p, &
1660 & pi_inf, gamma, rho, qv, rhoyks(:), pres, t, &
1661 & q_cons_vf(eqn_idx%stress%beg)%sf(j - 2, k, l), &
1662 & q_cons_vf(eqn_idx%mom%beg)%sf(j - 2, k, l), g_local)
1663 else
1664 call s_compute_pressure(q_cons_vf(eqn_idx%E)%sf(j - 2, k, l), q_cons_vf(eqn_idx%alf)%sf(j - 2, k, l), &
1665 & dyn_p, pi_inf, gamma, rho, qv, rhoyks, pres, t)
1666 end if
1667
1668 if (model_eqns == 4) then
1669 lit_gamma = gammas(1)
1670 else if (elasticity) then
1671 tau_e(1) = q_cons_vf(eqn_idx%stress%end)%sf(j - 2, k, l)/rho
1672 end if
1673
1674 if (bubbles_euler) then
1675 alf = q_cons_vf(eqn_idx%alf)%sf(j - 2, k, l)
1676 if (num_fluids == 3) then
1677 alfgr = q_cons_vf(eqn_idx%alf - 1)%sf(j - 2, k, l)
1678 end if
1679 do s = 1, nb
1680 nr(s) = q_cons_vf(qbmm_idx%rs(s))%sf(j - 2, k, l)
1681 nrdot(s) = q_cons_vf(qbmm_idx%vs(s))%sf(j - 2, k, l)
1682 end do
1683
1684 if (adv_n) then
1685 nbub = q_cons_vf(eqn_idx%n)%sf(j - 2, k, l)
1686 else
1687 nr3 = 0._wp
1688 do s = 1, nb
1689 nr3 = nr3 + weight(s)*(nr(s)**3._wp)
1690 end do
1691
1692 nbub = sqrt((4._wp*pi/3._wp)*nr3/alf)
1693 end if
1694#ifdef MFC_DEBUG
1695 print *, 'In probe, nbub: ', nbub
1696#endif
1697 if (qbmm) then
1698 m00 = q_cons_vf(qbmm_idx%moms(1, 1))%sf(j - 2, k, l)/nbub
1699 m10 = q_cons_vf(qbmm_idx%moms(1, 2))%sf(j - 2, k, l)/nbub
1700 m01 = q_cons_vf(qbmm_idx%moms(1, 3))%sf(j - 2, k, l)/nbub
1701 m20 = q_cons_vf(qbmm_idx%moms(1, 4))%sf(j - 2, k, l)/nbub
1702 m02 = q_cons_vf(qbmm_idx%moms(1, 6))%sf(j - 2, k, l)/nbub
1703
1704 m10 = m10/m00
1705 m01 = m01/m00
1706 m20 = m20/m00
1707 m02 = m02/m00
1708
1709 varr = m20 - m10**2._wp
1710 varv = m02 - m01**2._wp
1711 end if
1712 r(:) = nr(:)/nbub
1713 rdot(:) = nrdot(:)/nbub
1714
1715 ptilde = ptil(j - 2, k, l)
1716 ptot = pres - ptilde
1717 end if
1718
1719 ! Compute mixture sound Speed
1720 call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, ((gamma + 1._wp)*pres + pi_inf)/rho, alpha, 0._wp, &
1721 & 0._wp, c, qv)
1722
1723 accel = accel_mag(j - 2, k, l)
1724 end if
1725 else if (p == 0) then
1726 if (chemistry) then
1727 do d = 1, num_species
1728 rhoyks(d) = q_cons_vf(eqn_idx%species%beg + d - 1)%sf(j - 2, k - 2, l)
1729 end do
1730 end if
1731
1732 if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then
1733 if ((probe(i)%y >= y_cb(-1)) .and. (probe(i)%y <= y_cb(n))) then
1734 do s = -1, m
1735 distx(s) = x_cb(s) - probe(i)%x
1736 if (distx(s) < 0._wp) distx(s) = 1000._wp
1737 end do
1738 do s = -1, n
1739 disty(s) = y_cb(s) - probe(i)%y
1740 if (disty(s) < 0._wp) disty(s) = 1000._wp
1741 end do
1742 j = minloc(distx, 1)
1743 k = minloc(disty, 1)
1744 if (j == 1) j = 2 ! Pick first point if probe is at edge
1745 if (k == 1) k = 2 ! Pick first point if probe is at edge
1746 l = 0
1747
1748 ! Computing/Sharing necessary state variables
1749 call s_convert_to_mixture_variables(q_cons_vf, j - 2, k - 2, l, rho, gamma, pi_inf, qv, re, g_local, &
1750 & fluid_pp(:)%G)
1751 do s = 1, num_vels
1752 vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j - 2, k - 2, l)/rho
1753 end do
1754
1755 dyn_p = 0.5_wp*rho*dot_product(vel, vel)
1756
1757 if (elasticity) then
1758 if (cont_damage) then
1759 damage_state = q_cons_vf(eqn_idx%damage)%sf(j - 2, k - 2, l)
1760 g_local = g_local*max((1._wp - damage_state), 0._wp)
1761 end if
1762
1763 call s_compute_pressure(q_cons_vf(1)%sf(j - 2, k - 2, l), q_cons_vf(eqn_idx%alf)%sf(j - 2, k - 2, l), &
1764 & dyn_p, pi_inf, gamma, rho, qv, rhoyks, pres, t, &
1765 & q_cons_vf(eqn_idx%stress%beg)%sf(j - 2, k - 2, l), &
1766 & q_cons_vf(eqn_idx%mom%beg)%sf(j - 2, k - 2, l), g_local)
1767 else
1768 call s_compute_pressure(q_cons_vf(eqn_idx%E)%sf(j - 2, k - 2, l), q_cons_vf(eqn_idx%alf)%sf(j - 2, &
1769 & k - 2, l), dyn_p, pi_inf, gamma, rho, qv, rhoyks, pres, t)
1770 end if
1771
1772 if (model_eqns == 4) then
1773 lit_gamma = gs_min(1)
1774 else if (elasticity) then
1775 do s = 1, 3
1776 tau_e(s) = q_cons_vf(s)%sf(j - 2, k - 2, l)/rho
1777 end do
1778 end if
1779
1780 if (bubbles_euler) then
1781 alf = q_cons_vf(eqn_idx%alf)%sf(j - 2, k - 2, l)
1782 do s = 1, nb
1783 nr(s) = q_cons_vf(qbmm_idx%rs(s))%sf(j - 2, k - 2, l)
1784 nrdot(s) = q_cons_vf(qbmm_idx%vs(s))%sf(j - 2, k - 2, l)
1785 end do
1786
1787 if (adv_n) then
1788 nbub = q_cons_vf(eqn_idx%n)%sf(j - 2, k - 2, l)
1789 else
1790 nr3 = 0._wp
1791 do s = 1, nb
1792 nr3 = nr3 + weight(s)*(nr(s)**3._wp)
1793 end do
1794
1795 nbub = sqrt((4._wp*pi/3._wp)*nr3/alf)
1796 end if
1797
1798 r(:) = nr(:)/nbub
1799 rdot(:) = nrdot(:)/nbub
1800 end if
1801 ! Compute mixture sound speed
1802 call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, ((gamma + 1._wp)*pres + pi_inf)/rho, alpha, &
1803 & 0._wp, 0._wp, c, qv)
1804 end if
1805 end if
1806 else
1807 if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then
1808 if ((probe(i)%y >= y_cb(-1)) .and. (probe(i)%y <= y_cb(n))) then
1809 if ((probe(i)%z >= z_cb(-1)) .and. (probe(i)%z <= z_cb(p))) then
1810 do s = -1, m
1811 distx(s) = x_cb(s) - probe(i)%x
1812 if (distx(s) < 0._wp) distx(s) = 1000._wp
1813 end do
1814 do s = -1, n
1815 disty(s) = y_cb(s) - probe(i)%y
1816 if (disty(s) < 0._wp) disty(s) = 1000._wp
1817 end do
1818 do s = -1, p
1819 distz(s) = z_cb(s) - probe(i)%z
1820 if (distz(s) < 0._wp) distz(s) = 1000._wp
1821 end do
1822 j = minloc(distx, 1)
1823 k = minloc(disty, 1)
1824 l = minloc(distz, 1)
1825 if (j == 1) j = 2 ! Pick first point if probe is at edge
1826 if (k == 1) k = 2 ! Pick first point if probe is at edge
1827 if (l == 1) l = 2 ! Pick first point if probe is at edge
1828
1829 ! Computing/Sharing necessary state variables
1830 call s_convert_to_mixture_variables(q_cons_vf, j - 2, k - 2, l - 2, rho, gamma, pi_inf, qv, re, &
1831 & g_local, fluid_pp(:)%G)
1832 do s = 1, num_vels
1833 vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j - 2, k - 2, l - 2)/rho
1834 end do
1835
1836 dyn_p = 0.5_wp*rho*dot_product(vel, vel)
1837
1838 if (chemistry) then
1839 do d = 1, num_species
1840 rhoyks(d) = q_cons_vf(eqn_idx%species%beg + d - 1)%sf(j - 2, k - 2, l - 2)
1841 end do
1842 end if
1843
1844 if (elasticity) then
1845 if (cont_damage) then
1846 damage_state = q_cons_vf(eqn_idx%damage)%sf(j - 2, k - 2, l - 2)
1847 g_local = g_local*max((1._wp - damage_state), 0._wp)
1848 end if
1849
1850 call s_compute_pressure(q_cons_vf(1)%sf(j - 2, k - 2, l - 2), q_cons_vf(eqn_idx%alf)%sf(j - 2, &
1851 & k - 2, l - 2), dyn_p, pi_inf, gamma, rho, qv, rhoyks, pres, t, &
1852 & q_cons_vf(eqn_idx%stress%beg)%sf(j - 2, k - 2, l - 2), &
1853 & q_cons_vf(eqn_idx%mom%beg)%sf(j - 2, k - 2, l - 2), g_local)
1854 else
1855 call s_compute_pressure(q_cons_vf(eqn_idx%E)%sf(j - 2, k - 2, l - 2), &
1856 & q_cons_vf(eqn_idx%alf)%sf(j - 2, k - 2, l - 2), dyn_p, pi_inf, gamma, &
1857 & rho, qv, rhoyks, pres, t)
1858 end if
1859
1860 ! Compute mixture sound speed
1861 call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, ((gamma + 1._wp)*pres + pi_inf)/rho, alpha, &
1862 & 0._wp, 0._wp, c, qv)
1863
1864 accel = accel_mag(j - 2, k - 2, l - 2)
1865 end if
1866 end if
1867 end if
1868 end if
1869 if (num_procs > 1) then
1870# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1871 tmp = rho
1872 call s_mpi_allreduce_sum(tmp, rho)
1873# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1874 tmp = pres
1875 call s_mpi_allreduce_sum(tmp, pres)
1876# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1877 tmp = gamma
1878 call s_mpi_allreduce_sum(tmp, gamma)
1879# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1880 tmp = pi_inf
1881 call s_mpi_allreduce_sum(tmp, pi_inf)
1882# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1883 tmp = qv
1884 call s_mpi_allreduce_sum(tmp, qv)
1885# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1886 tmp = c
1887 call s_mpi_allreduce_sum(tmp, c)
1888# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1889 tmp = accel
1890 call s_mpi_allreduce_sum(tmp, accel)
1891# 1389 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1892
1893 do s = 1, num_vels
1894 tmp = vel(s)
1895 call s_mpi_allreduce_sum(tmp, vel(s))
1896 end do
1897
1898 if (bubbles_euler) then
1899# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1900 tmp = alf
1901 call s_mpi_allreduce_sum(tmp, alf)
1902# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1903 tmp = alfgr
1904 call s_mpi_allreduce_sum(tmp, alfgr)
1905# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1906 tmp = nbub
1907 call s_mpi_allreduce_sum(tmp, nbub)
1908# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1909 tmp = nr(1)
1910 call s_mpi_allreduce_sum(tmp, nr(1))
1911# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1912 tmp = nrdot(1)
1913 call s_mpi_allreduce_sum(tmp, nrdot(1))
1914# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1915 tmp = m00
1916 call s_mpi_allreduce_sum(tmp, m00)
1917# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1918 tmp = r(1)
1919 call s_mpi_allreduce_sum(tmp, r(1))
1920# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1921 tmp = rdot(1)
1922 call s_mpi_allreduce_sum(tmp, rdot(1))
1923# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1924 tmp = ptilde
1925 call s_mpi_allreduce_sum(tmp, ptilde)
1926# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1927 tmp = ptot
1928 call s_mpi_allreduce_sum(tmp, ptot)
1929# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1930
1931 if (qbmm) then
1932# 1403 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1933 tmp = varr
1934 call s_mpi_allreduce_sum(tmp, varr)
1935# 1403 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1936 tmp = varv
1937 call s_mpi_allreduce_sum(tmp, varv)
1938# 1403 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1939 tmp = m10
1940 call s_mpi_allreduce_sum(tmp, m10)
1941# 1403 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1942 tmp = m01
1943 call s_mpi_allreduce_sum(tmp, m01)
1944# 1403 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1945 tmp = m20
1946 call s_mpi_allreduce_sum(tmp, m20)
1947# 1403 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1948 tmp = m02
1949 call s_mpi_allreduce_sum(tmp, m02)
1950# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1951 end if
1952 end if
1953
1954 if (elasticity) then
1955 do s = 1, (num_dims*(num_dims + 1))/2
1956 tmp = tau_e(s)
1957 call s_mpi_allreduce_sum(tmp, tau_e(s))
1958 end do
1959 end if
1960
1961 if (cont_damage) then
1962 tmp = damage_state
1963 call s_mpi_allreduce_sum(tmp, damage_state)
1964 end if
1965 end if
1966 if (proc_rank == 0) then
1967 if (n == 0) then
1968 if (bubbles_euler .and. (num_fluids <= 2)) then
1969 if (qbmm) then
1970 write (i + 30, '(6x,f12.6,14f28.16)') nondim_time, rho, vel(1), pres, alf, r(1), rdot(1), nr(1), &
1971 & nrdot(1), varr, varv, m10, m01, m20, m02
1972 else
1973 write (i + 30, '(6x,f12.6,8f24.8)') nondim_time, rho, vel(1), pres, alf, r(1), rdot(1), nr(1), nrdot(1)
1974 ! ptilde, & ptot
1975 end if
1976 else if (bubbles_euler .and. (num_fluids == 3)) then
1977 write (i + 30, &
1978 & '(6x,f12.6,f24.8,f24.8,f24.8,f24.8,f24.8,' // 'f24.8,f24.8,f24.8,f24.8,f24.8, f24.8)') &
1979 & nondim_time, rho, vel(1), pres, alf, alfgr, nr(1), nrdot(1), r(1), rdot(1), ptilde, ptot
1980 else if (bubbles_euler .and. num_fluids == 4) then
1981 write (i + 30, &
1982 & '(6x,f12.6,f24.8,f24.8,f24.8,f24.8,' // 'f24.8,f24.8,f24.8,f24.8,f24.8,f24.8,f24.8,f24.8,f24.8)') &
1983 & nondim_time, q_cons_vf(1)%sf(j - 2, 0, 0), q_cons_vf(2)%sf(j - 2, 0, 0), q_cons_vf(3)%sf(j - 2, &
1984 & 0, 0), q_cons_vf(4)%sf(j - 2, 0, 0), q_cons_vf(5)%sf(j - 2, 0, 0), q_cons_vf(6)%sf(j - 2, 0, 0), &
1985 & q_cons_vf(7)%sf(j - 2, 0, 0), q_cons_vf(8)%sf(j - 2, 0, 0), q_cons_vf(9)%sf(j - 2, 0, 0), &
1986 & q_cons_vf(10)%sf(j - 2, 0, 0), nbub, r(1), rdot(1)
1987 else
1988 write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8)') nondim_time, rho, vel(1), pres
1989 end if
1990 else if (p == 0) then
1991 if (bubbles_euler) then
1992# 1448 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1993 write (i + 30, '(6X,10F24.8)') nondim_time, rho, vel(1), vel(2), pres, alf, nr(1), nrdot(1), r(1), &
1994 & rdot(1)
1995# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1996 else if (elasticity) then
1997# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
1998 write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,' // 'F24.8,F24.8,F24.8)') nondim_time, rho, &
1999 & vel(1), vel(2), pres, tau_e(1), tau_e(2), tau_e(3)
2000# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2001 else
2002 write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8)') nondim_time, rho, vel(1), pres
2003 print *, 'time =', nondim_time, 'rho =', rho, 'pres =', pres
2004 end if
2005 else
2006# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2007 write (i + 30, &
2008 & '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,' // 'F24.8,F24.8,F24.8,F24.8,F24.8,' // 'F24.8)') &
2009 & nondim_time, rho, vel(1), vel(2), vel(3), pres, gamma, pi_inf, qv, c, accel
2010# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2011 end if
2012 end if
2013 end do
2014
2015 if (integral_wrt .and. bubbles_euler) then
2016 if (n == 0) then
2017 do i = 1, num_integrals
2018 int_pres = 0._wp
2019 max_pres = 0._wp
2020 k = 0; l = 0
2021 npts = 0
2022 do j = 1, m
2023 pres = 0._wp
2024 do s = 1, num_vels
2025 vel(s) = 0._wp
2026 end do
2027 rho = 0._wp
2028 pres = 0._wp
2029 gamma = 0._wp
2030 pi_inf = 0._wp
2031 qv = 0._wp
2032
2033 if ((integral(i)%xmin <= x_cb(j)) .and. (integral(i)%xmax >= x_cb(j))) then
2034 npts = npts + 1
2035 call s_convert_to_mixture_variables(q_cons_vf, j, k, l, rho, gamma, pi_inf, qv, re)
2036 do s = 1, num_vels
2037 vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j, k, l)/rho
2038 end do
2039
2040 pres = ((q_cons_vf(eqn_idx%E)%sf(j, k, l) - 0.5_wp*(q_cons_vf(eqn_idx%mom%beg)%sf(j, k, &
2041 & l)**2._wp)/rho)/(1._wp - q_cons_vf(eqn_idx%alf)%sf(j, k, l)) - pi_inf - qv)/gamma
2042 int_pres = int_pres + (pres - 1._wp)**2._wp
2043 end if
2044 end do
2045 int_pres = sqrt(int_pres/(1._wp*npts))
2046
2047 if (num_procs > 1) then
2048 tmp = int_pres
2049 call s_mpi_allreduce_sum(tmp, int_pres)
2050 end if
2051
2052 if (proc_rank == 0) then
2053 if (bubbles_euler .and. (num_fluids <= 2)) then
2054 write (i + 70, '(6x,f12.6,f24.8)') nondim_time, int_pres
2055 end if
2056 end if
2057 end do
2058 else if (p == 0) then
2059 if (num_integrals /= 3) then
2060 call s_mpi_abort('Incorrect number of integrals')
2061 end if
2062
2063 rad = integral(1)%xmax
2064 thickness = integral(1)%xmin
2065
2066 do i = 1, num_integrals
2067 int_pres = 0._wp
2068 max_pres = 0._wp
2069 l = 0
2070 npts = 0
2071 do j = 1, m
2072 do k = 1, n
2073 trigger = .false.
2074 if (i == 1) then
2075 ! inner portion
2076 if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad - 0.5_wp*thickness)) trigger = .true.
2077 else if (i == 2) then
2078 ! net region
2079 if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad - 0.5_wp*thickness) .and. sqrt(x_cb(j)**2._wp &
2080 & + y_cb(k)**2._wp) < (rad + 0.5_wp*thickness)) trigger = .true.
2081 else if (i == 3) then
2082 ! everything else
2083 if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad + 0.5_wp*thickness)) trigger = .true.
2084 end if
2085
2086 pres = 0._wp
2087 do s = 1, num_vels
2088 vel(s) = 0._wp
2089 end do
2090 rho = 0._wp
2091 pres = 0._wp
2092 gamma = 0._wp
2093 pi_inf = 0._wp
2094 qv = 0._wp
2095
2096 if (trigger) then
2097 npts = npts + 1
2098 call s_convert_to_mixture_variables(q_cons_vf, j, k, l, rho, gamma, pi_inf, qv, re)
2099 do s = 1, num_vels
2100 vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j, k, l)/rho
2101 end do
2102
2103 pres = ((q_cons_vf(eqn_idx%E)%sf(j, k, l) - 0.5_wp*(q_cons_vf(eqn_idx%mom%beg)%sf(j, k, &
2104 & l)**2._wp)/rho)/(1._wp - q_cons_vf(eqn_idx%alf)%sf(j, k, l)) - pi_inf - qv)/gamma
2105 int_pres = int_pres + abs(pres - 1._wp)
2106 max_pres = max(max_pres, abs(pres - 1._wp))
2107 end if
2108 end do
2109 end do
2110
2111 if (npts > 0) then
2112 int_pres = int_pres/(1._wp*npts)
2113 else
2114 int_pres = 0._wp
2115 end if
2116
2117 if (num_procs > 1) then
2118 tmp = int_pres
2119 call s_mpi_allreduce_sum(tmp, int_pres)
2120
2121 tmp = max_pres
2122 call s_mpi_allreduce_max(tmp, max_pres)
2123 end if
2124
2125 if (proc_rank == 0) then
2126 if (bubbles_euler .and. (num_fluids <= 2)) then
2127 write (i + 70, '(6x,f12.6,f24.8,f24.8)') nondim_time, int_pres, max_pres
2128 end if
2129 end if
2130 end do
2131 end if
2132 end if
2133
2134 end subroutine s_write_probe_files
2135
2136 !> Write footer with stability criteria extrema and run-time to the information file, then close it
2137 impure subroutine s_close_run_time_information_file
2138
2139 real(wp) :: run_time !< Run-time of the simulation
2140
2141 write (3, '(A)') ' '
2142 write (3, '(A)') ''
2143
2144 write (3, '(A,F9.6)') 'ICFL Max: ', icfl_max
2145 if (viscous) write (3, '(A,F9.6)') 'VCFL Max: ', vcfl_max
2146 if (viscous) write (3, '(A,F10.6)') 'Rc Min: ', rc_min
2147
2148 call cpu_time(run_time)
2149
2150 write (3, '(A)') ''
2151 write (3, '(A,I0,A)') 'Run-time: ', int(anint(run_time)), 's'
2152 write (3, '(A)') ' '
2153 close (3)
2154
2155 end subroutine s_close_run_time_information_file
2156
2157 !> Closes communication files
2158 impure subroutine s_close_com_files()
2159
2160 integer :: i !< Generic loop iterator
2161
2162 do i = 1, num_fluids
2163 close (i + 120)
2164 end do
2165
2166 end subroutine s_close_com_files
2167
2168 !> Closes probe files
2169 impure subroutine s_close_probe_files
2170
2171 integer :: i !< Generic loop iterator
2172
2173 do i = 1, num_probes
2174 close (i + 30)
2175 end do
2176
2177 end subroutine s_close_probe_files
2178
2179 !> Initialize the data output module
2180 impure subroutine s_initialize_data_output_module
2181
2182 integer :: i, m_ds, n_ds, p_ds
2183
2184 if (run_time_info) then
2185#ifdef MFC_DEBUG
2186# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2187 block
2188# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2189 use iso_fortran_env, only: output_unit
2190# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2191
2192# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2193 print *, 'm_data_output.fpp:1640: ', '@:ALLOCATE(icfl_sf(0:m, 0:n, 0:p))'
2194# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2195
2196# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2197 call flush (output_unit)
2198# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2199 end block
2200# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2201#endif
2202# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2203 allocate (icfl_sf(0:m, 0:n, 0:p))
2204# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2205
2206# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2207
2208# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2209#if defined(MFC_OpenACC)
2210# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2211!$acc enter data create(icfl_sf)
2212# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2213#elif defined(MFC_OpenMP)
2214# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2215!$omp target enter data map(always,alloc:icfl_sf)
2216# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2217#endif
2218 icfl_max = 0._wp
2219
2220 if (viscous) then
2221#ifdef MFC_DEBUG
2222# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2223 block
2224# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2225 use iso_fortran_env, only: output_unit
2226# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2227
2228# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2229 print *, 'm_data_output.fpp:1644: ', '@:ALLOCATE(vcfl_sf(0:m, 0:n, 0:p))'
2230# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2231
2232# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2233 call flush (output_unit)
2234# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2235 end block
2236# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2237#endif
2238# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2239 allocate (vcfl_sf(0:m, 0:n, 0:p))
2240# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2241
2242# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2243
2244# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2245#if defined(MFC_OpenACC)
2246# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2247!$acc enter data create(vcfl_sf)
2248# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2249#elif defined(MFC_OpenMP)
2250# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2251!$omp target enter data map(always,alloc:vcfl_sf)
2252# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2253#endif
2254#ifdef MFC_DEBUG
2255# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2256 block
2257# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2258 use iso_fortran_env, only: output_unit
2259# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2260
2261# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2262 print *, 'm_data_output.fpp:1645: ', '@:ALLOCATE(Rc_sf (0:m, 0:n, 0:p))'
2263# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2264
2265# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2266 call flush (output_unit)
2267# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2268 end block
2269# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2270#endif
2271# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2272 allocate (rc_sf(0:m, 0:n, 0:p))
2273# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2274
2275# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2276
2277# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2278#if defined(MFC_OpenACC)
2279# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2280!$acc enter data create(Rc_sf)
2281# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2282#elif defined(MFC_OpenMP)
2283# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2284!$omp target enter data map(always,alloc:Rc_sf)
2285# 1645 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2286#endif
2287
2288 vcfl_max = 0._wp
2289 rc_min = 1.e3_wp
2290 end if
2291 end if
2292
2293 if (probe_wrt) then
2294#ifdef MFC_DEBUG
2295# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2296 block
2297# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2298 use iso_fortran_env, only: output_unit
2299# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2300
2301# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2302 print *, 'm_data_output.fpp:1653: ', '@:ALLOCATE(c_mass(num_fluids,5))'
2303# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2304
2305# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2306 call flush (output_unit)
2307# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2308 end block
2309# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2310#endif
2311# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2312 allocate (c_mass(num_fluids,5))
2313# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2314
2315# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2316
2317# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2318#if defined(MFC_OpenACC)
2319# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2320!$acc enter data create(c_mass)
2321# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2322#elif defined(MFC_OpenMP)
2323# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2324!$omp target enter data map(always,alloc:c_mass)
2325# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2326#endif
2327 end if
2328
2329 if (down_sample) then
2330 m_ds = int((m + 1)/3) - 1
2331 n_ds = int((n + 1)/3) - 1
2332 p_ds = int((p + 1)/3) - 1
2333
2334 allocate (q_cons_temp_ds(1:sys_size))
2335 do i = 1, sys_size
2336 allocate (q_cons_temp_ds(i)%sf(-1:m_ds + 1,-1:n_ds + 1,-1:p_ds + 1))
2337 end do
2338 end if
2339
2340 end subroutine s_initialize_data_output_module
2341
2342 !> Module deallocation and/or disassociation procedures
2343 impure subroutine s_finalize_data_output_module
2344
2345 integer :: i
2346
2347 if (probe_wrt) then
2348#ifdef MFC_DEBUG
2349# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2350 block
2351# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2352 use iso_fortran_env, only: output_unit
2353# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2354
2355# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2356 print *, 'm_data_output.fpp:1675: ', '@:DEALLOCATE(c_mass)'
2357# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2358
2359# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2360 call flush (output_unit)
2361# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2362 end block
2363# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2364#endif
2365# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2366
2367# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2368#if defined(MFC_OpenACC)
2369# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2370!$acc exit data delete(c_mass)
2371# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2372#elif defined(MFC_OpenMP)
2373# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2374!$omp target exit data map(release:c_mass)
2375# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2376#endif
2377# 1675 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2378 deallocate (c_mass)
2379 end if
2380
2381 if (run_time_info) then
2382#ifdef MFC_DEBUG
2383# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2384 block
2385# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2386 use iso_fortran_env, only: output_unit
2387# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2388
2389# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2390 print *, 'm_data_output.fpp:1679: ', '@:DEALLOCATE(icfl_sf)'
2391# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2392
2393# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2394 call flush (output_unit)
2395# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2396 end block
2397# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2398#endif
2399# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2400
2401# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2402#if defined(MFC_OpenACC)
2403# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2404!$acc exit data delete(icfl_sf)
2405# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2406#elif defined(MFC_OpenMP)
2407# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2408!$omp target exit data map(release:icfl_sf)
2409# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2410#endif
2411# 1679 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2412 deallocate (icfl_sf)
2413 if (viscous) then
2414#ifdef MFC_DEBUG
2415# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2416 block
2417# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2418 use iso_fortran_env, only: output_unit
2419# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2420
2421# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2422 print *, 'm_data_output.fpp:1681: ', '@:DEALLOCATE(vcfl_sf, Rc_sf)'
2423# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2424
2425# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2426 call flush (output_unit)
2427# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2428 end block
2429# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2430#endif
2431# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2432
2433# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2434#if defined(MFC_OpenACC)
2435# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2436!$acc exit data delete(vcfl_sf, Rc_sf)
2437# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2438#elif defined(MFC_OpenMP)
2439# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2440!$omp target exit data map(release:vcfl_sf, Rc_sf)
2441# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2442#endif
2443# 1681 "/home/runner/work/MFC/MFC/src/simulation/m_data_output.fpp"
2444 deallocate (vcfl_sf, rc_sf)
2445 end if
2446 end if
2447
2448 if (down_sample) then
2449 do i = 1, sys_size
2450 deallocate (q_cons_temp_ds(i)%sf)
2451 end do
2452 deallocate (q_cons_temp_ds)
2453 end if
2454
2455 end subroutine s_finalize_data_output_module
2456
2457end module m_data_output
q_cons_vf
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
Definition m_phase_change.fpp.f90:1065
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1067
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1067
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1067
m_boundary_common
Noncharacteristic and processor boundary condition application for ghost cells and buffer regions.
Definition m_boundary_common.fpp.f90:328
m_compile_specific
Platform-specific file and directory operations: create, delete, inquire, getcwd, and basename.
Definition m_compile_specific.f90:6
m_compile_specific::s_delete_directory
impure subroutine s_delete_directory(dir_name)
Recursively delete a directory using a platform-specific system command.
Definition m_compile_specific.f90:43
m_compile_specific::my_inquire
impure subroutine my_inquire(fileloc, dircheck)
Inquires on the existence of a directory.
Definition m_compile_specific.f90:57
m_compile_specific::s_create_directory
impure subroutine s_create_directory(dir_name)
Create a directory and all its parents if it does not exist.
Definition m_compile_specific.f90:17
m_data_output
Writes solution data, run-time stability diagnostics (ICFL, VCFL, CCFL, Rc), and probe/center-of-mass...
Definition m_data_output.fpp.f90:328
m_data_output::c_mass
real(wp), dimension(:,:), allocatable, public c_mass
Definition m_data_output.fpp.f90:353
m_data_output::s_open_probe_files
impure subroutine, public s_open_probe_files
Open flow probe data files for writing.
Definition m_data_output.fpp.f90:482
m_data_output::rc_min
real(wp) rc_min
Rc criterion maximum.
Definition m_data_output.fpp.f90:396
m_data_output::vcfl_max
real(wp) vcfl_max
VCFL criterion maximum.
Definition m_data_output.fpp.f90:395
m_data_output::vcfl_sf
real(wp), dimension(:,:,:), allocatable vcfl_sf
VCFL stability criterion.
Definition m_data_output.fpp.f90:351
m_data_output::s_write_probe_files
impure subroutine, public s_write_probe_files(t_step, q_cons_vf, accel_mag)
Write flow probe data at the current time step.
Definition m_data_output.fpp.f90:1542
m_data_output::s_write_parallel_ib_state
subroutine s_write_parallel_ib_state(t_step)
Writes the IB state information out to file.
Definition m_data_output.fpp.f90:1387
m_data_output::icfl_max_loc
real(wp) icfl_max_loc
Definition m_data_output.fpp.f90:366
m_data_output::rc_min_glb
real(wp) rc_min_glb
Rc stability extrema on local and global grids.
Definition m_data_output.fpp.f90:368
m_data_output::s_write_com_files
impure subroutine, public s_write_com_files(t_step, c_mass_in)
Write center-of-mass data at the current time step.
Definition m_data_output.fpp.f90:1509
m_data_output::vcfl_max_loc
real(wp) vcfl_max_loc
Definition m_data_output.fpp.f90:367
m_data_output::s_initialize_data_output_module
impure subroutine, public s_initialize_data_output_module
Initialize the data output module.
Definition m_data_output.fpp.f90:2181
m_data_output::s_finalize_data_output_module
impure subroutine, public s_finalize_data_output_module
Module deallocation and/or disassociation procedures.
Definition m_data_output.fpp.f90:2344
m_data_output::s_write_serial_ib_state
subroutine s_write_serial_ib_state(t_step)
Write IB state data to a per-timestep serial (unformatted) file.
Definition m_data_output.fpp.f90:1460
m_data_output::s_write_serial_ib_data
subroutine s_write_serial_ib_data(time_step)
Write immersed boundary marker data to a serial (per-processor) unformatted file.
Definition m_data_output.fpp.f90:1299
m_data_output::s_close_run_time_information_file
impure subroutine, public s_close_run_time_information_file
Write footer with stability criteria extrema and run-time to the information file,...
Definition m_data_output.fpp.f90:2138
m_data_output::vcfl_max_glb
real(wp) vcfl_max_glb
VCFL stability extrema on local and global grids.
Definition m_data_output.fpp.f90:367
m_data_output::s_write_data_files
impure subroutine, public s_write_data_files(q_cons_vf, q_t_sf, q_prim_vf, t_step, bc_type, beta)
Write data files. Dispatch subroutine that replaces procedure pointer.
Definition m_data_output.fpp.f90:405
m_data_output::s_write_serial_data_files
impure subroutine, public s_write_serial_data_files(q_cons_vf, q_t_sf, q_prim_vf, t_step, bc_type, beta)
Write grid and conservative variable data files in serial format.
Definition m_data_output.fpp.f90:734
m_data_output::rc_sf
real(wp), dimension(:,:,:), allocatable rc_sf
Rc stability criterion.
Definition m_data_output.fpp.f90:352
m_data_output::s_close_probe_files
impure subroutine, public s_close_probe_files
Closes probe files.
Definition m_data_output.fpp.f90:2170
m_data_output::s_close_com_files
impure subroutine, public s_close_com_files()
Closes communication files.
Definition m_data_output.fpp.f90:2159
m_data_output::icfl_max_glb
real(wp) icfl_max_glb
ICFL stability extrema on local and global grids.
Definition m_data_output.fpp.f90:366
m_data_output::s_write_run_time_information
impure subroutine, public s_write_run_time_information(q_prim_vf, t_step)
Write stability criteria extrema to the run-time information file at the given time step.
Definition m_data_output.fpp.f90:513
m_data_output::s_open_run_time_information_file
impure subroutine, public s_open_run_time_information_file
Open the run-time information file and write the stability criteria table header.
Definition m_data_output.fpp.f90:423
m_data_output::rc_min_loc
real(wp) rc_min_loc
Definition m_data_output.fpp.f90:368
m_data_output::icfl_max
real(wp) icfl_max
ICFL criterion maximum.
Definition m_data_output.fpp.f90:394
m_data_output::s_write_parallel_data_files
impure subroutine, public s_write_parallel_data_files(q_cons_vf, t_step, bc_type, beta, q_t_sf)
Write grid and conservative variable data files in parallel via MPI I/O.
Definition m_data_output.fpp.f90:1102
m_data_output::s_write_ib_state_file
impure subroutine, public s_write_ib_state_file(time_step)
Writes IB state records to restart_data/ib_state.dat. Must be called only on rank 0.
Definition m_data_output.fpp.f90:1496
m_data_output::q_cons_temp_ds
type(scalar_field), dimension(:), allocatable q_cons_temp_ds
Definition m_data_output.fpp.f90:399
m_data_output::s_write_parallel_ib_data
subroutine s_write_parallel_ib_data(time_step)
Write immersed boundary marker data in parallel using MPI I/O.
Definition m_data_output.fpp.f90:1327
m_data_output::icfl_sf
real(wp), dimension(:,:,:), allocatable icfl_sf
ICFL stability criterion.
Definition m_data_output.fpp.f90:350
m_data_output::s_open_com_files
impure subroutine, public s_open_com_files()
Open center-of-mass data files for writing.
Definition m_data_output.fpp.f90:457
m_data_output::s_write_ib_data_file
subroutine, public s_write_ib_data_file(time_step)
Dispatch immersed boundary data output to the serial or parallel writer.
Definition m_data_output.fpp.f90:1374
m_delay_file_access
Rank-staggered file access delays to prevent I/O contention on parallel file systems.
Definition m_delay_file_access.f90:6
m_delay_file_access::delayfileaccess
impure subroutine, public delayfileaccess(processrank)
Introduce a rank-dependent busy-wait delay to stagger parallel file access and reduce I/O contention.
Definition m_delay_file_access.f90:22
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:317
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:328
m_global_parameters::mytime
real(wp) mytime
Current simulation time.
Definition m_global_parameters.fpp.f90:1283
m_global_parameters::bubbles_euler
logical bubbles_euler
Bubbles euler on/off.
Definition m_global_parameters.fpp.f90:1050
m_global_parameters::cont_damage
logical cont_damage
Continuum damage modeling.
Definition m_global_parameters.fpp.f90:497
m_global_parameters::p_glb
integer p_glb
Definition m_global_parameters.fpp.f90:360
m_global_parameters::igr
logical igr
Use information geometric regularization.
Definition m_global_parameters.fpp.f90:461
m_global_parameters::idwint
type(int_bounds_info), dimension(1:3) idwint
Definition m_global_parameters.fpp.f90:818
m_global_parameters::z_cb
real(wp), dimension(:), allocatable, target z_cb
Definition m_global_parameters.fpp.f90:382
m_global_parameters::chemistry
logical, parameter chemistry
Chemistry modeling.
Definition m_global_parameters.fpp.f90:494
m_global_parameters::mpi_info_int
integer mpi_info_int
Definition m_global_parameters.fpp.f90:793
m_global_parameters::num_fluids
integer num_fluids
number of fluids in the simulation
Definition m_global_parameters.fpp.f90:451
m_global_parameters::qbmm_idx
type(qbmm_idx_info) qbmm_idx
QBMM moment index mappings (allocatable; GPU-managed separately).
Definition m_global_parameters.fpp.f90:801
m_global_parameters::proc_rank
integer proc_rank
Rank of the local processor.
Definition m_global_parameters.fpp.f90:349
m_global_parameters::mpi_io_ib_data
type(mpi_io_ib_var), public mpi_io_ib_data
Definition m_global_parameters.fpp.f90:784
m_global_parameters::dummy
logical dummy
AMDFlang workaround for case-optimization + GPU-kernel bug.
Definition m_global_parameters.fpp.f90:1332
m_global_parameters::mpiiofs
character(len=name_len) mpiiofs
Definition m_global_parameters.fpp.f90:792
m_global_parameters::probe
type(vec3_dt), dimension(num_probes_max) probe
Definition m_global_parameters.fpp.f90:958
m_global_parameters::sys_size
integer sys_size
Number of unknowns in system of eqns.
Definition m_global_parameters.fpp.f90:799
m_global_parameters::weight
real(wp), dimension(:), allocatable weight
Simpson quadrature weights.
Definition m_global_parameters.fpp.f90:1036
m_global_parameters::integral_wrt
logical integral_wrt
Definition m_global_parameters.fpp.f90:955
m_global_parameters::t_step_old
integer t_step_old
Existing IC/grid folder.
Definition m_global_parameters.fpp.f90:347
m_global_parameters::viscous
logical viscous
Viscous effects.
Definition m_global_parameters.fpp.f90:463
m_global_parameters::ib
logical ib
Definition m_global_parameters.fpp.f90:979
m_global_parameters::run_time_info
logical run_time_info
Run-time output flag.
Definition m_global_parameters.fpp.f90:346
m_global_parameters::model_eqns
integer model_eqns
Multicomponent flow model.
Definition m_global_parameters.fpp.f90:434
m_global_parameters::precision
integer precision
Precision of output files.
Definition m_global_parameters.fpp.f90:767
m_global_parameters::fluid_pp
type(physical_parameters), dimension(num_fluids_max) fluid_pp
Stiffened gas EOS parameters and Reynolds numbers per fluid.
Definition m_global_parameters.fpp.f90:937
m_global_parameters::num_dims
integer num_dims
Number of spatial dimensions.
Definition m_global_parameters.fpp.f90:436
m_global_parameters::prim_vars_wrt
logical prim_vars_wrt
Definition m_global_parameters.fpp.f90:441
m_global_parameters::num_integrals
integer num_integrals
Definition m_global_parameters.fpp.f90:957
m_global_parameters::pb_ts
type(pres_field), dimension(:), allocatable pb_ts
Definition m_global_parameters.fpp.f90:1286
m_global_parameters::mv_ts
type(pres_field), dimension(:), allocatable mv_ts
Definition m_global_parameters.fpp.f90:1287
m_global_parameters::bubbles_lagrange
logical bubbles_lagrange
Lagrangian subgrid bubble model switch.
Definition m_global_parameters.fpp.f90:1303
m_global_parameters::num_vels
integer num_vels
Number of velocity components (different from num_dims for mhd).
Definition m_global_parameters.fpp.f90:437
m_global_parameters::polytropic
logical polytropic
Polytropic switch.
Definition m_global_parameters.fpp.f90:1051
m_global_parameters::qbmm
logical qbmm
Quadrature moment method.
Definition m_global_parameters.fpp.f90:1109
m_global_parameters::t_step_save
integer t_step_save
Definition m_global_parameters.fpp.f90:411
m_global_parameters::num_probes
integer num_probes
Definition m_global_parameters.fpp.f90:956
m_global_parameters::qvs
real(wp), dimension(:), allocatable qvs
Definition m_global_parameters.fpp.f90:1270
m_global_parameters::pi_infs
real(wp), dimension(:), allocatable pi_infs
Definition m_global_parameters.fpp.f90:1270
m_global_parameters::adv_n
logical adv_n
Solve the number density equation and compute alpha from number density.
Definition m_global_parameters.fpp.f90:1065
m_global_parameters::num_procs
integer num_procs
Number of processors.
Definition m_global_parameters.fpp.f90:344
m_global_parameters::case_dir
character(len=path_len) case_dir
Case folder location.
Definition m_global_parameters.fpp.f90:345
m_global_parameters::p
integer p
Definition m_global_parameters.fpp.f90:352
m_global_parameters::parallel_io
logical parallel_io
Format of the data files.
Definition m_global_parameters.fpp.f90:765
m_global_parameters::integral
type(integral_parameters), dimension(num_probes_max) integral
Definition m_global_parameters.fpp.f90:959
m_global_parameters::y_cb
real(wp), dimension(:), allocatable, target y_cb
Definition m_global_parameters.fpp.f90:382
m_global_parameters::ptil
real(wp), dimension(:,:,:), allocatable ptil
Pressure modification.
Definition m_global_parameters.fpp.f90:1095
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:352
m_global_parameters::down_sample
logical down_sample
down sample the output files
Definition m_global_parameters.fpp.f90:768
m_global_parameters::file_per_process
logical file_per_process
shared file or not when using parallel io
Definition m_global_parameters.fpp.f90:766
m_global_parameters::elasticity
logical elasticity
elasticity modeling, true for hyper or hypo
Definition m_global_parameters.fpp.f90:493
m_global_parameters::m_glb
integer m_glb
Definition m_global_parameters.fpp.f90:360
m_global_parameters::nb
integer nb
Number of eq. bubble sizes.
Definition m_global_parameters.fpp.f90:1017
m_global_parameters::mpi_io_data
type(mpi_io_var), public mpi_io_data
Definition m_global_parameters.fpp.f90:783
m_global_parameters::n_glb
integer n_glb
Definition m_global_parameters.fpp.f90:360
m_global_parameters::dt
real(wp) dt
Size of the time-step.
Definition m_global_parameters.fpp.f90:395
m_global_parameters::time_stepper
integer time_stepper
Time-stepper algorithm.
Definition m_global_parameters.fpp.f90:440
m_global_parameters::m
integer m
Definition m_global_parameters.fpp.f90:352
m_global_parameters::gammas
real(wp), dimension(:), allocatable gammas
Definition m_global_parameters.fpp.f90:1270
m_global_parameters::gs_min
real(wp), dimension(:), allocatable gs_min
Definition m_global_parameters.fpp.f90:1270
m_global_parameters::eqn_idx
type(eqn_idx_info) eqn_idx
All conserved-variable equation index ranges and scalars.
Definition m_global_parameters.fpp.f90:800
m_global_parameters::num_ibs
integer num_ibs
Definition m_global_parameters.fpp.f90:980
m_global_parameters::patch_ib
type(ib_patch_parameters), dimension(num_ib_patches_max) patch_ib
Immersed boundary patch parameters.
Definition m_global_parameters.fpp.f90:986
m_global_parameters::x_cb
real(wp), dimension(:), allocatable, target x_cb
Definition m_global_parameters.fpp.f90:382
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:317
m_helper_basic::f_approx_equal
logical elemental function, public f_approx_equal(a, b, tol_input)
Check if two floating point numbers of wp are within tolerance.
Definition m_helper_basic.fpp.f90:333
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:328
m_helper::s_downsample_data
subroutine, public s_downsample_data(q_cons_vf, q_cons_temp, m_ds, n_ds, p_ds, m_glb_ds, n_glb_ds, p_glb_ds)
Downsample conservative variable fields by a factor of 3 in each direction using volume averaging.
Definition m_helper.fpp.f90:1103
m_helper::s_int_to_str
elemental subroutine, public s_int_to_str(i, res)
Convert an integer to its trimmed string representation.
Definition m_helper.fpp.f90:730
m_ibm
Ghost-node immersed boundary method: locates ghost/image points, computes interpolation coefficients,...
Definition m_ibm.fpp.f90:318
m_ibm::ib_markers
type(integer_field), public ib_markers
Definition m_ibm.fpp.f90:339
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:328
m_sim_helpers
Simulation helper routines for enthalpy computation, CFL calculation, and stability checks.
Definition m_sim_helpers.fpp.f90:328
m_sim_helpers::s_compute_enthalpy
subroutine, public s_compute_enthalpy(q_prim_vf, pres, rho, gamma, pi_inf, re, h, alpha, vel, vel_sum, qv, j, k, l)
Computes enthalpy.
Definition m_sim_helpers.fpp.f90:421
m_sim_helpers::s_compute_stability_from_dt
subroutine, public s_compute_stability_from_dt(vel, c, rho, re_l, j, k, l, icfl_sf, vcfl_sf, rc_sf)
Computes stability criterion for a specified dt.
Definition m_sim_helpers.fpp.f90:548
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:328
m_variables_conversion::s_compute_speed_of_sound
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 ...
Definition m_variables_conversion.fpp.f90:2556
m_variables_conversion::s_compute_pressure
subroutine, public s_compute_pressure(energy, alf, dyn_p, pi_inf, gamma, rho, qv, rhoyks, pres, t, stress, mom, g, pres_mag)
Compute the pressure from the appropriate equation of state.
Definition m_variables_conversion.fpp.f90:431
m_variables_conversion::s_convert_conservative_to_primitive_variables
subroutine, public s_convert_conservative_to_primitive_variables(qk_cons_vf, q_t_sf, qk_prim_vf, ibounds)
Convert conserved variables (rho*alpha, rho*u, E, alpha) to primitives (rho, u, p,...
Definition m_variables_conversion.fpp.f90:1254
m_variables_conversion::s_convert_to_mixture_variables
subroutine, public s_convert_to_mixture_variables(q_vf, i, j, k, rho, gamma, pi_inf, qv, re_k, g_k, g)
Dispatch to the s_convert_mixture_to_mixture_variables and s_convert_species_to_mixture_variables sub...
Definition m_variables_conversion.fpp.f90:413
m_derived_types::integer_field
Derived type annexing an integer scalar field (SF).
Definition m_derived_types.fpp.f90:341
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:331