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