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# 15 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
16# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
17# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
18
19# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20
21# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22
23# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24
25# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26
27# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28
29# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30
31# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32
33# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
34! New line at end of file is required for FYPP
35# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
36# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
37# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
38# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
46# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 15 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63
64# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67! New line at end of file is required for FYPP
68# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
69
70# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
71# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
72# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
73# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
74# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75
76# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77
78# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 126 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 156 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 197 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 211 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 236 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 247 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 249 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121# 260 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 310 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 320 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 356 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 366 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 373 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 379 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 385 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 391 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 397 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 403 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146! New line at end of file is required for FYPP
147# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
148# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
149# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
150# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
151# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
152# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
153# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
154# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155
156# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159
160# 15 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165
166# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171
172# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175
176# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179! New line at end of file is required for FYPP
180# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
181
182# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233
234# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
235
236# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
237! New line at end of file is required for FYPP
238# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
239
240! GPU parallel region (scalar reductions, maxval/minval)
241# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
242
243! GPU parallel loop over threads (most common GPU macro)
244# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
245
246! Required closing for GPU_PARALLEL_LOOP
247# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
248
249! Mark routine for device compilation
250# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
251
252! Declare device-resident data
253# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
254
255! Inner loop within a GPU parallel region
256# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
257
258! Scoped GPU data region
259# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
260
261! Host code with device pointers (for MPI with GPU buffers)
262# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
263
264! Allocate device memory (unscoped)
265# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
266
267! Free device memory
268# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
269
270! Atomic operation on device
271# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
272
273! End atomic capture block
274# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
275
276! Copy data between host and device
277# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
278
279! Synchronization barrier
280# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
281
282! Import GPU library module (openacc or omp_lib)
283# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
284
285! Emit code only for AMD compiler
286# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
287
288! Emit code for non-Cray compilers
289# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
290
291! Emit code only for Cray compiler
292# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
293
294! Emit code for non-NVIDIA compilers
295# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
296
297# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
298# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
299! New line at end of file is required for FYPP
300# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
301
302# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
303
304! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
305! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
306! example see misc/nvidia_uvm/bind.sh.
307# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
308
309! Allocate and create GPU device memory
310# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312! Free GPU device memory and deallocate
313# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
314
315! Cray-specific GPU pointer setup for vector fields
316# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
317
318! Cray-specific GPU pointer setup for scalar fields
319# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
320
321! Cray-specific GPU pointer setup for acoustic source spatials
322# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
323
324# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
325
326# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
327! New line at end of file is required for FYPP
328# 2 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp" 2
329
330!>
331!! @file
332!! @brief Contains module m_start_up
333
334!> @brief Reads and validates user inputs, allocates variables, and configures MPI decomposition and I/O for post-processing
335
337
338 use, intrinsic :: iso_c_binding
339
342 use m_mpi_proxy
343 use m_mpi_common
345 use m_boundary_io
347 use m_eos
348 use m_data_input
349 use m_data_output
351 use m_helper
354 use m_checker
355 use m_thermochem, only: num_species, species_names
358 use m_chemistry
359
360#ifdef MFC_MPI
361 use mpi
362#endif
363
364 implicit none
365
366 include 'fftw3.f03'
367
369 complex(c_double_complex), allocatable :: data_in(:), data_out(:)
370 complex(c_double_complex), allocatable :: data_cmplx(:,:,:), data_cmplx_y(:,:,:), data_cmplx_z(:,:,:)
371 real(wp), allocatable, dimension(:,:,:) :: en_real
372 real(wp), allocatable, dimension(:) :: en
373 integer :: nx, ny, nz, nxloc, nyloc, nyloc2, nzloc, nf
374 integer :: ierr
376 integer, dimension(3) :: cart3d_coords
377 integer, dimension(2) :: cart2d12_coords, cart2d13_coords
379
380contains
381
382 !> Reads the configuration file post_process.inp, in order to populate parameters in module m_global_parameters.f90 with the
383 !! user provided inputs
384 impure subroutine s_read_input_file
385
386 character(LEN=name_len) :: file_loc
387 logical :: file_check
388 integer :: iostatus
389 character(len=1000) :: line
390
391# 1 "/home/runner/work/MFC/MFC/build/include/post_process/generated_namelist.fpp" 1
392! AUTO-GENERATED - do not edit directly. Regenerate: cmake reconfigure
393!
394namelist /user_inputs/ bx0, ca, e_wrt, g, r0ref, re_inv, t_wrt, web, adv_n, alpha_rho_e_wrt, alpha_rho_wrt, alpha_wrt, &
395 & alt_soundspeed, avg_state, bc_x, bc_y, bc_z, bub_pp, bubbles_euler, bubbles_lagrange, c_wrt, case_dir, cf_wrt, &
396 & cfl_adap_dt, cfl_const_dt, cfl_target, chem_wrt_t, chem_wrt_y, cons_vars_wrt, cont_damage, cyl_coord, down_sample, &
397 & fd_order, fft_wrt, file_per_process, fluid_pp, flux_lim, flux_wrt, format, gamma_wrt, heat_ratio_wrt, hyper_cleaning, &
398 & hypoelasticity, ib, ib_force_stride, ib_force_wrt, ib_state_wrt, igr, igr_order, lag_betac_wrt, lag_betat_wrt, lag_db_wrt, &
399 & lag_dphidt_wrt, lag_header, lag_id_wrt, lag_mg_wrt, lag_mv_wrt, lag_pos_prev_wrt, lag_pos_wrt, lag_pres_wrt, lag_r0_wrt, &
400 & lag_rad_wrt, lag_rmax_wrt, lag_rmin_wrt, lag_rvel_wrt, lag_txt_wrt, lag_vel_wrt, liutex_wrt, m, mhd, mixture_err, &
401 & model_eqns, mom_wrt, mpp_lim, muscl_order, n, n_start, nb, num_bc_patches, num_fluids, num_ibs, num_particle_clouds, &
402 & omega_wrt, output_partial_domain, p, parallel_io, particle_cloud, pi_inf_wrt, poly_sigma, polydisperse, polytropic, &
403 & precision, pres_inf_wrt, pres_wrt, prim_vars_wrt, qbmm, qm_wrt, rburn, reactive_burn, recon_type, relativity, relax, &
404 & relax_model, rho_wrt, schlieren_alpha, schlieren_wrt, sigr, sigma, sim_data, surface_tension, t_save, t_step_save, &
405 & t_step_start, t_step_stop, t_stop, thermal, vel_wrt, weno_order, x_output, y_output, z_output
406# 65 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp" 2
407
408 file_loc = 'post_process.inp'
409 inquire (file=trim(file_loc), exist=file_check)
410
411 if (file_check) then
412 open (1, file=trim(file_loc), form='formatted', status='old', action='read')
413 read (1, nml=user_inputs, iostat=iostatus)
414
415 if (iostatus /= 0) then
416 backspace(1)
417 read (1, fmt='(A)') line
418 print *, 'Invalid line in namelist: ' // trim(line)
419 call s_mpi_abort('Invalid line in post_process.inp. It is ' // 'likely due to a datatype mismatch. Exiting.')
420 end if
421
422 close (1)
423
424 call s_update_cell_bounds(cells_bounds, m, n, p)
425
426 if (down_sample) then
427 m = int((m + 1)/3) - 1
428 n = int((n + 1)/3) - 1
429 p = int((p + 1)/3) - 1
430 end if
431
432 m_glb = m
433 n_glb = n
434 p_glb = p
435
436 nglobal = int(m_glb + 1, kind=8)*int(n_glb + 1, kind=8)*int(p_glb + 1, kind=8)
437
438 if (cfl_adap_dt .or. cfl_const_dt) cfl_dt = .true.
439
440 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
441 bc_io = .true.
442 end if
443 else
444 call s_mpi_abort('File post_process.inp is missing. Exiting.')
445 end if
446
447 end subroutine s_read_input_file
448
449 !> Checking that the user inputs make sense, i.e. that the individual choices are compatible with the code's options and that
450 !! the combination of these choices results into a valid configuration for the post-process
451 impure subroutine s_check_input_file
452
453 character(LEN=len_trim(case_dir)) :: file_loc
454 logical :: dir_check
455
456 case_dir = adjustl(case_dir)
457
458 file_loc = trim(case_dir) // '/.'
459
460 call my_inquire(file_loc, dir_check)
461
462 if (dir_check .neqv. .true.) then
463 call s_mpi_abort('Unsupported choice for the value of ' // 'case_dir. Exiting.')
464 end if
465
466 call s_check_inputs_common(check_total_cells=.true., n_global=nglobal)
467 call s_check_inputs()
468
469 end subroutine s_check_input_file
470
471 !> Load grid and conservative data for a time step, fill ghost-cell buffers, and convert to primitive variables.
472 impure subroutine s_perform_time_step(t_step)
473
474 integer, intent(inout) :: t_step
475 integer :: eta_hh, eta_mm, eta_ss
476 real(wp) :: eta_sec
477
478 if (proc_rank == 0) then
479 if (cfl_dt) then
480 eta_sec = wall_time_avg*real(n_save - 1 - t_step, wp)
481 eta_hh = int(eta_sec)/3600
482 eta_mm = mod(int(eta_sec), 3600)/60
483 eta_ss = mod(int(eta_sec), 60)
484 print '(" [", I3, "%] Saving ", I0, " of ", I0, " t/step ", ES9.2, "s (avg ", ES9.2, "s) ETA ", I0, ":", I2.2, ":", I2.2)', &
485 & int(ceiling(100._wp*(real(t_step - n_start)/(n_save)))), t_step, n_save, wall_time, wall_time_avg, eta_hh, &
486 & eta_mm, eta_ss
487 else
488 eta_sec = wall_time_avg*real((t_step_stop - t_step)/t_step_save, wp)
489 eta_hh = int(eta_sec)/3600
490 eta_mm = mod(int(eta_sec), 3600)/60
491 eta_ss = mod(int(eta_sec), 60)
492 print '(" [", I3, "%] Saving ", I0, " of ", I0, " (t_step ", I0, ") t/step ", ES9.2, "s (avg ", ES9.2, "s) ETA ", I0, ":", I2.2, ":", I2.2)', &
493 & int(ceiling(100._wp*(real(t_step - t_step_start)/(t_step_stop - t_step_start + 1)))), &
494 & (t_step - t_step_start)/t_step_save + 1, (t_step_stop - t_step_start)/t_step_save + 1, t_step, wall_time, &
495 & wall_time_avg, eta_hh, eta_mm, eta_ss
496 end if
497 end if
498
499 call s_read_data_files(t_step)
500
501 ! seed the chemistry temperature over the INTERIOR only (mirrors the simulation,
502 ! m_start_up): the ghost q_cons is unread at this point, so a ghost-inclusive sweep
503 ! would Newton-iterate on garbage (NaN under NaN-init builds) at rank seams and
504 ! physical boundaries; s_populate_variables_buffers below extends q_T into the ghosts
505 if (chemistry) call s_compute_q_t_sf(q_t_sf, q_cons_vf, idwint)
506
507 if (buff_size > 0) then
508 if (n == 0) then
510 else if (p == 0) then
512 else
514 end if
516 end if
517
519
520 end subroutine s_perform_time_step
521
522 !> Derive requested flow quantities from primitive variables and write them to the formatted database files.
523 impure subroutine s_save_data(t_step, varname, pres, c)
524
525 integer, intent(inout) :: t_step
526 character(LEN=name_len), intent(inout) :: varname
527 real(wp), intent(inout) :: pres, c
528
529 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
530 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
531 integer :: i, j, k, l, kx, ky, kz, kf, j_glb, k_glb, l_glb
532 character(50) :: filename
533 logical :: file_exists
534 real(wp), dimension(num_fluids) :: alpha_rho
535 real(wp) :: t
536 integer :: x_beg, x_end, y_beg, y_end, z_beg, z_end
537
538 if (output_partial_domain) then
540 x_beg = -offset_x%beg + x_output_idx%beg
541 x_end = offset_x%end + x_output_idx%end
542 y_beg = -offset_y%beg + y_output_idx%beg
543 y_end = offset_y%end + y_output_idx%end
544 z_beg = -offset_z%beg + z_output_idx%beg
545 z_end = offset_z%end + z_output_idx%end
546 else
547 x_beg = -offset_x%beg
548 x_end = offset_x%end + m
549 y_beg = -offset_y%beg
550 y_end = offset_y%end + n
551 z_beg = -offset_z%beg
552 z_end = offset_z%end + p
553 end if
554
556
557 if (sim_data .and. proc_rank == 0) then
560 end if
561
562 if (sim_data) then
565 end if
566
568
569 if (omega_wrt(2) .or. omega_wrt(3) .or. qm_wrt .or. liutex_wrt .or. schlieren_wrt) then
571 end if
572
573 if (omega_wrt(1) .or. omega_wrt(3) .or. qm_wrt .or. liutex_wrt .or. (n > 0 .and. schlieren_wrt)) then
575 end if
576
577 if (omega_wrt(1) .or. omega_wrt(2) .or. qm_wrt .or. liutex_wrt .or. (p > 0 .and. schlieren_wrt)) then
579 end if
580
581 if ((model_eqns == model_eqns_5eq) .or. (model_eqns == model_eqns_6eq)) then
582 do i = 1, num_fluids
583 if (alpha_rho_wrt(i) .or. (cons_vars_wrt .or. prim_vars_wrt)) then
584 write (varname, '(A,I0)') 'alpha_rho', i
585 call s_write_field(varname, t_step, q_cons_vf(i), x_beg, x_end, y_beg, y_end, z_beg, z_end)
586 end if
587 end do
588 end if
589
590 if ((rho_wrt .or. (model_eqns == model_eqns_gamma_law .and. (cons_vars_wrt .or. prim_vars_wrt))) .and. (.not. relativity)) &
591 & then
592 out%q_sf(:,:,:) = rho_sf(x_beg:x_end,y_beg:y_end,z_beg:z_end)
593 write (varname, '(A)') 'rho'
594 call s_write_field(varname, t_step)
595 end if
596
597 if (relativity .and. (rho_wrt .or. prim_vars_wrt)) then
598 write (varname, '(A)') 'rho'
599 call s_write_field(varname, t_step, q_prim_vf(1), x_beg, x_end, y_beg, y_end, z_beg, z_end)
600 end if
601
602 if (relativity .and. (rho_wrt .or. cons_vars_wrt)) then
603 ! For relativistic flow, conservative and primitive densities are different Hard-coded single-component for now
604 write (varname, '(A)') 'D'
605 call s_write_field(varname, t_step, q_cons_vf(1), x_beg, x_end, y_beg, y_end, z_beg, z_end)
606 end if
607
608 do i = 1, eqn_idx%E - eqn_idx%mom%beg
609 if (mom_wrt(i) .or. cons_vars_wrt) then
610 write (varname, '(A,I0)') 'mom', i
611 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)
612 end if
613 end do
614
615 do i = 1, eqn_idx%E - eqn_idx%mom%beg
616 if (vel_wrt(i) .or. prim_vars_wrt) then
617 write (varname, '(A,I0)') 'vel', i
618 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)
619 end if
620 end do
621
622 if (chemistry) then
623 do i = 1, num_species
624 if (chem_wrt_y(i) .or. prim_vars_wrt) then
625 write (varname, '(A,A)') 'Y_', trim(species_names(i))
626 call s_write_field(varname, t_step, q_prim_vf(eqn_idx%species%beg + i - 1), x_beg, x_end, y_beg, y_end, &
627 & z_beg, z_end)
628 end if
629 end do
630
631 if (chem_wrt_t) then
632 out%q_sf(:,:,:) = q_t_sf%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end)
633 write (varname, '(A)') 'T'
634 call s_write_field(varname, t_step)
635 end if
636 end if
637
638 do i = 1, eqn_idx%E - eqn_idx%mom%beg
639 if (flux_wrt(i)) then
640 call s_derive_flux_limiter(i, q_prim_vf, out%q_sf)
641 write (varname, '(A,I0)') 'flux', i
642 call s_write_field(varname, t_step)
643 end if
644 end do
645
646 if (e_wrt .or. cons_vars_wrt) then
647 write (varname, '(A)') 'E'
648 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)
649 end if
650
651 if (model_eqns == model_eqns_6eq) then
652 do i = 1, num_fluids
653 if (alpha_rho_e_wrt(i) .or. cons_vars_wrt) then
654 write (varname, '(A,I0)') 'alpha_rho_e', i
655 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, &
656 & z_end)
657 end if
658 end do
659 end if
660
661 if (fft_wrt) then
662 do l = 0, p
663 do k = 0, n
664 do j = 0, m
665 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), &
666 & 0._wp)
667 end do
668 end do
669 end do
670
671 call s_mpi_fft_fwd()
672
673 en_real = 0.5_wp*abs(data_cmplx_z)**2._wp/(1._wp*nx*ny*nz)**2._wp
674
675 do l = 0, p
676 do k = 0, n
677 do j = 0, m
678 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, &
679 & l), 0._wp)
680 end do
681 end do
682 end do
683
684 call s_mpi_fft_fwd()
685
686 en_real = en_real + 0.5_wp*abs(data_cmplx_z)**2._wp/(1._wp*nx*ny*nz)**2._wp
687
688 do l = 0, p
689 do k = 0, n
690 do j = 0, m
691 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, &
692 & l), 0._wp)
693 end do
694 end do
695 end do
696
697 call s_mpi_fft_fwd()
698
699 en_real = en_real + 0.5_wp*abs(data_cmplx_z)**2._wp/(1._wp*nx*ny*nz)**2._wp
700
701 do kf = 1, nf
702 en(kf) = 0._wp
703 end do
704
705 do l = 1, nz
706 do k = 1, nyloc2
707 do j = 1, nxloc
708 j_glb = j + cart3d_coords(2)*nxloc
709 k_glb = k + cart3d_coords(3)*nyloc2
710 l_glb = l
711
712 if (j_glb >= (m_glb + 1)/2) then
713 kx = (j_glb - 1) - (m_glb + 1)
714 else
715 kx = j_glb - 1
716 end if
717
718 if (k_glb >= (n_glb + 1)/2) then
719 ky = (k_glb - 1) - (n_glb + 1)
720 else
721 ky = k_glb - 1
722 end if
723
724 if (l_glb >= (p_glb + 1)/2) then
725 kz = (l_glb - 1) - (p_glb + 1)
726 else
727 kz = l_glb - 1
728 end if
729
730 kf = nint(sqrt(kx**2._wp + ky**2._wp + kz**2._wp)) + 1
731
732 en(kf) = en(kf) + en_real(j, k, l)
733 end do
734 end do
735 end do
736
737#ifdef MFC_MPI
738 call mpi_allreduce(mpi_in_place, en, nf, mpi_p, mpi_sum, mpi_comm_world, ierr)
739#endif
740
741 if (proc_rank == 0) then
742 call s_create_directory('En_FFT_DATA')
743 write (filename, '(a,i0,a)') 'En_FFT_DATA/En_tot', t_step, '.dat'
744 inquire (file=filename, exist=file_exists)
745 if (file_exists) then
746 call s_delete_file(trim(filename))
747 end if
748 end if
749
750 do kf = 1, nf
751 if (proc_rank == 0) then
752 write (filename, '(a,i0,a)') 'En_FFT_DATA/En_tot', t_step, '.dat'
753 inquire (file=filename, exist=file_exists)
754 if (file_exists) then
755 open (1, file=filename, position='append', status='old')
756 write (1, *) en(kf), t_step
757 close (1)
758 else
759 open (1, file=filename, status='new')
760 write (1, *) en(kf), t_step
761 close (1)
762 end if
763 end if
764 end do
765 end if
766
767 if (mhd .and. prim_vars_wrt) then
768 do i = eqn_idx%B%beg, eqn_idx%B%end
769 ! 1D: output By, Bz
770 if (n == 0) then
771 if (i == eqn_idx%B%beg) then
772 write (varname, '(A)') 'By'
773 else
774 write (varname, '(A)') 'Bz'
775 end if
776 ! 2D/3D: output Bx, By, Bz
777 else
778 if (i == eqn_idx%B%beg) then
779 write (varname, '(A)') 'Bx'
780 else if (i == eqn_idx%B%beg + 1) then
781 write (varname, '(A)') 'By'
782 else
783 write (varname, '(A)') 'Bz'
784 end if
785 end if
786 call s_write_field(varname, t_step, q_prim_vf(i), x_beg, x_end, y_beg, y_end, z_beg, z_end)
787 end do
788 end if
789
790 if (hypoelasticity) then
791 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
792 if (prim_vars_wrt) then
793 write (varname, '(A,I0)') 'tau', i
794 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, &
795 & z_end)
796 end if
797 end do
798 end if
799
800 if (cont_damage) then
801 write (varname, '(A)') 'damage_state'
802 call s_write_field(varname, t_step, q_prim_vf(eqn_idx%damage), x_beg, x_end, y_beg, y_end, z_beg, z_end)
803 end if
804
805 if (hyper_cleaning) then
806 write (varname, '(A)') 'psi'
807 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)
808 end if
809
810 if (pres_wrt .or. prim_vars_wrt) then
811 write (varname, '(A)') 'pres'
812 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)
813 end if
814
815 if (((model_eqns == model_eqns_5eq) .and. (bubbles_euler .neqv. .true.)) .or. (model_eqns == model_eqns_6eq)) then
816 do i = 1, num_fluids - 1
817 if (alpha_wrt(i) .or. (cons_vars_wrt .or. prim_vars_wrt)) then
818 write (varname, '(A,I0)') 'alpha', i
819 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)
820 end if
821 end do
822
823 if (alpha_wrt(num_fluids) .or. (cons_vars_wrt .or. prim_vars_wrt)) then
824 if (igr) then
825 do k = z_beg, z_end
826 do j = y_beg, y_end
827 do i = x_beg, x_end
828 out%q_sf(i, j, k) = 1._wp
829 do l = 1, num_fluids - 1
830 out%q_sf(i, j, k) = out%q_sf(i, j, k) - q_cons_vf(eqn_idx%E + l)%sf(i, j, k)
831 end do
832 end do
833 end do
834 end do
835 else
836 out%q_sf(:,:,:) = q_cons_vf(eqn_idx%adv%end)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end)
837 end if
838 write (varname, '(A,I0)') 'alpha', num_fluids
839 call s_write_field(varname, t_step)
840 end if
841 end if
842
843 if (gamma_wrt .or. (model_eqns == model_eqns_gamma_law .and. (cons_vars_wrt .or. prim_vars_wrt))) then
844 out%q_sf(:,:,:) = gamma_sf(x_beg:x_end,y_beg:y_end,z_beg:z_end)
845 write (varname, '(A)') 'gamma'
846 call s_write_field(varname, t_step)
847 end if
848
849 if (heat_ratio_wrt) then
851 write (varname, '(A)') 'heat_ratio'
852 call s_write_field(varname, t_step)
853 end if
854
855 if (pi_inf_wrt .or. (model_eqns == model_eqns_gamma_law .and. (cons_vars_wrt .or. prim_vars_wrt))) then
856 out%q_sf(:,:,:) = pi_inf_sf(x_beg:x_end,y_beg:y_end,z_beg:z_end)
857 write (varname, '(A)') 'pi_inf'
858 call s_write_field(varname, t_step)
859 end if
860
861 if (pres_inf_wrt) then
863 write (varname, '(A)') 'pres_inf'
864 call s_write_field(varname, t_step)
865 end if
866
867 if (c_wrt) then
868 do k = -offset_z%beg, p + offset_z%end
869 do j = -offset_y%beg, n + offset_y%end
870 do i = -offset_x%beg, m + offset_x%end
871 do l = 1, eqn_idx%adv%end - eqn_idx%E
872 adv(l) = q_prim_vf(eqn_idx%E + l)%sf(i, j, k)
873 alpha_rho(l) = q_prim_vf(eqn_idx%cont%beg + l - 1)%sf(i, j, k)
874 end do
875
876 pres = q_prim_vf(eqn_idx%E)%sf(i, j, k)
877
878 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, &
879 & alpha_rho)
880
881 out%q_sf(i, j, k) = c
882 end do
883 end do
884 end do
885
886 write (varname, '(A)') 'c'
887 call s_write_field(varname, t_step)
888 end if
889
890 if (t_wrt) then
891 do l = 1, num_fluids
892 do k = -offset_z%beg, p + offset_z%end
893 do j = -offset_y%beg, n + offset_y%end
894 do i = -offset_x%beg, m + offset_x%end
895 call s_phase_temperature(q_prim_vf(eqn_idx%cont%beg + l - 1)%sf(i, j, &
896 & k)/max(q_prim_vf(eqn_idx%E + l)%sf(i, j, k), sgm_eps), &
897 & q_prim_vf(eqn_idx%E)%sf(i, j, k), l, t)
898 out%q_sf(i, j, k) = t
899 end do
900 end do
901 end do
902 write (varname, '(A,I0)') 'T', l
903 call s_write_field(varname, t_step)
904 end do
905 end if
906
907 do i = 1, 3
908 if (omega_wrt(i)) then
910 write (varname, '(A,I0)') 'omega', i
911 call s_write_field(varname, t_step)
912 end if
913 end do
914
915 if (ib) then
916 out%q_sf(:,:,:) = real(ib_markers%sf(-offset_x%beg:m + offset_x%end,-offset_y%beg:n + offset_y%end, &
917 & -offset_z%beg:p + offset_z%end), wp)
918 varname = 'ib_markers'
919 call s_write_field(varname, t_step)
920 end if
921
922 if (p > 0 .and. qm_wrt) then
923 call s_derive_qm(q_prim_vf, out%q_sf)
924 write (varname, '(A)') 'qm'
925 call s_write_field(varname, t_step)
926 end if
927
928 if (liutex_wrt) then
929 call s_derive_liutex(q_prim_vf, liutex_mag, liutex_axis)
930
931 out%q_sf = liutex_mag
932 write (varname, '(A)') 'liutex_mag'
933 call s_write_field(varname, t_step)
934
935 do i = 1, 3
936 out%q_sf = liutex_axis(:,:,:,i)
937 write (varname, '(A,I0)') 'liutex_axis', i
938 call s_write_field(varname, t_step)
939 end do
940 end if
941
942 if (schlieren_wrt) then
944 write (varname, '(A)') 'schlieren'
945 call s_write_field(varname, t_step)
946 end if
947
948 if (cf_wrt) then
949 write (varname, '(A,I0)') 'color_function'
950 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)
951 end if
952
953 if (bubbles_euler) then
954 do i = eqn_idx%adv%beg, eqn_idx%adv%end
955 write (varname, '(A,I0)') 'alpha', i - eqn_idx%E
956 call s_write_field(varname, t_step, q_cons_vf(i), x_beg, x_end, y_beg, y_end, z_beg, z_end)
957 end do
958 end if
959
960 if (bubbles_euler) then
961 ! nR
962 do i = 1, nb
963 write (varname, '(A,I3.3)') 'nR', i
964 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)
965 end do
966
967 ! nRdot
968 do i = 1, nb
969 write (varname, '(A,I3.3)') 'nV', i
970 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)
971 end do
972 if ((polytropic .neqv. .true.) .and. (.not. qbmm)) then
973 ! nP
974 do i = 1, nb
975 write (varname, '(A,I3.3)') 'nP', i
976 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)
977 end do
978
979 ! nM
980 do i = 1, nb
981 write (varname, '(A,I3.3)') 'nM', i
982 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)
983 end do
984 end if
985
986 ! number density
987 if (adv_n) then
988 write (varname, '(A)') 'n'
989 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)
990 end if
991 end if
992
993 if (bubbles_lagrange) then
994 ! Void fraction field
995 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, &
996 & -offset_z%beg:p + offset_z%end)
997 write (varname, '(A)') 'voidFraction'
998 call s_write_field(varname, t_step)
999
1000 if (lag_txt_wrt) call s_write_lag_bubbles_results_to_text(t_step) ! text output
1001 if (lag_db_wrt) call s_write_lag_bubbles_to_formatted_database_file(t_step) ! silo file output
1002 end if
1003
1004 if (ib_state_wrt) call s_write_ib_bodies_to_formatted_database_file(t_step)
1005
1006 if (sim_data .and. proc_rank == 0) then
1009 end if
1010
1012
1013 end subroutine s_save_data
1014
1015 !> Fill out%q_sf from src (if given), write varname to the database, and clear varname.
1016 !! @param varname field name (set by caller); blanked on return
1017 !! @param t_step current time step
1018 !! @param src optional scalar_field to slice into out%q_sf
1019 !! @param x_beg, x_end, y_beg, y_end, z_beg, z_end output region bounds (required if src present)
1020 impure subroutine s_write_field(varname, t_step, src, x_beg, x_end, y_beg, y_end, z_beg, z_end)
1021
1022 character(LEN=name_len), intent(inout) :: varname
1023 integer, intent(in) :: t_step
1024 type(scalar_field), intent(in), optional :: src
1025 integer, intent(in), optional :: x_beg, x_end, y_beg, y_end, z_beg, z_end
1026
1027 if (present(src)) then
1028 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
1029# 688 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1030 call s_mpi_abort("m_start_up.fpp:688: " // .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). " &
1031# 688 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1032 & // "s_write_field: src requires all six output bounds")
1033# 688 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1034 end if
1035# 690 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1036 out%q_sf(:,:,:) = src%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end)
1037 end if
1039 varname(:) = ' '
1040
1041 end subroutine s_write_field
1042
1043 !> Transpose 3-D complex data from x-pencil to y-pencil layout via MPI_Alltoall.
1044 subroutine s_mpi_transpose_x2y
1045
1046 complex(c_double_complex), allocatable :: sendbuf(:), recvbuf(:)
1047 integer :: dest_rank, src_rank
1048 integer :: i, j, k, l
1049
1050#ifdef MFC_MPI
1051 allocate (sendbuf(nx*nyloc*nzloc))
1052 allocate (recvbuf(nx*nyloc*nzloc))
1053
1054 do dest_rank = 0, num_procs_y - 1
1055 do l = 1, nzloc
1056 do k = 1, nyloc
1057 do j = 1, nxloc
1058 sendbuf(j + (k - 1)*nxloc + (l - 1)*nxloc*nyloc + dest_rank*nxloc*nyloc*nzloc) = data_cmplx(j &
1059 & + dest_rank*nxloc, k, l)
1060 end do
1061 end do
1062 end do
1063 end do
1064
1065 call mpi_alltoall(sendbuf, nxloc*nyloc*nzloc, mpi_c_double_complex, recvbuf, nxloc*nyloc*nzloc, mpi_c_double_complex, &
1067
1068 do src_rank = 0, num_procs_y - 1
1069 do l = 1, nzloc
1070 do k = 1, nyloc
1071 do j = 1, nxloc
1072 data_cmplx_y(j, k + src_rank*nyloc, &
1073 & l) = recvbuf(j + (k - 1)*nxloc + (l - 1)*nxloc*nyloc + src_rank*nxloc*nyloc*nzloc)
1074 end do
1075 end do
1076 end do
1077 end do
1078
1079 deallocate (sendbuf)
1080 deallocate (recvbuf)
1081#endif
1082
1083 end subroutine s_mpi_transpose_x2y
1084
1085 !> Transpose 3-D complex data from y-pencil to z-pencil layout via MPI_Alltoall.
1086 subroutine s_mpi_transpose_y2z
1087
1088 complex(c_double_complex), allocatable :: sendbuf(:), recvbuf(:)
1089 integer :: dest_rank, src_rank
1090 integer :: j, k, l
1091
1092#ifdef MFC_MPI
1093 allocate (sendbuf(ny*nxloc*nzloc))
1094 allocate (recvbuf(ny*nxloc*nzloc))
1095
1096 do dest_rank = 0, num_procs_z - 1
1097 do l = 1, nzloc
1098 do j = 1, nxloc
1099 do k = 1, nyloc2
1100 sendbuf(k + (j - 1)*nyloc2 + (l - 1)*(nyloc2*nxloc) + dest_rank*nyloc2*nxloc*nzloc) = data_cmplx_y(j, &
1101 & k + dest_rank*nyloc2, l)
1102 end do
1103 end do
1104 end do
1105 end do
1106
1107 call mpi_alltoall(sendbuf, nyloc2*nxloc*nzloc, mpi_c_double_complex, recvbuf, nyloc2*nxloc*nzloc, mpi_c_double_complex, &
1109
1110 do src_rank = 0, num_procs_z - 1
1111 do l = 1, nzloc
1112 do j = 1, nxloc
1113 do k = 1, nyloc2
1114 data_cmplx_z(j, k, &
1115 & l + src_rank*nzloc) = recvbuf(k + (j - 1)*nyloc2 + (l - 1)*(nyloc2*nxloc) &
1116 & + src_rank*nyloc2*nxloc*nzloc)
1117 end do
1118 end do
1119 end do
1120 end do
1121
1122 deallocate (sendbuf)
1123 deallocate (recvbuf)
1124#endif
1125
1126 end subroutine s_mpi_transpose_y2z
1127
1128 !> Initialize all post-process sub-modules, set up I/O pointers, and prepare FFTW plans and MPI communicators.
1129 impure subroutine s_initialize_modules
1130
1131 integer :: size_n(1), inembed(1), onembed(1)
1132
1134 if (bubbles_euler .or. bubbles_lagrange) then
1136 end if
1137 if (num_procs > 1) then
1139 call s_initialize_mpi_common_module(exchange_all_chemistry_temperatures_in=.true., use_rdma_transport_in=.false.)
1140 end if
1143 call s_initialize_variables_conversion_module(store_mixture_fields=.true., lagrange_beta_index=beta_idx)
1147
1148 if (parallel_io .neqv. .true.) then
1150 else
1152 end if
1153
1154#ifdef MFC_MPI
1155 if (fft_wrt) then
1156 num_procs_x = (m_glb + 1)/(m + 1)
1157 num_procs_y = (n_glb + 1)/(n + 1)
1158 num_procs_z = (p_glb + 1)/(p + 1)
1159
1160 nx = m_glb + 1
1161 ny = n_glb + 1
1162 nz = p_glb + 1
1163
1164 nxloc = (m_glb + 1)/num_procs_y
1165 nyloc = n + 1
1166 nyloc2 = (n_glb + 1)/num_procs_z
1167 nzloc = p + 1
1168
1169 nf = max(nx, ny, nz)
1170
1171#ifdef MFC_DEBUG
1172# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1173 block
1174# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1175 use iso_fortran_env, only: output_unit
1176# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1177
1178# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1179 print *, 'm_start_up.fpp:825: ', '@:ALLOCATE(data_in(Nx*Nyloc*Nzloc))'
1180# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1181
1182# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1183 call flush (output_unit)
1184# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1185 end block
1186# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1187#endif
1188# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1189 allocate (data_in(nx*nyloc*nzloc))
1190# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1191
1192# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1193
1194# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1195#if defined(MFC_OpenACC)
1196# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1197!$acc enter data create(data_in)
1198# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1199#elif defined(MFC_OpenMP)
1200# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1201!$omp target enter data map(always,alloc:data_in)
1202# 825 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1203#endif
1204#ifdef MFC_DEBUG
1205# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1206 block
1207# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1208 use iso_fortran_env, only: output_unit
1209# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1210
1211# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1212 print *, 'm_start_up.fpp:826: ', '@:ALLOCATE(data_out(Nx*Nyloc*Nzloc))'
1213# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1214
1215# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1216 call flush (output_unit)
1217# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1218 end block
1219# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1220#endif
1221# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1222 allocate (data_out(nx*nyloc*nzloc))
1223# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1224
1225# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1226
1227# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1228#if defined(MFC_OpenACC)
1229# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1230!$acc enter data create(data_out)
1231# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1232#elif defined(MFC_OpenMP)
1233# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1234!$omp target enter data map(always,alloc:data_out)
1235# 826 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1236#endif
1237
1238#ifdef MFC_DEBUG
1239# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1240 block
1241# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1242 use iso_fortran_env, only: output_unit
1243# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1244
1245# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1246 print *, 'm_start_up.fpp:828: ', '@:ALLOCATE(data_cmplx(Nx, Nyloc, Nzloc))'
1247# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1248
1249# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1250 call flush (output_unit)
1251# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1252 end block
1253# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1254#endif
1255# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1256 allocate (data_cmplx(nx, nyloc, nzloc))
1257# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1258
1259# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1260
1261# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1262#if defined(MFC_OpenACC)
1263# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1264!$acc enter data create(data_cmplx)
1265# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1266#elif defined(MFC_OpenMP)
1267# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1268!$omp target enter data map(always,alloc:data_cmplx)
1269# 828 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1270#endif
1271#ifdef MFC_DEBUG
1272# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1273 block
1274# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1275 use iso_fortran_env, only: output_unit
1276# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1277
1278# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1279 print *, 'm_start_up.fpp:829: ', '@:ALLOCATE(data_cmplx_y(Nxloc, Ny, Nzloc))'
1280# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1281
1282# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1283 call flush (output_unit)
1284# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1285 end block
1286# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1287#endif
1288# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1289 allocate (data_cmplx_y(nxloc, ny, nzloc))
1290# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1291
1292# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1293
1294# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1295#if defined(MFC_OpenACC)
1296# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1297!$acc enter data create(data_cmplx_y)
1298# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1299#elif defined(MFC_OpenMP)
1300# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1301!$omp target enter data map(always,alloc:data_cmplx_y)
1302# 829 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1303#endif
1304#ifdef MFC_DEBUG
1305# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1306 block
1307# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1308 use iso_fortran_env, only: output_unit
1309# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1310
1311# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1312 print *, 'm_start_up.fpp:830: ', '@:ALLOCATE(data_cmplx_z(Nxloc, Nyloc2, Nz))'
1313# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1314
1315# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1316 call flush (output_unit)
1317# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1318 end block
1319# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1320#endif
1321# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1322 allocate (data_cmplx_z(nxloc, nyloc2, nz))
1323# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1324
1325# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1326
1327# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1328#if defined(MFC_OpenACC)
1329# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1330!$acc enter data create(data_cmplx_z)
1331# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1332#elif defined(MFC_OpenMP)
1333# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1334!$omp target enter data map(always,alloc:data_cmplx_z)
1335# 830 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1336#endif
1337
1338#ifdef MFC_DEBUG
1339# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1340 block
1341# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1342 use iso_fortran_env, only: output_unit
1343# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1344
1345# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1346 print *, 'm_start_up.fpp:832: ', '@:ALLOCATE(En_real(Nxloc, Nyloc2, Nz))'
1347# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1348
1349# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1350 call flush (output_unit)
1351# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1352 end block
1353# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1354#endif
1355# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1356 allocate (en_real(nxloc, nyloc2, nz))
1357# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1358
1359# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1360
1361# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1362#if defined(MFC_OpenACC)
1363# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1364!$acc enter data create(En_real)
1365# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1366#elif defined(MFC_OpenMP)
1367# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1368!$omp target enter data map(always,alloc:En_real)
1369# 832 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1370#endif
1371#ifdef MFC_DEBUG
1372# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1373 block
1374# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1375 use iso_fortran_env, only: output_unit
1376# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1377
1378# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1379 print *, 'm_start_up.fpp:833: ', '@:ALLOCATE(En(Nf))'
1380# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1381
1382# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1383 call flush (output_unit)
1384# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1385 end block
1386# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1387#endif
1388# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1389 allocate (en(nf))
1390# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1391
1392# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1393
1394# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1395#if defined(MFC_OpenACC)
1396# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1397!$acc enter data create(En)
1398# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1399#elif defined(MFC_OpenMP)
1400# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1401!$omp target enter data map(always,alloc:En)
1402# 833 "/home/runner/work/MFC/MFC/src/post_process/m_start_up.fpp"
1403#endif
1404
1405 size_n(1) = nx
1406 inembed(1) = nx
1407 onembed(1) = nx
1408
1409 fwd_plan_x = fftw_plan_many_dft(1, size_n, nyloc*nzloc, data_in, inembed, 1, nx, data_out, onembed, 1, nx, &
1410 & fftw_forward, fftw_measure)
1411
1412 size_n(1) = ny
1413 inembed(1) = ny
1414 onembed(1) = ny
1415
1416 fwd_plan_y = fftw_plan_many_dft(1, size_n, nxloc*nzloc, data_out, inembed, 1, ny, data_in, onembed, 1, ny, &
1417 & fftw_forward, fftw_measure)
1418
1419 size_n(1) = nz
1420 inembed(1) = nz
1421 onembed(1) = nz
1422
1423 fwd_plan_z = fftw_plan_many_dft(1, size_n, nxloc*nyloc2, data_in, inembed, 1, nz, data_out, onembed, 1, nz, &
1424 & fftw_forward, fftw_measure)
1425
1426 call mpi_cart_create(mpi_comm_world, 3, (/num_procs_x, num_procs_y, num_procs_z/), (/.true., .true., .true./), &
1427 & .false., mpi_comm_cart, ierr)
1428 call mpi_cart_coords(mpi_comm_cart, proc_rank, 3, cart3d_coords, ierr)
1429
1430 call mpi_cart_sub(mpi_comm_cart, (/.true., .true., .false./), mpi_comm_cart12, ierr)
1431 call mpi_comm_rank(mpi_comm_cart12, proc_rank12, ierr)
1432 call mpi_cart_coords(mpi_comm_cart12, proc_rank12, 2, cart2d12_coords, ierr)
1433
1434 call mpi_cart_sub(mpi_comm_cart, (/.true., .false., .true./), mpi_comm_cart13, ierr)
1435 call mpi_comm_rank(mpi_comm_cart13, proc_rank13, ierr)
1436 call mpi_cart_coords(mpi_comm_cart13, proc_rank13, 2, cart2d13_coords, ierr)
1437 end if
1438#endif
1439
1440 end subroutine s_initialize_modules
1441
1442 !> Perform a distributed forward 3-D FFT using pencil decomposition with FFTW and MPI transposes.
1443 subroutine s_mpi_fft_fwd
1444
1445 integer :: j, k, l
1446
1447#ifdef MFC_MPI
1448 do l = 1, nzloc
1449 do k = 1, nyloc
1450 do j = 1, nx
1451 data_in(j + (k - 1)*nx + (l - 1)*nx*nyloc) = data_cmplx(j, k, l)
1452 end do
1453 end do
1454 end do
1455
1456 call fftw_execute_dft(fwd_plan_x, data_in, data_out)
1457
1458 do l = 1, nzloc
1459 do k = 1, nyloc
1460 do j = 1, nx
1461 data_cmplx(j, k, l) = data_out(j + (k - 1)*nx + (l - 1)*nx*nyloc)
1462 end do
1463 end do
1464 end do
1465
1466 call s_mpi_transpose_x2y !!Change Pencil from data_cmplx to data_cmpx_y
1467
1468 do l = 1, nzloc
1469 do k = 1, nxloc
1470 do j = 1, ny
1471 data_out(j + (k - 1)*ny + (l - 1)*ny*nxloc) = data_cmplx_y(k, j, l)
1472 end do
1473 end do
1474 end do
1475
1476 call fftw_execute_dft(fwd_plan_y, data_out, data_in)
1477
1478 do l = 1, nzloc
1479 do k = 1, nxloc
1480 do j = 1, ny
1481 data_cmplx_y(k, j, l) = data_in(j + (k - 1)*ny + (l - 1)*ny*nxloc)
1482 end do
1483 end do
1484 end do
1485
1486 call s_mpi_transpose_y2z !!Change Pencil from data_cmplx_y to data_cmpx_z
1487
1488 do l = 1, nyloc2
1489 do k = 1, nxloc
1490 do j = 1, nz
1491 data_in(j + (k - 1)*nz + (l - 1)*nz*nxloc) = data_cmplx_z(k, l, j)
1492 end do
1493 end do
1494 end do
1495
1496 call fftw_execute_dft(fwd_plan_z, data_in, data_out)
1497
1498 do l = 1, nyloc2
1499 do k = 1, nxloc
1500 do j = 1, nz
1501 data_cmplx_z(k, l, j) = data_out(j + (k - 1)*nz + (l - 1)*nz*nxloc)
1502 end do
1503 end do
1504 end do
1505#endif
1506
1507 end subroutine s_mpi_fft_fwd
1508
1509 !> Set up the MPI environment, read and broadcast user inputs, and decompose the computational domain.
1510 impure subroutine s_initialize_mpi_domain
1511
1512 type(int_bounds_info), dimension(3) :: output_offsets
1513
1514 num_dims = 1 + min(1, n) + min(1, p)
1515
1516 call s_mpi_initialize()
1517
1518 if (proc_rank == 0) then
1519 call s_assign_default_values_to_user_inputs()
1520 call s_read_input_file()
1521 call s_check_input_file()
1522
1523 print '(" Post-processing a ", I0, "x", I0, "x", I0, " case on ", I0, " rank(s)")', m, n, p, num_procs
1524 end if
1525
1526 call s_mpi_bcast_user_inputs()
1527
1528 ! Save original BCs before decomposition overwrites them with MPI neighbor ranks
1529 ib_bc_x = bc_x
1530 ib_bc_y = bc_y
1531 ib_bc_z = bc_z
1532
1533 call s_initialize_parallel_io()
1534 output_offsets = (/offset_x, offset_y, offset_z/)
1535 call s_mpi_decompose_computational_domain(write_silo_ghost_offsets=format == format_silo, adjust_local_domains=.false., &
1536 & output_offsets=output_offsets)
1537 offset_x = output_offsets(1)
1538 offset_y = output_offsets(2)
1539 offset_z = output_offsets(3)
1540 call s_check_inputs_fft()
1541
1542 bc = bc_xyz_info(bc_x, bc_y, bc_z)
1543
1544 end subroutine s_initialize_mpi_domain
1545
1546 !> Destroy FFTW plans, free MPI communicators, and finalize all post-process sub-modules.
1547 impure subroutine s_finalize_modules
1548
1549 s_read_data_files => null()
1550
1551 if (fft_wrt) then
1552 if (c_associated(fwd_plan_x)) call fftw_destroy_plan(fwd_plan_x)
1553 if (c_associated(fwd_plan_y)) call fftw_destroy_plan(fwd_plan_y)
1554 if (c_associated(fwd_plan_z)) call fftw_destroy_plan(fwd_plan_z)
1555 if (allocated(data_in)) deallocate (data_in)
1556 if (allocated(data_out)) deallocate (data_out)
1557 if (allocated(data_cmplx)) deallocate (data_cmplx)
1558 if (allocated(data_cmplx_y)) deallocate (data_cmplx_y)
1559 if (allocated(data_cmplx_z)) deallocate (data_cmplx_z)
1560 if (allocated(en_real)) deallocate (en_real)
1561 if (allocated(en)) deallocate (en)
1562 call fftw_cleanup()
1563 end if
1564
1565#ifdef MFC_MPI
1566 if (fft_wrt) then
1567 if (mpi_comm_cart12 /= mpi_comm_null) call mpi_comm_free(mpi_comm_cart12, ierr)
1568 if (mpi_comm_cart13 /= mpi_comm_null) call mpi_comm_free(mpi_comm_cart13, ierr)
1569 if (mpi_comm_cart /= mpi_comm_null) call mpi_comm_free(mpi_comm_cart, ierr)
1570 end if
1571#endif
1572
1573 call s_finalize_data_output_module()
1574 call s_finalize_derived_variables_module()
1575 call s_finalize_data_input_module()
1576 call s_finalize_variables_conversion_module()
1577 call s_finalize_eos_module()
1578 if (num_procs > 1) then
1579 call s_finalize_mpi_proxy_module()
1580 call s_finalize_mpi_common_module()
1581 end if
1582 call s_finalize_global_parameters_module()
1583
1584 call s_mpi_finalize()
1585
1586 end subroutine s_finalize_modules
1587
1588end module m_start_up
1589
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
real(wp), parameter sgm_eps
Segmentation tolerance.
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...
Equations of state in Gamma/Pi form, rho e = Gamma(rho) p + Pi(rho).
subroutine, public s_phase_temperature(rho, pres, i, t)
Temperature of phase i at (rho, p): the stiffened-gas relation, or T_ref(rho) + (e - e_ref)/c_v.
impure subroutine, public s_initialize_eos_module()
Resolve every fluid's EOS coefficients once, before any conversion runs.
subroutine, public s_compute_speed_of_sound(pres, rho, gamma, pi_inf, adv, c, alpha_rho)
Speed of sound of a thermodynamic state. Enthalpy is not an argument: for a real state H,...
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.
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).