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/simulation/m_start_up.fpp"
2!>
3!! @file
4!! @brief Contains module m_start_up
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
7! This file exists so that Fypp can be run without generating case.fpp files for
8! each target. This is useful when generating documentation, for example. This
9! should also let MFC be built with CMake directly, without invoking mfc.sh.
10
11! For pre-process.
12# 8 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
13
14! For moving immersed boundaries in simulation
15# 12 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
16# 6 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp" 2
17# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
18# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
19# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
20# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
21# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
23# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
25
26# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
27# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29
30# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31
32# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
33
34# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
35
36# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37
38# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39
40# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45! New line at end of file is required for FYPP
46# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
47# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
48# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
49# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54
55# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58
59# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60
61# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
62
63# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
64
65# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
66
67# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68
69# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
70
71# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
72
73# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
74! New line at end of file is required for FYPP
75# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
76
77# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
78# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
80# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
82
83# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
84
85# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
86
87# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
88
89# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90
91# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
92
93# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
94
95# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
96
97# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
98
99# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
100
101# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
102
103# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
104
105# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
106
107# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
108
109# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
110
111# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
112
113# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151
152# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
153! New line at end of file is required for FYPP
154# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
155# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
156# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
157# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162
163# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
164# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166
167# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
168
169# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170
171# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172
173# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
174
175# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176
177# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
178
179# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
180
181# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
182! New line at end of file is required for FYPP
183# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
184
185# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
186
187# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
188
189# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
190
191# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
192
193# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
194
195# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
196
197# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
198
199# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
200
201# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
202
203# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
204
205# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
206
207# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236
237# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
238
239# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
240! New line at end of file is required for FYPP
241# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
242
243! GPU parallel region (scalar reductions, maxval/minval)
244# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
245
246! GPU parallel loop over threads (most common GPU macro)
247# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
248
249! Required closing for GPU_PARALLEL_LOOP
250# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
251
252! Mark routine for device compilation
253# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
254
255! Declare device-resident data
256# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
257
258! Inner loop within a GPU parallel region
259# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
260
261! Scoped GPU data region
262# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
263
264! Host code with device pointers (for MPI with GPU buffers)
265# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
266
267! Allocate device memory (unscoped)
268# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
269
270! Free device memory
271# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
272
273! Atomic operation on device
274# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
275
276! End atomic capture block
277# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
278
279! Copy data between host and device
280# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
281
282! Synchronization barrier
283# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
284
285! Import GPU library module (openacc or omp_lib)
286# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
287
288! Emit code only for AMD compiler
289# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
290
291! Emit code for non-Cray compilers
292# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
293
294! Emit code only for Cray compiler
295# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
296
297! Emit code for non-NVIDIA compilers
298# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
299
300# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
301# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
302! New line at end of file is required for FYPP
303# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
304
305# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
306
307! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
308! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
309! example see misc/nvidia_uvm/bind.sh.
310# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312! Allocate and create GPU device memory
313# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
314
315! Free GPU device memory and deallocate
316# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
317
318! Cray-specific GPU pointer setup for vector fields
319# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
320
321! Cray-specific GPU pointer setup for scalar fields
322# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
323
324! Cray-specific GPU pointer setup for acoustic source spatials
325# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
326
327# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
328
329# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
330! New line at end of file is required for FYPP
331# 7 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp" 2
332
333!> @brief Reads input files, loads initial conditions and grid data, and orchestrates solver initialization and finalization
335
338 use m_mpi_proxy
339 use m_mpi_common
341 use m_weno
342 use m_muscl
343 use m_thinc
345 use m_cbc
347 use m_boundary_io
349 use m_rhs
350 use m_chemistry
351 use m_data_output
353 use m_qbmm
355 use m_hypoelastic
358 use m_viscous
359 use m_bubbles_ee
360 use m_bubbles_el
361 use ieee_arithmetic
363 use m_helper
364
365#if defined(MFC_OpenACC)
366# 40 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
367 use openacc
368# 40 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
369#elif defined(MFC_OpenMP)
370# 40 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
371 use omp_lib
372# 40 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
373#endif
374
375 use m_nvtx
376 use m_ibm
377 use m_ib_patches
378 use m_model
380 use m_collisions
383 use m_checker
385 use m_body_forces
386 use m_sim_helpers
387 use m_igr
389
390 implicit none
391
395
396 type(scalar_field), allocatable, dimension(:) :: q_cons_temp
397 real(wp) :: dt_init
398
399contains
400
401 !> Read data files. Dispatch subroutine that replaces procedure pointer.
402 impure subroutine s_read_data_files(q_cons_vf)
403
404 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
405
406 if (.not. parallel_io) then
408 else
410 end if
411
412 end subroutine s_read_data_files
413
414 !> Verify the input file exists and read it
415 impure subroutine s_read_input_file
416
417 character(LEN=name_len), parameter :: file_path = './simulation.inp'
418 logical :: file_exist !< Logical used to check the existence of the input file
419 integer :: iostatus
420 ! Integer to check iostat of file read
421
422 character(len=1000) :: line
423
424# 1 "/home/runner/work/MFC/MFC/build/include/simulation/generated_namelist.fpp" 1
425! AUTO-GENERATED - do not edit directly. Regenerate: cmake reconfigure
426!
427# 21 "/home/runner/work/MFC/MFC/build/include/simulation/generated_namelist.fpp"
428namelist /user_inputs/ bx0, ca, r0ref, re_inv, web, acoustic, acoustic_source, adap_dt, adap_dt_max_iters, adap_dt_tol, adv_n, &
429 & alf_factor, alpha_bar, alt_soundspeed, avg_state, bc_x, bc_y, bc_z, bf_spatial_support, bf_x, bf_y, bf_z, bub_pp, &
430 & bubble_model, bubbles_euler, bubbles_lagrange, case_dir, cfl_adap_dt, cfl_const_dt, cfl_target, chem_params, &
431 & coefficient_of_restitution, collision_model, collision_time, cont_damage, cont_damage_s, cyl_coord, down_sample, dt, &
432 & fd_order, fft_wrt, file_per_process, fluid_pp, g_x, g_y, g_z, hyper_cleaning, hyper_cleaning_speed, hyper_cleaning_tau, &
433 & hyperelasticity, hypoelasticity, ib, ib_airfoil, ib_coefficient_of_friction, ib_neighborhood_radius, ib_state_wrt, &
434 & ic_beta, ic_eps, int_comp, integral, integral_wrt, k_x, k_y, k_z, lag_params, low_mach, m, many_ib_patch_parallelism, &
435 & mixture_err, model_eqns, mp_weno, mpp_lim, muscl_eps, n, n_start, null_weights, num_bc_patches, num_ibs, num_igr_iters, &
436 & num_igr_warm_start_iters, num_integrals, num_particle_clouds, num_probes, num_source, num_stl_models, &
437 & num_turbulent_sources, nv_uvm_igr_temps_on_gpu, nv_uvm_out_of_core, nv_uvm_pref_gpu, p, p_x, p_y, p_z, palpha_eps, &
438 & parallel_io, particle_cloud, patch_ib, pi_fac, poly_sigma, polydisperse, polytropic, precision, pref, prim_vars_wrt, &
439 & probe, probe_wrt, ptgalpha_eps, qbmm, rburn, rdma_mpi, reactive_burn, relax, relax_model, rhoref, riemann_solver, &
440 & run_time_info, sigma, spatial_bf, stl_models, surface_tension, synth_l, synth_u_inf, synth_amp_shell, synth_k_shell, &
441 & synth_n_shells, synth_n_waves_per_shell, synth_seed, synthetic_turbulence, t_save, t_step_old, t_step_print, t_step_save, &
442 & t_step_start, t_step_stop, t_stop, tau_star, teno_ct, thermal, time_stepper, turb_pos, w_x, w_y, w_z, wave_speeds, &
443 & weno_re_flux, weno_avg, weno_eps, &
444 & igr, igr_iter_solver, igr_order, igr_pres_lim, mapped_weno, mhd, muscl_lim, muscl_order, nb, num_fluids, recon_type, &
445 & relativity, teno, viscous, weno_order, wenoz, wenoz_q
446# 40 "/home/runner/work/MFC/MFC/build/include/simulation/generated_namelist.fpp"
447# 92 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp" 2
448
449 inquire (file=trim(file_path), exist=file_exist)
450
451 if (file_exist) then
452 open (1, file=trim(file_path), form='formatted', action='read', status='old')
453 read (1, nml=user_inputs, iostat=iostatus)
454
455 if (iostatus /= 0) then
456 backspace(1)
457 read (1, fmt='(A)') line
458 print *, 'Invalid line in namelist: ' // trim(line)
459 call s_mpi_abort('Invalid line in simulation.inp. It is ' // 'likely due to a datatype mismatch. Exiting.')
460 end if
461
462 close (1)
463
464 if ((bf_x) .or. (bf_y) .or. (bf_z) .or. (bf_spatial_support)) then
465 bodyforces = .true.
466 end if
467
468 m_glb = m
469 n_glb = n
470 p_glb = p
471
473
474 if (cfl_adap_dt .or. cfl_const_dt) cfl_dt = .true.
475
476 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
477 bc_io = .true.
478 end if
479
480 if (bc_x%beg == bc_periodic .and. bc_x%end == bc_periodic) periodic_bc(1) = .true.
481 if (bc_y%beg == bc_periodic .and. bc_y%end == bc_periodic) periodic_bc(2) = .true.
482 if (bc_z%beg == bc_periodic .and. bc_z%end == bc_periodic) periodic_bc(3) = .true.
483 else
484 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
485 end if
486
487 end subroutine s_read_input_file
488
489 !> Validate that all user-provided inputs form a consistent simulation configuration
490 impure subroutine s_check_input_file
491
492 character(LEN=path_len) :: file_path
493 logical :: file_exist
494
495 file_path = trim(case_dir) // '/.'
496
497 call my_inquire(file_path, file_exist)
498
499 if (file_exist .neqv. .true.) then
500 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
501 end if
502
504 call s_check_inputs()
505
506 end subroutine s_check_input_file
507
508 !> Read serial initial condition and grid data files and compute cell-width distributions
509 impure subroutine s_read_serial_data_files(q_cons_vf)
510
511 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
512 character(LEN=path_len + 2*name_len) :: t_step_dir !< Relative path to the starting time-step directory
513 character(LEN=path_len + 3*name_len) :: file_path !< Relative path to the grid and conservative variables data files
514 logical :: file_exist !< Logical used to check the existence of the input file
515 integer :: i, r
516
517 if (cfl_dt) then
518 write (t_step_dir, '(A,I0,A,I0)') trim(case_dir) // '/p_all/p', proc_rank, '/', n_start
519 else
520 write (t_step_dir, '(A,I0,A,I0)') trim(case_dir) // '/p_all/p', proc_rank, '/', t_step_start
521 end if
522
523 file_path = trim(t_step_dir) // '/.'
524 call my_inquire(file_path, file_exist)
525
526 if (file_exist .neqv. .true.) then
527 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
528 end if
529
530 if (bc_io) then
532 else
534 end if
535
536 file_path = trim(t_step_dir) // '/x_cb.dat'
537
538 inquire (file=trim(file_path), exist=file_exist)
539
540 if (file_exist) then
541 open (2, file=trim(file_path), form='unformatted', action='read', status='old')
542 read (2) x_cb(-1:m); close (2)
543 else
544 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
545 end if
546
547 dx(0:m) = x_cb(0:m) - x_cb(-1:m - 1)
548 x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2._wp
549
550 if (n > 0) then
551 file_path = trim(t_step_dir) // '/y_cb.dat'
552
553 inquire (file=trim(file_path), exist=file_exist)
554
555 if (file_exist) then
556 open (2, file=trim(file_path), form='unformatted', action='read', status='old')
557 read (2) y_cb(-1:n); close (2)
558 else
559 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
560 end if
561
562 dy(0:n) = y_cb(0:n) - y_cb(-1:n - 1)
563 y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2._wp
564 end if
565
566 if (p > 0) then
567 file_path = trim(t_step_dir) // '/z_cb.dat'
568
569 inquire (file=trim(file_path), exist=file_exist)
570
571 if (file_exist) then
572 open (2, file=trim(file_path), form='unformatted', action='read', status='old')
573 read (2) z_cb(-1:p); close (2)
574 else
575 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
576 end if
577
578 dz(0:p) = z_cb(0:p) - z_cb(-1:p - 1)
579 z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2._wp
580 end if
581
582 do i = 1, sys_size
583 write (file_path, '(A,I0,A)') trim(t_step_dir) // '/q_cons_vf', i, '.dat'
584 inquire (file=trim(file_path), exist=file_exist)
585 if (file_exist) then
586 open (2, file=trim(file_path), form='unformatted', action='read', status='old')
587 read (2) q_cons_vf(i)%sf(0:m,0:n,0:p); close (2)
588 else
589 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
590 end if
591 end do
592
593 if (bubbles_euler .or. elasticity) then
594 ! Read pb and mv for non-polytropic qbmm
595 if (qbmm .and. .not. polytropic) then
596 do i = 1, nb
597 do r = 1, nnode
598 write (file_path, '(A,I0,A)') trim(t_step_dir) // '/pb', sys_size + (i - 1)*nnode + r, '.dat'
599 inquire (file=trim(file_path), exist=file_exist)
600 if (file_exist) then
601 open (2, file=trim(file_path), form='unformatted', action='read', status='old')
602 read (2) pb_ts(1)%sf(0:m,0:n,0:p,r, i); close (2)
603 else
604 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
605 end if
606 end do
607 end do
608 do i = 1, nb
609 do r = 1, nnode
610 write (file_path, '(A,I0,A)') trim(t_step_dir) // '/mv', sys_size + (i - 1)*nnode + r, '.dat'
611 inquire (file=trim(file_path), exist=file_exist)
612 if (file_exist) then
613 open (2, file=trim(file_path), form='unformatted', action='read', status='old')
614 read (2) mv_ts(1)%sf(0:m,0:n,0:p,r, i); close (2)
615 else
616 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
617 end if
618 end do
619 end do
620 end if
621 end if
622
623 end subroutine s_read_serial_data_files
624
625 !> Read parallel initial condition and grid data files via MPI I/O
626 impure subroutine s_read_parallel_data_files(q_cons_vf)
627
628 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
629
630#ifdef MFC_MPI
631 real(wp), allocatable, dimension(:) :: x_cb_glb, y_cb_glb, z_cb_glb
632 integer :: ifile, ierr, data_size
633 integer, dimension(MPI_STATUS_SIZE) :: status
634 integer(KIND=MPI_OFFSET_KIND) :: disp
635 integer(KIND=MPI_OFFSET_KIND) :: m_mok, n_mok, p_mok
636 integer(KIND=MPI_OFFSET_KIND) :: wp_mok, var_mok
637 integer(KIND=MPI_OFFSET_KIND) :: mok
638 character(LEN=path_len + 2*name_len) :: file_loc
639 logical :: file_exist
640 character(len=10) :: t_step_start_string
641 integer :: i, j
642
643 ! Downsampled data variables
644 integer :: m_ds, n_ds, p_ds
645 integer :: m_glb_ds, n_glb_ds, p_glb_ds
646 integer :: m_glb_read, n_glb_read, p_glb_read !< data size of read
647
648 allocate (x_cb_glb(-1:m_glb))
649 allocate (y_cb_glb(-1:n_glb))
650 allocate (z_cb_glb(-1:p_glb))
651
652 file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'x_cb.dat'
653 inquire (file=trim(file_loc), exist=file_exist)
654
655 if (down_sample) then
656 m_ds = int((m + 1)/3) - 1
657 n_ds = int((n + 1)/3) - 1
658 p_ds = int((p + 1)/3) - 1
659
660 m_glb_ds = int((m_glb + 1)/3) - 1
661 n_glb_ds = int((n_glb + 1)/3) - 1
662 p_glb_ds = int((p_glb + 1)/3) - 1
663 end if
664
665 if (file_exist) then
666 data_size = m_glb + 2
667 call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
668 call mpi_file_read(ifile, x_cb_glb, data_size, mpi_p, status, ierr)
669 call mpi_file_close(ifile, ierr)
670 else
671 call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting.')
672 end if
673
674 call s_apply_grid_from_global_dim(x_cb_glb, m_glb, m, start_idx(1), bc_x%beg, bc_x%end, buff_size, buff_size, buff_size, &
675 & buff_size, x_cb, x_cc, dx)
676
677 if (n > 0) then
678 file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'y_cb.dat'
679 inquire (file=trim(file_loc), exist=file_exist)
680
681 if (file_exist) then
682 data_size = n_glb + 2
683 call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
684 call mpi_file_read(ifile, y_cb_glb, data_size, mpi_p, status, ierr)
685 call mpi_file_close(ifile, ierr)
686 else
687 call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting.')
688 end if
689
690 call s_apply_grid_from_global_dim(y_cb_glb, n_glb, n, start_idx(2), bc_y%beg, bc_y%end, buff_size, buff_size, &
692
693 if (p > 0) then
694 file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'z_cb.dat'
695 inquire (file=trim(file_loc), exist=file_exist)
696
697 if (file_exist) then
698 data_size = p_glb + 2
699 call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
700 call mpi_file_read(ifile, z_cb_glb, data_size, mpi_p, status, ierr)
701 call mpi_file_close(ifile, ierr)
702 else
703 call s_mpi_abort('File ' // trim(file_loc) // 'is missing. Exiting.')
704 end if
705
706 call s_apply_grid_from_global_dim(z_cb_glb, p_glb, p, start_idx(3), bc_z%beg, bc_z%end, buff_size, buff_size, &
708 end if
709 end if
710
711 if (file_per_process) then
712 if (cfl_dt) then
713 call s_int_to_str(n_start, t_step_start_string)
714 write (file_loc, '(I0,A1,I7.7,A)') n_start, '_', proc_rank, '.dat'
715 else
716 call s_int_to_str(t_step_start, t_step_start_string)
717 write (file_loc, '(I0,A1,I7.7,A)') t_step_start, '_', proc_rank, '.dat'
718 end if
719 file_loc = trim(case_dir) // '/restart_data/lustre_' // trim(t_step_start_string) // trim(mpiiofs) // trim(file_loc)
720 inquire (file=trim(file_loc), exist=file_exist)
721
722 if (file_exist) then
723 call mpi_file_open(mpi_comm_self, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
724
725 if (down_sample) then
727 else
728 if (ib) then
730 else
732 end if
733 end if
734
735 if (down_sample) then
736 data_size = (m_ds + 3)*(n_ds + 3)*(p_ds + 3)
737 m_glb_read = m_glb_ds + 1
738 n_glb_read = n_glb_ds + 1
739 p_glb_read = p_glb_ds + 1
740 else
741 data_size = (m + 1)*(n + 1)*(p + 1)
742 m_glb_read = m_glb + 1
743 n_glb_read = n_glb + 1
744 p_glb_read = p_glb + 1
745 end if
746
747 m_mok = int(m_glb_read + 1, mpi_offset_kind)
748 n_mok = int(m_glb_read + 1, mpi_offset_kind)
749 p_mok = int(m_glb_read + 1, mpi_offset_kind)
750 wp_mok = int(storage_size(0._stp)/8, mpi_offset_kind)
751 mok = int(1._wp, mpi_offset_kind)
752
753 if (bubbles_euler .or. elasticity) then
754 do i = 1, sys_size
755 var_mok = int(i, mpi_offset_kind)
756
757 call mpi_file_read(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
758 end do
759 ! Read pb and mv for non-polytropic qbmm
760 if (qbmm .and. .not. polytropic) then
761 do i = sys_size + 1, sys_size + 2*nb*nnode
762 var_mok = int(i, mpi_offset_kind)
763
764 call mpi_file_read(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
765 end do
766 end if
767 else
768 if (down_sample) then
769 do i = 1, sys_size
770 var_mok = int(i, mpi_offset_kind)
771
772 call mpi_file_read(ifile, q_cons_temp(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
773 end do
774 else
775 do i = 1, sys_size
776 var_mok = int(i, mpi_offset_kind)
777
778 call mpi_file_read(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
779 end do
780 end if
781 end if
782
783 call s_mpi_barrier()
784
785 call mpi_file_close(ifile, ierr)
786 else
787 call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting.')
788 end if
789 else
790 if (cfl_dt) then
791 write (file_loc, '(I0,A)') n_start, '.dat'
792 else
793 write (file_loc, '(I0,A)') t_step_start, '.dat'
794 end if
795 file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // trim(file_loc)
796 inquire (file=trim(file_loc), exist=file_exist)
797
798 if (file_exist) then
799 call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
800
801 if (ib) then
803 else
805 end if
806
807 data_size = (m + 1)*(n + 1)*(p + 1)
808
809 m_mok = int(m_glb + 1, mpi_offset_kind)
810 n_mok = int(n_glb + 1, mpi_offset_kind)
811 p_mok = int(p_glb + 1, mpi_offset_kind)
812 wp_mok = int(storage_size(0._stp)/8, mpi_offset_kind)
813 mok = int(1._wp, mpi_offset_kind)
814
815 if (bubbles_euler .or. elasticity) then
816 do i = 1, sys_size
817 var_mok = int(i, mpi_offset_kind)
818 disp = m_mok*max(mok, n_mok)*max(mok, p_mok)*wp_mok*(var_mok - 1)
819
820 call mpi_file_set_view(ifile, disp, mpi_io_p, mpi_io_data%view(i), 'native', mpi_info_int, ierr)
821 call mpi_file_read(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
822 end do
823 ! Read pb and mv for non-polytropic qbmm
824 if (qbmm .and. .not. polytropic) then
825 do i = sys_size + 1, sys_size + 2*nb*nnode
826 var_mok = int(i, mpi_offset_kind)
827 disp = m_mok*max(mok, n_mok)*max(mok, p_mok)*wp_mok*(var_mok - 1)
828
829 call mpi_file_set_view(ifile, disp, mpi_io_p, mpi_io_data%view(i), 'native', mpi_info_int, ierr)
830 call mpi_file_read(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
831 end do
832 end if
833 else
834 do i = 1, sys_size
835 var_mok = int(i, mpi_offset_kind)
836
837 disp = m_mok*max(mok, n_mok)*max(mok, p_mok)*wp_mok*(var_mok - 1)
838
839 call mpi_file_set_view(ifile, disp, mpi_io_p, mpi_io_data%view(i), 'native', mpi_info_int, ierr)
840 call mpi_file_read_all(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
841 end do
842 end if
843
844 call s_mpi_barrier()
845
846 call mpi_file_close(ifile, ierr)
847 else
848 call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting.')
849 end if
850 end if
851
852 deallocate (x_cb_glb, y_cb_glb, z_cb_glb)
853
854 if (bc_io) then
856 else
858 end if
859#endif
860
861 end subroutine s_read_parallel_data_files
862
863 !> Initialize internal-energy equations from phase mass, mixture momentum, and total energy
865
866 type(scalar_field), dimension(sys_size), intent(inout) :: v_vf
867 real(wp) :: rho
868 real(wp) :: dyn_pres
869 real(wp) :: gamma
870 real(wp) :: pi_inf
871 real(wp) :: qv
872 real(wp), dimension(2) :: re
873 real(wp) :: pres, t
874 integer :: i, j, k, l, c
875 real(wp), dimension(num_species) :: rhoyks
876 real(wp) :: pres_mag
877
878 pres_mag = 0._wp
879
880 t = dflt_t_guess
881
882 do j = 0, m
883 do k = 0, n
884 do l = 0, p
885 call s_convert_to_mixture_variables(v_vf, j, k, l, rho, gamma, pi_inf, qv, re)
886
887 dyn_pres = 0._wp
888 do i = eqn_idx%mom%beg, eqn_idx%mom%end
889 dyn_pres = dyn_pres + 5.e-1_wp*v_vf(i)%sf(j, k, l)*v_vf(i)%sf(j, k, l)/max(rho, sgm_eps)
890 end do
891
892 if (chemistry) then
893 do c = 1, num_species
894 rhoyks(c) = v_vf(eqn_idx%species%beg + c - 1)%sf(j, k, l)
895 end do
896 end if
897
898 if (mhd) then
899 if (n == 0) then
900 pres_mag = 0.5_wp*(bx0**2 + v_vf(eqn_idx%B%beg)%sf(j, k, l)**2 + v_vf(eqn_idx%B%beg + 1)%sf(j, k, l)**2)
901 else
902 pres_mag = 0.5_wp*(v_vf(eqn_idx%B%beg)%sf(j, k, l)**2 + v_vf(eqn_idx%B%beg + 1)%sf(j, k, &
903 & l)**2 + v_vf(eqn_idx%B%beg + 2)%sf(j, k, l)**2)
904 end if
905 end if
906
907 call s_compute_pressure(v_vf(eqn_idx%E)%sf(j, k, l), 0._stp, dyn_pres, pi_inf, gamma, rho, qv, rhoyks, pres, &
908 & t, pres_mag=pres_mag)
909
910 do i = 1, num_fluids
911 v_vf(i + eqn_idx%int_en%beg - 1)%sf(j, k, l) = v_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, &
912 & l)*(gammas(i)*pres + pi_infs(i)) + v_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*qvs(i)
913 end do
914 end do
915 end do
916 end do
917
919
920 !> Advance the simulation by one time step, handling CFL-based dt and time-stepper dispatch
921 impure subroutine s_perform_time_step(t_step, time_avg)
922
923 integer, intent(inout) :: t_step
924 real(wp), intent(inout) :: time_avg
925 integer :: i, eta_hh, eta_mm, eta_ss
926 real(wp) :: eta_sec
927
928 if (cfl_dt) then
929 if (cfl_const_dt .and. t_step == 0) call s_compute_dt()
930
931 if (cfl_adap_dt) call s_compute_dt()
932
933 if (t_step == 0) dt_init = dt
934
935 if (dt < 1.e-3_wp*dt_init .and. cfl_adap_dt .and. proc_rank == 0) then
936 print *, "Delta t = ", dt
937 call s_mpi_abort("Delta t has become too small")
938 end if
939 end if
940
941 if (cfl_dt) then
942 if ((mytime + dt) >= t_stop) then
943 dt = t_stop - mytime
944
945# 588 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
946#if defined(MFC_OpenACC)
947# 588 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
948!$acc update device(dt)
949# 588 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
950#elif defined(MFC_OpenMP)
951# 588 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
952!$omp target update to(dt)
953# 588 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
954#endif
955 end if
956 else
957 if ((mytime + dt) >= finaltime) then
958 dt = finaltime - mytime
959
960# 593 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
961#if defined(MFC_OpenACC)
962# 593 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
963!$acc update device(dt)
964# 593 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
965#elif defined(MFC_OpenMP)
966# 593 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
967!$omp target update to(dt)
968# 593 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
969#endif
970 end if
971 end if
972
973 if (cfl_dt) then
974 if (proc_rank == 0 .and. mod(t_step - t_step_start, t_step_print) == 0) then
975 eta_sec = wall_time_avg*(t_stop - mytime)/max(dt, tiny(dt))
976 eta_hh = int(eta_sec)/3600
977 eta_mm = mod(int(eta_sec), 3600)/60
978 eta_ss = mod(int(eta_sec), 60)
979 print '(" [", I3, "%] Time ", ES16.6, " dt = ", ES16.6, " @ Time Step = ", I8, " Time Avg = ", ES16.6, " Time/step = ", ES12.6, " ETA (HH:MM:SS) = ", I0, ":", I2.2, ":", I2.2)', &
980 & int(ceiling(100._wp*(mytime/t_stop))), mytime, dt, t_step, wall_time_avg, wall_time, eta_hh, eta_mm, eta_ss
981 end if
982 else
983 if (proc_rank == 0 .and. mod(t_step - t_step_start, t_step_print) == 0) then
984 eta_sec = wall_time_avg*real(t_step_stop - t_step, wp)
985 eta_hh = int(eta_sec)/3600
986 eta_mm = mod(int(eta_sec), 3600)/60
987 eta_ss = mod(int(eta_sec), 60)
988 print '(" [", I3, "%] Time step ", I8, " of ", I0, " @ t_step = ", I8, " Time Avg = ", ES12.6, " Time/step= ", ES12.6, " ETA (HH:MM:SS) = ", I0, ":", I2.2, ":", I2.2)', &
989 & int(ceiling(100._wp*(real(t_step - t_step_start)/(t_step_stop - t_step_start + 1)))), &
990 & t_step - t_step_start + 1, t_step_stop - t_step_start + 1, t_step, wall_time_avg, wall_time, eta_hh, &
991 & eta_mm, eta_ss
992 end if
993 end if
994
995 if (probe_wrt) then
996 do i = 1, sys_size
997
998# 621 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
999#if defined(MFC_OpenACC)
1000# 621 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1001!$acc update host(q_cons_ts(1)%vf(i)%sf)
1002# 621 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1003#elif defined(MFC_OpenMP)
1004# 621 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1005!$omp target update from(q_cons_ts(1)%vf(i)%sf)
1006# 621 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1007#endif
1008 end do
1009 end if
1010
1011 ! Total-variation-diminishing (TVD) Runge-Kutta (RK) time-steppers
1012 if (any(time_stepper == (/time_stepper_rk1, time_stepper_rk2, time_stepper_rk3/))) then
1013 call s_tvd_rk(t_step, time_avg, time_stepper)
1014 end if
1015
1016 ! Advance time after RK so source terms see current-step time
1017 mytime = mytime + dt
1018
1019 if (relax) call s_infinite_relaxation_k(q_cons_ts(1)%vf)
1020
1021 ! Time-stepping loop controls
1022 t_step = t_step + 1
1023
1024 end subroutine s_perform_time_step
1025
1026 !> Collect per-process wall-clock times and write aggregate performance metrics to file
1027 impure subroutine s_save_performance_metrics(time_avg, time_final, io_time_avg, io_time_final, proc_time, io_proc_time, &
1028 & file_exists)
1029
1030 real(wp), intent(inout) :: time_avg, time_final
1031 real(wp), intent(inout) :: io_time_avg, io_time_final
1032 real(wp), dimension(:), intent(inout) :: proc_time
1033 real(wp), dimension(:), intent(inout) :: io_proc_time
1034 logical, intent(inout) :: file_exists
1035 real(wp) :: grind_time
1036
1037 call s_mpi_barrier()
1038
1039 if (num_procs > 1) then
1040 call mpi_bcast_time_step_values(proc_time, time_avg)
1041
1042 call mpi_bcast_time_step_values(io_proc_time, io_time_avg)
1043 end if
1044
1045 if (proc_rank == 0) then
1046 time_final = 0._wp
1047 io_time_final = 0._wp
1048 if (num_procs == 1) then
1049 time_final = time_avg
1050 io_time_final = io_time_avg
1051 else
1052 time_final = maxval(proc_time)
1053 io_time_final = maxval(io_proc_time)
1054 end if
1055
1056 grind_time = time_final*1.0e9_wp/(real(sys_size, wp)*real(maxval((/1, m_glb/)), wp)*real(maxval((/1, n_glb/)), &
1057 & wp)*real(maxval((/1, p_glb/)), wp))
1058
1059 print *, "Performance:", grind_time, "ns/gp/eq/rhs"
1060 inquire (file='time_data.dat', exist=file_exists)
1061 if (file_exists) then
1062 open (1, file='time_data.dat', position='append', status='old')
1063 else
1064 open (1, file='time_data.dat', status='new')
1065 write (1, '(A10, A15, A15)') "Ranks", "s/step", "ns/gp/eq/rhs"
1066 end if
1067
1068 write (1, '(I10, 2(F15.8))') num_procs, time_final, grind_time
1069
1070 close (1)
1071
1072 inquire (file='io_time_data.dat', exist=file_exists)
1073 if (file_exists) then
1074 open (1, file='io_time_data.dat', position='append', status='old')
1075 else
1076 open (1, file='io_time_data.dat', status='new')
1077 write (1, '(A10, A15)') "Ranks", "s/step"
1078 end if
1079
1080 write (1, '(I10, F15.8)') num_procs, io_time_final
1081 close (1)
1082 end if
1083
1084 end subroutine s_save_performance_metrics
1085
1086 !> Save conservative variable data to disk at the current time step
1087 impure subroutine s_save_data(t_step, start, finish, io_time_avg, nt)
1088
1089 integer, intent(inout) :: t_step
1090 real(wp), intent(inout) :: start, finish, io_time_avg
1091 integer, intent(inout) :: nt
1092 integer(kind=8) :: i, j, k, l
1093 integer :: stor
1094 integer :: save_count
1095
1096 if (down_sample) then
1098 end if
1099
1100 stor = 1
1101
1102 if (time_stepper /= time_stepper_rk1) then
1103
1104# 717 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1105
1106# 717 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1107#if defined(MFC_OpenACC)
1108# 717 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1109!$acc parallel loop collapse(4) gang vector default(present) copyin(idwbuff)
1110# 717 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1111#elif defined(MFC_OpenMP)
1112# 717 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1113
1114# 717 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1115
1116# 717 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1117
1118# 717 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1119!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) map(to:idwbuff)
1120# 717 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1121#endif
1122 do i = 1, sys_size
1123 do l = idwbuff(3)%beg, idwbuff(3)%end
1124 do k = idwbuff(2)%beg, idwbuff(2)%end
1125 do j = idwbuff(1)%beg, idwbuff(1)%end
1126 q_cons_ts(2)%vf(i)%sf(j, k, l) = q_cons_ts(1)%vf(i)%sf(j, k, l)
1127 end do
1128 end do
1129 end do
1130 end do
1131
1132# 727 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1133#if defined(MFC_OpenACC)
1134# 727 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1135!$acc end parallel loop
1136# 727 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1137#elif defined(MFC_OpenMP)
1138# 727 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1139
1140# 727 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1141!$omp end target teams loop
1142# 727 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1143#endif
1144 stor = 2
1145 end if
1146
1147 call cpu_time(start)
1148 call nvtxstartrange("SAVE-DATA")
1149 do i = 1, sys_size
1150#ifndef FRONTIER_UNIFIED
1151
1152# 735 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1153#if defined(MFC_OpenACC)
1154# 735 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1155!$acc update host(q_cons_ts(stor)%vf(i)%sf)
1156# 735 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1157#elif defined(MFC_OpenMP)
1158# 735 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1159!$omp target update from(q_cons_ts(stor)%vf(i)%sf)
1160# 735 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1161#endif
1162#endif
1163 do l = 0, p
1164 do k = 0, n
1165 do j = 0, m
1166 if (ieee_is_nan(real(q_cons_ts(stor)%vf(i)%sf(j, k, l), kind=wp))) then
1167 print *, "NaN(s) in timestep output.", j, k, l, i, proc_rank, t_step, m, n, p
1168 call s_mpi_abort("NaN(s) in timestep output.")
1169 end if
1170 end do
1171 end do
1172 end do
1173 end do
1174
1175 if (qbmm .and. .not. polytropic) then
1176
1177# 750 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1178#if defined(MFC_OpenACC)
1179# 750 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1180!$acc update host(pb_ts(1)%sf)
1181# 750 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1182#elif defined(MFC_OpenMP)
1183# 750 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1184!$omp target update from(pb_ts(1)%sf)
1185# 750 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1186#endif
1187
1188# 751 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1189#if defined(MFC_OpenACC)
1190# 751 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1191!$acc update host(mv_ts(1)%sf)
1192# 751 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1193#elif defined(MFC_OpenMP)
1194# 751 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1195!$omp target update from(mv_ts(1)%sf)
1196# 751 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1197#endif
1198 end if
1199
1200 if (cfl_dt) then
1201 save_count = int(mytime/t_save)
1202 else
1203 save_count = t_step
1204 end if
1205
1206 if (bubbles_lagrange) then
1207
1208# 761 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1209#if defined(MFC_OpenACC)
1210# 761 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1211!$acc update host(lag_id, mtn_pos, mtn_posPrev, mtn_vel, intfc_rad, intfc_vel, bub_R0, Rmax_stats, Rmin_stats, bub_dphidt, gas_p, gas_mv, gas_mg, gas_betaT, gas_betaC)
1212# 761 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1213#elif defined(MFC_OpenMP)
1214# 761 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1215!$omp target update from(lag_id, mtn_pos, mtn_posPrev, mtn_vel, intfc_rad, intfc_vel, bub_R0, Rmax_stats, Rmin_stats, bub_dphidt, gas_p, gas_mv, gas_mg, gas_betaT, gas_betaC)
1216# 761 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1217#endif
1218# 763 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1219 do i = 1, n_el_bubs_loc
1220 if (ieee_is_nan(intfc_rad(i, 1)) .or. intfc_rad(i, 1) <= 0._wp) then
1221 call s_mpi_abort("Bubble radius is negative or NaN, please reduce dt.")
1222 end if
1223 end do
1224
1225
1226# 769 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1227#if defined(MFC_OpenACC)
1228# 769 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1229!$acc update host(q_beta(1)%sf)
1230# 769 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1231#elif defined(MFC_OpenMP)
1232# 769 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1233!$omp target update from(q_beta(1)%sf)
1234# 769 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1235#endif
1236 call s_write_data_files(q_cons_ts(stor)%vf, q_t_sf, q_prim_vf, save_count, bc_type, q_beta(1))
1237
1238# 771 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1239#if defined(MFC_OpenACC)
1240# 771 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1241!$acc update host(Rmax_stats, Rmin_stats, gas_p, gas_mv, intfc_vel)
1242# 771 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1243#elif defined(MFC_OpenMP)
1244# 771 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1245!$omp target update from(Rmax_stats, Rmin_stats, gas_p, gas_mv, intfc_vel)
1246# 771 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1247#endif
1248 call s_write_restart_lag_bubbles(save_count) ! parallel
1249 if (lag_params%write_bubbles_stats) call s_write_lag_bubble_stats()
1250 else
1251 call s_write_data_files(q_cons_ts(stor)%vf, q_t_sf, q_prim_vf, save_count, bc_type)
1252 end if
1253
1254 ! Write IB kinematic state for restart
1255 if (ib) call s_write_ib_state_file(save_count)
1256
1257 call nvtxendrange
1258 call cpu_time(finish)
1259 if (cfl_dt) then
1260 nt = mytime/t_save
1261 else
1262 nt = int((t_step - t_step_start)/(t_step_save))
1263 end if
1264
1265 if (nt == 1) then
1266 io_time_avg = abs(finish - start)
1267 else
1268 io_time_avg = (abs(finish - start) + io_time_avg*(nt - 1))/nt
1269 end if
1270
1271 end subroutine s_save_data
1272
1273 !> Initialize all simulation sub-modules in the required dependency order
1274 impure subroutine s_initialize_modules
1275
1276 integer :: m_ds, n_ds, p_ds
1277 integer :: i
1278
1280# 814 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1281 if (bubbles_euler .or. bubbles_lagrange) then
1283 end if
1287 if (grid_geometry == 3) call s_initialize_fftw_module()
1288
1289 if (bubbles_euler) call s_initialize_bubbles_ee_module()
1290 if (ib) then
1292 end if
1293 if (qbmm) call s_initialize_qbmm_module()
1294
1295 if (acoustic_source) then
1297 end if
1298
1299 if (viscous .and. (.not. igr)) then
1301 end if
1302
1304
1305 if (surface_tension) call s_initialize_surface_tension_module()
1306
1307 if (relax) call s_initialize_phasechange_module()
1308
1312
1314
1315 if (down_sample) then
1316 m_ds = int((m + 1)/3) - 1
1317 n_ds = int((n + 1)/3) - 1
1318 p_ds = int((p + 1)/3) - 1
1319
1320 allocate (q_cons_temp(1:sys_size))
1321 do i = 1, sys_size
1322 allocate (q_cons_temp(i)%sf(-1:m_ds + 1,-1:n_ds + 1,-1:p_ds + 1))
1323 end do
1324 end if
1325
1326 if (down_sample) then
1329 do i = 1, sys_size
1330
1331# 863 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1332#if defined(MFC_OpenACC)
1333# 863 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1334!$acc update device(q_cons_ts(1)%vf(i)%sf)
1335# 863 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1336#elif defined(MFC_OpenMP)
1337# 863 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1338!$omp target update to(q_cons_ts(1)%vf(i)%sf)
1339# 863 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1340#endif
1341 end do
1342 do i = 1, sys_size
1343 deallocate (q_cons_temp(i)%sf)
1344 end do
1345 deallocate (q_cons_temp)
1346 else
1347 call s_read_data_files(q_cons_ts(1)%vf)
1348 end if
1349
1351
1353 if (ib) then
1354 block
1355 type(ib_patch_parameters), allocatable :: particle_cloud_ibs(:)
1356
1357 if (cfl_dt .and. n_start > 0) then
1358 call s_read_ib_restart_data(n_start)
1359 allocate (particle_cloud_ibs(0))
1360 else if (t_step_start > 0) then
1361 call s_read_ib_restart_data(t_step_start)
1362 allocate (particle_cloud_ibs(0))
1363 else
1364 call s_generate_particle_clouds(particle_cloud_ibs)
1365 end if
1368 call s_reduce_ib_patch_array(particle_cloud_ibs)
1369 deallocate (particle_cloud_ibs)
1370 end block
1371 call s_ibm_setup()
1372 if (t_step_start == 0 .or. (cfl_dt .and. n_start == 0)) then
1373 call s_write_ib_data_file(0)
1374 call s_write_ib_state_file(0)
1375 end if
1376 end if
1377 if (bodyforces .or. synthetic_turbulence) call s_initialize_body_forces_module()
1378 if (acoustic_source) call s_precalculate_acoustic_spatial_sources()
1379
1380 ! Initialize the Temperature cache.
1381 if (chemistry) call s_compute_q_t_sf(q_t_sf, q_cons_ts(1)%vf, idwint)
1382
1383 ! Computation of parameters, allocation of memory, association of pointers, and/or execution of any other tasks that are
1384 ! needed to properly configure the modules. The preparations below DO DEPEND on the grid being complete.
1385 if (igr) then
1387 end if
1388 if (.not. igr) then
1389 if (recon_type == recon_type_weno) then
1391 else if (recon_type == recon_type_muscl) then
1393 end if
1396 end if
1397 if (int_comp > 0) call s_initialize_thinc_module()
1399 if (bubbles_lagrange) call s_initialize_bubbles_el_module(q_cons_ts(1)%vf, bc_type)
1400
1401 if (hypoelasticity) call s_initialize_hypoelastic_module()
1402 if (hyperelasticity) call s_initialize_hyperelastic_module()
1403
1404 end subroutine s_initialize_modules
1405
1406 !> Set up the MPI execution environment, bind GPUs, and decompose the computational domain
1407 impure subroutine s_initialize_mpi_domain
1408
1409 integer :: ierr
1410
1411#ifdef MFC_GPU
1412 real(wp) :: starttime, endtime
1413 integer :: num_devices, local_size, num_nodes, ppn, my_device_num
1414 integer :: dev, devnum, local_rank
1415#ifdef MFC_MPI
1416 integer :: local_comm
1417#endif
1418#if defined(MFC_OpenACC)
1419 integer(acc_device_kind) :: devtype
1420#endif
1421#endif
1422
1423 call s_mpi_initialize()
1424
1425#ifdef MFC_GPU
1426#ifndef MFC_MPI
1427 local_size = 1
1428 local_rank = 0
1429#else
1430 call mpi_comm_split_type(mpi_comm_world, mpi_comm_type_shared, 0, mpi_info_null, local_comm, ierr)
1431 call mpi_comm_size(local_comm, local_size, ierr)
1432 call mpi_comm_rank(local_comm, local_rank, ierr)
1433#endif
1434#if defined(MFC_OpenACC)
1435 devtype = acc_get_device_type()
1436 devnum = acc_get_num_devices(devtype)
1437 dev = mod(local_rank, devnum)
1438
1439 call acc_set_device_num(dev, devtype)
1440#elif defined(MFC_OpenMP)
1441 devnum = omp_get_num_devices()
1442 dev = mod(local_rank, devnum)
1443 call omp_set_default_device(dev)
1444#endif
1445#endif
1446
1447 if (proc_rank == 0) then
1448 call s_assign_default_values_to_user_inputs()
1449 call s_read_input_file()
1450 call s_check_input_file()
1451
1452 print '(" Simulating a ", A, " ", I0, "x", I0, "x", I0, " case on ", I0, " rank(s) ", A, ".")', &
1453# 977 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1454 "regular", &
1455# 981 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1456 m, n, p, num_procs, &
1457#if defined(MFC_OpenACC)
1458 "with OpenACC offloading"
1459#elif defined(MFC_OpenMP)
1460 "with OpenMP offloading"
1461#else
1462 "on CPUs"
1463#endif
1464 end if
1465
1466 call s_mpi_bcast_user_inputs()
1467
1468 ! Save original BCs before decomposition overwrites them with MPI neighbor ranks
1469 ib_bc_x = bc_x
1470 ib_bc_y = bc_y
1471 ib_bc_z = bc_z
1472
1473 call s_initialize_parallel_io()
1474
1475 call s_mpi_decompose_computational_domain()
1476
1477 bc = bc_xyz_info(bc_x, bc_y, bc_z)
1478
1479 end subroutine s_initialize_mpi_domain
1480
1481 !> Transfer initial conservative variable and model parameter data to the GPU device
1483
1484 integer :: i
1485
1486 if (.not. down_sample) then
1487 do i = 1, sys_size
1488
1489# 1013 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1490#if defined(MFC_OpenACC)
1491# 1013 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1492!$acc update device(q_cons_ts(1)%vf(i)%sf)
1493# 1013 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1494#elif defined(MFC_OpenMP)
1495# 1013 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1496!$omp target update to(q_cons_ts(1)%vf(i)%sf)
1497# 1013 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1498#endif
1499 end do
1500 end if
1501
1502 if (qbmm .and. .not. polytropic) then
1503
1504# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1505#if defined(MFC_OpenACC)
1506# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1507!$acc update device(pb_ts(1)%sf, mv_ts(1)%sf)
1508# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1509#elif defined(MFC_OpenMP)
1510# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1511!$omp target update to(pb_ts(1)%sf, mv_ts(1)%sf)
1512# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1513#endif
1514 end if
1515 if (chemistry) then
1516
1517# 1021 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1518#if defined(MFC_OpenACC)
1519# 1021 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1520!$acc update device(q_T_sf%sf)
1521# 1021 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1522#elif defined(MFC_OpenMP)
1523# 1021 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1524!$omp target update to(q_T_sf%sf)
1525# 1021 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1526#endif
1527 end if
1528
1529
1530# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1531#if defined(MFC_OpenACC)
1532# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1533!$acc update device(chem_params)
1534# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1535#elif defined(MFC_OpenMP)
1536# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1537!$omp target update to(chem_params)
1538# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1539#endif
1540
1541
1542# 1026 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1543#if defined(MFC_OpenACC)
1544# 1026 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1545!$acc update device(rburn)
1546# 1026 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1547#elif defined(MFC_OpenMP)
1548# 1026 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1549!$omp target update to(rburn)
1550# 1026 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1551#endif
1552
1553
1554# 1028 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1555#if defined(MFC_OpenACC)
1556# 1028 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1557!$acc update device(R0ref, p0ref, rho0ref, ss, pv, vd, mu_l, mu_v, mu_g, gam_v, gam_g, M_v, M_g, R_v, R_g, Tw, cp_v, cp_g, k_vl, k_gl, gam, gam_m, Eu, Ca, Web, Re_inv, Pe_c, phi_vg, phi_gv, omegaN, bubbles_euler, polytropic, polydisperse, qbmm, ptil, bubble_model, thermal, poly_sigma, adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, eqn_idx%n, pi_fac, low_Mach)
1558# 1028 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1559#elif defined(MFC_OpenMP)
1560# 1028 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1561!$omp target update to(R0ref, p0ref, rho0ref, ss, pv, vd, mu_l, mu_v, mu_g, gam_v, gam_g, M_v, M_g, R_v, R_g, Tw, cp_v, cp_g, k_vl, k_gl, gam, gam_m, Eu, Ca, Web, Re_inv, Pe_c, phi_vg, phi_gv, omegaN, bubbles_euler, polytropic, polydisperse, qbmm, ptil, bubble_model, thermal, poly_sigma, adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, eqn_idx%n, pi_fac, low_Mach)
1562# 1028 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1563#endif
1564# 1032 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1565
1566 if (bubbles_euler) then
1567
1568# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1569#if defined(MFC_OpenACC)
1570# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1571!$acc update device(weight, R0)
1572# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1573#elif defined(MFC_OpenMP)
1574# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1575!$omp target update to(weight, R0)
1576# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1577#endif
1578 if (.not. polytropic) then
1579
1580# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1581#if defined(MFC_OpenACC)
1582# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1583!$acc update device(pb0, Pe_T, k_g, k_v, mass_g0, mass_v0, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c)
1584# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1585#elif defined(MFC_OpenMP)
1586# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1587!$omp target update to(pb0, Pe_T, k_g, k_v, mass_g0, mass_v0, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c)
1588# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1589#endif
1590 else if (qbmm) then
1591
1592# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1593#if defined(MFC_OpenACC)
1594# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1595!$acc update device(pb0)
1596# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1597#elif defined(MFC_OpenMP)
1598# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1599!$omp target update to(pb0)
1600# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1601#endif
1602 end if
1603 end if
1604
1605
1606# 1042 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1607#if defined(MFC_OpenACC)
1608# 1042 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1609!$acc update device(adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, pi_fac, low_Mach)
1610# 1042 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1611#elif defined(MFC_OpenMP)
1612# 1042 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1613!$omp target update to(adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, pi_fac, low_Mach)
1614# 1042 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1615#endif
1616
1617
1618# 1044 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1619#if defined(MFC_OpenACC)
1620# 1044 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1621!$acc update device(acoustic_source, num_source)
1622# 1044 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1623#elif defined(MFC_OpenMP)
1624# 1044 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1625!$omp target update to(acoustic_source, num_source)
1626# 1044 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1627#endif
1628
1629# 1045 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1630#if defined(MFC_OpenACC)
1631# 1045 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1632!$acc update device(sigma, surface_tension)
1633# 1045 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1634#elif defined(MFC_OpenMP)
1635# 1045 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1636!$omp target update to(sigma, surface_tension)
1637# 1045 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1638#endif
1639
1640
1641# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1642#if defined(MFC_OpenACC)
1643# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1644!$acc update device(dx, dy, dz, x_cb, x_cc, y_cb, y_cc, z_cb, z_cc)
1645# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1646#elif defined(MFC_OpenMP)
1647# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1648!$omp target update to(dx, dy, dz, x_cb, x_cc, y_cb, y_cc, z_cb, z_cc)
1649# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1650#endif
1651
1652# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1653#if defined(MFC_OpenACC)
1654# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1655!$acc update device(bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end)
1656# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1657#elif defined(MFC_OpenMP)
1658# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1659!$omp target update to(bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end)
1660# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1661#endif
1662
1663# 1049 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1664#if defined(MFC_OpenACC)
1665# 1049 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1666!$acc update device(bc_x%vb1, bc_x%vb2, bc_x%vb3, bc_x%ve1, bc_x%ve2, bc_x%ve3)
1667# 1049 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1668#elif defined(MFC_OpenMP)
1669# 1049 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1670!$omp target update to(bc_x%vb1, bc_x%vb2, bc_x%vb3, bc_x%ve1, bc_x%ve2, bc_x%ve3)
1671# 1049 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1672#endif
1673
1674# 1050 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1675#if defined(MFC_OpenACC)
1676# 1050 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1677!$acc update device(bc_y%vb1, bc_y%vb2, bc_y%vb3, bc_y%ve1, bc_y%ve2, bc_y%ve3)
1678# 1050 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1679#elif defined(MFC_OpenMP)
1680# 1050 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1681!$omp target update to(bc_y%vb1, bc_y%vb2, bc_y%vb3, bc_y%ve1, bc_y%ve2, bc_y%ve3)
1682# 1050 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1683#endif
1684
1685# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1686#if defined(MFC_OpenACC)
1687# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1688!$acc update device(bc_z%vb1, bc_z%vb2, bc_z%vb3, bc_z%ve1, bc_z%ve2, bc_z%ve3)
1689# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1690#elif defined(MFC_OpenMP)
1691# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1692!$omp target update to(bc_z%vb1, bc_z%vb2, bc_z%vb3, bc_z%ve1, bc_z%ve2, bc_z%ve3)
1693# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1694#endif
1695
1696
1697# 1053 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1698#if defined(MFC_OpenACC)
1699# 1053 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1700!$acc update device(bc_x%grcbc_in, bc_x%grcbc_out, bc_x%grcbc_vel_out)
1701# 1053 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1702#elif defined(MFC_OpenMP)
1703# 1053 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1704!$omp target update to(bc_x%grcbc_in, bc_x%grcbc_out, bc_x%grcbc_vel_out)
1705# 1053 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1706#endif
1707
1708# 1054 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1709#if defined(MFC_OpenACC)
1710# 1054 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1711!$acc update device(bc_y%grcbc_in, bc_y%grcbc_out, bc_y%grcbc_vel_out)
1712# 1054 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1713#elif defined(MFC_OpenMP)
1714# 1054 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1715!$omp target update to(bc_y%grcbc_in, bc_y%grcbc_out, bc_y%grcbc_vel_out)
1716# 1054 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1717#endif
1718
1719# 1055 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1720#if defined(MFC_OpenACC)
1721# 1055 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1722!$acc update device(bc_z%grcbc_in, bc_z%grcbc_out, bc_z%grcbc_vel_out)
1723# 1055 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1724#elif defined(MFC_OpenMP)
1725# 1055 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1726!$omp target update to(bc_z%grcbc_in, bc_z%grcbc_out, bc_z%grcbc_vel_out)
1727# 1055 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1728#endif
1729
1730
1731# 1057 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1732#if defined(MFC_OpenACC)
1733# 1057 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1734!$acc update device(bc_x%isothermal_in, bc_x%isothermal_out)
1735# 1057 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1736#elif defined(MFC_OpenMP)
1737# 1057 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1738!$omp target update to(bc_x%isothermal_in, bc_x%isothermal_out)
1739# 1057 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1740#endif
1741
1742# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1743#if defined(MFC_OpenACC)
1744# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1745!$acc update device(bc_y%isothermal_in, bc_y%isothermal_out)
1746# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1747#elif defined(MFC_OpenMP)
1748# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1749!$omp target update to(bc_y%isothermal_in, bc_y%isothermal_out)
1750# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1751#endif
1752
1753# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1754#if defined(MFC_OpenACC)
1755# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1756!$acc update device(bc_z%isothermal_in, bc_z%isothermal_out)
1757# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1758#elif defined(MFC_OpenMP)
1759# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1760!$omp target update to(bc_z%isothermal_in, bc_z%isothermal_out)
1761# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1762#endif
1763
1764# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1765#if defined(MFC_OpenACC)
1766# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1767!$acc update device(bc_x%Twall_in, bc_x%Twall_out, bc_y%Twall_in, bc_y%Twall_out, bc_z%Twall_in, bc_z%Twall_out)
1768# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1769#elif defined(MFC_OpenMP)
1770# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1771!$omp target update to(bc_x%Twall_in, bc_x%Twall_out, bc_y%Twall_in, bc_y%Twall_out, bc_z%Twall_in, bc_z%Twall_out)
1772# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1773#endif
1774
1775
1776# 1062 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1777#if defined(MFC_OpenACC)
1778# 1062 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1779!$acc update device(bc)
1780# 1062 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1781#elif defined(MFC_OpenMP)
1782# 1062 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1783!$omp target update to(bc)
1784# 1062 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1785#endif
1786
1787
1788# 1064 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1789#if defined(MFC_OpenACC)
1790# 1064 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1791!$acc update device(relax, relax_model)
1792# 1064 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1793#elif defined(MFC_OpenMP)
1794# 1064 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1795!$omp target update to(relax, relax_model)
1796# 1064 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1797#endif
1798 if (relax) then
1799
1800# 1066 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1801#if defined(MFC_OpenACC)
1802# 1066 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1803!$acc update device(palpha_eps, ptgalpha_eps)
1804# 1066 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1805#elif defined(MFC_OpenMP)
1806# 1066 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1807!$omp target update to(palpha_eps, ptgalpha_eps)
1808# 1066 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1809#endif
1810 end if
1811
1812 if (ib) then
1813
1814# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1815#if defined(MFC_OpenACC)
1816# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1817!$acc update device(ib_markers%sf)
1818# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1819#elif defined(MFC_OpenMP)
1820# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1821!$omp target update to(ib_markers%sf)
1822# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1823#endif
1824 end if
1825# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1826
1827# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1828#if defined(MFC_OpenACC)
1829# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1830!$acc update device(igr, nb, igr_order)
1831# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1832#elif defined(MFC_OpenMP)
1833# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1834!$omp target update to(igr, nb, igr_order)
1835# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1836#endif
1837# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1838
1839 end subroutine s_initialize_gpu_vars
1840
1841 !> Finalize and deallocate all simulation sub-modules in reverse initialization order
1842 impure subroutine s_finalize_modules
1843
1844 call s_finalize_time_steppers_module()
1845 if (hypoelasticity) call s_finalize_hypoelastic_module()
1846 if (hyperelasticity) call s_finalize_hyperelastic_module()
1847 call s_finalize_derived_variables_module()
1848 call s_finalize_data_output_module()
1849 call s_finalize_rhs_module()
1850 if (igr) then
1851 call s_finalize_igr_module()
1852 else
1853 call s_finalize_cbc_module()
1854 call s_finalize_riemann_solvers_module()
1855 if (recon_type == recon_type_weno) then
1856 call s_finalize_weno_module()
1857 else if (recon_type == recon_type_muscl) then
1858 call s_finalize_muscl_module()
1859 end if
1860 end if
1861 if (int_comp > 0) call s_finalize_thinc_module()
1862 call s_finalize_variables_conversion_module()
1863 if (grid_geometry == 3) call s_finalize_fftw_module
1864 call s_finalize_mpi_common_module()
1865 call s_finalize_global_parameters_module()
1866 call s_finalize_boundary_common_module()
1867 if (relax) call s_finalize_relaxation_solver_module()
1868 if (bubbles_lagrange) call s_finalize_lagrangian_solver()
1869 if (viscous .and. (.not. igr)) then
1870 call s_finalize_viscous_module()
1871 end if
1872 call s_finalize_mpi_proxy_module()
1873
1874 if (surface_tension) call s_finalize_surface_tension_module()
1875 if (bodyforces .or. synthetic_turbulence) call s_finalize_body_forces_module()
1876 if (ib) call s_finalize_ibm_module()
1877
1878 call s_mpi_finalize()
1879
1880 end subroutine s_finalize_modules
1881
1882 !> @brief Reads IB kinematic state from restart_data/ib_state.dat on restart. Rank 0 reads the last num_ibs records and
1883 !! broadcasts to all ranks. Overwrites patch_ib vel, angular_vel, angles, and centroid.
1884 impure subroutine s_read_ib_restart_data(t_step)
1885
1886 integer, intent(in) :: t_step
1887 character(len=path_len + 2*name_len) :: file_loc
1888 integer :: i, ios, file_unit, ierr
1889 integer :: r, nlocal, gbl_id
1890 integer, parameter :: nfields_per_ib = 20
1891 real(wp) :: ib_buf(nfields_per_ib)
1892 logical :: file_exist
1893 character(len=10) :: t_step_string
1894
1895 if (file_per_process) then
1896 call s_int_to_str(t_step, t_step_string)
1897
1898 do r = 0, num_procs - 1
1899 write (file_loc, '(A,I0,A,i7.7,A)') 'ib_state_', t_step, '_', r, '.dat'
1900 file_loc = trim(case_dir) // '/restart_data/lustre_' // trim(t_step_string) // '/' // trim(file_loc)
1901
1902 inquire (file=trim(file_loc), exist=file_exist)
1903 if (.not. file_exist) call s_mpi_abort('Cannot open IB state file for restart: ' // trim(file_loc))
1904
1905 open (newunit=file_unit, file=trim(file_loc), form='unformatted', access='stream', status='old', iostat=ios)
1906 if (ios /= 0) call s_mpi_abort('Error opening IB state restart file: ' // trim(file_loc))
1907
1908 read (file_unit, iostat=ios) nlocal
1909 if (ios /= 0) call s_mpi_abort('Error reading IB state file header: ' // trim(file_loc))
1910
1911 do i = 1, nlocal
1912 read (file_unit, iostat=ios) gbl_id
1913 if (ios /= 0) call s_mpi_abort('Error reading IB patch ID: ' // trim(file_loc))
1914 read (file_unit, iostat=ios) ib_buf
1915 if (ios /= 0) call s_mpi_abort('Error reading IB state data: ' // trim(file_loc))
1916
1917 patch_ib(gbl_id)%vel = ib_buf(8:10)
1918 patch_ib(gbl_id)%angular_vel = ib_buf(11:13)
1919 patch_ib(gbl_id)%angles = ib_buf(14:16)
1920 patch_ib(gbl_id)%x_centroid = ib_buf(17)
1921 patch_ib(gbl_id)%y_centroid = ib_buf(18)
1922 patch_ib(gbl_id)%z_centroid = ib_buf(19)
1923 end do
1924
1925 close (file_unit)
1926 end do
1927 else
1928 write (file_loc, '(A,I0,A)') '/restart_data/ib_state_', t_step, '.dat'
1929 file_loc = trim(case_dir) // trim(file_loc)
1930
1931 if (proc_rank == 0) then
1932 inquire (file=trim(file_loc), exist=file_exist)
1933 if (.not. file_exist) then
1934 call s_mpi_abort('Cannot open IB state file for restart: ' // trim(file_loc))
1935 end if
1936
1937 open (newunit=file_unit, file=trim(file_loc), form='unformatted', access='stream', status='old', iostat=ios)
1938 if (ios /= 0) call s_mpi_abort('Error opening IB state restart file: ' // trim(file_loc))
1939
1940 do i = 1, num_ibs
1941 read (file_unit, iostat=ios) ib_buf
1942 if (ios /= 0) call s_mpi_abort('Error reading IB state restart file')
1943
1944 patch_ib(i)%vel = ib_buf(8:10)
1945 patch_ib(i)%angular_vel = ib_buf(11:13)
1946 patch_ib(i)%angles = ib_buf(14:16)
1947 patch_ib(i)%x_centroid = ib_buf(17)
1948 patch_ib(i)%y_centroid = ib_buf(18)
1949 patch_ib(i)%z_centroid = ib_buf(19)
1950 end do
1951
1952 close (file_unit)
1953 end if
1954
1955#ifdef MFC_MPI
1956 do i = 1, num_ibs
1957 call mpi_bcast(patch_ib(i)%vel, 3, mpi_p, 0, mpi_comm_world, ierr)
1958 call mpi_bcast(patch_ib(i)%angular_vel, 3, mpi_p, 0, mpi_comm_world, ierr)
1959 call mpi_bcast(patch_ib(i)%angles, 3, mpi_p, 0, mpi_comm_world, ierr)
1960 call mpi_bcast(patch_ib(i)%x_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1961 call mpi_bcast(patch_ib(i)%y_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1962 call mpi_bcast(patch_ib(i)%z_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1963 end do
1964#endif
1965 end if
1966
1967 end subroutine s_read_ib_restart_data
1968
1969 !> @brief Merges patch_ib (namelist patches, fixed at num_ib_patches_max_namelist) with particle_cloud_ibs (CPU-only, exact
1970 !! size) and reduces to only the patches in or near the local computational domain. patch_ib is never reallocated; the local
1971 !! subset is written in-place from the front. particle_cloud_ibs is owned by the caller and freed there after this returns.
1972 subroutine s_reduce_ib_patch_array(particle_cloud_ibs)
1973
1974 type(ib_patch_parameters), intent(in), dimension(:) :: particle_cloud_ibs
1975 real(wp), dimension(3) :: centroid
1976 integer :: i
1977 integer :: num_namelist_ibs, num_bed_ibs
1978
1979 num_namelist_ibs = num_ibs
1980 num_bed_ibs = 0
1981 do i = 1, num_particle_clouds
1982 num_bed_ibs = num_bed_ibs + particle_cloud(i)%num_particles
1983 end do
1984
1985 ! Check for moving IBs across both namelist and particle bed patches.
1986 moving_immersed_boundary_flag = .false.
1987 do i = 1, num_namelist_ibs
1988 if (patch_ib(i)%moving_ibm /= 0) then
1989 moving_immersed_boundary_flag = .true.
1990 exit
1991 end if
1992 end do
1993 if (.not. moving_immersed_boundary_flag) then
1994 do i = 1, num_bed_ibs
1995 if (particle_cloud_ibs(i)%moving_ibm /= 0) then
1996 moving_immersed_boundary_flag = .true.
1997 exit
1998 end if
1999 end do
2000 end if
2001
2002 call get_neighbor_bounds()
2004
2005 num_gbl_ibs = num_namelist_ibs + num_bed_ibs
2006
2007#ifdef MFC_MPI
2008 if (num_procs == 1) then
2009 ! single-rank: all patches are local; append particle bed entries directly into patch_ib.
2010 if (num_gbl_ibs > num_ib_patches_max_namelist) then
2011# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2012 call s_prohibit_abort("num_gbl_ibs > num_ib_patches_max_namelist", "Total IB count exceeds patch_ib capacity. Increase num_ib_patches_max_namelist.")
2013# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2014 end if
2015# 1249 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2016 do i = 1, num_bed_ibs
2017 patch_ib(num_namelist_ibs + i) = particle_cloud_ibs(i)
2018 patch_ib(num_namelist_ibs + i)%gbl_patch_id = num_namelist_ibs + i
2019 end do
2020 num_ibs = num_gbl_ibs
2021 num_local_ibs = num_gbl_ibs
2022 do i = 1, num_gbl_ibs
2023 local_ib_patch_ids(i) = i
2024 end do
2025 else
2026 ! multi-rank: compact namelist patches in-place (write_idx <= read_idx, no aliasing), then append local particle beds.
2027 num_ibs = 0
2028 num_local_ibs = 0
2029 do i = 1, num_namelist_ibs
2030 centroid = [patch_ib(i)%x_centroid, patch_ib(i)%y_centroid, 0._wp]
2031 if (num_dims == 3) centroid(3) = patch_ib(i)%z_centroid
2032 if (f_neighborhood_ranks_own_location(centroid)) then
2033 num_ibs = num_ibs + 1
2034 patch_ib(num_ibs) = patch_ib(i)
2035 patch_ib(num_ibs)%gbl_patch_id = i
2036 if (f_local_rank_owns_location(centroid)) then
2037 num_local_ibs = num_local_ibs + 1
2038 local_ib_patch_ids(num_local_ibs) = num_ibs
2039 end if
2040 end if
2041 end do
2042 do i = 1, num_bed_ibs
2043 centroid = [particle_cloud_ibs(i)%x_centroid, particle_cloud_ibs(i)%y_centroid, 0._wp]
2044 if (num_dims == 3) centroid(3) = particle_cloud_ibs(i)%z_centroid
2045 if (f_neighborhood_ranks_own_location(centroid)) then
2046 num_ibs = num_ibs + 1
2047 if (num_ibs > num_ib_patches_max_namelist) then
2048# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2049 call s_prohibit_abort("num_ibs > num_ib_patches_max_namelist", "Local IB count exceeds patch_ib capacity. Increase num_ib_patches_max_namelist.")
2050# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2051 end if
2052# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2053 patch_ib(num_ibs) = particle_cloud_ibs(i)
2054 patch_ib(num_ibs)%gbl_patch_id = num_namelist_ibs + i
2055 if (f_local_rank_owns_location(centroid)) then
2056 num_local_ibs = num_local_ibs + 1
2057 local_ib_patch_ids(num_local_ibs) = num_ibs
2058 end if
2059 end if
2060 end do
2061 if (num_local_ibs > num_local_ibs_max) then
2062# 1290 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2063 call s_prohibit_abort("num_local_ibs > num_local_ibs_max", "Too many IBs on a single processor rank. Modify case file or increase limit of num_local_ibs_max to resolve.")
2064# 1290 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2065 end if
2066# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2067 end if
2068#else
2069 ! no-MPI: all patches are local; append particle bed entries directly into patch_ib.
2070 if (num_gbl_ibs > num_ib_patches_max_namelist) then
2071# 1295 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2072 call s_prohibit_abort("num_gbl_ibs > num_ib_patches_max_namelist", "Total IB count exceeds patch_ib capacity. Increase num_ib_patches_max_namelist.")
2073# 1295 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2074 end if
2075# 1297 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2076 do i = 1, num_bed_ibs
2077 patch_ib(num_namelist_ibs + i) = particle_cloud_ibs(i)
2078 patch_ib(num_namelist_ibs + i)%gbl_patch_id = num_namelist_ibs + i
2079 end do
2080 num_ibs = num_gbl_ibs
2081 num_local_ibs = num_gbl_ibs
2082 do i = 1, num_gbl_ibs
2083 local_ib_patch_ids(i) = i
2084 end do
2085#endif
2086
2087#ifdef MFC_DEBUG
2088# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2089 block
2090# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2091 use iso_fortran_env, only: output_unit
2092# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2093
2094# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2095 print *, 'm_start_up.fpp:1308: ', '@:ALLOCATE(ib_gbl_idx_lookup(1:num_gbl_ibs))'
2096# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2097
2098# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2099 call flush (output_unit)
2100# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2101 end block
2102# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2103#endif
2104# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2105 allocate (ib_gbl_idx_lookup(1:num_gbl_ibs))
2106# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2107
2108# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2109
2110# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2111#if defined(MFC_OpenACC)
2112# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2113!$acc enter data create(ib_gbl_idx_lookup)
2114# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2115#elif defined(MFC_OpenMP)
2116# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2117!$omp target enter data map(always,alloc:ib_gbl_idx_lookup)
2118# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2119#endif
2120
2121 end subroutine s_reduce_ib_patch_array
2122
2123 !> Build ib_neighbor_ranks(-1:1,-1:1,-1:1): MPI ranks of all neighbor domains. Uses two rounds of MPI_SENDRECV cascades - face
2124 !! neighbors are known from bc_*, edge neighbors are obtained in round 1, and (3D) corner neighbors in round 2.
2126
2127 integer :: ax, k, nbr_idx, nreqs, sx, sy, sz, dx, dy, dz
2128 integer, allocatable :: send_table(:,:,:), recv_tables(:,:,:,:)
2129 integer, dimension(52) :: requests
2130
2131#ifdef MFC_MPI
2132 integer :: ierr
2133 integer, dimension(4) :: buf4, rbuf4
2134 integer, dimension(2) :: buf2, rbuf2
2135
2136 ax = ib_neighborhood_radius
2137
2138 if (allocated(ib_neighbor_ranks)) deallocate (ib_neighbor_ranks)
2139 allocate (ib_neighbor_ranks(-ax:ax,-ax:ax,-ax:ax))
2140 ib_neighbor_ranks = mpi_proc_null
2141 ib_neighbor_ranks(0, 0, 0) = proc_rank
2142
2143 ! Fill radius-1 entries: face neighbors are known from domain decomposition
2144 ib_neighbor_ranks(-1, 0, 0) = bc_x%beg
2145 ib_neighbor_ranks(+1, 0, 0) = bc_x%end
2146 if (num_dims >= 2) then
2147 ib_neighbor_ranks(0, -1, 0) = bc_y%beg
2148 ib_neighbor_ranks(0, +1, 0) = bc_y%end
2149 end if
2150 if (num_dims == 3) then
2151 ib_neighbor_ranks(0, 0, -1) = bc_z%beg
2152 ib_neighbor_ranks(0, 0, +1) = bc_z%end
2153 end if
2154
2155 if (num_dims >= 2) then
2156 ! Round 1a: exchange y/z face ranks with +/-x face neighbors -> xy and xz edge ranks
2157 buf4 = [bc_y%beg, bc_y%end, bc_z%beg, bc_z%end]
2158
2159 ! Send to -x, receive from +x -> edges (+1,+/-1,0) and (+1,0,+/-1)
2160 call mpi_sendrecv(buf4, 4, mpi_integer, merge(bc_x%beg, mpi_proc_null, bc_x%beg >= 0), 310, rbuf4, 4, mpi_integer, &
2161 & merge(bc_x%end, mpi_proc_null, bc_x%end >= 0), 310, mpi_comm_world, mpi_status_ignore, ierr)
2162 if (bc_x%end >= 0) then
2163 ib_neighbor_ranks(+1, -1, 0) = rbuf4(1)
2164 ib_neighbor_ranks(+1, +1, 0) = rbuf4(2)
2165 ib_neighbor_ranks(+1, 0, -1) = rbuf4(3)
2166 ib_neighbor_ranks(+1, 0, +1) = rbuf4(4)
2167 end if
2168
2169 call mpi_sendrecv(buf4, 4, mpi_integer, merge(bc_x%end, mpi_proc_null, bc_x%end >= 0), 311, rbuf4, 4, mpi_integer, &
2170 & merge(bc_x%beg, mpi_proc_null, bc_x%beg >= 0), 311, mpi_comm_world, mpi_status_ignore, ierr)
2171 if (bc_x%beg >= 0) then
2172 ib_neighbor_ranks(-1, -1, 0) = rbuf4(1)
2173 ib_neighbor_ranks(-1, +1, 0) = rbuf4(2)
2174 ib_neighbor_ranks(-1, 0, -1) = rbuf4(3)
2175 ib_neighbor_ranks(-1, 0, +1) = rbuf4(4)
2176 end if
2177 end if
2178
2179 if (num_dims == 3) then
2180 ! Round 1b: exchange z face ranks with +/-y face neighbors -> yz edge ranks
2181 buf2 = [bc_z%beg, bc_z%end]
2182
2183 call mpi_sendrecv(buf2, 2, mpi_integer, merge(bc_y%beg, mpi_proc_null, bc_y%beg >= 0), 312, rbuf2, 2, mpi_integer, &
2184 & merge(bc_y%end, mpi_proc_null, bc_y%end >= 0), 312, mpi_comm_world, mpi_status_ignore, ierr)
2185 if (bc_y%end >= 0) then
2186 ib_neighbor_ranks(0, +1, -1) = rbuf2(1)
2187 ib_neighbor_ranks(0, +1, +1) = rbuf2(2)
2188 end if
2189
2190 call mpi_sendrecv(buf2, 2, mpi_integer, merge(bc_y%end, mpi_proc_null, bc_y%end >= 0), 313, rbuf2, 2, mpi_integer, &
2191 & merge(bc_y%beg, mpi_proc_null, bc_y%beg >= 0), 313, mpi_comm_world, mpi_status_ignore, ierr)
2192 if (bc_y%beg >= 0) then
2193 ib_neighbor_ranks(0, -1, -1) = rbuf2(1)
2194 ib_neighbor_ranks(0, -1, +1) = rbuf2(2)
2195 end if
2196
2197 ! Round 2: exchange z face ranks with xy-diagonal edge neighbors -> corner ranks. Each of the 4 xy diagonals gives 2
2198 ! corners (the +/-z variants). Pattern: send buf2 to mirror diagonal, receive from this diagonal -> that edge's z face
2199 ! ranks.
2200# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2201 call mpi_sendrecv(buf2, 2, mpi_integer, merge(ib_neighbor_ranks(-1, -1, 0), mpi_proc_null, &
2202 & ib_neighbor_ranks(-1, -1, 0) >= 0), 320, rbuf2, 2, mpi_integer, &
2203 & merge(ib_neighbor_ranks(1, 1, 0), mpi_proc_null, ib_neighbor_ranks(1, 1, &
2204 & 0) >= 0), 320, mpi_comm_world, mpi_status_ignore, ierr)
2205 if (ib_neighbor_ranks(1, 1, 0) >= 0) then
2206 ib_neighbor_ranks(1, 1, -1) = rbuf2(1)
2207 ib_neighbor_ranks(1, 1, +1) = rbuf2(2)
2208 end if
2209# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2210 call mpi_sendrecv(buf2, 2, mpi_integer, merge(ib_neighbor_ranks(-1, 1, 0), mpi_proc_null, &
2211 & ib_neighbor_ranks(-1, 1, 0) >= 0), 321, rbuf2, 2, mpi_integer, &
2212 & merge(ib_neighbor_ranks(1, -1, 0), mpi_proc_null, ib_neighbor_ranks(1, -1, &
2213 & 0) >= 0), 321, mpi_comm_world, mpi_status_ignore, ierr)
2214 if (ib_neighbor_ranks(1, -1, 0) >= 0) then
2215 ib_neighbor_ranks(1, -1, -1) = rbuf2(1)
2216 ib_neighbor_ranks(1, -1, +1) = rbuf2(2)
2217 end if
2218# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2219 call mpi_sendrecv(buf2, 2, mpi_integer, merge(ib_neighbor_ranks(1, -1, 0), mpi_proc_null, &
2220 & ib_neighbor_ranks(1, -1, 0) >= 0), 322, rbuf2, 2, mpi_integer, &
2221 & merge(ib_neighbor_ranks(-1, 1, 0), mpi_proc_null, ib_neighbor_ranks(-1, 1, &
2222 & 0) >= 0), 322, mpi_comm_world, mpi_status_ignore, ierr)
2223 if (ib_neighbor_ranks(-1, 1, 0) >= 0) then
2224 ib_neighbor_ranks(-1, 1, -1) = rbuf2(1)
2225 ib_neighbor_ranks(-1, 1, +1) = rbuf2(2)
2226 end if
2227# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2228 call mpi_sendrecv(buf2, 2, mpi_integer, merge(ib_neighbor_ranks(1, 1, 0), mpi_proc_null, &
2229 & ib_neighbor_ranks(1, 1, 0) >= 0), 323, rbuf2, 2, mpi_integer, &
2230 & merge(ib_neighbor_ranks(-1, -1, 0), mpi_proc_null, ib_neighbor_ranks(-1, -1, &
2231 & 0) >= 0), 323, mpi_comm_world, mpi_status_ignore, ierr)
2232 if (ib_neighbor_ranks(-1, -1, 0) >= 0) then
2233 ib_neighbor_ranks(-1, -1, -1) = rbuf2(1)
2234 ib_neighbor_ranks(-1, -1, +1) = rbuf2(2)
2235 end if
2236# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2237 end if
2238
2239 ! For radius > 1: extend the table by iterative 26-neighbor full-table exchanges. In each round, every rank broadcasts its
2240 ! current table to all 26 immediate neighbors. Their entry at offset (dx,dy,dz) from them = our entry at
2241 ! (dx+sx,dy+sy,dz+sz). One extension round fills the entire next shell, so ax-1 rounds suffice.
2242 if (ax > 1) then
2243 allocate (send_table(-ax:ax,-ax:ax,-ax:ax))
2244 allocate (recv_tables(-ax:ax,-ax:ax,-ax:ax,1:26))
2245
2246 do k = 2, ax
2247 send_table = ib_neighbor_ranks
2248
2249 nreqs = 0
2250 nbr_idx = 0
2251 do sz = -1, 1
2252 do sy = -1, 1
2253 do sx = -1, 1
2254 if (sx == 0 .and. sy == 0 .and. sz == 0) cycle
2255 nbr_idx = nbr_idx + 1
2256 if (ib_neighbor_ranks(sx, sy, sz) < 0) cycle
2257 nreqs = nreqs + 1
2258 call mpi_irecv(recv_tables(:,:,:,nbr_idx), (2*ax + 1)**3, mpi_integer, ib_neighbor_ranks(sx, sy, sz), &
2259 & 400, mpi_comm_world, requests(nreqs), ierr)
2260 end do
2261 end do
2262 end do
2263
2264 do sz = -1, 1
2265 do sy = -1, 1
2266 do sx = -1, 1
2267 if (sx == 0 .and. sy == 0 .and. sz == 0) cycle
2268 if (ib_neighbor_ranks(sx, sy, sz) < 0) cycle
2269 nreqs = nreqs + 1
2270 call mpi_isend(send_table, (2*ax + 1)**3, mpi_integer, ib_neighbor_ranks(sx, sy, sz), 400, &
2271 & mpi_comm_world, requests(nreqs), ierr)
2272 end do
2273 end do
2274 end do
2275
2276 call mpi_waitall(nreqs, requests, mpi_statuses_ignore, ierr)
2277
2278 nbr_idx = 0
2279 do sz = -1, 1
2280 do sy = -1, 1
2281 do sx = -1, 1
2282 if (sx == 0 .and. sy == 0 .and. sz == 0) cycle
2283 nbr_idx = nbr_idx + 1
2284 if (ib_neighbor_ranks(sx, sy, sz) < 0) cycle
2285 do dz = -ax, ax
2286 do dy = -ax, ax
2287 do dx = -ax, ax
2288 if (recv_tables(dx, dy, dz, nbr_idx) == mpi_proc_null) cycle
2289 if (dx + sx < -ax .or. dx + sx > ax) cycle
2290 if (dy + sy < -ax .or. dy + sy > ax) cycle
2291 if (dz + sz < -ax .or. dz + sz > ax) cycle
2292 if (ib_neighbor_ranks(dx + sx, dy + sy, dz + sz) /= mpi_proc_null) cycle
2293 ib_neighbor_ranks(dx + sx, dy + sy, dz + sz) = recv_tables(dx, dy, dz, nbr_idx)
2294 end do
2295 end do
2296 end do
2297 end do
2298 end do
2299 end do
2300 end do
2301
2302 deallocate (send_table, recv_tables)
2303 end if
2304#endif
2305
2306 end subroutine s_compute_ib_neighbor_ranks
2307
2309
2310 real(wp) :: beg_val, end_val, recv_val
2311 integer :: k, send_neighbor, recv_neighbor, ierr
2312
2313 ! Default: unbounded in all directions (covers single-rank and no-MPI cases)
2314
2315 neighbor_domain_x%beg = -huge(0._wp)
2316 neighbor_domain_x%end = huge(0._wp)
2317 neighbor_domain_y%beg = -huge(0._wp)
2318 neighbor_domain_y%end = huge(0._wp)
2319 neighbor_domain_z%beg = -huge(0._wp)
2320 neighbor_domain_z%end = huge(0._wp)
2321
2322#ifdef MFC_MPI
2323 ! For each direction, propagate the left/right boundary edges outward ib_neighborhood_radius hops. After k rounds: beg_val =
2324 ! left edge of the rank k hops to the left; end_val = right edge of the rank k hops to the right.
2325# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2326 if (num_dims >= 1) then
2327 beg_val = x_cb(-1)
2328 end_val = x_cb(m)
2329 do k = 1, ib_neighborhood_radius
2330 send_neighbor = merge(bc_x%end, mpi_proc_null, bc_x%end >= 0)
2331 recv_neighbor = merge(bc_x%beg, mpi_proc_null, bc_x%beg >= 0)
2332 recv_val = -huge(0._wp)
2333 call mpi_sendrecv(beg_val, 1, mpi_p, send_neighbor, 100, recv_val, 1, mpi_p, recv_neighbor, 100, &
2334 & mpi_comm_world, mpi_status_ignore, ierr)
2335 beg_val = recv_val
2336
2337 send_neighbor = merge(bc_x%beg, mpi_proc_null, bc_x%beg >= 0)
2338 recv_neighbor = merge(bc_x%end, mpi_proc_null, bc_x%end >= 0)
2339 recv_val = huge(0._wp)
2340 call mpi_sendrecv(end_val, 1, mpi_p, send_neighbor, 101, recv_val, 1, mpi_p, recv_neighbor, &
2341 & 101, mpi_comm_world, mpi_status_ignore, ierr)
2342 end_val = recv_val
2343
2344 ! protect from looping back around on yourself multiple times
2345 if (f_approx_equal(beg_val, x_cb(m)) .or. f_approx_equal(end_val, x_cb(-1))) then
2346 beg_val = -huge(0._wp)
2347 end_val = huge(0._wp)
2348 exit
2349 end if
2350 end do
2351 neighbor_domain_x%beg = beg_val
2352 neighbor_domain_x%end = end_val
2353 end if
2354# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2355 if (num_dims >= 2) then
2356 beg_val = y_cb(-1)
2357 end_val = y_cb(n)
2358 do k = 1, ib_neighborhood_radius
2359 send_neighbor = merge(bc_y%end, mpi_proc_null, bc_y%end >= 0)
2360 recv_neighbor = merge(bc_y%beg, mpi_proc_null, bc_y%beg >= 0)
2361 recv_val = -huge(0._wp)
2362 call mpi_sendrecv(beg_val, 1, mpi_p, send_neighbor, 102, recv_val, 1, mpi_p, recv_neighbor, 102, &
2363 & mpi_comm_world, mpi_status_ignore, ierr)
2364 beg_val = recv_val
2365
2366 send_neighbor = merge(bc_y%beg, mpi_proc_null, bc_y%beg >= 0)
2367 recv_neighbor = merge(bc_y%end, mpi_proc_null, bc_y%end >= 0)
2368 recv_val = huge(0._wp)
2369 call mpi_sendrecv(end_val, 1, mpi_p, send_neighbor, 103, recv_val, 1, mpi_p, recv_neighbor, &
2370 & 103, mpi_comm_world, mpi_status_ignore, ierr)
2371 end_val = recv_val
2372
2373 ! protect from looping back around on yourself multiple times
2374 if (f_approx_equal(beg_val, y_cb(n)) .or. f_approx_equal(end_val, y_cb(-1))) then
2375 beg_val = -huge(0._wp)
2376 end_val = huge(0._wp)
2377 exit
2378 end if
2379 end do
2380 neighbor_domain_y%beg = beg_val
2381 neighbor_domain_y%end = end_val
2382 end if
2383# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2384 if (num_dims >= 3) then
2385 beg_val = z_cb(-1)
2386 end_val = z_cb(p)
2387 do k = 1, ib_neighborhood_radius
2388 send_neighbor = merge(bc_z%end, mpi_proc_null, bc_z%end >= 0)
2389 recv_neighbor = merge(bc_z%beg, mpi_proc_null, bc_z%beg >= 0)
2390 recv_val = -huge(0._wp)
2391 call mpi_sendrecv(beg_val, 1, mpi_p, send_neighbor, 104, recv_val, 1, mpi_p, recv_neighbor, 104, &
2392 & mpi_comm_world, mpi_status_ignore, ierr)
2393 beg_val = recv_val
2394
2395 send_neighbor = merge(bc_z%beg, mpi_proc_null, bc_z%beg >= 0)
2396 recv_neighbor = merge(bc_z%end, mpi_proc_null, bc_z%end >= 0)
2397 recv_val = huge(0._wp)
2398 call mpi_sendrecv(end_val, 1, mpi_p, send_neighbor, 105, recv_val, 1, mpi_p, recv_neighbor, &
2399 & 105, mpi_comm_world, mpi_status_ignore, ierr)
2400 end_val = recv_val
2401
2402 ! protect from looping back around on yourself multiple times
2403 if (f_approx_equal(beg_val, z_cb(p)) .or. f_approx_equal(end_val, z_cb(-1))) then
2404 beg_val = -huge(0._wp)
2405 end_val = huge(0._wp)
2406 exit
2407 end if
2408 end do
2409 neighbor_domain_z%beg = beg_val
2410 neighbor_domain_z%end = end_val
2411 end if
2412# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2413#endif
2414
2415 end subroutine get_neighbor_bounds
2416
2417end module m_start_up
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
One-way acoustic source injection, Maeda and Colonius JCP (2017).
impure subroutine, public s_precalculate_acoustic_spatial_sources
Pre-compute non-zero spatial source weights before time-stepping.
impure subroutine, public s_initialize_acoustic_src
Initialize the acoustic source module.
Computes gravitational and body force source terms for the momentum equations.
impure subroutine, public s_initialize_body_forces_module
Initialize the body forces module. When synthetic_turbulence is enabled, generates random wave vector...
Noncharacteristic and processor boundary condition application for ghost cells and buffer regions.
impure subroutine, public s_initialize_boundary_common_module()
Allocate and set up boundary condition buffer arrays for all coordinate directions.
subroutine, public s_populate_grid_variables_buffers
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.
Boundary condition restart I/O, capillary/IGR buffer population, and grid-variable buffers.
subroutine s_assign_default_bc_type(bc_type)
Initialize the per-cell boundary condition type arrays with the global default BC values.
subroutine s_read_serial_boundary_condition_files(step_dirpath, bc_type)
Read boundary condition type and buffer data from serial (unformatted) restart files.
subroutine s_read_parallel_boundary_condition_files(bc_type)
Read boundary condition type and buffer data from per-rank parallel files using MPI I/O.
Computes ensemble-averaged (Euler–Euler) bubble source terms for radius, velocity,...
impure subroutine s_initialize_bubbles_ee_module
Initialize the Euler-Euler bubble module.
Tracks Lagrangian bubbles and couples their dynamics to the Eulerian flow via volume averaging.
impure subroutine s_write_lag_bubble_stats()
Write the maximum and minimum radius of each bubble.
impure subroutine s_write_restart_lag_bubbles(t_step)
Write restart files for the Lagrangian bubble solver.
type(scalar_field), dimension(:), allocatable q_beta
Projection of the lagrangian particles in the Eulerian framework.
impure subroutine s_initialize_bubbles_el_module(q_cons_vf, bc_type)
Initializes the lagrangian subgrid bubble solver.
real(wp), dimension(:,:), allocatable intfc_rad
Bubble radius.
Characteristic boundary conditions (CBC) for slip walls, non-reflecting subsonic inflow/outflow,...
impure subroutine, public s_initialize_cbc_module
Initialize the CBC module.
Shared input validation checks for grid dimensions and AMD GPU compiler limits.
impure subroutine, public s_check_inputs_common
Checks compatibility of parameters in the input file. Used by all three stages.
Validates simulation input parameters for consistency and supported configurations.
impure subroutine, public s_check_inputs
Checks compatibility of parameters in the input file. Used by the simulation 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.
Ghost-node immersed boundary method: locates ghost/image points, computes interpolation coefficients,...
Platform-specific file and directory operations: create, delete, inquire, getcwd, and basename.
impure subroutine my_inquire(fileloc, dircheck)
Inquire on the existence of a directory or file.
Compile-time constant parameters: default values, tolerances, and physical constants.
real(wp), parameter dflt_t_guess
Default guess for temperature (when a previous value is not available).
integer, parameter time_stepper_rk2
real(wp), parameter sgm_eps
Segmentation tolerance.
integer, parameter recon_type_muscl
integer, parameter time_stepper_rk1
integer, parameter time_stepper_rk3
integer, parameter nnode
Number of QBMM nodes.
integer, parameter recon_type_weno
integer, parameter model_eqns_6eq
integer, parameter bc_periodic
Writes solution data, run-time stability diagnostics (ICFL, VCFL, CCFL, Rc), and probe/center-of-mass...
impure subroutine, public s_initialize_data_output_module
Initialize the data output module.
impure subroutine, public s_write_data_files(q_cons_vf, q_t_sf, q_prim_vf, t_step, bc_type, beta)
Write data files. Dispatch subroutine that replaces procedure pointer.
impure subroutine, public s_write_ib_state_file(time_step)
Writes IB state records to restart_data/ib_state.dat. Must be called only on rank 0.
subroutine, public s_write_ib_data_file(time_step)
Dispatch immersed boundary data output to the serial or parallel writer.
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Derives diagnostic flow quantities (vorticity, speed of sound, numerical Schlieren,...
impure subroutine, public s_initialize_derived_variables
Allocate and open derived variables. Computing FD coefficients.
impure subroutine, public s_initialize_derived_variables_module
Computation of parameters, allocation procedures, and/or any other tasks needed to properly setup the...
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
real(wp) mytime
Current simulation time.
real(wp), dimension(num_synth_shells_max) synth_k_shell
real(wp), dimension(num_synth_shells_max) synth_amp_shell
type(int_bounds_info), dimension(1:3) idwint
real(wp), dimension(:), allocatable, target z_cb
logical, dimension(3) periodic_bc
integer proc_rank
Rank of the local processor.
type(int_bounds_info), dimension(1:3) idwbuff
integer buff_size
Number of ghost cells for boundary condition storage.
impure subroutine s_initialize_global_parameters_module
Initialize the global parameters module.
real(wp), dimension(:), allocatable, target y_cc
type(pres_field), dimension(:), allocatable pb_ts
type(pres_field), dimension(:), allocatable mv_ts
real(wp), dimension(:), allocatable, target z_cc
real(wp), dimension(:), allocatable qvs
real(wp), dimension(:), allocatable pi_infs
integer num_procs
Number of processors.
real(wp), dimension(:), allocatable, target x_cc
integer, dimension(num_synth_shells_max) synth_n_waves_per_shell
real(wp), dimension(num_turb_sources_max, 3) turb_pos
real(wp), dimension(:), allocatable, target y_cb
type(cell_num_bounds) cells_bounds
type(mpi_io_var), public mpi_io_data
real(wp), dimension(:), allocatable, target dy
real(wp), dimension(num_turb_sources_max, 3) synth_l
real(wp), dimension(:), allocatable gammas
real(wp) finaltime
Final simulation time.
real(wp), dimension(:), allocatable, target dz
real(wp), dimension(:), allocatable, target dx
real(wp), dimension(:), allocatable, target x_cb
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
elemental subroutine, public s_update_cell_bounds(bounds, m, n, p)
Update the min and max number of cells in each set of axes.
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
subroutine, public s_upsample_data(q_cons_vf, q_cons_temp)
Upsample conservative variable fields from a coarsened grid back to the original resolution using int...
impure subroutine, public s_initialize_bubbles_model()
Initialize bubble model arrays for Euler or Lagrangian bubbles with polytropic or non-polytropic gas.
elemental subroutine, public s_int_to_str(i, res)
Convert an integer to its trimmed string representation.
Computes the left Cauchy–Green deformation tensor and hyperelastic stress source terms.
impure subroutine, public s_initialize_hyperelastic_module
Initialize the hyperelastic module.
Computes hypoelastic stress-rate source terms and damage-state evolution.
impure subroutine, public s_initialize_hypoelastic_module
Initialize the hypoelastic module.
Allocate memory and read initial condition data for IC extrusion.
subroutine, public s_initialize_ib_airfoils()
Initialize the NACA surface grids for all airfoil IB patches. Must be called after the grid is establ...
Ghost-node immersed boundary method: locates ghost/image points, computes interpolation coefficients,...
impure subroutine, public s_ibm_setup()
Initializes the values of various IBM variables, such as ghost points and image points.
type(integer_field), public ib_markers
impure subroutine, public s_initialize_ibm_module()
Allocates memory for the variables in the IBM module.
Iterative ghost rasterization (IGR) for sharp immersed boundary treatment.
subroutine, public s_initialize_igr_module()
Initialize the IGR module.
integer(kind=8) j
integer(kind=8) i
integer(kind=8) l
integer(kind=8) r
integer(kind=8) k
Binary STL file reader and processor for immersed boundary geometry.
subroutine, public s_instantiate_stl_models()
Load, transform, and register STL/OBJ immersed-boundary models onto the simulation grid.
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
Initialize the module.
impure subroutine s_mpi_barrier
Halts all processes until all have reached barrier.
impure subroutine s_initialize_mpi_data(q_cons_vf, ib_markers, beta)
Set up MPI I/O data views and variable pointers for parallel file output.
subroutine s_initialize_mpi_data_ds(q_cons_vf)
Set up MPI I/O data views for downsampled (coarsened) parallel file output.
subroutine s_apply_grid_from_global_dim(x_cb_glb, m_dim_glb, m_dim, sidx, bc_beg, bc_end, cb_lo, cb_hi, cw_lo, cw_hi, x_cb_loc, x_cc_loc, dx_loc)
Populate the local cell-boundary, cell-center, and cell-width arrays in one direction directly from t...
impure subroutine mpi_bcast_time_step_values(proc_time, time_avg)
Gather per-rank time step wall-clock times onto rank 0 for performance reporting.
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
subroutine s_initialize_mpi_proxy_module()
Initialize the MPI proxy module.
MUSCL reconstruction with interface sharpening for contact-preserving advection.
subroutine, public s_initialize_muscl_module()
Allocate and initialize MUSCL reconstruction working arrays.
NVIDIA NVTX profiling API bindings for GPU performance instrumentation.
Definition m_nvtx.f90:6
subroutine nvtxstartrange(name, id)
Push a named NVTX range for GPU profiling, optionally with a color based on the given identifier.
Definition m_nvtx.f90:62
subroutine nvtxendrange
Pop the current NVTX range to end the GPU profiling region.
Definition m_nvtx.f90:83
Generates particle beds by converting particle_cloud patch specifications into individual immersed bo...
impure subroutine, public s_generate_particle_clouds(particle_cloud_ibs)
Generate all particle beds and fill particle_cloud_ibs. Called on all ranks before s_reduce_ib_patch_...
Phase transition relaxation solvers for liquid-vapor flows with cavitation and boiling.
subroutine, public s_infinite_relaxation_k(q_cons_vf)
Apply pT- or pTg-equilibrium relaxation with mass depletion based on the incoming state conditions.
impure subroutine, public s_initialize_phasechange_module
Initialize the phase change module (no module-level state to set up; the pT/pTg relaxation solvers ar...
Quadrature-based moment methods (QBMM) for polydisperse bubble moment inversion and transport.
impure subroutine, public s_initialize_qbmm_module
Initialize the QBMM module.
Assemble the right-hand side of the governing equations using finite-volume flux differencing,...
impure subroutine, public s_initialize_rhs_module
Initialize the RHS module.
Approximate and exact Riemann solvers (HLL, HLLC, HLLD, exact) for the multicomponent Navier–Stokes e...
impure subroutine, public s_initialize_riemann_solvers_module
Initialize the Riemann solvers module.
Simulation helper routines for enthalpy computation, CFL calculation, and stability checks.
Reads input files, loads initial conditions and grid data, and orchestrates solver initialization and...
impure subroutine s_read_ib_restart_data(t_step)
Reads IB kinematic state from restart_data/ib_state.dat on restart. Rank 0 reads the last num_ibs rec...
impure subroutine, public s_read_serial_data_files(q_cons_vf)
Read serial initial condition and grid data files and compute cell-width distributions.
impure subroutine, public s_initialize_modules
Initialize all simulation sub-modules in the required dependency order.
impure subroutine, public s_read_data_files(q_cons_vf)
Read data files. Dispatch subroutine that replaces procedure pointer.
impure subroutine, public s_read_parallel_data_files(q_cons_vf)
Read parallel initial condition and grid data files via MPI I/O.
subroutine, public s_initialize_internal_energy_equations(v_vf)
Initialize internal-energy equations from phase mass, mixture momentum, and total energy.
impure subroutine, public s_save_performance_metrics(time_avg, time_final, io_time_avg, io_time_final, proc_time, io_proc_time, file_exists)
Collect per-process wall-clock times and write aggregate performance metrics to file.
subroutine get_neighbor_bounds()
subroutine s_compute_ib_neighbor_ranks()
Build ib_neighbor_ranks(-1:1,-1:1,-1:1): MPI ranks of all neighbor domains. Uses two rounds of MPI_SE...
subroutine s_reduce_ib_patch_array(particle_cloud_ibs)
Merges patch_ib (namelist patches, fixed at num_ib_patches_max_namelist) with particle_cloud_ibs (CPU...
impure subroutine, public s_save_data(t_step, start, finish, io_time_avg, nt)
Save conservative variable data to disk at the current time step.
type(scalar_field), dimension(:), allocatable q_cons_temp
subroutine, public s_initialize_gpu_vars
Transfer initial conservative variable and model parameter data to the GPU device.
impure subroutine, public s_initialize_mpi_domain
Set up the MPI execution environment, bind GPUs, and decompose the computational domain.
impure subroutine, public s_finalize_modules
Finalize and deallocate all simulation sub-modules in reverse initialization order.
impure subroutine, public s_read_input_file
Verify the input file exists and read it.
impure subroutine, public s_check_input_file
Validate that all user-provided inputs form a consistent simulation configuration.
impure subroutine, public s_perform_time_step(t_step, time_avg)
Advance the simulation by one time step, handling CFL-based dt and time-stepper dispatch.
Computes capillary source fluxes and color-function gradients for the diffuse-interface surface tensi...
impure subroutine, public s_initialize_surface_tension_module
Allocate and initialize surface tension module arrays.
THINC and MTHINC interface compression for volume fraction sharpening. THINC (int_comp=1): 1D directi...
subroutine, public s_initialize_thinc_module()
real(wp), dimension(:,:,:), allocatable position
Total-variation-diminishing (TVD) Runge–Kutta time integrators (1st-, 2nd-, and 3rd-order SSP).
type(scalar_field) q_t_sf
Cell-average temperature variables at the current time-stage.
type(integer_field), dimension(:,:), allocatable bc_type
Boundary condition identifiers.
impure subroutine s_initialize_time_steppers_module
Initialize the time steppers module.
type(vector_field), dimension(:), allocatable q_cons_ts
Cell-average conservative variables at each time-stage (TS).
type(scalar_field), dimension(:), allocatable q_prim_vf
Cell-average primitive variables at the current time-stage.
impure subroutine s_compute_dt()
Compute the global time step size from CFL stability constraints across all cells.
impure subroutine s_tvd_rk(t_step, time_avg, nstage)
Advance the solution one full step using a TVD Runge-Kutta time integrator.
integer stor
storage index
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
subroutine, public s_compute_pressure(energy, alf, dyn_p, pi_inf, gamma, rho, qv, rhoyks, pres, t, stress, mom, g, pres_mag)
Compute the pressure from the appropriate equation of state.
impure subroutine, public s_initialize_variables_conversion_module
Initialize the variables conversion module.
subroutine, public s_convert_to_mixture_variables(q_vf, i, j, k, rho, gamma, pi_inf, qv, re_k, g_k, g)
Dispatch to the s_convert_mixture_to_mixture_variables and s_convert_species_to_mixture_variables sub...
Computes viscous stress tensors and diffusive flux contributions for the Navier–Stokes equations.
impure subroutine, public s_initialize_viscous_module
Initialize the viscous module.
WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights.
impure subroutine, public s_initialize_weno_module
Initialize the WENO module.
Derived type annexing a scalar field (SF).