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