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