MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_start_up.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
2# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
3# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
4# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
5# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
6# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
7# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
8# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
9# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
10
11# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
12# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
13# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
14
15# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
16
17# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
18
19# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20
21# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22
23# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24
25# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26
27# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28
29# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30! New line at end of file is required for FYPP
31# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
32# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
33# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
34# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
35# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
36# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39
40# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45
46# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49
50# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 167 "/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# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 126 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 156 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 197 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 211 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 236 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 247 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 249 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113# 260 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 310 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 320 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 356 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 366 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 373 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 379 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 385 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 391 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 397 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 403 "/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
166# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167! New line at end of file is required for FYPP
168# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
169
170# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
171
172# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
173
174# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
175
176# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
177
178# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
179
180# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
181
182# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225! New line at end of file is required for FYPP
226# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
227
228! GPU parallel region (scalar reductions, maxval/minval)
229# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
230
231! GPU parallel loop over threads (most common GPU macro)
232# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
233
234! Required closing for GPU_PARALLEL_LOOP
235# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
236
237! Mark routine for device compilation
238# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
239
240! Declare device-resident data
241# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
242
243! Inner loop within a GPU parallel region
244# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
245
246! Scoped GPU data region
247# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
248
249! Host code with device pointers (for MPI with GPU buffers)
250# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
251
252! Allocate device memory (unscoped)
253# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
254
255! Free device memory
256# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
257
258! Atomic operation on device
259# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
260
261! End atomic capture block
262# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
263
264! Copy data between host and device
265# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
266
267! Synchronization barrier
268# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
269
270! Import GPU library module (openacc or omp_lib)
271# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
272
273! Emit code only for AMD compiler
274# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
275
276! Emit code for non-Cray compilers
277# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
278
279! Emit code only for Cray compiler
280# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
281
282! Emit code for non-NVIDIA compilers
283# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
284
285# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
286# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
287! New line at end of file is required for FYPP
288# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
289
290# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
291
292! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
293! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
294! example see misc/nvidia_uvm/bind.sh.
295# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
296
297! Allocate and create GPU device memory
298# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
299
300! Free GPU device memory and deallocate
301# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
302
303! Cray-specific GPU pointer setup for vector fields
304# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
305
306! Cray-specific GPU pointer setup for scalar fields
307# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
308
309! Cray-specific GPU pointer setup for acoustic source spatials
310# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
313
314# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
315! New line at end of file is required for FYPP
316# 2 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp" 2
317
318!>
319!! @file
320!! @brief Contains module m_start_up
321
322!> @brief Reads and validates user inputs, allocates variables, and configures MPI decomposition and I/O for post-processing
323
325
326 use, intrinsic :: iso_c_binding
327
330 use m_mpi_proxy
331 use m_mpi_common
333 use m_boundary_io
335 use m_data_input
336 use m_data_output
338 use m_helper
341 use m_checker
342 use m_thermochem, only: num_species, species_names
345 use m_chemistry
346
347#ifdef MFC_MPI
348 use mpi
349#endif
350
351 implicit none
352
353 include 'fftw3.f03'
354
356 complex(c_double_complex), allocatable :: data_in(:), data_out(:)
357 complex(c_double_complex), allocatable :: data_cmplx(:,:,:), data_cmplx_y(:,:,:), data_cmplx_z(:,:,:)
358 real(wp), allocatable, dimension(:,:,:) :: en_real
359 real(wp), allocatable, dimension(:) :: en
360 integer :: nx, ny, nz, nxloc, nyloc, nyloc2, nzloc, nf
361 integer :: ierr
363 integer, dimension(3) :: cart3d_coords
364 integer, dimension(2) :: cart2d12_coords, cart2d13_coords
366
367contains
368
369 !> Reads the configuration file post_process.inp, in order to populate parameters in module m_global_parameters.f90 with the
370 !! user provided inputs
371 impure subroutine s_read_input_file
372
373 character(LEN=name_len) :: file_loc
374 logical :: file_check
375 integer :: iostatus
376 character(len=1000) :: line
377
378# 1 "/home/runner/work/MFC/MFC/build/include/post_process/generated_namelist.fpp" 1
379! AUTO-GENERATED - do not edit directly. Regenerate: cmake reconfigure
380!
381namelist /user_inputs/ bx0, ca, e_wrt, g, r0ref, re_inv, web, adv_n, alpha_rho_e_wrt, alpha_rho_wrt, alpha_wrt, alt_soundspeed, &
382 & avg_state, bc_x, bc_y, bc_z, bub_pp, bubbles_euler, bubbles_lagrange, c_wrt, case_dir, cf_wrt, cfl_adap_dt, cfl_const_dt, &
383 & cfl_target, chem_wrt_t, chem_wrt_y, cons_vars_wrt, cont_damage, cyl_coord, down_sample, fd_order, fft_wrt, &
384 & file_per_process, fluid_pp, flux_lim, flux_wrt, format, gamma_wrt, heat_ratio_wrt, hyper_cleaning, hypoelasticity, ib, &
385 & ib_state_wrt, igr, igr_order, lag_betac_wrt, lag_betat_wrt, lag_db_wrt, lag_dphidt_wrt, lag_header, lag_id_wrt, &
386 & lag_mg_wrt, lag_mv_wrt, lag_pos_prev_wrt, lag_pos_wrt, lag_pres_wrt, lag_r0_wrt, lag_rad_wrt, lag_rmax_wrt, lag_rmin_wrt, &
387 & lag_rvel_wrt, lag_txt_wrt, lag_vel_wrt, liutex_wrt, m, mhd, mixture_err, model_eqns, mom_wrt, mpp_lim, muscl_order, n, &
388 & n_start, nb, num_bc_patches, num_fluids, num_ibs, omega_wrt, output_partial_domain, p, parallel_io, pi_inf_wrt, &
389 & poly_sigma, polydisperse, polytropic, precision, pres_inf_wrt, pres_wrt, prim_vars_wrt, qbmm, qm_wrt, rburn, &
390 & reactive_burn, recon_type, relativity, relax, relax_model, rho_wrt, schlieren_alpha, schlieren_wrt, sigr, sigma, sim_data, &
391 & surface_tension, t_save, t_step_save, t_step_start, t_step_stop, t_stop, thermal, vel_wrt, weno_order, x_output, y_output, &
392 & z_output
393# 64 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp" 2
394
395 file_loc = 'post_process.inp'
396 inquire (file=trim(file_loc), exist=file_check)
397
398 if (file_check) then
399 open (1, file=trim(file_loc), form='formatted', status='old', action='read')
400 read (1, nml=user_inputs, iostat=iostatus)
401
402 if (iostatus /= 0) then
403 backspace(1)
404 read (1, fmt='(A)') line
405 print *, 'Invalid line in namelist: ' // trim(line)
406 call s_mpi_abort('Invalid line in post_process.inp. It is ' // 'likely due to a datatype mismatch. Exiting.')
407 end if
408
409 close (1)
410
411 call s_update_cell_bounds(cells_bounds, m, n, p)
412
413 if (down_sample) then
414 m = int((m + 1)/3) - 1
415 n = int((n + 1)/3) - 1
416 p = int((p + 1)/3) - 1
417 end if
418
419 m_glb = m
420 n_glb = n
421 p_glb = p
422
423 nglobal = int(m_glb + 1, kind=8)*int(n_glb + 1, kind=8)*int(p_glb + 1, kind=8)
424
425 if (cfl_adap_dt .or. cfl_const_dt) cfl_dt = .true.
426
427 if (any((/bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end/) == -17) .or. num_bc_patches > 0) then
428 bc_io = .true.
429 end if
430 else
431 call s_mpi_abort('File post_process.inp is missing. Exiting.')
432 end if
433
434 end subroutine s_read_input_file
435
436 !> Checking that the user inputs make sense, i.e. that the individual choices are compatible with the code's options and that
437 !! the combination of these choices results into a valid configuration for the post-process
438 impure subroutine s_check_input_file
439
440 character(LEN=len_trim(case_dir)) :: file_loc
441 logical :: dir_check
442
443 case_dir = adjustl(case_dir)
444
445 file_loc = trim(case_dir) // '/.'
446
447 call my_inquire(file_loc, dir_check)
448
449 if (dir_check .neqv. .true.) then
450 call s_mpi_abort('Unsupported choice for the value of ' // 'case_dir. Exiting.')
451 end if
452
453 call s_check_inputs_common(check_total_cells=.true., n_global=nglobal)
454 call s_check_inputs()
455
456 end subroutine s_check_input_file
457
458 !> Load grid and conservative data for a time step, fill ghost-cell buffers, and convert to primitive variables.
459 impure subroutine s_perform_time_step(t_step)
460
461 integer, intent(inout) :: t_step
462 integer :: eta_hh, eta_mm, eta_ss
463 real(wp) :: eta_sec
464
465 if (proc_rank == 0) then
466 if (cfl_dt) then
467 eta_sec = wall_time_avg*real(n_save - 1 - t_step, wp)
468 eta_hh = int(eta_sec)/3600
469 eta_mm = mod(int(eta_sec), 3600)/60
470 eta_ss = mod(int(eta_sec), 60)
471 print '(" [", I3, "%] Saving ", I8, " of ", I0, " Time Avg = ", ES16.6, " Time/step = ", ES12.6, " ETA (HH:MM:SS) = ", I0, ":", I2.2, ":", I2.2)', &
472 & int(ceiling(100._wp*(real(t_step - n_start)/(n_save)))), t_step, n_save, wall_time_avg, wall_time, eta_hh, &
473 & eta_mm, eta_ss
474 else
475 eta_sec = wall_time_avg*real((t_step_stop - t_step)/t_step_save, wp)
476 eta_hh = int(eta_sec)/3600
477 eta_mm = mod(int(eta_sec), 3600)/60
478 eta_ss = mod(int(eta_sec), 60)
479 print '(" [", I3, "%] Saving ", I8, " of ", I0, " @ t_step = ", I8, " Time Avg = ", ES16.6, " Time/step = ", ES12.6, " ETA (HH:MM:SS) = ", I0, ":", I2.2, ":", I2.2)', &
480 & int(ceiling(100._wp*(real(t_step - t_step_start)/(t_step_stop - t_step_start + 1)))), &
481 & (t_step - t_step_start)/t_step_save + 1, (t_step_stop - t_step_start)/t_step_save + 1, t_step, &
482 & wall_time_avg, wall_time, eta_hh, eta_mm, eta_ss
483 end if
484 end if
485
486 call s_read_data_files(t_step)
487
488 ! seed the chemistry temperature over the INTERIOR only (mirrors the simulation,
489 ! m_start_up): the ghost q_cons is unread at this point, so a ghost-inclusive sweep
490 ! would Newton-iterate on garbage (NaN under NaN-init builds) at rank seams and
491 ! physical boundaries; s_populate_variables_buffers below extends q_T into the ghosts
492 if (chemistry) call s_compute_q_t_sf(q_t_sf, q_cons_vf, idwint)
493
494 if (buff_size > 0) then
495 if (n == 0) then
497 else if (p == 0) then
499 else
501 end if
503 end if
504
506
507 end subroutine s_perform_time_step
508
509 !> Derive requested flow quantities from primitive variables and write them to the formatted database files.
510 impure subroutine s_save_data(t_step, varname, pres, c)
511
512 integer, intent(inout) :: t_step
513 character(LEN=name_len), intent(inout) :: varname
514 real(wp), intent(inout) :: pres, c
515
516 real(wp), dimension(-offset_x%beg:m + offset_x%end,-offset_y%beg:n + offset_y%end, & & -offset_z%beg:p + offset_z%end) :: liutex_mag
517 real(wp), dimension(-offset_x%beg:m + offset_x%end,-offset_y%beg:n + offset_y%end,-offset_z%beg:p + offset_z%end, & & 3) :: liutex_axis
518 integer :: i, j, k, l, kx, ky, kz, kf, j_glb, k_glb, l_glb
519 character(50) :: filename
520 logical :: file_exists
521 integer :: x_beg, x_end, y_beg, y_end, z_beg, z_end
522
523 if (output_partial_domain) then
525 x_beg = -offset_x%beg + x_output_idx%beg
526 x_end = offset_x%end + x_output_idx%end
527 y_beg = -offset_y%beg + y_output_idx%beg
528 y_end = offset_y%end + y_output_idx%end
529 z_beg = -offset_z%beg + z_output_idx%beg
530 z_end = offset_z%end + z_output_idx%end
531 else
532 x_beg = -offset_x%beg
533 x_end = offset_x%end + m
534 y_beg = -offset_y%beg
535 y_end = offset_y%end + n
536 z_beg = -offset_z%beg
537 z_end = offset_z%end + p
538 end if
539
541
542 if (sim_data .and. proc_rank == 0) then
545 end if
546
547 if (sim_data) then
550 end if
551
553
554 if (omega_wrt(2) .or. omega_wrt(3) .or. qm_wrt .or. liutex_wrt .or. schlieren_wrt) then
556 end if
557
558 if (omega_wrt(1) .or. omega_wrt(3) .or. qm_wrt .or. liutex_wrt .or. (n > 0 .and. schlieren_wrt)) then
560 end if
561
562 if (omega_wrt(1) .or. omega_wrt(2) .or. qm_wrt .or. liutex_wrt .or. (p > 0 .and. schlieren_wrt)) then
564 end if
565
566 if ((model_eqns == model_eqns_5eq) .or. (model_eqns == model_eqns_6eq)) then
567 do i = 1, num_fluids
568 if (alpha_rho_wrt(i) .or. (cons_vars_wrt .or. prim_vars_wrt)) then
569 write (varname, '(A,I0)') 'alpha_rho', i
570 call s_write_field(varname, t_step, q_cons_vf(i), x_beg, x_end, y_beg, y_end, z_beg, z_end)
571 end if
572 end do
573 end if
574
575 if ((rho_wrt .or. (model_eqns == model_eqns_gamma_law .and. (cons_vars_wrt .or. prim_vars_wrt))) .and. (.not. relativity)) &
576 & then
577 out%q_sf(:,:,:) = rho_sf(x_beg:x_end,y_beg:y_end,z_beg:z_end)
578 write (varname, '(A)') 'rho'
579 call s_write_field(varname, t_step)
580 end if
581
582 if (relativity .and. (rho_wrt .or. prim_vars_wrt)) then
583 write (varname, '(A)') 'rho'
584 call s_write_field(varname, t_step, q_prim_vf(1), x_beg, x_end, y_beg, y_end, z_beg, z_end)
585 end if
586
587 if (relativity .and. (rho_wrt .or. cons_vars_wrt)) then
588 ! For relativistic flow, conservative and primitive densities are different Hard-coded single-component for now
589 write (varname, '(A)') 'D'
590 call s_write_field(varname, t_step, q_cons_vf(1), x_beg, x_end, y_beg, y_end, z_beg, z_end)
591 end if
592
593 do i = 1, eqn_idx%E - eqn_idx%mom%beg
594 if (mom_wrt(i) .or. cons_vars_wrt) then
595 write (varname, '(A,I0)') 'mom', i
596 call s_write_field(varname, t_step, q_cons_vf(i + eqn_idx%cont%end), x_beg, x_end, y_beg, y_end, z_beg, z_end)
597 end if
598 end do
599
600 do i = 1, eqn_idx%E - eqn_idx%mom%beg
601 if (vel_wrt(i) .or. prim_vars_wrt) then
602 write (varname, '(A,I0)') 'vel', i
603 call s_write_field(varname, t_step, q_prim_vf(i + eqn_idx%cont%end), x_beg, x_end, y_beg, y_end, z_beg, z_end)
604 end if
605 end do
606
607 if (chemistry) then
608 do i = 1, num_species
609 if (chem_wrt_y(i) .or. prim_vars_wrt) then
610 write (varname, '(A,A)') 'Y_', trim(species_names(i))
611 call s_write_field(varname, t_step, q_prim_vf(eqn_idx%species%beg + i - 1), x_beg, x_end, y_beg, y_end, &
612 & z_beg, z_end)
613 end if
614 end do
615
616 if (chem_wrt_t) then
617 out%q_sf(:,:,:) = q_t_sf%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end)
618 write (varname, '(A)') 'T'
619 call s_write_field(varname, t_step)
620 end if
621 end if
622
623 do i = 1, eqn_idx%E - eqn_idx%mom%beg
624 if (flux_wrt(i)) then
625 call s_derive_flux_limiter(i, q_prim_vf, out%q_sf)
626 write (varname, '(A,I0)') 'flux', i
627 call s_write_field(varname, t_step)
628 end if
629 end do
630
631 if (e_wrt .or. cons_vars_wrt) then
632 write (varname, '(A)') 'E'
633 call s_write_field(varname, t_step, q_cons_vf(eqn_idx%E), x_beg, x_end, y_beg, y_end, z_beg, z_end)
634 end if
635
636 if (model_eqns == model_eqns_6eq) then
637 do i = 1, num_fluids
638 if (alpha_rho_e_wrt(i) .or. cons_vars_wrt) then
639 write (varname, '(A,I0)') 'alpha_rho_e', i
640 call s_write_field(varname, t_step, q_cons_vf(i + eqn_idx%int_en%beg - 1), x_beg, x_end, y_beg, y_end, z_beg, &
641 & z_end)
642 end if
643 end do
644 end if
645
646 if (fft_wrt) then
647 do l = 0, p
648 do k = 0, n
649 do j = 0, m
650 data_cmplx(j + 1, k + 1, l + 1) = cmplx(q_cons_vf(eqn_idx%mom%beg)%sf(j, k, l)/q_cons_vf(1)%sf(j, k, l), &
651 & 0._wp)
652 end do
653 end do
654 end do
655
656 call s_mpi_fft_fwd()
657
658 en_real = 0.5_wp*abs(data_cmplx_z)**2._wp/(1._wp*nx*ny*nz)**2._wp
659
660 do l = 0, p
661 do k = 0, n
662 do j = 0, m
663 data_cmplx(j + 1, k + 1, l + 1) = cmplx(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k, l)/q_cons_vf(1)%sf(j, k, &
664 & l), 0._wp)
665 end do
666 end do
667 end do
668
669 call s_mpi_fft_fwd()
670
671 en_real = en_real + 0.5_wp*abs(data_cmplx_z)**2._wp/(1._wp*nx*ny*nz)**2._wp
672
673 do l = 0, p
674 do k = 0, n
675 do j = 0, m
676 data_cmplx(j + 1, k + 1, l + 1) = cmplx(q_cons_vf(eqn_idx%mom%beg + 2)%sf(j, k, l)/q_cons_vf(1)%sf(j, k, &
677 & l), 0._wp)
678 end do
679 end do
680 end do
681
682 call s_mpi_fft_fwd()
683
684 en_real = en_real + 0.5_wp*abs(data_cmplx_z)**2._wp/(1._wp*nx*ny*nz)**2._wp
685
686 do kf = 1, nf
687 en(kf) = 0._wp
688 end do
689
690 do l = 1, nz
691 do k = 1, nyloc2
692 do j = 1, nxloc
693 j_glb = j + cart3d_coords(2)*nxloc
694 k_glb = k + cart3d_coords(3)*nyloc2
695 l_glb = l
696
697 if (j_glb >= (m_glb + 1)/2) then
698 kx = (j_glb - 1) - (m_glb + 1)
699 else
700 kx = j_glb - 1
701 end if
702
703 if (k_glb >= (n_glb + 1)/2) then
704 ky = (k_glb - 1) - (n_glb + 1)
705 else
706 ky = k_glb - 1
707 end if
708
709 if (l_glb >= (p_glb + 1)/2) then
710 kz = (l_glb - 1) - (p_glb + 1)
711 else
712 kz = l_glb - 1
713 end if
714
715 kf = nint(sqrt(kx**2._wp + ky**2._wp + kz**2._wp)) + 1
716
717 en(kf) = en(kf) + en_real(j, k, l)
718 end do
719 end do
720 end do
721
722#ifdef MFC_MPI
723 call mpi_allreduce(mpi_in_place, en, nf, mpi_p, mpi_sum, mpi_comm_world, ierr)
724#endif
725
726 if (proc_rank == 0) then
727 call s_create_directory('En_FFT_DATA')
728 write (filename, '(a,i0,a)') 'En_FFT_DATA/En_tot', t_step, '.dat'
729 inquire (file=filename, exist=file_exists)
730 if (file_exists) then
731 call s_delete_file(trim(filename))
732 end if
733 end if
734
735 do kf = 1, nf
736 if (proc_rank == 0) then
737 write (filename, '(a,i0,a)') 'En_FFT_DATA/En_tot', t_step, '.dat'
738 inquire (file=filename, exist=file_exists)
739 if (file_exists) then
740 open (1, file=filename, position='append', status='old')
741 write (1, *) en(kf), t_step
742 close (1)
743 else
744 open (1, file=filename, status='new')
745 write (1, *) en(kf), t_step
746 close (1)
747 end if
748 end if
749 end do
750 end if
751
752 if (mhd .and. prim_vars_wrt) then
753 do i = eqn_idx%B%beg, eqn_idx%B%end
754 ! 1D: output By, Bz
755 if (n == 0) then
756 if (i == eqn_idx%B%beg) then
757 write (varname, '(A)') 'By'
758 else
759 write (varname, '(A)') 'Bz'
760 end if
761 ! 2D/3D: output Bx, By, Bz
762 else
763 if (i == eqn_idx%B%beg) then
764 write (varname, '(A)') 'Bx'
765 else if (i == eqn_idx%B%beg + 1) then
766 write (varname, '(A)') 'By'
767 else
768 write (varname, '(A)') 'Bz'
769 end if
770 end if
771 call s_write_field(varname, t_step, q_prim_vf(i), x_beg, x_end, y_beg, y_end, z_beg, z_end)
772 end do
773 end if
774
775 if (hypoelasticity) then
776 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
777 if (prim_vars_wrt) then
778 write (varname, '(A,I0)') 'tau', i
779 call s_write_field(varname, t_step, q_prim_vf(i - 1 + eqn_idx%stress%beg), x_beg, x_end, y_beg, y_end, z_beg, &
780 & z_end)
781 end if
782 end do
783 end if
784
785 if (cont_damage) then
786 write (varname, '(A)') 'damage_state'
787 call s_write_field(varname, t_step, q_cons_vf(eqn_idx%damage), x_beg, x_end, y_beg, y_end, z_beg, z_end)
788 end if
789
790 if (hyper_cleaning) then
791 write (varname, '(A)') 'psi'
792 call s_write_field(varname, t_step, q_cons_vf(eqn_idx%psi), x_beg, x_end, y_beg, y_end, z_beg, z_end)
793 end if
794
795 if (pres_wrt .or. prim_vars_wrt) then
796 write (varname, '(A)') 'pres'
797 call s_write_field(varname, t_step, q_prim_vf(eqn_idx%E), x_beg, x_end, y_beg, y_end, z_beg, z_end)
798 end if
799
800 if (((model_eqns == model_eqns_5eq) .and. (bubbles_euler .neqv. .true.)) .or. (model_eqns == model_eqns_6eq)) then
801 do i = 1, num_fluids - 1
802 if (alpha_wrt(i) .or. (cons_vars_wrt .or. prim_vars_wrt)) then
803 write (varname, '(A,I0)') 'alpha', i
804 call s_write_field(varname, t_step, q_cons_vf(i + eqn_idx%E), x_beg, x_end, y_beg, y_end, z_beg, z_end)
805 end if
806 end do
807
808 if (alpha_wrt(num_fluids) .or. (cons_vars_wrt .or. prim_vars_wrt)) then
809 if (igr) then
810 do k = z_beg, z_end
811 do j = y_beg, y_end
812 do i = x_beg, x_end
813 out%q_sf(i, j, k) = 1._wp
814 do l = 1, num_fluids - 1
815 out%q_sf(i, j, k) = out%q_sf(i, j, k) - q_cons_vf(eqn_idx%E + l)%sf(i, j, k)
816 end do
817 end do
818 end do
819 end do
820 else
821 out%q_sf(:,:,:) = q_cons_vf(eqn_idx%adv%end)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end)
822 end if
823 write (varname, '(A,I0)') 'alpha', num_fluids
824 call s_write_field(varname, t_step)
825 end if
826 end if
827
828 if (gamma_wrt .or. (model_eqns == model_eqns_gamma_law .and. (cons_vars_wrt .or. prim_vars_wrt))) then
829 out%q_sf(:,:,:) = gamma_sf(x_beg:x_end,y_beg:y_end,z_beg:z_end)
830 write (varname, '(A)') 'gamma'
831 call s_write_field(varname, t_step)
832 end if
833
834 if (heat_ratio_wrt) then
836 write (varname, '(A)') 'heat_ratio'
837 call s_write_field(varname, t_step)
838 end if
839
840 if (pi_inf_wrt .or. (model_eqns == model_eqns_gamma_law .and. (cons_vars_wrt .or. prim_vars_wrt))) then
841 out%q_sf(:,:,:) = pi_inf_sf(x_beg:x_end,y_beg:y_end,z_beg:z_end)
842 write (varname, '(A)') 'pi_inf'
843 call s_write_field(varname, t_step)
844 end if
845
846 if (pres_inf_wrt) then
848 write (varname, '(A)') 'pres_inf'
849 call s_write_field(varname, t_step)
850 end if
851
852 if (c_wrt) then
853 do k = -offset_z%beg, p + offset_z%end
854 do j = -offset_y%beg, n + offset_y%end
855 do i = -offset_x%beg, m + offset_x%end
856 do l = 1, eqn_idx%adv%end - eqn_idx%E
857 adv(l) = q_prim_vf(eqn_idx%E + l)%sf(i, j, k)
858 end do
859
860 pres = q_prim_vf(eqn_idx%E)%sf(i, j, k)
861
862 call s_compute_speed_of_sound(pres, rho_sf(i, j, k), gamma_sf(i, j, k), pi_inf_sf(i, j, k), adv, c)
863
864 out%q_sf(i, j, k) = c
865 end do
866 end do
867 end do
868
869 write (varname, '(A)') 'c'
870 call s_write_field(varname, t_step)
871 end if
872
873 do i = 1, 3
874 if (omega_wrt(i)) then
876 write (varname, '(A,I0)') 'omega', i
877 call s_write_field(varname, t_step)
878 end if
879 end do
880
881 if (ib) then
882 out%q_sf(:,:,:) = real(ib_markers%sf(-offset_x%beg:m + offset_x%end,-offset_y%beg:n + offset_y%end, &
883 & -offset_z%beg:p + offset_z%end), wp)
884 varname = 'ib_markers'
885 call s_write_field(varname, t_step)
886 end if
887
888 if (p > 0 .and. qm_wrt) then
889 call s_derive_qm(q_prim_vf, out%q_sf)
890 write (varname, '(A)') 'qm'
891 call s_write_field(varname, t_step)
892 end if
893
894 if (liutex_wrt) then
895 call s_derive_liutex(q_prim_vf, liutex_mag, liutex_axis)
896
897 out%q_sf = liutex_mag
898 write (varname, '(A)') 'liutex_mag'
899 call s_write_field(varname, t_step)
900
901 do i = 1, 3
902 out%q_sf = liutex_axis(:,:,:,i)
903 write (varname, '(A,I0)') 'liutex_axis', i
904 call s_write_field(varname, t_step)
905 end do
906 end if
907
908 if (schlieren_wrt) then
910 write (varname, '(A)') 'schlieren'
911 call s_write_field(varname, t_step)
912 end if
913
914 if (cf_wrt) then
915 write (varname, '(A,I0)') 'color_function'
916 call s_write_field(varname, t_step, q_cons_vf(eqn_idx%c), x_beg, x_end, y_beg, y_end, z_beg, z_end)
917 end if
918
919 if (bubbles_euler) then
920 do i = eqn_idx%adv%beg, eqn_idx%adv%end
921 write (varname, '(A,I0)') 'alpha', i - eqn_idx%E
922 call s_write_field(varname, t_step, q_cons_vf(i), x_beg, x_end, y_beg, y_end, z_beg, z_end)
923 end do
924 end if
925
926 if (bubbles_euler) then
927 ! nR
928 do i = 1, nb
929 write (varname, '(A,I3.3)') 'nR', i
930 call s_write_field(varname, t_step, q_cons_vf(qbmm_idx%rs(i)), x_beg, x_end, y_beg, y_end, z_beg, z_end)
931 end do
932
933 ! nRdot
934 do i = 1, nb
935 write (varname, '(A,I3.3)') 'nV', i
936 call s_write_field(varname, t_step, q_cons_vf(qbmm_idx%vs(i)), x_beg, x_end, y_beg, y_end, z_beg, z_end)
937 end do
938 if ((polytropic .neqv. .true.) .and. (.not. qbmm)) then
939 ! nP
940 do i = 1, nb
941 write (varname, '(A,I3.3)') 'nP', i
942 call s_write_field(varname, t_step, q_cons_vf(qbmm_idx%ps(i)), x_beg, x_end, y_beg, y_end, z_beg, z_end)
943 end do
944
945 ! nM
946 do i = 1, nb
947 write (varname, '(A,I3.3)') 'nM', i
948 call s_write_field(varname, t_step, q_cons_vf(qbmm_idx%ms(i)), x_beg, x_end, y_beg, y_end, z_beg, z_end)
949 end do
950 end if
951
952 ! number density
953 if (adv_n) then
954 write (varname, '(A)') 'n'
955 call s_write_field(varname, t_step, q_cons_vf(eqn_idx%n), x_beg, x_end, y_beg, y_end, z_beg, z_end)
956 end if
957 end if
958
959 if (bubbles_lagrange) then
960 ! Void fraction field
961 out%q_sf(:,:,:) = 1._wp - q_cons_vf(beta_idx)%sf(-offset_x%beg:m + offset_x%end,-offset_y%beg:n + offset_y%end, &
962 & -offset_z%beg:p + offset_z%end)
963 write (varname, '(A)') 'voidFraction'
964 call s_write_field(varname, t_step)
965
966 if (lag_txt_wrt) call s_write_lag_bubbles_results_to_text(t_step) ! text output
967 if (lag_db_wrt) call s_write_lag_bubbles_to_formatted_database_file(t_step) ! silo file output
968 end if
969
970 if (ib_state_wrt) call s_write_ib_bodies_to_formatted_database_file(t_step)
971
972 if (sim_data .and. proc_rank == 0) then
975 end if
976
978
979 end subroutine s_save_data
980
981 !> Fill out%q_sf from src (if given), write varname to the database, and clear varname.
982 !! @param varname field name (set by caller); blanked on return
983 !! @param t_step current time step
984 !! @param src optional scalar_field to slice into out%q_sf
985 !! @param x_beg, x_end, y_beg, y_end, z_beg, z_end output region bounds (required if src present)
986 impure subroutine s_write_field(varname, t_step, src, x_beg, x_end, y_beg, y_end, z_beg, z_end)
987
988 character(LEN=name_len), intent(inout) :: varname
989 integer, intent(in) :: t_step
990 type(scalar_field), intent(in), optional :: src
991 integer, intent(in), optional :: x_beg, x_end, y_beg, y_end, z_beg, z_end
992
993 if (present(src)) then
994 if (.not. (present(x_beg) .and. present(x_end) .and. present(y_beg) .and. present(y_end) .and. present(z_beg) .and. present(z_end))) then
995# 666 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
996 call s_mpi_abort("m_start_up.fpp:666: " // .and..and..and..and..and."Assertion failed: present(x_beg) present(x_end) present(y_beg) present(y_end) present(z_beg) present(z_end). " &
997# 666 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
998 & // "s_write_field: src requires all six output bounds")
999# 666 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1000 end if
1001# 668 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1002 out%q_sf(:,:,:) = src%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end)
1003 end if
1005 varname(:) = ' '
1006
1007 end subroutine s_write_field
1008
1009 !> Transpose 3-D complex data from x-pencil to y-pencil layout via MPI_Alltoall.
1010 subroutine s_mpi_transpose_x2y
1011
1012 complex(c_double_complex), allocatable :: sendbuf(:), recvbuf(:)
1013 integer :: dest_rank, src_rank
1014 integer :: i, j, k, l
1015
1016#ifdef MFC_MPI
1017 allocate (sendbuf(nx*nyloc*nzloc))
1018 allocate (recvbuf(nx*nyloc*nzloc))
1019
1020 do dest_rank = 0, num_procs_y - 1
1021 do l = 1, nzloc
1022 do k = 1, nyloc
1023 do j = 1, nxloc
1024 sendbuf(j + (k - 1)*nxloc + (l - 1)*nxloc*nyloc + dest_rank*nxloc*nyloc*nzloc) = data_cmplx(j &
1025 & + dest_rank*nxloc, k, l)
1026 end do
1027 end do
1028 end do
1029 end do
1030
1031 call mpi_alltoall(sendbuf, nxloc*nyloc*nzloc, mpi_c_double_complex, recvbuf, nxloc*nyloc*nzloc, mpi_c_double_complex, &
1033
1034 do src_rank = 0, num_procs_y - 1
1035 do l = 1, nzloc
1036 do k = 1, nyloc
1037 do j = 1, nxloc
1038 data_cmplx_y(j, k + src_rank*nyloc, &
1039 & l) = recvbuf(j + (k - 1)*nxloc + (l - 1)*nxloc*nyloc + src_rank*nxloc*nyloc*nzloc)
1040 end do
1041 end do
1042 end do
1043 end do
1044
1045 deallocate (sendbuf)
1046 deallocate (recvbuf)
1047#endif
1048
1049 end subroutine s_mpi_transpose_x2y
1050
1051 !> Transpose 3-D complex data from y-pencil to z-pencil layout via MPI_Alltoall.
1052 subroutine s_mpi_transpose_y2z
1053
1054 complex(c_double_complex), allocatable :: sendbuf(:), recvbuf(:)
1055 integer :: dest_rank, src_rank
1056 integer :: j, k, l
1057
1058#ifdef MFC_MPI
1059 allocate (sendbuf(ny*nxloc*nzloc))
1060 allocate (recvbuf(ny*nxloc*nzloc))
1061
1062 do dest_rank = 0, num_procs_z - 1
1063 do l = 1, nzloc
1064 do j = 1, nxloc
1065 do k = 1, nyloc2
1066 sendbuf(k + (j - 1)*nyloc2 + (l - 1)*(nyloc2*nxloc) + dest_rank*nyloc2*nxloc*nzloc) = data_cmplx_y(j, &
1067 & k + dest_rank*nyloc2, l)
1068 end do
1069 end do
1070 end do
1071 end do
1072
1073 call mpi_alltoall(sendbuf, nyloc2*nxloc*nzloc, mpi_c_double_complex, recvbuf, nyloc2*nxloc*nzloc, mpi_c_double_complex, &
1075
1076 do src_rank = 0, num_procs_z - 1
1077 do l = 1, nzloc
1078 do j = 1, nxloc
1079 do k = 1, nyloc2
1080 data_cmplx_z(j, k, &
1081 & l + src_rank*nzloc) = recvbuf(k + (j - 1)*nyloc2 + (l - 1)*(nyloc2*nxloc) &
1082 & + src_rank*nyloc2*nxloc*nzloc)
1083 end do
1084 end do
1085 end do
1086 end do
1087
1088 deallocate (sendbuf)
1089 deallocate (recvbuf)
1090#endif
1091
1092 end subroutine s_mpi_transpose_y2z
1093
1094 !> Initialize all post-process sub-modules, set up I/O pointers, and prepare FFTW plans and MPI communicators.
1095 impure subroutine s_initialize_modules
1096
1097 integer :: size_n(1), inembed(1), onembed(1)
1098
1100 if (bubbles_euler .or. bubbles_lagrange) then
1102 end if
1103 if (num_procs > 1) then
1105 call s_initialize_mpi_common_module(exchange_all_chemistry_temperatures_in=.true., use_rdma_transport_in=.false.)
1106 end if
1108 call s_initialize_variables_conversion_module(store_mixture_fields=.true., lagrange_beta_index=beta_idx)
1112
1113 if (parallel_io .neqv. .true.) then
1115 else
1117 end if
1118
1119#ifdef MFC_MPI
1120 if (fft_wrt) then
1121 num_procs_x = (m_glb + 1)/(m + 1)
1122 num_procs_y = (n_glb + 1)/(n + 1)
1123 num_procs_z = (p_glb + 1)/(p + 1)
1124
1125 nx = m_glb + 1
1126 ny = n_glb + 1
1127 nz = p_glb + 1
1128
1129 nxloc = (m_glb + 1)/num_procs_y
1130 nyloc = n + 1
1131 nyloc2 = (n_glb + 1)/num_procs_z
1132 nzloc = p + 1
1133
1134 nf = max(nx, ny, nz)
1135
1136#ifdef MFC_DEBUG
1137# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1138 block
1139# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1140 use iso_fortran_env, only: output_unit
1141# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1142
1143# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1144 print *, 'm_start_up.fpp:802: ', '@:ALLOCATE(data_in(Nx*Nyloc*Nzloc))'
1145# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1146
1147# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1148 call flush (output_unit)
1149# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1150 end block
1151# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1152#endif
1153# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1154 allocate (data_in(nx*nyloc*nzloc))
1155# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1156
1157# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1158
1159# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1160#if defined(MFC_OpenACC)
1161# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1162!$acc enter data create(data_in)
1163# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1164#elif defined(MFC_OpenMP)
1165# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1166!$omp target enter data map(always,alloc:data_in)
1167# 802 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1168#endif
1169#ifdef MFC_DEBUG
1170# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1171 block
1172# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1173 use iso_fortran_env, only: output_unit
1174# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1175
1176# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1177 print *, 'm_start_up.fpp:803: ', '@:ALLOCATE(data_out(Nx*Nyloc*Nzloc))'
1178# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1179
1180# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1181 call flush (output_unit)
1182# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1183 end block
1184# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1185#endif
1186# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1187 allocate (data_out(nx*nyloc*nzloc))
1188# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1189
1190# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1191
1192# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1193#if defined(MFC_OpenACC)
1194# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1195!$acc enter data create(data_out)
1196# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1197#elif defined(MFC_OpenMP)
1198# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1199!$omp target enter data map(always,alloc:data_out)
1200# 803 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1201#endif
1202
1203#ifdef MFC_DEBUG
1204# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1205 block
1206# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1207 use iso_fortran_env, only: output_unit
1208# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1209
1210# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1211 print *, 'm_start_up.fpp:805: ', '@:ALLOCATE(data_cmplx(Nx, Nyloc, Nzloc))'
1212# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1213
1214# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1215 call flush (output_unit)
1216# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1217 end block
1218# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1219#endif
1220# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1221 allocate (data_cmplx(nx, nyloc, nzloc))
1222# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1223
1224# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1225
1226# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1227#if defined(MFC_OpenACC)
1228# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1229!$acc enter data create(data_cmplx)
1230# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1231#elif defined(MFC_OpenMP)
1232# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1233!$omp target enter data map(always,alloc:data_cmplx)
1234# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1235#endif
1236#ifdef MFC_DEBUG
1237# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1238 block
1239# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1240 use iso_fortran_env, only: output_unit
1241# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1242
1243# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1244 print *, 'm_start_up.fpp:806: ', '@:ALLOCATE(data_cmplx_y(Nxloc, Ny, Nzloc))'
1245# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1246
1247# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1248 call flush (output_unit)
1249# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1250 end block
1251# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1252#endif
1253# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1254 allocate (data_cmplx_y(nxloc, ny, nzloc))
1255# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1256
1257# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1258
1259# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1260#if defined(MFC_OpenACC)
1261# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1262!$acc enter data create(data_cmplx_y)
1263# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1264#elif defined(MFC_OpenMP)
1265# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1266!$omp target enter data map(always,alloc:data_cmplx_y)
1267# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1268#endif
1269#ifdef MFC_DEBUG
1270# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1271 block
1272# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1273 use iso_fortran_env, only: output_unit
1274# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1275
1276# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1277 print *, 'm_start_up.fpp:807: ', '@:ALLOCATE(data_cmplx_z(Nxloc, Nyloc2, Nz))'
1278# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1279
1280# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1281 call flush (output_unit)
1282# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1283 end block
1284# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1285#endif
1286# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1287 allocate (data_cmplx_z(nxloc, nyloc2, nz))
1288# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1289
1290# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1291
1292# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1293#if defined(MFC_OpenACC)
1294# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1295!$acc enter data create(data_cmplx_z)
1296# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1297#elif defined(MFC_OpenMP)
1298# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1299!$omp target enter data map(always,alloc:data_cmplx_z)
1300# 807 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1301#endif
1302
1303#ifdef MFC_DEBUG
1304# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1305 block
1306# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1307 use iso_fortran_env, only: output_unit
1308# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1309
1310# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1311 print *, 'm_start_up.fpp:809: ', '@:ALLOCATE(En_real(Nxloc, Nyloc2, Nz))'
1312# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1313
1314# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1315 call flush (output_unit)
1316# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1317 end block
1318# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1319#endif
1320# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1321 allocate (en_real(nxloc, nyloc2, nz))
1322# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1323
1324# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1325
1326# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1327#if defined(MFC_OpenACC)
1328# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1329!$acc enter data create(En_real)
1330# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1331#elif defined(MFC_OpenMP)
1332# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1333!$omp target enter data map(always,alloc:En_real)
1334# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1335#endif
1336#ifdef MFC_DEBUG
1337# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1338 block
1339# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1340 use iso_fortran_env, only: output_unit
1341# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1342
1343# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1344 print *, 'm_start_up.fpp:810: ', '@:ALLOCATE(En(Nf))'
1345# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1346
1347# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1348 call flush (output_unit)
1349# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1350 end block
1351# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1352#endif
1353# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1354 allocate (en(nf))
1355# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1356
1357# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1358
1359# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1360#if defined(MFC_OpenACC)
1361# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1362!$acc enter data create(En)
1363# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1364#elif defined(MFC_OpenMP)
1365# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1366!$omp target enter data map(always,alloc:En)
1367# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1368#endif
1369
1370 size_n(1) = nx
1371 inembed(1) = nx
1372 onembed(1) = nx
1373
1374 fwd_plan_x = fftw_plan_many_dft(1, size_n, nyloc*nzloc, data_in, inembed, 1, nx, data_out, onembed, 1, nx, &
1375 & fftw_forward, fftw_measure)
1376
1377 size_n(1) = ny
1378 inembed(1) = ny
1379 onembed(1) = ny
1380
1381 fwd_plan_y = fftw_plan_many_dft(1, size_n, nxloc*nzloc, data_out, inembed, 1, ny, data_in, onembed, 1, ny, &
1382 & fftw_forward, fftw_measure)
1383
1384 size_n(1) = nz
1385 inembed(1) = nz
1386 onembed(1) = nz
1387
1388 fwd_plan_z = fftw_plan_many_dft(1, size_n, nxloc*nyloc2, data_in, inembed, 1, nz, data_out, onembed, 1, nz, &
1389 & fftw_forward, fftw_measure)
1390
1391 call mpi_cart_create(mpi_comm_world, 3, (/num_procs_x, num_procs_y, num_procs_z/), (/.true., .true., .true./), &
1392 & .false., mpi_comm_cart, ierr)
1393 call mpi_cart_coords(mpi_comm_cart, proc_rank, 3, cart3d_coords, ierr)
1394
1395 call mpi_cart_sub(mpi_comm_cart, (/.true., .true., .false./), mpi_comm_cart12, ierr)
1396 call mpi_comm_rank(mpi_comm_cart12, proc_rank12, ierr)
1397 call mpi_cart_coords(mpi_comm_cart12, proc_rank12, 2, cart2d12_coords, ierr)
1398
1399 call mpi_cart_sub(mpi_comm_cart, (/.true., .false., .true./), mpi_comm_cart13, ierr)
1400 call mpi_comm_rank(mpi_comm_cart13, proc_rank13, ierr)
1401 call mpi_cart_coords(mpi_comm_cart13, proc_rank13, 2, cart2d13_coords, ierr)
1402 end if
1403#endif
1404
1405 end subroutine s_initialize_modules
1406
1407 !> Perform a distributed forward 3-D FFT using pencil decomposition with FFTW and MPI transposes.
1408 subroutine s_mpi_fft_fwd
1409
1410 integer :: j, k, l
1411
1412#ifdef MFC_MPI
1413 do l = 1, nzloc
1414 do k = 1, nyloc
1415 do j = 1, nx
1416 data_in(j + (k - 1)*nx + (l - 1)*nx*nyloc) = data_cmplx(j, k, l)
1417 end do
1418 end do
1419 end do
1420
1421 call fftw_execute_dft(fwd_plan_x, data_in, data_out)
1422
1423 do l = 1, nzloc
1424 do k = 1, nyloc
1425 do j = 1, nx
1426 data_cmplx(j, k, l) = data_out(j + (k - 1)*nx + (l - 1)*nx*nyloc)
1427 end do
1428 end do
1429 end do
1430
1431 call s_mpi_transpose_x2y !!Change Pencil from data_cmplx to data_cmpx_y
1432
1433 do l = 1, nzloc
1434 do k = 1, nxloc
1435 do j = 1, ny
1436 data_out(j + (k - 1)*ny + (l - 1)*ny*nxloc) = data_cmplx_y(k, j, l)
1437 end do
1438 end do
1439 end do
1440
1441 call fftw_execute_dft(fwd_plan_y, data_out, data_in)
1442
1443 do l = 1, nzloc
1444 do k = 1, nxloc
1445 do j = 1, ny
1446 data_cmplx_y(k, j, l) = data_in(j + (k - 1)*ny + (l - 1)*ny*nxloc)
1447 end do
1448 end do
1449 end do
1450
1451 call s_mpi_transpose_y2z !!Change Pencil from data_cmplx_y to data_cmpx_z
1452
1453 do l = 1, nyloc2
1454 do k = 1, nxloc
1455 do j = 1, nz
1456 data_in(j + (k - 1)*nz + (l - 1)*nz*nxloc) = data_cmplx_z(k, l, j)
1457 end do
1458 end do
1459 end do
1460
1461 call fftw_execute_dft(fwd_plan_z, data_in, data_out)
1462
1463 do l = 1, nyloc2
1464 do k = 1, nxloc
1465 do j = 1, nz
1466 data_cmplx_z(k, l, j) = data_out(j + (k - 1)*nz + (l - 1)*nz*nxloc)
1467 end do
1468 end do
1469 end do
1470#endif
1471
1472 end subroutine s_mpi_fft_fwd
1473
1474 !> Set up the MPI environment, read and broadcast user inputs, and decompose the computational domain.
1475 impure subroutine s_initialize_mpi_domain
1476
1477 type(int_bounds_info), dimension(3) :: output_offsets
1478
1479 num_dims = 1 + min(1, n) + min(1, p)
1480
1481 call s_mpi_initialize()
1482
1483 if (proc_rank == 0) then
1484 call s_assign_default_values_to_user_inputs()
1485 call s_read_input_file()
1486 call s_check_input_file()
1487
1488 print '(" Post-processing a ", I0, "x", I0, "x", I0, " case on ", I0, " rank(s)")', m, n, p, num_procs
1489 end if
1490
1491 call s_mpi_bcast_user_inputs()
1492 call s_initialize_parallel_io()
1493 output_offsets = (/offset_x, offset_y, offset_z/)
1494 call s_mpi_decompose_computational_domain(write_silo_ghost_offsets=format == format_silo, adjust_local_domains=.false., &
1495 & output_offsets=output_offsets)
1496 offset_x = output_offsets(1)
1497 offset_y = output_offsets(2)
1498 offset_z = output_offsets(3)
1499 call s_check_inputs_fft()
1500
1501 bc = bc_xyz_info(bc_x, bc_y, bc_z)
1502
1503 end subroutine s_initialize_mpi_domain
1504
1505 !> Destroy FFTW plans, free MPI communicators, and finalize all post-process sub-modules.
1506 impure subroutine s_finalize_modules
1507
1508 s_read_data_files => null()
1509
1510 if (fft_wrt) then
1511 if (c_associated(fwd_plan_x)) call fftw_destroy_plan(fwd_plan_x)
1512 if (c_associated(fwd_plan_y)) call fftw_destroy_plan(fwd_plan_y)
1513 if (c_associated(fwd_plan_z)) call fftw_destroy_plan(fwd_plan_z)
1514 if (allocated(data_in)) deallocate (data_in)
1515 if (allocated(data_out)) deallocate (data_out)
1516 if (allocated(data_cmplx)) deallocate (data_cmplx)
1517 if (allocated(data_cmplx_y)) deallocate (data_cmplx_y)
1518 if (allocated(data_cmplx_z)) deallocate (data_cmplx_z)
1519 if (allocated(en_real)) deallocate (en_real)
1520 if (allocated(en)) deallocate (en)
1521 call fftw_cleanup()
1522 end if
1523
1524#ifdef MFC_MPI
1525 if (fft_wrt) then
1526 if (mpi_comm_cart12 /= mpi_comm_null) call mpi_comm_free(mpi_comm_cart12, ierr)
1527 if (mpi_comm_cart13 /= mpi_comm_null) call mpi_comm_free(mpi_comm_cart13, ierr)
1528 if (mpi_comm_cart /= mpi_comm_null) call mpi_comm_free(mpi_comm_cart, ierr)
1529 end if
1530#endif
1531
1532 call s_finalize_data_output_module()
1533 call s_finalize_derived_variables_module()
1534 call s_finalize_data_input_module()
1535 call s_finalize_variables_conversion_module()
1536 if (num_procs > 1) then
1537 call s_finalize_mpi_proxy_module()
1538 call s_finalize_mpi_common_module()
1539 end if
1540 call s_finalize_global_parameters_module()
1541
1542 call s_mpi_finalize()
1543
1544 end subroutine s_finalize_modules
1545
1546end module m_start_up
1547
integer, intent(in) k
integer, intent(in) j
integer, intent(in) l
Noncharacteristic and processor boundary condition application for ghost cells and buffer regions.
subroutine, public s_populate_grid_variables_buffers(x_cb_in, x_cc_in, dx_in, x_offset, y_offset, z_offset, y_cb_in, y_cc_in, dy_in, z_cb_in, z_cc_in, dz_in, global_bounds)
Populate the buffers of the grid variables, which are constituted of the cell-boundary locations and ...
impure subroutine, public s_populate_variables_buffers(bc_type, q_prim_vf, pb_in, mv_in, q_t_sf)
Populate the buffers of the primitive variables based on the selected boundary conditions.
impure subroutine, public s_initialize_boundary_common_module(use_dirichlet_buffers)
Allocate and set up boundary condition buffer arrays for all coordinate directions.
Boundary condition restart I/O, capillary/IGR buffer population, and grid-variable buffers.
Shared input validation checks for grid dimensions and AMD GPU compiler limits.
impure subroutine, public s_check_inputs_common(check_total_cells, n_global)
Checks compatibility of parameters in the input file. Used by all three stages.
Validates post-process input parameters and output format consistency.
impure subroutine, public s_check_inputs
Checks compatibility of parameters in the input file. Used by the post_process stage.
Multi-species chemistry interface for thermodynamic properties, reaction rates, and transport coeffic...
subroutine s_compute_q_t_sf(q_t_sf, q_cons_vf, bounds)
Initialize the temperature field from conservative variables by inverting the energy equation.
Platform-specific file and directory operations: create, delete, inquire, getcwd, and basename.
impure subroutine s_delete_file(filepath)
Delete a file at the given path using a platform-specific system command.
impure subroutine my_inquire(fileloc, dircheck)
Inquire on the existence of a directory or file.
impure subroutine s_create_directory(dir_name)
Create a directory and all its parents if it does not exist.
Compile-time constant parameters: default values, tolerances, and physical constants.
integer, parameter model_eqns_5eq
integer, parameter format_silo
integer, parameter model_eqns_6eq
integer, parameter model_eqns_gamma_law
Reads raw simulation grid and conservative-variable data for a given time-step and fills buffer regio...
impure subroutine, public s_read_parallel_data_files(t_step)
Parallel-read the raw data files present in the corresponding time-step directory and to populate the...
type(scalar_field), public q_t_sf
Temperature field.
type(scalar_field), dimension(:), allocatable, public q_cons_vf
Conservative variables.
impure subroutine, public s_initialize_data_input_module
Computation of parameters, allocation procedures, and/or any other tasks needed to properly setup the...
type(scalar_field), dimension(:), allocatable, public q_prim_vf
Primitive variables.
impure subroutine, public s_read_serial_data_files(t_step)
Read the raw data files present in the corresponding time-step directory and to populate the associat...
procedure(s_read_abstract_data_files), pointer, public s_read_data_files
type(integer_field), dimension(:,:), allocatable, public bc_type
Boundary condition identifiers.
type(integer_field), public ib_markers
Writes post-processed grid and flow-variable data to Silo-HDF5 or binary database files.
impure subroutine, public s_write_grid_to_formatted_database_file(t_step)
Write the computational grid (cell-boundary coordinates) to the formatted database slave and master f...
impure subroutine, public s_write_variable_to_formatted_database_file(varname, t_step)
Write a single flow variable field to the formatted database slave and master files for a given time ...
impure subroutine, public s_open_energy_data_file()
Open the energy data file for appending volume-integrated energy budget quantities.
impure subroutine, public s_open_intf_data_file()
Open the interface data file for appending extracted interface coordinates.
impure subroutine, public s_write_energy_data_file(q_prim_vf, q_cons_vf)
Compute volume-integrated kinetic, potential, and internal energies and write the energy budget to th...
impure subroutine, public s_write_lag_bubbles_to_formatted_database_file(t_step)
Read Lagrangian bubble restart data and write bubble positions and scalar fields to the Silo database...
impure subroutine, public s_write_intf_data_file(q_prim_vf)
Extract the volume-fraction interface contour from primitive fields and write the coordinates to the ...
impure subroutine, public s_initialize_data_output_module()
Allocate storage arrays, configure output directories, and count flow variables for formatted databas...
impure subroutine, public s_close_energy_data_file()
Close the energy data file.
impure subroutine, public s_close_formatted_database_file()
Close the formatted database slave file and, for the root process, the master file.
impure subroutine, public s_open_formatted_database_file(t_step)
Open (or create) the Silo-HDF5 or Binary formatted database slave and master files for a given time s...
impure subroutine, public s_close_intf_data_file()
Close the interface data file.
impure subroutine, public s_write_lag_bubbles_results_to_text(t_step)
Write the post-processed results in the folder 'lag_bubbles_data'.
impure subroutine, public s_define_output_region
Compute the cell-index bounds for the user-specified partial output domain in each coordinate directi...
impure subroutine, public s_write_ib_bodies_to_formatted_database_file(t_step)
Read IB state and write a Silo point mesh with per-body scalar fields.
type(output_context), public out
Output workspace: flow variable buffers, VisIt extents/offsets, directory paths, file handles,...
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Computes derived flow quantities (sound speed, vorticity, Schlieren, etc.) from conservative and prim...
type(fd_context), public fd
Finite-difference state: density gradient magnitude and centered FD coefficients in x-,...
impure subroutine, public s_derive_liutex(q_prim_vf, liutex_mag, liutex_axis)
Compute the Liutex vector and its magnitude based on Xu et al. (2019).
subroutine, public s_derive_specific_heat_ratio(q_sf)
Derive the specific heat ratio from the specific heat ratio function gamma_sf. The latter is stored i...
subroutine, public s_derive_liquid_stiffness(q_sf)
Compute the liquid stiffness from the specific heat ratio function gamma_sf and the liquid stiffness ...
impure subroutine, public s_initialize_derived_variables_module
Computation of parameters, allocation procedures, and/or any other tasks needed to properly setup the...
subroutine, public s_derive_vorticity_component(i, q_prim_vf, q_sf)
Compute the specified component of the vorticity from the primitive variables. From those inputs,...
impure subroutine, public s_derive_numerical_schlieren_function(q_cons_vf, q_sf)
Compute the values of the numerical Schlieren function, which are subsequently stored in the derived ...
subroutine, public s_derive_flux_limiter(i, q_prim_vf, q_sf)
Derive the flux limiter at cell boundary i+1/2. This is an approximation because the velocity used to...
subroutine, public s_derive_qm(q_prim_vf, q_sf)
Compute the Q_M criterion from the primitive variables. The Q_M function, which are subsequently stor...
Finite difference operators for computing divergence of velocity fields.
subroutine s_compute_finite_difference_coefficients(q, s_cc, fd_coeff_s, local_buff_size, fd_number_in, fd_order_in, offset_s)
Compute the centered finite-difference coefficients for first-order spatial derivatives in the s-coor...
Global parameters for the post-process: domain geometry, equation of state, and output database setti...
type(int_bounds_info), dimension(1:3) idwint
integer beta_idx
Index of lagrange bubbles beta.
type(int_bounds_info) offset_y
type(qbmm_idx_info) qbmm_idx
QBMM moment index mappings.
real(wp), dimension(:), allocatable y_cc
integer proc_rank
Rank of the local processor.
real(wp), dimension(:), allocatable adv
Advection variables.
type(int_bounds_info) z_output_idx
Indices of domain to output for post-processing.
real(wp), dimension(:), allocatable y_cb
real(wp), dimension(:), allocatable dz
integer fd_number
Finite-difference half-stencil size: MAX(1, fd_order/2).
type(int_bounds_info), dimension(1:3) idwbuff
integer buff_size
Number of ghost cells for boundary condition storage.
real(wp), dimension(:), allocatable z_cb
type(bounds_info) z_output
Portion of domain to output for post-processing.
type(int_bounds_info) x_output_idx
impure subroutine s_initialize_global_parameters_module
Computation of parameters, allocation procedures, and/or any other tasks needed to properly setup the...
real(wp), dimension(:), allocatable x_cc
real(wp), dimension(:), allocatable x_cb
real(wp), dimension(:), allocatable dy
type(int_bounds_info) offset_x
real(wp), dimension(:), allocatable z_cc
integer num_procs
Number of processors.
type(int_bounds_info) y_output_idx
type(int_bounds_info) offset_z
type(cell_num_bounds) cells_bounds
real(wp) wall_time_avg
Wall time measurements.
real(wp), dimension(:), allocatable dx
Cell-width distributions in the x-, y- and z-coordinate directions.
integer(kind=8) nglobal
Total number of cells in global domain.
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
impure subroutine, public s_initialize_bubbles_model()
Initialize bubble model arrays for Euler or Lagrangian bubbles with polytropic or non-polytropic gas.
MPI communication layer: domain decomposition, halo exchange, reductions, and parallel I/O setup.
impure subroutine s_mpi_abort(prnt, code)
The subroutine terminates the MPI execution environment.
impure subroutine s_initialize_mpi_common_module(exchange_all_chemistry_temperatures_in, use_rdma_transport_in)
Initialize the module.
MPI gather and scatter operations for distributing post-process grid and flow-variable data.
impure subroutine s_initialize_mpi_proxy_module
Computation of parameters, allocation procedures, and/or any other tasks needed to properly setup the...
Reads and validates user inputs, allocates variables, and configures MPI decomposition and I/O for po...
impure subroutine s_check_input_file
Checking that the user inputs make sense, i.e. that the individual choices are compatible with the co...
real(wp), dimension(:), allocatable en
complex(c_double_complex), dimension(:,:,:), allocatable data_cmplx_y
impure subroutine s_save_data(t_step, varname, pres, c)
Derive requested flow quantities from primitive variables and write them to the formatted database fi...
subroutine s_mpi_fft_fwd
Perform a distributed forward 3-D FFT using pencil decomposition with FFTW and MPI transposes.
type(c_ptr) fwd_plan_y
integer mpi_comm_cart13
impure subroutine s_initialize_mpi_domain
Set up the MPI environment, read and broadcast user inputs, and decompose the computational domain.
complex(c_double_complex), dimension(:,:,:), allocatable data_cmplx_z
impure subroutine s_read_input_file
Reads the configuration file post_process.inp, in order to populate parameters in module m_global_par...
complex(c_double_complex), dimension(:), allocatable data_out
integer, dimension(2) cart2d13_coords
type(c_ptr) fwd_plan_z
impure subroutine s_write_field(varname, t_step, src, x_beg, x_end, y_beg, y_end, z_beg, z_end)
Fill outq_sf from src (if given), write varname to the database, and clear varname.
real(wp), dimension(:,:,:), allocatable en_real
complex(c_double_complex), dimension(:), allocatable data_in
integer, dimension(3) cart3d_coords
impure subroutine s_perform_time_step(t_step)
Load grid and conservative data for a time step, fill ghost-cell buffers, and convert to primitive va...
integer mpi_comm_cart
complex(c_double_complex), dimension(:,:,:), allocatable data_cmplx
integer proc_rank12
subroutine s_mpi_transpose_x2y
Transpose 3-D complex data from x-pencil to y-pencil layout via MPI_Alltoall.
impure subroutine s_finalize_modules
Destroy FFTW plans, free MPI communicators, and finalize all post-process sub-modules.
subroutine s_mpi_transpose_y2z
Transpose 3-D complex data from y-pencil to z-pencil layout via MPI_Alltoall.
impure subroutine s_initialize_modules
Initialize all post-process sub-modules, set up I/O pointers, and prepare FFTW plans and MPI communic...
integer mpi_comm_cart12
type(c_ptr) fwd_plan_x
integer proc_rank13
integer, dimension(2) cart2d12_coords
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
subroutine, public s_convert_conservative_to_primitive_variables(qk_cons_vf, q_t_sf, qk_prim_vf, ibounds)
Convert conserved variables (rho*alpha, rho*u, E, alpha) to primitives (rho, u, p,...
real(wp), dimension(:,:,:), allocatable, public pi_inf_sf
Scalar liquid stiffness function.
subroutine, public s_compute_speed_of_sound(pres, rho, gamma, pi_inf, adv, c)
Speed of sound of a thermodynamic state. Enthalpy is not an argument: for a real state H,...
real(wp), dimension(:,:,:), allocatable, public gamma_sf
Scalar sp. heat ratio function.
impure subroutine, public s_initialize_variables_conversion_module(store_mixture_fields, enforce_density_floor, preserve_qbmm_number, lagrange_beta_index)
Initialize the variables conversion module.
real(wp), dimension(:,:,:), allocatable, public rho_sf
Scalar density function.
Derived type annexing a scalar field (SF).