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