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# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138! New line at end of file is required for FYPP
139# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
140# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
141# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
142# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
143# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
144# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
145# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
146# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
147
148# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
149# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
150# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
151
152# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
153
154# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155
156# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157
158# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159
160# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161
162# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165
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# 55 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
296
297! Allocate and create GPU device memory
298# 75 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
299
300! Free GPU device memory and deallocate
301# 83 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
302
303! Cray-specific GPU pointer setup for vector fields
304# 107 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
305
306! Cray-specific GPU pointer setup for scalar fields
307# 123 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
308
309! Cray-specific GPU pointer setup for acoustic source spatials
310# 148 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312# 154 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
313
314# 161 "/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, H)
511
512 integer, intent(inout) :: t_step
513 character(LEN=name_len), intent(inout) :: varname
514 real(wp), intent(inout) :: pres, c, h
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 h = ((gamma_sf(i, j, k) + 1._wp)*pres + pi_inf_sf(i, j, k) + qv_sf(i, j, k))/rho_sf(i, j, k)
863
864 call s_compute_speed_of_sound(pres, rho_sf(i, j, k), gamma_sf(i, j, k), pi_inf_sf(i, j, k), h, adv, &
865 & 0._wp, 0._wp, c, qv_sf(i, j, k))
866
867 out%q_sf(i, j, k) = c
868 end do
869 end do
870 end do
871
872 write (varname, '(A)') 'c'
873 call s_write_field(varname, t_step)
874 end if
875
876 do i = 1, 3
877 if (omega_wrt(i)) then
879 write (varname, '(A,I0)') 'omega', i
880 call s_write_field(varname, t_step)
881 end if
882 end do
883
884 if (ib) then
885 out%q_sf(:,:,:) = real(ib_markers%sf(-offset_x%beg:m + offset_x%end,-offset_y%beg:n + offset_y%end, &
886 & -offset_z%beg:p + offset_z%end), wp)
887 varname = 'ib_markers'
888 call s_write_field(varname, t_step)
889 end if
890
891 if (p > 0 .and. qm_wrt) then
892 call s_derive_qm(q_prim_vf, out%q_sf)
893 write (varname, '(A)') 'qm'
894 call s_write_field(varname, t_step)
895 end if
896
897 if (liutex_wrt) then
898 call s_derive_liutex(q_prim_vf, liutex_mag, liutex_axis)
899
900 out%q_sf = liutex_mag
901 write (varname, '(A)') 'liutex_mag'
902 call s_write_field(varname, t_step)
903
904 do i = 1, 3
905 out%q_sf = liutex_axis(:,:,:,i)
906 write (varname, '(A,I0)') 'liutex_axis', i
907 call s_write_field(varname, t_step)
908 end do
909 end if
910
911 if (schlieren_wrt) then
913 write (varname, '(A)') 'schlieren'
914 call s_write_field(varname, t_step)
915 end if
916
917 if (cf_wrt) then
918 write (varname, '(A,I0)') 'color_function'
919 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)
920 end if
921
922 if (bubbles_euler) then
923 do i = eqn_idx%adv%beg, eqn_idx%adv%end
924 write (varname, '(A,I0)') 'alpha', i - eqn_idx%E
925 call s_write_field(varname, t_step, q_cons_vf(i), x_beg, x_end, y_beg, y_end, z_beg, z_end)
926 end do
927 end if
928
929 if (bubbles_euler) then
930 ! nR
931 do i = 1, nb
932 write (varname, '(A,I3.3)') 'nR', i
933 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)
934 end do
935
936 ! nRdot
937 do i = 1, nb
938 write (varname, '(A,I3.3)') 'nV', i
939 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)
940 end do
941 if ((polytropic .neqv. .true.) .and. (.not. qbmm)) then
942 ! nP
943 do i = 1, nb
944 write (varname, '(A,I3.3)') 'nP', i
945 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)
946 end do
947
948 ! nM
949 do i = 1, nb
950 write (varname, '(A,I3.3)') 'nM', i
951 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)
952 end do
953 end if
954
955 ! number density
956 if (adv_n) then
957 write (varname, '(A)') 'n'
958 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)
959 end if
960 end if
961
962 if (bubbles_lagrange) then
963 ! Void fraction field
964 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, &
965 & -offset_z%beg:p + offset_z%end)
966 write (varname, '(A)') 'voidFraction'
967 call s_write_field(varname, t_step)
968
969 if (lag_txt_wrt) call s_write_lag_bubbles_results_to_text(t_step) ! text output
970 if (lag_db_wrt) call s_write_lag_bubbles_to_formatted_database_file(t_step) ! silo file output
971 end if
972
973 if (ib_state_wrt) call s_write_ib_bodies_to_formatted_database_file(t_step)
974
975 if (sim_data .and. proc_rank == 0) then
978 end if
979
981
982 end subroutine s_save_data
983
984 !> Fill out%q_sf from src (if given), write varname to the database, and clear varname.
985 !! @param varname field name (set by caller); blanked on return
986 !! @param t_step current time step
987 !! @param src optional scalar_field to slice into out%q_sf
988 !! @param x_beg, x_end, y_beg, y_end, z_beg, z_end output region bounds (required if src present)
989 impure subroutine s_write_field(varname, t_step, src, x_beg, x_end, y_beg, y_end, z_beg, z_end)
990
991 character(LEN=name_len), intent(inout) :: varname
992 integer, intent(in) :: t_step
993 type(scalar_field), intent(in), optional :: src
994 integer, intent(in), optional :: x_beg, x_end, y_beg, y_end, z_beg, z_end
995
996 if (present(src)) then
997 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
998# 669 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
999 call s_mpi_abort("m_start_up.fpp:669: " // .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). " &
1000# 669 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1001 & // "s_write_field: src requires all six output bounds")
1002# 669 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1003 end if
1004# 671 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1005 out%q_sf(:,:,:) = src%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end)
1006 end if
1008 varname(:) = ' '
1009
1010 end subroutine s_write_field
1011
1012 !> Transpose 3-D complex data from x-pencil to y-pencil layout via MPI_Alltoall.
1013 subroutine s_mpi_transpose_x2y
1014
1015 complex(c_double_complex), allocatable :: sendbuf(:), recvbuf(:)
1016 integer :: dest_rank, src_rank
1017 integer :: i, j, k, l
1018
1019#ifdef MFC_MPI
1020 allocate (sendbuf(nx*nyloc*nzloc))
1021 allocate (recvbuf(nx*nyloc*nzloc))
1022
1023 do dest_rank = 0, num_procs_y - 1
1024 do l = 1, nzloc
1025 do k = 1, nyloc
1026 do j = 1, nxloc
1027 sendbuf(j + (k - 1)*nxloc + (l - 1)*nxloc*nyloc + dest_rank*nxloc*nyloc*nzloc) = data_cmplx(j &
1028 & + dest_rank*nxloc, k, l)
1029 end do
1030 end do
1031 end do
1032 end do
1033
1034 call mpi_alltoall(sendbuf, nxloc*nyloc*nzloc, mpi_c_double_complex, recvbuf, nxloc*nyloc*nzloc, mpi_c_double_complex, &
1036
1037 do src_rank = 0, num_procs_y - 1
1038 do l = 1, nzloc
1039 do k = 1, nyloc
1040 do j = 1, nxloc
1041 data_cmplx_y(j, k + src_rank*nyloc, &
1042 & l) = recvbuf(j + (k - 1)*nxloc + (l - 1)*nxloc*nyloc + src_rank*nxloc*nyloc*nzloc)
1043 end do
1044 end do
1045 end do
1046 end do
1047
1048 deallocate (sendbuf)
1049 deallocate (recvbuf)
1050#endif
1051
1052 end subroutine s_mpi_transpose_x2y
1053
1054 !> Transpose 3-D complex data from y-pencil to z-pencil layout via MPI_Alltoall.
1055 subroutine s_mpi_transpose_y2z
1056
1057 complex(c_double_complex), allocatable :: sendbuf(:), recvbuf(:)
1058 integer :: dest_rank, src_rank
1059 integer :: j, k, l
1060
1061#ifdef MFC_MPI
1062 allocate (sendbuf(ny*nxloc*nzloc))
1063 allocate (recvbuf(ny*nxloc*nzloc))
1064
1065 do dest_rank = 0, num_procs_z - 1
1066 do l = 1, nzloc
1067 do j = 1, nxloc
1068 do k = 1, nyloc2
1069 sendbuf(k + (j - 1)*nyloc2 + (l - 1)*(nyloc2*nxloc) + dest_rank*nyloc2*nxloc*nzloc) = data_cmplx_y(j, &
1070 & k + dest_rank*nyloc2, l)
1071 end do
1072 end do
1073 end do
1074 end do
1075
1076 call mpi_alltoall(sendbuf, nyloc2*nxloc*nzloc, mpi_c_double_complex, recvbuf, nyloc2*nxloc*nzloc, mpi_c_double_complex, &
1078
1079 do src_rank = 0, num_procs_z - 1
1080 do l = 1, nzloc
1081 do j = 1, nxloc
1082 do k = 1, nyloc2
1083 data_cmplx_z(j, k, &
1084 & l + src_rank*nzloc) = recvbuf(k + (j - 1)*nyloc2 + (l - 1)*(nyloc2*nxloc) &
1085 & + src_rank*nyloc2*nxloc*nzloc)
1086 end do
1087 end do
1088 end do
1089 end do
1090
1091 deallocate (sendbuf)
1092 deallocate (recvbuf)
1093#endif
1094
1095 end subroutine s_mpi_transpose_y2z
1096
1097 !> Initialize all post-process sub-modules, set up I/O pointers, and prepare FFTW plans and MPI communicators.
1098 impure subroutine s_initialize_modules
1099
1100 integer :: size_n(1), inembed(1), onembed(1)
1101
1103 if (bubbles_euler .or. bubbles_lagrange) then
1105 end if
1106 if (num_procs > 1) then
1108 call s_initialize_mpi_common_module(exchange_all_chemistry_temperatures_in=.true., use_rdma_transport_in=.false.)
1109 end if
1111 call s_initialize_variables_conversion_module(store_mixture_fields=.true., lagrange_beta_index=beta_idx)
1115
1116 if (parallel_io .neqv. .true.) then
1118 else
1120 end if
1121
1122#ifdef MFC_MPI
1123 if (fft_wrt) then
1124 num_procs_x = (m_glb + 1)/(m + 1)
1125 num_procs_y = (n_glb + 1)/(n + 1)
1126 num_procs_z = (p_glb + 1)/(p + 1)
1127
1128 nx = m_glb + 1
1129 ny = n_glb + 1
1130 nz = p_glb + 1
1131
1132 nxloc = (m_glb + 1)/num_procs_y
1133 nyloc = n + 1
1134 nyloc2 = (n_glb + 1)/num_procs_z
1135 nzloc = p + 1
1136
1137 nf = max(nx, ny, nz)
1138
1139#ifdef MFC_DEBUG
1140# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1141 block
1142# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1143 use iso_fortran_env, only: output_unit
1144# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1145
1146# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1147 print *, 'm_start_up.fpp:805: ', '@:ALLOCATE(data_in(Nx*Nyloc*Nzloc))'
1148# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1149
1150# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1151 call flush (output_unit)
1152# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1153 end block
1154# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1155#endif
1156# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1157 allocate (data_in(nx*nyloc*nzloc))
1158# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1159
1160# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1161
1162# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1163#if defined(MFC_OpenACC)
1164# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1165!$acc enter data create(data_in)
1166# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1167#elif defined(MFC_OpenMP)
1168# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1169!$omp target enter data map(always,alloc:data_in)
1170# 805 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1171#endif
1172#ifdef MFC_DEBUG
1173# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1174 block
1175# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1176 use iso_fortran_env, only: output_unit
1177# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1178
1179# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1180 print *, 'm_start_up.fpp:806: ', '@:ALLOCATE(data_out(Nx*Nyloc*Nzloc))'
1181# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1182
1183# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1184 call flush (output_unit)
1185# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1186 end block
1187# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1188#endif
1189# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1190 allocate (data_out(nx*nyloc*nzloc))
1191# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1192
1193# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1194
1195# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1196#if defined(MFC_OpenACC)
1197# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1198!$acc enter data create(data_out)
1199# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1200#elif defined(MFC_OpenMP)
1201# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1202!$omp target enter data map(always,alloc:data_out)
1203# 806 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1204#endif
1205
1206#ifdef MFC_DEBUG
1207# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1208 block
1209# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1210 use iso_fortran_env, only: output_unit
1211# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1212
1213# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1214 print *, 'm_start_up.fpp:808: ', '@:ALLOCATE(data_cmplx(Nx, Nyloc, Nzloc))'
1215# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1216
1217# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1218 call flush (output_unit)
1219# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1220 end block
1221# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1222#endif
1223# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1224 allocate (data_cmplx(nx, nyloc, nzloc))
1225# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1226
1227# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1228
1229# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1230#if defined(MFC_OpenACC)
1231# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1232!$acc enter data create(data_cmplx)
1233# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1234#elif defined(MFC_OpenMP)
1235# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1236!$omp target enter data map(always,alloc:data_cmplx)
1237# 808 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1238#endif
1239#ifdef MFC_DEBUG
1240# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1241 block
1242# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1243 use iso_fortran_env, only: output_unit
1244# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1245
1246# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1247 print *, 'm_start_up.fpp:809: ', '@:ALLOCATE(data_cmplx_y(Nxloc, Ny, Nzloc))'
1248# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1249
1250# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1251 call flush (output_unit)
1252# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1253 end block
1254# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1255#endif
1256# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1257 allocate (data_cmplx_y(nxloc, ny, nzloc))
1258# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1259
1260# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1261
1262# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1263#if defined(MFC_OpenACC)
1264# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1265!$acc enter data create(data_cmplx_y)
1266# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1267#elif defined(MFC_OpenMP)
1268# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1269!$omp target enter data map(always,alloc:data_cmplx_y)
1270# 809 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1271#endif
1272#ifdef MFC_DEBUG
1273# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1274 block
1275# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1276 use iso_fortran_env, only: output_unit
1277# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1278
1279# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1280 print *, 'm_start_up.fpp:810: ', '@:ALLOCATE(data_cmplx_z(Nxloc, Nyloc2, Nz))'
1281# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1282
1283# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1284 call flush (output_unit)
1285# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1286 end block
1287# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1288#endif
1289# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1290 allocate (data_cmplx_z(nxloc, nyloc2, nz))
1291# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1292
1293# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1294
1295# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1296#if defined(MFC_OpenACC)
1297# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1298!$acc enter data create(data_cmplx_z)
1299# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1300#elif defined(MFC_OpenMP)
1301# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1302!$omp target enter data map(always,alloc:data_cmplx_z)
1303# 810 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1304#endif
1305
1306#ifdef MFC_DEBUG
1307# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1308 block
1309# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1310 use iso_fortran_env, only: output_unit
1311# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1312
1313# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1314 print *, 'm_start_up.fpp:812: ', '@:ALLOCATE(En_real(Nxloc, Nyloc2, Nz))'
1315# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1316
1317# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1318 call flush (output_unit)
1319# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1320 end block
1321# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1322#endif
1323# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1324 allocate (en_real(nxloc, nyloc2, nz))
1325# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1326
1327# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1328
1329# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1330#if defined(MFC_OpenACC)
1331# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1332!$acc enter data create(En_real)
1333# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1334#elif defined(MFC_OpenMP)
1335# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1336!$omp target enter data map(always,alloc:En_real)
1337# 812 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1338#endif
1339#ifdef MFC_DEBUG
1340# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1341 block
1342# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1343 use iso_fortran_env, only: output_unit
1344# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1345
1346# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1347 print *, 'm_start_up.fpp:813: ', '@:ALLOCATE(En(Nf))'
1348# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1349
1350# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1351 call flush (output_unit)
1352# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1353 end block
1354# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1355#endif
1356# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1357 allocate (en(nf))
1358# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1359
1360# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1361
1362# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1363#if defined(MFC_OpenACC)
1364# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1365!$acc enter data create(En)
1366# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1367#elif defined(MFC_OpenMP)
1368# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1369!$omp target enter data map(always,alloc:En)
1370# 813 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1371#endif
1372
1373 size_n(1) = nx
1374 inembed(1) = nx
1375 onembed(1) = nx
1376
1377 fwd_plan_x = fftw_plan_many_dft(1, size_n, nyloc*nzloc, data_in, inembed, 1, nx, data_out, onembed, 1, nx, &
1378 & fftw_forward, fftw_measure)
1379
1380 size_n(1) = ny
1381 inembed(1) = ny
1382 onembed(1) = ny
1383
1384 fwd_plan_y = fftw_plan_many_dft(1, size_n, nxloc*nzloc, data_out, inembed, 1, ny, data_in, onembed, 1, ny, &
1385 & fftw_forward, fftw_measure)
1386
1387 size_n(1) = nz
1388 inembed(1) = nz
1389 onembed(1) = nz
1390
1391 fwd_plan_z = fftw_plan_many_dft(1, size_n, nxloc*nyloc2, data_in, inembed, 1, nz, data_out, onembed, 1, nz, &
1392 & fftw_forward, fftw_measure)
1393
1394 call mpi_cart_create(mpi_comm_world, 3, (/num_procs_x, num_procs_y, num_procs_z/), (/.true., .true., .true./), &
1395 & .false., mpi_comm_cart, ierr)
1396 call mpi_cart_coords(mpi_comm_cart, proc_rank, 3, cart3d_coords, ierr)
1397
1398 call mpi_cart_sub(mpi_comm_cart, (/.true., .true., .false./), mpi_comm_cart12, ierr)
1399 call mpi_comm_rank(mpi_comm_cart12, proc_rank12, ierr)
1400 call mpi_cart_coords(mpi_comm_cart12, proc_rank12, 2, cart2d12_coords, ierr)
1401
1402 call mpi_cart_sub(mpi_comm_cart, (/.true., .false., .true./), mpi_comm_cart13, ierr)
1403 call mpi_comm_rank(mpi_comm_cart13, proc_rank13, ierr)
1404 call mpi_cart_coords(mpi_comm_cart13, proc_rank13, 2, cart2d13_coords, ierr)
1405 end if
1406#endif
1407
1408 end subroutine s_initialize_modules
1409
1410 !> Perform a distributed forward 3-D FFT using pencil decomposition with FFTW and MPI transposes.
1411 subroutine s_mpi_fft_fwd
1412
1413 integer :: j, k, l
1414
1415#ifdef MFC_MPI
1416 do l = 1, nzloc
1417 do k = 1, nyloc
1418 do j = 1, nx
1419 data_in(j + (k - 1)*nx + (l - 1)*nx*nyloc) = data_cmplx(j, k, l)
1420 end do
1421 end do
1422 end do
1423
1424 call fftw_execute_dft(fwd_plan_x, data_in, data_out)
1425
1426 do l = 1, nzloc
1427 do k = 1, nyloc
1428 do j = 1, nx
1429 data_cmplx(j, k, l) = data_out(j + (k - 1)*nx + (l - 1)*nx*nyloc)
1430 end do
1431 end do
1432 end do
1433
1434 call s_mpi_transpose_x2y !!Change Pencil from data_cmplx to data_cmpx_y
1435
1436 do l = 1, nzloc
1437 do k = 1, nxloc
1438 do j = 1, ny
1439 data_out(j + (k - 1)*ny + (l - 1)*ny*nxloc) = data_cmplx_y(k, j, l)
1440 end do
1441 end do
1442 end do
1443
1444 call fftw_execute_dft(fwd_plan_y, data_out, data_in)
1445
1446 do l = 1, nzloc
1447 do k = 1, nxloc
1448 do j = 1, ny
1449 data_cmplx_y(k, j, l) = data_in(j + (k - 1)*ny + (l - 1)*ny*nxloc)
1450 end do
1451 end do
1452 end do
1453
1454 call s_mpi_transpose_y2z !!Change Pencil from data_cmplx_y to data_cmpx_z
1455
1456 do l = 1, nyloc2
1457 do k = 1, nxloc
1458 do j = 1, nz
1459 data_in(j + (k - 1)*nz + (l - 1)*nz*nxloc) = data_cmplx_z(k, l, j)
1460 end do
1461 end do
1462 end do
1463
1464 call fftw_execute_dft(fwd_plan_z, data_in, data_out)
1465
1466 do l = 1, nyloc2
1467 do k = 1, nxloc
1468 do j = 1, nz
1469 data_cmplx_z(k, l, j) = data_out(j + (k - 1)*nz + (l - 1)*nz*nxloc)
1470 end do
1471 end do
1472 end do
1473#endif
1474
1475 end subroutine s_mpi_fft_fwd
1476
1477 !> Set up the MPI environment, read and broadcast user inputs, and decompose the computational domain.
1478 impure subroutine s_initialize_mpi_domain
1479
1480 type(int_bounds_info), dimension(3) :: output_offsets
1481
1482 num_dims = 1 + min(1, n) + min(1, p)
1483
1484 call s_mpi_initialize()
1485
1486 if (proc_rank == 0) then
1487 call s_assign_default_values_to_user_inputs()
1488 call s_read_input_file()
1489 call s_check_input_file()
1490
1491 print '(" Post-processing a ", I0, "x", I0, "x", I0, " case on ", I0, " rank(s)")', m, n, p, num_procs
1492 end if
1493
1494 call s_mpi_bcast_user_inputs()
1495 call s_initialize_parallel_io()
1496 output_offsets = (/offset_x, offset_y, offset_z/)
1497 call s_mpi_decompose_computational_domain(write_silo_ghost_offsets=format == format_silo, adjust_local_domains=.false., &
1498 & output_offsets=output_offsets)
1499 offset_x = output_offsets(1)
1500 offset_y = output_offsets(2)
1501 offset_z = output_offsets(3)
1502 call s_check_inputs_fft()
1503
1504 bc = bc_xyz_info(bc_x, bc_y, bc_z)
1505
1506 end subroutine s_initialize_mpi_domain
1507
1508 !> Destroy FFTW plans, free MPI communicators, and finalize all post-process sub-modules.
1509 impure subroutine s_finalize_modules
1510
1511 s_read_data_files => null()
1512
1513 if (fft_wrt) then
1514 if (c_associated(fwd_plan_x)) call fftw_destroy_plan(fwd_plan_x)
1515 if (c_associated(fwd_plan_y)) call fftw_destroy_plan(fwd_plan_y)
1516 if (c_associated(fwd_plan_z)) call fftw_destroy_plan(fwd_plan_z)
1517 if (allocated(data_in)) deallocate (data_in)
1518 if (allocated(data_out)) deallocate (data_out)
1519 if (allocated(data_cmplx)) deallocate (data_cmplx)
1520 if (allocated(data_cmplx_y)) deallocate (data_cmplx_y)
1521 if (allocated(data_cmplx_z)) deallocate (data_cmplx_z)
1522 if (allocated(en_real)) deallocate (en_real)
1523 if (allocated(en)) deallocate (en)
1524 call fftw_cleanup()
1525 end if
1526
1527#ifdef MFC_MPI
1528 if (fft_wrt) then
1529 if (mpi_comm_cart12 /= mpi_comm_null) call mpi_comm_free(mpi_comm_cart12, ierr)
1530 if (mpi_comm_cart13 /= mpi_comm_null) call mpi_comm_free(mpi_comm_cart13, ierr)
1531 if (mpi_comm_cart /= mpi_comm_null) call mpi_comm_free(mpi_comm_cart, ierr)
1532 end if
1533#endif
1534
1535 call s_finalize_data_output_module()
1536 call s_finalize_derived_variables_module()
1537 call s_finalize_data_input_module()
1538 call s_finalize_variables_conversion_module()
1539 if (num_procs > 1) then
1540 call s_finalize_mpi_proxy_module()
1541 call s_finalize_mpi_common_module()
1542 end if
1543 call s_finalize_global_parameters_module()
1544
1545 call s_mpi_finalize()
1546
1547 end subroutine s_finalize_modules
1548
1549end module m_start_up
1550
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_save_data(t_step, varname, pres, c, h)
Derive requested flow quantities from primitive variables and write them to the formatted database fi...
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
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_compute_speed_of_sound(pres, rho, gamma, pi_inf, h, adv, vel_sum, c_c, c, qv)
Compute the speed of sound from thermodynamic state variables, supporting multiple equation-of-state ...
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 qv_sf
Scalar liquid energy reference function.
real(wp), dimension(:,:,:), allocatable, public pi_inf_sf
Scalar liquid stiffness function.
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).