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. NVIDIA unified memory page placement hint
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
348 use m_rhs
349 use m_chemistry
350 use m_data_output
352 use m_qbmm
354 use m_hypoelastic
357 use m_viscous
358 use m_bubbles_ee
359 use m_bubbles_el
360 use ieee_arithmetic
362 use m_helper
363
364#if defined(MFC_OpenACC)
365# 39 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
366 use openacc
367# 39 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
368#elif defined(MFC_OpenMP)
369# 39 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
370 use omp_lib
371# 39 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
372#endif
373
374 use m_nvtx
375 use m_ibm
376 use m_ib_patches
377 use m_model
379 use m_collisions
382 use m_checker
384 use m_body_forces
385 use m_sim_helpers
386 use m_igr
388
389 implicit none
390
394
395 type(scalar_field), allocatable, dimension(:) :: q_cons_temp
396 real(wp) :: dt_init
397
398contains
399
400 !> Read data files. Dispatch subroutine that replaces procedure pointer.
401 impure subroutine s_read_data_files(q_cons_vf)
402
403 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
404
405 if (.not. parallel_io) then
407 else
409 end if
410
411 end subroutine s_read_data_files
412
413 !> Verify the input file exists and read it
414 impure subroutine s_read_input_file
415
416 character(LEN=name_len), parameter :: file_path = './simulation.inp'
417 logical :: file_exist !< Logical used to check the existence of the input file
418 integer :: iostatus
419 ! Integer to check iostat of file read
420
421 character(len=1000) :: line
422
423# 1 "/home/runner/work/MFC/MFC/build/include/simulation/generated_namelist.fpp" 1
424! AUTO-GENERATED - do not edit directly. Regenerate: cmake reconfigure
425!
426# 19 "/home/runner/work/MFC/MFC/build/include/simulation/generated_namelist.fpp"
427namelist /user_inputs/ bx0, ca, r0ref, re_inv, web, acoustic, acoustic_source, adap_dt, adap_dt_max_iters, adap_dt_tol, adv_n, &
428 & alf_factor, alpha_bar, alt_soundspeed, avg_state, bc_x, bc_y, bc_z, bf_x, bf_y, bf_z, bub_pp, bubble_model, bubbles_euler, &
429 & bubbles_lagrange, case_dir, cfl_adap_dt, cfl_const_dt, cfl_target, chem_params, coefficient_of_restitution, &
430 & collision_model, collision_time, cont_damage, cont_damage_s, cyl_coord, down_sample, dt, fd_order, fft_wrt, &
431 & file_per_process, fluid_pp, g_x, g_y, g_z, hyper_cleaning, hyper_cleaning_speed, hyper_cleaning_tau, hyperelasticity, &
432 & hypoelasticity, ib, ib_airfoil, ib_coefficient_of_friction, ib_neighborhood_radius, ib_state_wrt, ic_beta, ic_eps, &
433 & int_comp, integral, integral_wrt, k_x, k_y, k_z, lag_params, low_mach, m, many_ib_patch_parallelism, mixture_err, &
434 & model_eqns, mp_weno, mpp_lim, muscl_eps, n, n_start, null_weights, num_bc_patches, num_ibs, num_igr_iters, &
435 & num_igr_warm_start_iters, num_integrals, num_particle_clouds, num_probes, num_source, num_stl_models, &
436 & nv_uvm_igr_temps_on_gpu, nv_uvm_out_of_core, nv_uvm_pref_gpu, p, p_x, p_y, p_z, palpha_eps, parallel_io, particle_cloud, &
437 & patch_ib, pi_fac, poly_sigma, polydisperse, polytropic, precision, pref, prim_vars_wrt, probe, probe_wrt, ptgalpha_eps, &
438 & qbmm, rdma_mpi, relax, relax_model, rhoref, riemann_solver, run_time_info, sigma, stl_models, surface_tension, t_save, &
439 & t_step_old, t_step_print, t_step_save, t_step_start, t_step_stop, t_stop, tau_star, teno_ct, thermal, time_stepper, w_x, &
440 & w_y, w_z, wave_speeds, weno_re_flux, weno_avg, weno_eps, x_a, x_b, x_domain, y_a, y_b, y_domain, z_a, z_b, z_domain, &
441 & igr, igr_iter_solver, igr_order, igr_pres_lim, mapped_weno, mhd, muscl_lim, muscl_order, nb, num_fluids, recon_type, &
442 & relativity, teno, viscous, weno_order, wenoz, wenoz_q
443# 36 "/home/runner/work/MFC/MFC/build/include/simulation/generated_namelist.fpp"
444# 91 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp" 2
445
446 inquire (file=trim(file_path), exist=file_exist)
447
448 if (file_exist) then
449 open (1, file=trim(file_path), form='formatted', action='read', status='old')
450 read (1, nml=user_inputs, iostat=iostatus)
451
452 if (iostatus /= 0) then
453 backspace(1)
454 read (1, fmt='(A)') line
455 print *, 'Invalid line in namelist: ' // trim(line)
456 call s_mpi_abort('Invalid line in simulation.inp. It is ' // 'likely due to a datatype mismatch. Exiting.')
457 end if
458
459 close (1)
460
461 if ((bf_x) .or. (bf_y) .or. (bf_z)) then
462 bodyforces = .true.
463 end if
464
465 m_glb = m
466 n_glb = n
467 p_glb = p
468
470
471 if (cfl_adap_dt .or. cfl_const_dt) cfl_dt = .true.
472
473 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
474 bc_io = .true.
475 end if
476 else
477 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
478 end if
479
480 end subroutine s_read_input_file
481
482 !> Validate that all user-provided inputs form a consistent simulation configuration
483 impure subroutine s_check_input_file
484
485 character(LEN=path_len) :: file_path
486 logical :: file_exist
487
488 file_path = trim(case_dir) // '/.'
489
490 call my_inquire(file_path, file_exist)
491
492 if (file_exist .neqv. .true.) then
493 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
494 end if
495
497 call s_check_inputs()
498
499 end subroutine s_check_input_file
500
501 !> Read serial initial condition and grid data files and compute cell-width distributions
502 impure subroutine s_read_serial_data_files(q_cons_vf)
503
504 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
505 character(LEN=path_len + 2*name_len) :: t_step_dir !< Relative path to the starting time-step directory
506 character(LEN=path_len + 3*name_len) :: file_path !< Relative path to the grid and conservative variables data files
507 logical :: file_exist !< Logical used to check the existence of the input file
508 integer :: i, r
509
510 if (cfl_dt) then
511 write (t_step_dir, '(A,I0,A,I0)') trim(case_dir) // '/p_all/p', proc_rank, '/', n_start
512 else
513 write (t_step_dir, '(A,I0,A,I0)') trim(case_dir) // '/p_all/p', proc_rank, '/', t_step_start
514 end if
515
516 file_path = trim(t_step_dir) // '/.'
517 call my_inquire(file_path, file_exist)
518
519 if (file_exist .neqv. .true.) then
520 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
521 end if
522
523 if (bc_io) then
524 call s_read_serial_boundary_condition_files(t_step_dir, bc_type)
525 else
526 call s_assign_default_bc_type(bc_type)
527 end if
528
529 file_path = trim(t_step_dir) // '/x_cb.dat'
530
531 inquire (file=trim(file_path), exist=file_exist)
532
533 if (file_exist) then
534 open (2, file=trim(file_path), form='unformatted', action='read', status='old')
535 read (2) x_cb(-1:m); close (2)
536 else
537 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
538 end if
539
540 dx(0:m) = x_cb(0:m) - x_cb(-1:m - 1)
541 x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2._wp
542
543 if (n > 0) then
544 file_path = trim(t_step_dir) // '/y_cb.dat'
545
546 inquire (file=trim(file_path), exist=file_exist)
547
548 if (file_exist) then
549 open (2, file=trim(file_path), form='unformatted', action='read', status='old')
550 read (2) y_cb(-1:n); close (2)
551 else
552 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
553 end if
554
555 dy(0:n) = y_cb(0:n) - y_cb(-1:n - 1)
556 y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2._wp
557 end if
558
559 if (p > 0) then
560 file_path = trim(t_step_dir) // '/z_cb.dat'
561
562 inquire (file=trim(file_path), exist=file_exist)
563
564 if (file_exist) then
565 open (2, file=trim(file_path), form='unformatted', action='read', status='old')
566 read (2) z_cb(-1:p); close (2)
567 else
568 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
569 end if
570
571 dz(0:p) = z_cb(0:p) - z_cb(-1:p - 1)
572 z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2._wp
573 end if
574
575 do i = 1, sys_size
576 write (file_path, '(A,I0,A)') trim(t_step_dir) // '/q_cons_vf', i, '.dat'
577 inquire (file=trim(file_path), exist=file_exist)
578 if (file_exist) then
579 open (2, file=trim(file_path), form='unformatted', action='read', status='old')
580 read (2) q_cons_vf(i)%sf(0:m,0:n,0:p); close (2)
581 else
582 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
583 end if
584 end do
585
586 if (bubbles_euler .or. elasticity) then
587 ! Read pb and mv for non-polytropic qbmm
588 if (qbmm .and. .not. polytropic) then
589 do i = 1, nb
590 do r = 1, nnode
591 write (file_path, '(A,I0,A)') trim(t_step_dir) // '/pb', sys_size + (i - 1)*nnode + r, '.dat'
592 inquire (file=trim(file_path), exist=file_exist)
593 if (file_exist) then
594 open (2, file=trim(file_path), form='unformatted', action='read', status='old')
595 read (2) pb_ts(1)%sf(0:m,0:n,0:p,r, i); close (2)
596 else
597 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
598 end if
599 end do
600 end do
601 do i = 1, nb
602 do r = 1, nnode
603 write (file_path, '(A,I0,A)') trim(t_step_dir) // '/mv', sys_size + (i - 1)*nnode + r, '.dat'
604 inquire (file=trim(file_path), exist=file_exist)
605 if (file_exist) then
606 open (2, file=trim(file_path), form='unformatted', action='read', status='old')
607 read (2) mv_ts(1)%sf(0:m,0:n,0:p,r, i); close (2)
608 else
609 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
610 end if
611 end do
612 end do
613 end if
614 end if
615
616 end subroutine s_read_serial_data_files
617
618 !> Read parallel initial condition and grid data files via MPI I/O
619 impure subroutine s_read_parallel_data_files(q_cons_vf)
620
621 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
622
623#ifdef MFC_MPI
624 real(wp), allocatable, dimension(:) :: x_cb_glb, y_cb_glb, z_cb_glb
625 integer :: ifile, ierr, data_size
626 integer, dimension(MPI_STATUS_SIZE) :: status
627 integer(KIND=MPI_OFFSET_KIND) :: disp
628 integer(KIND=MPI_OFFSET_KIND) :: m_mok, n_mok, p_mok
629 integer(KIND=MPI_OFFSET_KIND) :: wp_mok, var_mok
630 integer(KIND=MPI_OFFSET_KIND) :: mok
631 character(LEN=path_len + 2*name_len) :: file_loc
632 logical :: file_exist
633 character(len=10) :: t_step_start_string
634 integer :: i, j
635
636 ! Downsampled data variables
637 integer :: m_ds, n_ds, p_ds
638 integer :: m_glb_ds, n_glb_ds, p_glb_ds
639 integer :: m_glb_read, n_glb_read, p_glb_read !< data size of read
640
641 allocate (x_cb_glb(-1:m_glb))
642 allocate (y_cb_glb(-1:n_glb))
643 allocate (z_cb_glb(-1:p_glb))
644
645 file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'x_cb.dat'
646 inquire (file=trim(file_loc), exist=file_exist)
647
648 if (down_sample) then
649 m_ds = int((m + 1)/3) - 1
650 n_ds = int((n + 1)/3) - 1
651 p_ds = int((p + 1)/3) - 1
652
653 m_glb_ds = int((m_glb + 1)/3) - 1
654 n_glb_ds = int((n_glb + 1)/3) - 1
655 p_glb_ds = int((p_glb + 1)/3) - 1
656 end if
657
658 if (file_exist) then
659 data_size = m_glb + 2
660 call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
661 call mpi_file_read(ifile, x_cb_glb, data_size, mpi_p, status, ierr)
662 call mpi_file_close(ifile, ierr)
663 else
664 call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting.')
665 end if
666
667 x_cb(-1:m) = x_cb_glb((start_idx(1) - 1):(start_idx(1) + m))
668 dx(0:m) = x_cb(0:m) - x_cb(-1:m - 1)
669 x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2._wp
670
671 if (n > 0) then
672 file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'y_cb.dat'
673 inquire (file=trim(file_loc), exist=file_exist)
674
675 if (file_exist) then
676 data_size = n_glb + 2
677 call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
678 call mpi_file_read(ifile, y_cb_glb, data_size, mpi_p, status, ierr)
679 call mpi_file_close(ifile, ierr)
680 else
681 call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting.')
682 end if
683
684 y_cb(-1:n) = y_cb_glb((start_idx(2) - 1):(start_idx(2) + n))
685 dy(0:n) = y_cb(0:n) - y_cb(-1:n - 1)
686 y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2._wp
687
688 if (p > 0) then
689 file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'z_cb.dat'
690 inquire (file=trim(file_loc), exist=file_exist)
691
692 if (file_exist) then
693 data_size = p_glb + 2
694 call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
695 call mpi_file_read(ifile, z_cb_glb, data_size, mpi_p, status, ierr)
696 call mpi_file_close(ifile, ierr)
697 else
698 call s_mpi_abort('File ' // trim(file_loc) // 'is missing. Exiting.')
699 end if
700
701 z_cb(-1:p) = z_cb_glb((start_idx(3) - 1):(start_idx(3) + p))
702 dz(0:p) = z_cb(0:p) - z_cb(-1:p - 1)
703 z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2._wp
704 end if
705 end if
706
707 if (file_per_process) then
708 if (cfl_dt) then
709 call s_int_to_str(n_start, t_step_start_string)
710 write (file_loc, '(I0,A1,I7.7,A)') n_start, '_', proc_rank, '.dat'
711 else
712 call s_int_to_str(t_step_start, t_step_start_string)
713 write (file_loc, '(I0,A1,I7.7,A)') t_step_start, '_', proc_rank, '.dat'
714 end if
715 file_loc = trim(case_dir) // '/restart_data/lustre_' // trim(t_step_start_string) // trim(mpiiofs) // trim(file_loc)
716 inquire (file=trim(file_loc), exist=file_exist)
717
718 if (file_exist) then
719 call mpi_file_open(mpi_comm_self, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
720
721 if (down_sample) then
723 else
724 if (ib) then
726 else
728 end if
729 end if
730
731 if (down_sample) then
732 data_size = (m_ds + 3)*(n_ds + 3)*(p_ds + 3)
733 m_glb_read = m_glb_ds + 1
734 n_glb_read = n_glb_ds + 1
735 p_glb_read = p_glb_ds + 1
736 else
737 data_size = (m + 1)*(n + 1)*(p + 1)
738 m_glb_read = m_glb + 1
739 n_glb_read = n_glb + 1
740 p_glb_read = p_glb + 1
741 end if
742
743 m_mok = int(m_glb_read + 1, mpi_offset_kind)
744 n_mok = int(m_glb_read + 1, mpi_offset_kind)
745 p_mok = int(m_glb_read + 1, mpi_offset_kind)
746 wp_mok = int(storage_size(0._stp)/8, mpi_offset_kind)
747 mok = int(1._wp, mpi_offset_kind)
748
749 if (bubbles_euler .or. elasticity) then
750 do i = 1, sys_size
751 var_mok = int(i, mpi_offset_kind)
752
753 call mpi_file_read(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
754 end do
755 ! Read pb and mv for non-polytropic qbmm
756 if (qbmm .and. .not. polytropic) then
757 do i = sys_size + 1, sys_size + 2*nb*nnode
758 var_mok = int(i, mpi_offset_kind)
759
760 call mpi_file_read(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
761 end do
762 end if
763 else
764 if (down_sample) then
765 do i = 1, sys_size
766 var_mok = int(i, mpi_offset_kind)
767
768 call mpi_file_read(ifile, q_cons_temp(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
769 end do
770 else
771 do i = 1, sys_size
772 var_mok = int(i, mpi_offset_kind)
773
774 call mpi_file_read(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
775 end do
776 end if
777 end if
778
779 call s_mpi_barrier()
780
781 call mpi_file_close(ifile, ierr)
782 else
783 call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting.')
784 end if
785 else
786 if (cfl_dt) then
787 write (file_loc, '(I0,A)') n_start, '.dat'
788 else
789 write (file_loc, '(I0,A)') t_step_start, '.dat'
790 end if
791 file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // trim(file_loc)
792 inquire (file=trim(file_loc), exist=file_exist)
793
794 if (file_exist) then
795 call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
796
797 if (ib) then
799 else
801 end if
802
803 data_size = (m + 1)*(n + 1)*(p + 1)
804
805 m_mok = int(m_glb + 1, mpi_offset_kind)
806 n_mok = int(n_glb + 1, mpi_offset_kind)
807 p_mok = int(p_glb + 1, mpi_offset_kind)
808 wp_mok = int(storage_size(0._stp)/8, mpi_offset_kind)
809 mok = int(1._wp, mpi_offset_kind)
810
811 if (bubbles_euler .or. elasticity) then
812 do i = 1, sys_size
813 var_mok = int(i, mpi_offset_kind)
814 disp = m_mok*max(mok, n_mok)*max(mok, p_mok)*wp_mok*(var_mok - 1)
815
816 call mpi_file_set_view(ifile, disp, mpi_io_p, mpi_io_data%view(i), 'native', mpi_info_int, ierr)
817 call mpi_file_read(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
818 end do
819 ! Read pb and mv for non-polytropic qbmm
820 if (qbmm .and. .not. polytropic) then
821 do i = sys_size + 1, sys_size + 2*nb*nnode
822 var_mok = int(i, mpi_offset_kind)
823 disp = m_mok*max(mok, n_mok)*max(mok, p_mok)*wp_mok*(var_mok - 1)
824
825 call mpi_file_set_view(ifile, disp, mpi_io_p, mpi_io_data%view(i), 'native', mpi_info_int, ierr)
826 call mpi_file_read(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
827 end do
828 end if
829 else
830 do i = 1, sys_size
831 var_mok = int(i, mpi_offset_kind)
832
833 disp = m_mok*max(mok, n_mok)*max(mok, p_mok)*wp_mok*(var_mok - 1)
834
835 call mpi_file_set_view(ifile, disp, mpi_io_p, mpi_io_data%view(i), 'native', mpi_info_int, ierr)
836 call mpi_file_read_all(ifile, mpi_io_data%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr)
837 end do
838 end if
839
840 call s_mpi_barrier()
841
842 call mpi_file_close(ifile, ierr)
843 else
844 call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting.')
845 end if
846 end if
847
848 deallocate (x_cb_glb, y_cb_glb, z_cb_glb)
849
850 if (bc_io) then
851 call s_read_parallel_boundary_condition_files(bc_type)
852 else
853 call s_assign_default_bc_type(bc_type)
854 end if
855#endif
856
857 end subroutine s_read_parallel_data_files
858
859 !> Initialize internal-energy equations from phase mass, mixture momentum, and total energy
861
862 type(scalar_field), dimension(sys_size), intent(inout) :: v_vf
863 real(wp) :: rho
864 real(wp) :: dyn_pres
865 real(wp) :: gamma
866 real(wp) :: pi_inf
867 real(wp) :: qv
868 real(wp), dimension(2) :: re
869 real(wp) :: pres, t
870 integer :: i, j, k, l, c
871 real(wp), dimension(num_species) :: rhoyks
872 real(wp) :: pres_mag
873
874 pres_mag = 0._wp
875
876 t = dflt_t_guess
877
878 do j = 0, m
879 do k = 0, n
880 do l = 0, p
881 call s_convert_to_mixture_variables(v_vf, j, k, l, rho, gamma, pi_inf, qv, re)
882
883 dyn_pres = 0._wp
884 do i = eqn_idx%mom%beg, eqn_idx%mom%end
885 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)
886 end do
887
888 if (chemistry) then
889 do c = 1, num_species
890 rhoyks(c) = v_vf(eqn_idx%species%beg + c - 1)%sf(j, k, l)
891 end do
892 end if
893
894 if (mhd) then
895 if (n == 0) then
896 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)
897 else
898 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, &
899 & l)**2 + v_vf(eqn_idx%B%beg + 2)%sf(j, k, l)**2)
900 end if
901 end if
902
903 call s_compute_pressure(v_vf(eqn_idx%E)%sf(j, k, l), 0._stp, dyn_pres, pi_inf, gamma, rho, qv, rhoyks, pres, &
904 & t, pres_mag=pres_mag)
905
906 do i = 1, num_fluids
907 v_vf(i + eqn_idx%int_en%beg - 1)%sf(j, k, l) = v_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, &
908 & l)*(gammas(i)*pres + pi_infs(i)) + v_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*qvs(i)
909 end do
910 end do
911 end do
912 end do
913
915
916 !> Advance the simulation by one time step, handling CFL-based dt and time-stepper dispatch
917 impure subroutine s_perform_time_step(t_step, time_avg)
918
919 integer, intent(inout) :: t_step
920 real(wp), intent(inout) :: time_avg
921 integer :: i, eta_hh, eta_mm, eta_ss
922 real(wp) :: eta_sec
923
924 if (cfl_dt) then
925 if (cfl_const_dt .and. t_step == 0) call s_compute_dt()
926
927 if (cfl_adap_dt) call s_compute_dt()
928
929 if (t_step == 0) dt_init = dt
930
931 if (dt < 1.e-3_wp*dt_init .and. cfl_adap_dt .and. proc_rank == 0) then
932 print *, "Delta t = ", dt
933 call s_mpi_abort("Delta t has become too small")
934 end if
935 end if
936
937 if (cfl_dt) then
938 if ((mytime + dt) >= t_stop) then
939 dt = t_stop - mytime
940
941# 586 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
942#if defined(MFC_OpenACC)
943# 586 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
944!$acc update device(dt)
945# 586 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
946#elif defined(MFC_OpenMP)
947# 586 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
948!$omp target update to(dt)
949# 586 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
950#endif
951 end if
952 else
953 if ((mytime + dt) >= finaltime) then
954 dt = finaltime - mytime
955
956# 591 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
957#if defined(MFC_OpenACC)
958# 591 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
959!$acc update device(dt)
960# 591 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
961#elif defined(MFC_OpenMP)
962# 591 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
963!$omp target update to(dt)
964# 591 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
965#endif
966 end if
967 end if
968
969 if (cfl_dt) then
970 if (proc_rank == 0 .and. mod(t_step - t_step_start, t_step_print) == 0) then
971 eta_sec = wall_time_avg*(t_stop - mytime)/max(dt, tiny(dt))
972 eta_hh = int(eta_sec)/3600
973 eta_mm = mod(int(eta_sec), 3600)/60
974 eta_ss = mod(int(eta_sec), 60)
975 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)', &
976 & int(ceiling(100._wp*(mytime/t_stop))), mytime, dt, t_step, wall_time_avg, wall_time, eta_hh, eta_mm, eta_ss
977 end if
978 else
979 if (proc_rank == 0 .and. mod(t_step - t_step_start, t_step_print) == 0) then
980 eta_sec = wall_time_avg*real(t_step_stop - t_step, wp)
981 eta_hh = int(eta_sec)/3600
982 eta_mm = mod(int(eta_sec), 3600)/60
983 eta_ss = mod(int(eta_sec), 60)
984 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)', &
985 & int(ceiling(100._wp*(real(t_step - t_step_start)/(t_step_stop - t_step_start + 1)))), &
986 & t_step - t_step_start + 1, t_step_stop - t_step_start + 1, t_step, wall_time_avg, wall_time, eta_hh, &
987 & eta_mm, eta_ss
988 end if
989 end if
990
991 if (probe_wrt) then
992 do i = 1, sys_size
993
994# 619 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
995#if defined(MFC_OpenACC)
996# 619 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
997!$acc update host(q_cons_ts(1)%vf(i)%sf)
998# 619 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
999#elif defined(MFC_OpenMP)
1000# 619 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1001!$omp target update from(q_cons_ts(1)%vf(i)%sf)
1002# 619 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1003#endif
1004 end do
1005 end if
1006
1007 ! Total-variation-diminishing (TVD) Runge-Kutta (RK) time-steppers
1008 if (any(time_stepper == (/time_stepper_rk1, time_stepper_rk2, time_stepper_rk3/))) then
1009 call s_tvd_rk(t_step, time_avg, time_stepper)
1010 end if
1011
1012 ! Advance time after RK so source terms see current-step time
1013 mytime = mytime + dt
1014
1015 if (relax) call s_infinite_relaxation_k(q_cons_ts(1)%vf)
1016
1017 ! Time-stepping loop controls
1018 t_step = t_step + 1
1019
1020 end subroutine s_perform_time_step
1021
1022 !> Collect per-process wall-clock times and write aggregate performance metrics to file
1023 impure subroutine s_save_performance_metrics(time_avg, time_final, io_time_avg, io_time_final, proc_time, io_proc_time, &
1024 & file_exists)
1025
1026 real(wp), intent(inout) :: time_avg, time_final
1027 real(wp), intent(inout) :: io_time_avg, io_time_final
1028 real(wp), dimension(:), intent(inout) :: proc_time
1029 real(wp), dimension(:), intent(inout) :: io_proc_time
1030 logical, intent(inout) :: file_exists
1031 real(wp) :: grind_time
1032
1033 call s_mpi_barrier()
1034
1035 if (num_procs > 1) then
1036 call mpi_bcast_time_step_values(proc_time, time_avg)
1037
1038 call mpi_bcast_time_step_values(io_proc_time, io_time_avg)
1039 end if
1040
1041 if (proc_rank == 0) then
1042 time_final = 0._wp
1043 io_time_final = 0._wp
1044 if (num_procs == 1) then
1045 time_final = time_avg
1046 io_time_final = io_time_avg
1047 else
1048 time_final = maxval(proc_time)
1049 io_time_final = maxval(io_proc_time)
1050 end if
1051
1052 grind_time = time_final*1.0e9_wp/(real(sys_size, wp)*real(maxval((/1, m_glb/)), wp)*real(maxval((/1, n_glb/)), &
1053 & wp)*real(maxval((/1, p_glb/)), wp))
1054
1055 print *, "Performance:", grind_time, "ns/gp/eq/rhs"
1056 inquire (file='time_data.dat', exist=file_exists)
1057 if (file_exists) then
1058 open (1, file='time_data.dat', position='append', status='old')
1059 else
1060 open (1, file='time_data.dat', status='new')
1061 write (1, '(A10, A15, A15)') "Ranks", "s/step", "ns/gp/eq/rhs"
1062 end if
1063
1064 write (1, '(I10, 2(F15.8))') num_procs, time_final, grind_time
1065
1066 close (1)
1067
1068 inquire (file='io_time_data.dat', exist=file_exists)
1069 if (file_exists) then
1070 open (1, file='io_time_data.dat', position='append', status='old')
1071 else
1072 open (1, file='io_time_data.dat', status='new')
1073 write (1, '(A10, A15)') "Ranks", "s/step"
1074 end if
1075
1076 write (1, '(I10, F15.8)') num_procs, io_time_final
1077 close (1)
1078 end if
1079
1080 end subroutine s_save_performance_metrics
1081
1082 !> Save conservative variable data to disk at the current time step
1083 impure subroutine s_save_data(t_step, start, finish, io_time_avg, nt)
1084
1085 integer, intent(inout) :: t_step
1086 real(wp), intent(inout) :: start, finish, io_time_avg
1087 integer, intent(inout) :: nt
1088 integer(kind=8) :: i, j, k, l
1089 integer :: stor
1090 integer :: save_count
1091
1092 if (down_sample) then
1094 end if
1095
1096 stor = 1
1097
1098 if (time_stepper /= time_stepper_rk1) then
1099
1100# 715 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1101
1102# 715 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1103#if defined(MFC_OpenACC)
1104# 715 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1105!$acc parallel loop collapse(4) gang vector default(present) copyin(idwbuff)
1106# 715 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1107#elif defined(MFC_OpenMP)
1108# 715 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1109
1110# 715 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1111
1112# 715 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1113
1114# 715 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1115!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) map(to:idwbuff)
1116# 715 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1117#endif
1118 do i = 1, sys_size
1119 do l = idwbuff(3)%beg, idwbuff(3)%end
1120 do k = idwbuff(2)%beg, idwbuff(2)%end
1121 do j = idwbuff(1)%beg, idwbuff(1)%end
1122 q_cons_ts(2)%vf(i)%sf(j, k, l) = q_cons_ts(1)%vf(i)%sf(j, k, l)
1123 end do
1124 end do
1125 end do
1126 end do
1127
1128# 725 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1129#if defined(MFC_OpenACC)
1130# 725 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1131!$acc end parallel loop
1132# 725 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1133#elif defined(MFC_OpenMP)
1134# 725 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1135
1136# 725 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1137!$omp end target teams loop
1138# 725 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1139#endif
1140 stor = 2
1141 end if
1142
1143 call cpu_time(start)
1144 call nvtxstartrange("SAVE-DATA")
1145 do i = 1, sys_size
1146#ifndef FRONTIER_UNIFIED
1147
1148# 733 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1149#if defined(MFC_OpenACC)
1150# 733 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1151!$acc update host(q_cons_ts(stor)%vf(i)%sf)
1152# 733 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1153#elif defined(MFC_OpenMP)
1154# 733 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1155!$omp target update from(q_cons_ts(stor)%vf(i)%sf)
1156# 733 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1157#endif
1158#endif
1159 do l = 0, p
1160 do k = 0, n
1161 do j = 0, m
1162 if (ieee_is_nan(real(q_cons_ts(stor)%vf(i)%sf(j, k, l), kind=wp))) then
1163 print *, "NaN(s) in timestep output.", j, k, l, i, proc_rank, t_step, m, n, p
1164 call s_mpi_abort("NaN(s) in timestep output.")
1165 end if
1166 end do
1167 end do
1168 end do
1169 end do
1170
1171 if (qbmm .and. .not. polytropic) then
1172
1173# 748 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1174#if defined(MFC_OpenACC)
1175# 748 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1176!$acc update host(pb_ts(1)%sf)
1177# 748 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1178#elif defined(MFC_OpenMP)
1179# 748 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1180!$omp target update from(pb_ts(1)%sf)
1181# 748 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1182#endif
1183
1184# 749 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1185#if defined(MFC_OpenACC)
1186# 749 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1187!$acc update host(mv_ts(1)%sf)
1188# 749 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1189#elif defined(MFC_OpenMP)
1190# 749 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1191!$omp target update from(mv_ts(1)%sf)
1192# 749 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1193#endif
1194 end if
1195
1196 if (cfl_dt) then
1197 save_count = int(mytime/t_save)
1198 else
1199 save_count = t_step
1200 end if
1201
1202 if (bubbles_lagrange) then
1203
1204# 759 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1205#if defined(MFC_OpenACC)
1206# 759 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1207!$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)
1208# 759 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1209#elif defined(MFC_OpenMP)
1210# 759 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1211!$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)
1212# 759 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1213#endif
1214# 761 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1215 do i = 1, nbubs
1216 if (ieee_is_nan(intfc_rad(i, 1)) .or. intfc_rad(i, 1) <= 0._wp) then
1217 call s_mpi_abort("Bubble radius is negative or NaN, please reduce dt.")
1218 end if
1219 end do
1220
1221
1222# 767 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1223#if defined(MFC_OpenACC)
1224# 767 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1225!$acc update host(q_beta(1)%sf)
1226# 767 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1227#elif defined(MFC_OpenMP)
1228# 767 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1229!$omp target update from(q_beta(1)%sf)
1230# 767 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1231#endif
1232 call s_write_data_files(q_cons_ts(stor)%vf, q_t_sf, q_prim_vf, save_count, bc_type, q_beta(1))
1233
1234# 769 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1235#if defined(MFC_OpenACC)
1236# 769 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1237!$acc update host(Rmax_stats, Rmin_stats, gas_p, gas_mv, intfc_vel)
1238# 769 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1239#elif defined(MFC_OpenMP)
1240# 769 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1241!$omp target update from(Rmax_stats, Rmin_stats, gas_p, gas_mv, intfc_vel)
1242# 769 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1243#endif
1244 call s_write_restart_lag_bubbles(save_count) ! parallel
1245 if (lag_params%write_bubbles_stats) call s_write_lag_bubble_stats()
1246 else
1247 call s_write_data_files(q_cons_ts(stor)%vf, q_t_sf, q_prim_vf, save_count, bc_type)
1248 end if
1249
1250 ! Write IB kinematic state for restart
1251 if (ib) call s_write_ib_state_file(save_count)
1252
1253 call nvtxendrange
1254 call cpu_time(finish)
1255 if (cfl_dt) then
1256 nt = mytime/t_save
1257 else
1258 nt = int((t_step - t_step_start)/(t_step_save))
1259 end if
1260
1261 if (nt == 1) then
1262 io_time_avg = abs(finish - start)
1263 else
1264 io_time_avg = (abs(finish - start) + io_time_avg*(nt - 1))/nt
1265 end if
1266
1267 end subroutine s_save_data
1268
1269 !> Initialize all simulation sub-modules in the required dependency order
1270 impure subroutine s_initialize_modules
1271
1272 integer :: m_ds, n_ds, p_ds
1273 integer :: i
1274
1276# 812 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1277 if (bubbles_euler .or. bubbles_lagrange) then
1279 end if
1283 if (grid_geometry == 3) call s_initialize_fftw_module()
1284
1285 if (bubbles_euler) call s_initialize_bubbles_ee_module()
1286 if (ib) then
1288 end if
1289 if (qbmm) call s_initialize_qbmm_module()
1290
1291 if (acoustic_source) then
1293 end if
1294
1295 if (viscous .and. (.not. igr)) then
1297 end if
1298
1300
1301 if (surface_tension) call s_initialize_surface_tension_module()
1302
1303 if (relax) call s_initialize_phasechange_module()
1304
1308
1310
1311 if (down_sample) then
1312 m_ds = int((m + 1)/3) - 1
1313 n_ds = int((n + 1)/3) - 1
1314 p_ds = int((p + 1)/3) - 1
1315
1316 allocate (q_cons_temp(1:sys_size))
1317 do i = 1, sys_size
1318 allocate (q_cons_temp(i)%sf(-1:m_ds + 1,-1:n_ds + 1,-1:p_ds + 1))
1319 end do
1320 end if
1321
1322 if (down_sample) then
1325 do i = 1, sys_size
1326
1327# 861 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1328#if defined(MFC_OpenACC)
1329# 861 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1330!$acc update device(q_cons_ts(1)%vf(i)%sf)
1331# 861 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1332#elif defined(MFC_OpenMP)
1333# 861 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1334!$omp target update to(q_cons_ts(1)%vf(i)%sf)
1335# 861 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1336#endif
1337 end do
1338 do i = 1, sys_size
1339 deallocate (q_cons_temp(i)%sf)
1340 end do
1341 deallocate (q_cons_temp)
1342 else
1343 call s_read_data_files(q_cons_ts(1)%vf)
1344 end if
1345
1346 call s_populate_grid_variables_buffers()
1347
1349 if (ib) then
1350 block
1351 type(ib_patch_parameters), allocatable :: particle_cloud_ibs(:)
1352
1353 if (cfl_dt .and. n_start > 0) then
1354 call s_read_ib_restart_data(n_start)
1355 allocate (particle_cloud_ibs(0))
1356 else if (t_step_start > 0) then
1357 call s_read_ib_restart_data(t_step_start)
1358 allocate (particle_cloud_ibs(0))
1359 else
1360 call s_generate_particle_clouds(particle_cloud_ibs)
1361 end if
1364 call s_reduce_ib_patch_array(particle_cloud_ibs)
1365 deallocate (particle_cloud_ibs)
1366 end block
1367 call s_ibm_setup()
1368 if (t_step_start == 0 .or. (cfl_dt .and. n_start == 0)) then
1369 call s_write_ib_data_file(0)
1370 call s_write_ib_state_file(0)
1371 end if
1372 end if
1374 if (acoustic_source) call s_precalculate_acoustic_spatial_sources()
1375
1376 ! Initialize the Temperature cache.
1377 if (chemistry) call s_compute_q_t_sf(q_t_sf, q_cons_ts(1)%vf, idwint)
1378
1379 ! Computation of parameters, allocation of memory, association of pointers, and/or execution of any other tasks that are
1380 ! needed to properly configure the modules. The preparations below DO DEPEND on the grid being complete.
1381 if (igr) then
1383 end if
1384 if (.not. igr) then
1385 if (recon_type == recon_type_weno) then
1387 else if (recon_type == recon_type_muscl) then
1389 end if
1392 end if
1393 if (int_comp > 0) call s_initialize_thinc_module()
1395 if (bubbles_lagrange) call s_initialize_bubbles_el_module(q_cons_ts(1)%vf)
1396
1397 if (hypoelasticity) call s_initialize_hypoelastic_module()
1398 if (hyperelasticity) call s_initialize_hyperelastic_module()
1399
1400 end subroutine s_initialize_modules
1401
1402 !> Set up the MPI execution environment, bind GPUs, and decompose the computational domain
1403 impure subroutine s_initialize_mpi_domain
1404
1405 integer :: ierr
1406
1407#ifdef MFC_GPU
1408 real(wp) :: starttime, endtime
1409 integer :: num_devices, local_size, num_nodes, ppn, my_device_num
1410 integer :: dev, devnum, local_rank
1411#ifdef MFC_MPI
1412 integer :: local_comm
1413#endif
1414#if defined(MFC_OpenACC)
1415 integer(acc_device_kind) :: devtype
1416#endif
1417#endif
1418
1419 call s_mpi_initialize()
1420
1421#ifdef MFC_GPU
1422#ifndef MFC_MPI
1423 local_size = 1
1424 local_rank = 0
1425#else
1426 call mpi_comm_split_type(mpi_comm_world, mpi_comm_type_shared, 0, mpi_info_null, local_comm, ierr)
1427 call mpi_comm_size(local_comm, local_size, ierr)
1428 call mpi_comm_rank(local_comm, local_rank, ierr)
1429#endif
1430#if defined(MFC_OpenACC)
1431 devtype = acc_get_device_type()
1432 devnum = acc_get_num_devices(devtype)
1433 dev = mod(local_rank, devnum)
1434
1435 call acc_set_device_num(dev, devtype)
1436#elif defined(MFC_OpenMP)
1437 devnum = omp_get_num_devices()
1438 dev = mod(local_rank, devnum)
1439 call omp_set_default_device(dev)
1440#endif
1441#endif
1442
1443 if (proc_rank == 0) then
1444 call s_assign_default_values_to_user_inputs()
1445 call s_read_input_file()
1446 call s_check_input_file()
1447
1448 print '(" Simulating a ", A, " ", I0, "x", I0, "x", I0, " case on ", I0, " rank(s) ", A, ".")', &
1449# 975 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1450 "regular", &
1451# 979 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1452 m, n, p, num_procs, &
1453#if defined(MFC_OpenACC)
1454 "with OpenACC offloading"
1455#elif defined(MFC_OpenMP)
1456 "with OpenMP offloading"
1457#else
1458 "on CPUs"
1459#endif
1460 end if
1461
1462 call s_mpi_bcast_user_inputs()
1463
1464 ! Save original BCs before decomposition overwrites them with MPI neighbor ranks
1465 ib_bc_x = bc_x
1466 ib_bc_y = bc_y
1467 ib_bc_z = bc_z
1468
1469 call s_initialize_parallel_io()
1470
1471 call s_mpi_decompose_computational_domain()
1472
1473 end subroutine s_initialize_mpi_domain
1474
1475 !> Transfer initial conservative variable and model parameter data to the GPU device
1477
1478 integer :: i
1479
1480 if (.not. down_sample) then
1481 do i = 1, sys_size
1482
1483# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1484#if defined(MFC_OpenACC)
1485# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1486!$acc update device(q_cons_ts(1)%vf(i)%sf)
1487# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1488#elif defined(MFC_OpenMP)
1489# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1490!$omp target update to(q_cons_ts(1)%vf(i)%sf)
1491# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1492#endif
1493 end do
1494 end if
1495
1496 if (qbmm .and. .not. polytropic) then
1497
1498# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1499#if defined(MFC_OpenACC)
1500# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1501!$acc update device(pb_ts(1)%sf, mv_ts(1)%sf)
1502# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1503#elif defined(MFC_OpenMP)
1504# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1505!$omp target update to(pb_ts(1)%sf, mv_ts(1)%sf)
1506# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1507#endif
1508 end if
1509 if (chemistry) then
1510
1511# 1017 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1512#if defined(MFC_OpenACC)
1513# 1017 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1514!$acc update device(q_T_sf%sf)
1515# 1017 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1516#elif defined(MFC_OpenMP)
1517# 1017 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1518!$omp target update to(q_T_sf%sf)
1519# 1017 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1520#endif
1521 end if
1522
1523
1524# 1020 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1525#if defined(MFC_OpenACC)
1526# 1020 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1527!$acc update device(chem_params)
1528# 1020 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1529#elif defined(MFC_OpenMP)
1530# 1020 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1531!$omp target update to(chem_params)
1532# 1020 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1533#endif
1534
1535
1536# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1537#if defined(MFC_OpenACC)
1538# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1539!$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)
1540# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1541#elif defined(MFC_OpenMP)
1542# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1543!$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)
1544# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1545#endif
1546# 1026 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1547
1548 if (bubbles_euler) then
1549
1550# 1028 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1551#if defined(MFC_OpenACC)
1552# 1028 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1553!$acc update device(weight, R0)
1554# 1028 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1555#elif defined(MFC_OpenMP)
1556# 1028 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1557!$omp target update to(weight, R0)
1558# 1028 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1559#endif
1560 if (.not. polytropic) then
1561
1562# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1563#if defined(MFC_OpenACC)
1564# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1565!$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)
1566# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1567#elif defined(MFC_OpenMP)
1568# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1569!$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)
1570# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1571#endif
1572 else if (qbmm) then
1573
1574# 1032 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1575#if defined(MFC_OpenACC)
1576# 1032 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1577!$acc update device(pb0)
1578# 1032 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1579#elif defined(MFC_OpenMP)
1580# 1032 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1581!$omp target update to(pb0)
1582# 1032 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1583#endif
1584 end if
1585 end if
1586
1587
1588# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1589#if defined(MFC_OpenACC)
1590# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1591!$acc update device(adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, pi_fac, low_Mach)
1592# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1593#elif defined(MFC_OpenMP)
1594# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1595!$omp target update to(adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, pi_fac, low_Mach)
1596# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1597#endif
1598
1599
1600# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1601#if defined(MFC_OpenACC)
1602# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1603!$acc update device(acoustic_source, num_source)
1604# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1605#elif defined(MFC_OpenMP)
1606# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1607!$omp target update to(acoustic_source, num_source)
1608# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1609#endif
1610
1611# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1612#if defined(MFC_OpenACC)
1613# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1614!$acc update device(sigma, surface_tension)
1615# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1616#elif defined(MFC_OpenMP)
1617# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1618!$omp target update to(sigma, surface_tension)
1619# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1620#endif
1621
1622
1623# 1041 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1624#if defined(MFC_OpenACC)
1625# 1041 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1626!$acc update device(dx, dy, dz, x_cb, x_cc, y_cb, y_cc, z_cb, z_cc)
1627# 1041 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1628#elif defined(MFC_OpenMP)
1629# 1041 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1630!$omp target update to(dx, dy, dz, x_cb, x_cc, y_cb, y_cc, z_cb, z_cc)
1631# 1041 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1632#endif
1633
1634# 1042 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1635#if defined(MFC_OpenACC)
1636# 1042 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1637!$acc update device(bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end)
1638# 1042 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1639#elif defined(MFC_OpenMP)
1640# 1042 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1641!$omp target update to(bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end)
1642# 1042 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1643#endif
1644
1645# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1646#if defined(MFC_OpenACC)
1647# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1648!$acc update device(bc_x%vb1, bc_x%vb2, bc_x%vb3, bc_x%ve1, bc_x%ve2, bc_x%ve3)
1649# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1650#elif defined(MFC_OpenMP)
1651# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1652!$omp target update to(bc_x%vb1, bc_x%vb2, bc_x%vb3, bc_x%ve1, bc_x%ve2, bc_x%ve3)
1653# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1654#endif
1655
1656# 1044 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1657#if defined(MFC_OpenACC)
1658# 1044 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1659!$acc update device(bc_y%vb1, bc_y%vb2, bc_y%vb3, bc_y%ve1, bc_y%ve2, bc_y%ve3)
1660# 1044 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1661#elif defined(MFC_OpenMP)
1662# 1044 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1663!$omp target update to(bc_y%vb1, bc_y%vb2, bc_y%vb3, bc_y%ve1, bc_y%ve2, bc_y%ve3)
1664# 1044 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1665#endif
1666
1667# 1045 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1668#if defined(MFC_OpenACC)
1669# 1045 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1670!$acc update device(bc_z%vb1, bc_z%vb2, bc_z%vb3, bc_z%ve1, bc_z%ve2, bc_z%ve3)
1671# 1045 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1672#elif defined(MFC_OpenMP)
1673# 1045 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1674!$omp target update to(bc_z%vb1, bc_z%vb2, bc_z%vb3, bc_z%ve1, bc_z%ve2, bc_z%ve3)
1675# 1045 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1676#endif
1677
1678
1679# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1680#if defined(MFC_OpenACC)
1681# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1682!$acc update device(bc_x%grcbc_in, bc_x%grcbc_out, bc_x%grcbc_vel_out)
1683# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1684#elif defined(MFC_OpenMP)
1685# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1686!$omp target update to(bc_x%grcbc_in, bc_x%grcbc_out, bc_x%grcbc_vel_out)
1687# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1688#endif
1689
1690# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1691#if defined(MFC_OpenACC)
1692# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1693!$acc update device(bc_y%grcbc_in, bc_y%grcbc_out, bc_y%grcbc_vel_out)
1694# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1695#elif defined(MFC_OpenMP)
1696# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1697!$omp target update to(bc_y%grcbc_in, bc_y%grcbc_out, bc_y%grcbc_vel_out)
1698# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1699#endif
1700
1701# 1049 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1702#if defined(MFC_OpenACC)
1703# 1049 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1704!$acc update device(bc_z%grcbc_in, bc_z%grcbc_out, bc_z%grcbc_vel_out)
1705# 1049 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1706#elif defined(MFC_OpenMP)
1707# 1049 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1708!$omp target update to(bc_z%grcbc_in, bc_z%grcbc_out, bc_z%grcbc_vel_out)
1709# 1049 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1710#endif
1711
1712
1713# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1714#if defined(MFC_OpenACC)
1715# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1716!$acc update device(bc_x%isothermal_in, bc_x%isothermal_out)
1717# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1718#elif defined(MFC_OpenMP)
1719# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1720!$omp target update to(bc_x%isothermal_in, bc_x%isothermal_out)
1721# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1722#endif
1723
1724# 1052 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1725#if defined(MFC_OpenACC)
1726# 1052 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1727!$acc update device(bc_y%isothermal_in, bc_y%isothermal_out)
1728# 1052 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1729#elif defined(MFC_OpenMP)
1730# 1052 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1731!$omp target update to(bc_y%isothermal_in, bc_y%isothermal_out)
1732# 1052 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1733#endif
1734
1735# 1053 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1736#if defined(MFC_OpenACC)
1737# 1053 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1738!$acc update device(bc_z%isothermal_in, bc_z%isothermal_out)
1739# 1053 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1740#elif defined(MFC_OpenMP)
1741# 1053 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1742!$omp target update to(bc_z%isothermal_in, bc_z%isothermal_out)
1743# 1053 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1744#endif
1745
1746# 1054 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1747#if defined(MFC_OpenACC)
1748# 1054 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1749!$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)
1750# 1054 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1751#elif defined(MFC_OpenMP)
1752# 1054 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1753!$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)
1754# 1054 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1755#endif
1756
1757
1758# 1056 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1759#if defined(MFC_OpenACC)
1760# 1056 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1761!$acc update device(relax, relax_model)
1762# 1056 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1763#elif defined(MFC_OpenMP)
1764# 1056 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1765!$omp target update to(relax, relax_model)
1766# 1056 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1767#endif
1768 if (relax) then
1769
1770# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1771#if defined(MFC_OpenACC)
1772# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1773!$acc update device(palpha_eps, ptgalpha_eps)
1774# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1775#elif defined(MFC_OpenMP)
1776# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1777!$omp target update to(palpha_eps, ptgalpha_eps)
1778# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1779#endif
1780 end if
1781
1782 if (ib) then
1783
1784# 1062 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1785#if defined(MFC_OpenACC)
1786# 1062 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1787!$acc update device(ib_markers%sf)
1788# 1062 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1789#elif defined(MFC_OpenMP)
1790# 1062 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1791!$omp target update to(ib_markers%sf)
1792# 1062 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1793#endif
1794 end if
1795# 1065 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1796
1797# 1065 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1798#if defined(MFC_OpenACC)
1799# 1065 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1800!$acc update device(igr, nb, igr_order)
1801# 1065 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1802#elif defined(MFC_OpenMP)
1803# 1065 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1804!$omp target update to(igr, nb, igr_order)
1805# 1065 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1806#endif
1807# 1067 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1808
1809 end subroutine s_initialize_gpu_vars
1810
1811 !> Finalize and deallocate all simulation sub-modules in reverse initialization order
1812 impure subroutine s_finalize_modules
1813
1814 call s_finalize_time_steppers_module()
1815 if (hypoelasticity) call s_finalize_hypoelastic_module()
1816 if (hyperelasticity) call s_finalize_hyperelastic_module()
1817 call s_finalize_derived_variables_module()
1818 call s_finalize_data_output_module()
1819 call s_finalize_rhs_module()
1820 if (igr) then
1821 call s_finalize_igr_module()
1822 else
1823 call s_finalize_cbc_module()
1824 call s_finalize_riemann_solvers_module()
1825 if (recon_type == recon_type_weno) then
1826 call s_finalize_weno_module()
1827 else if (recon_type == recon_type_muscl) then
1828 call s_finalize_muscl_module()
1829 end if
1830 end if
1831 if (int_comp > 0) call s_finalize_thinc_module()
1832 call s_finalize_variables_conversion_module()
1833 if (grid_geometry == 3) call s_finalize_fftw_module
1834 call s_finalize_mpi_common_module()
1835 call s_finalize_global_parameters_module()
1836 call s_finalize_boundary_common_module()
1837 if (relax) call s_finalize_relaxation_solver_module()
1838 if (bubbles_lagrange) call s_finalize_lagrangian_solver()
1839 if (viscous .and. (.not. igr)) then
1840 call s_finalize_viscous_module()
1841 end if
1842 call s_finalize_mpi_proxy_module()
1843
1844 if (surface_tension) call s_finalize_surface_tension_module()
1845 if (bodyforces) call s_finalize_body_forces_module()
1846 if (ib) call s_finalize_ibm_module()
1847
1848 call s_mpi_finalize()
1849
1850 end subroutine s_finalize_modules
1851
1852 !> @brief Reads IB kinematic state from restart_data/ib_state.dat on restart. Rank 0 reads the last num_ibs records and
1853 !! broadcasts to all ranks. Overwrites patch_ib vel, angular_vel, angles, and centroid.
1854 impure subroutine s_read_ib_restart_data(t_step)
1855
1856 integer, intent(in) :: t_step
1857 character(len=path_len + 2*name_len) :: file_loc
1858 integer :: i, ios, file_unit, ierr
1859 integer :: r, nlocal, gbl_id
1860 integer, parameter :: nfields_per_ib = 20
1861 real(wp) :: ib_buf(nfields_per_ib)
1862 logical :: file_exist
1863 character(len=10) :: t_step_string
1864
1865 if (file_per_process) then
1866 call s_int_to_str(t_step, t_step_string)
1867
1868 do r = 0, num_procs - 1
1869 write (file_loc, '(A,I0,A,i7.7,A)') 'ib_state_', t_step, '_', r, '.dat'
1870 file_loc = trim(case_dir) // '/restart_data/lustre_' // trim(t_step_string) // '/' // trim(file_loc)
1871
1872 inquire (file=trim(file_loc), exist=file_exist)
1873 if (.not. file_exist) call s_mpi_abort('Cannot open IB state file for restart: ' // trim(file_loc))
1874
1875 open (newunit=file_unit, file=trim(file_loc), form='unformatted', access='stream', status='old', iostat=ios)
1876 if (ios /= 0) call s_mpi_abort('Error opening IB state restart file: ' // trim(file_loc))
1877
1878 read (file_unit, iostat=ios) nlocal
1879 if (ios /= 0) call s_mpi_abort('Error reading IB state file header: ' // trim(file_loc))
1880
1881 do i = 1, nlocal
1882 read (file_unit, iostat=ios) gbl_id
1883 if (ios /= 0) call s_mpi_abort('Error reading IB patch ID: ' // trim(file_loc))
1884 read (file_unit, iostat=ios) ib_buf
1885 if (ios /= 0) call s_mpi_abort('Error reading IB state data: ' // trim(file_loc))
1886
1887 patch_ib(gbl_id)%vel = ib_buf(8:10)
1888 patch_ib(gbl_id)%angular_vel = ib_buf(11:13)
1889 patch_ib(gbl_id)%angles = ib_buf(14:16)
1890 patch_ib(gbl_id)%x_centroid = ib_buf(17)
1891 patch_ib(gbl_id)%y_centroid = ib_buf(18)
1892 patch_ib(gbl_id)%z_centroid = ib_buf(19)
1893 end do
1894
1895 close (file_unit)
1896 end do
1897 else
1898 write (file_loc, '(A,I0,A)') '/restart_data/ib_state_', t_step, '.dat'
1899 file_loc = trim(case_dir) // trim(file_loc)
1900
1901 if (proc_rank == 0) then
1902 inquire (file=trim(file_loc), exist=file_exist)
1903 if (.not. file_exist) then
1904 call s_mpi_abort('Cannot open IB state file for restart: ' // trim(file_loc))
1905 end if
1906
1907 open (newunit=file_unit, file=trim(file_loc), form='unformatted', access='stream', status='old', iostat=ios)
1908 if (ios /= 0) call s_mpi_abort('Error opening IB state restart file: ' // trim(file_loc))
1909
1910 do i = 1, num_ibs
1911 read (file_unit, iostat=ios) ib_buf
1912 if (ios /= 0) call s_mpi_abort('Error reading IB state restart file')
1913
1914 patch_ib(i)%vel = ib_buf(8:10)
1915 patch_ib(i)%angular_vel = ib_buf(11:13)
1916 patch_ib(i)%angles = ib_buf(14:16)
1917 patch_ib(i)%x_centroid = ib_buf(17)
1918 patch_ib(i)%y_centroid = ib_buf(18)
1919 patch_ib(i)%z_centroid = ib_buf(19)
1920 end do
1921
1922 close (file_unit)
1923 end if
1924
1925#ifdef MFC_MPI
1926 do i = 1, num_ibs
1927 call mpi_bcast(patch_ib(i)%vel, 3, mpi_p, 0, mpi_comm_world, ierr)
1928 call mpi_bcast(patch_ib(i)%angular_vel, 3, mpi_p, 0, mpi_comm_world, ierr)
1929 call mpi_bcast(patch_ib(i)%angles, 3, mpi_p, 0, mpi_comm_world, ierr)
1930 call mpi_bcast(patch_ib(i)%x_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1931 call mpi_bcast(patch_ib(i)%y_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1932 call mpi_bcast(patch_ib(i)%z_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1933 end do
1934#endif
1935 end if
1936
1937 end subroutine s_read_ib_restart_data
1938
1939 !> @brief Merges patch_ib (namelist patches, fixed at num_ib_patches_max_namelist) with particle_cloud_ibs (CPU-only, exact
1940 !! size) and reduces to only the patches in or near the local computational domain. patch_ib is never reallocated; the local
1941 !! subset is written in-place from the front. particle_cloud_ibs is owned by the caller and freed there after this returns.
1942 subroutine s_reduce_ib_patch_array(particle_cloud_ibs)
1943
1944 type(ib_patch_parameters), intent(in), dimension(:) :: particle_cloud_ibs
1945 real(wp), dimension(3) :: centroid
1946 integer :: i
1947 integer :: num_namelist_ibs, num_bed_ibs
1948
1949 num_namelist_ibs = num_ibs
1950 num_bed_ibs = 0
1951 do i = 1, num_particle_clouds
1952 num_bed_ibs = num_bed_ibs + particle_cloud(i)%num_particles
1953 end do
1954
1955 ! Check for moving IBs across both namelist and particle bed patches.
1956 moving_immersed_boundary_flag = .false.
1957 do i = 1, num_namelist_ibs
1958 if (patch_ib(i)%moving_ibm /= 0) then
1959 moving_immersed_boundary_flag = .true.
1960 exit
1961 end if
1962 end do
1963 if (.not. moving_immersed_boundary_flag) then
1964 do i = 1, num_bed_ibs
1965 if (particle_cloud_ibs(i)%moving_ibm /= 0) then
1966 moving_immersed_boundary_flag = .true.
1967 exit
1968 end if
1969 end do
1970 end if
1971
1972 call get_neighbor_bounds()
1974
1975 num_gbl_ibs = num_namelist_ibs + num_bed_ibs
1976
1977#ifdef MFC_MPI
1978 if (num_procs == 1) then
1979 ! single-rank: all patches are local; append particle bed entries directly into patch_ib.
1980 if (num_gbl_ibs > num_ib_patches_max_namelist) then
1981# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1982 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.")
1983# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1984 end if
1985# 1241 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
1986 do i = 1, num_bed_ibs
1987 patch_ib(num_namelist_ibs + i) = particle_cloud_ibs(i)
1988 patch_ib(num_namelist_ibs + i)%gbl_patch_id = num_namelist_ibs + i
1989 end do
1990 num_ibs = num_gbl_ibs
1991 num_local_ibs = num_gbl_ibs
1992 do i = 1, num_gbl_ibs
1993 local_ib_patch_ids(i) = i
1994 end do
1995 else
1996 ! multi-rank: compact namelist patches in-place (write_idx <= read_idx, no aliasing), then append local particle beds.
1997 num_ibs = 0
1998 num_local_ibs = 0
1999 do i = 1, num_namelist_ibs
2000 centroid = [patch_ib(i)%x_centroid, patch_ib(i)%y_centroid, 0._wp]
2001 if (num_dims == 3) centroid(3) = patch_ib(i)%z_centroid
2002 if (f_neighborhood_ranks_own_location(centroid)) then
2003 num_ibs = num_ibs + 1
2004 patch_ib(num_ibs) = patch_ib(i)
2005 patch_ib(num_ibs)%gbl_patch_id = i
2006 if (f_local_rank_owns_location(centroid)) then
2007 num_local_ibs = num_local_ibs + 1
2008 local_ib_patch_ids(num_local_ibs) = num_ibs
2009 end if
2010 end if
2011 end do
2012 do i = 1, num_bed_ibs
2013 centroid = [particle_cloud_ibs(i)%x_centroid, particle_cloud_ibs(i)%y_centroid, 0._wp]
2014 if (num_dims == 3) centroid(3) = particle_cloud_ibs(i)%z_centroid
2015 if (f_neighborhood_ranks_own_location(centroid)) then
2016 num_ibs = num_ibs + 1
2017 if (num_ibs > num_ib_patches_max_namelist) then
2018# 1272 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2019 call s_prohibit_abort("num_ibs > num_ib_patches_max_namelist", "Local IB count exceeds patch_ib capacity. Increase num_ib_patches_max_namelist.")
2020# 1272 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2021 end if
2022# 1274 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2023 patch_ib(num_ibs) = particle_cloud_ibs(i)
2024 patch_ib(num_ibs)%gbl_patch_id = num_namelist_ibs + i
2025 if (f_local_rank_owns_location(centroid)) then
2026 num_local_ibs = num_local_ibs + 1
2027 local_ib_patch_ids(num_local_ibs) = num_ibs
2028 end if
2029 end if
2030 end do
2031 if (num_local_ibs > num_local_ibs_max) then
2032# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2033 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.")
2034# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2035 end if
2036# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2037 end if
2038#else
2039 ! no-MPI: all patches are local; append particle bed entries directly into patch_ib.
2040 if (num_gbl_ibs > num_ib_patches_max_namelist) then
2041# 1287 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2042 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.")
2043# 1287 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2044 end if
2045# 1289 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2046 do i = 1, num_bed_ibs
2047 patch_ib(num_namelist_ibs + i) = particle_cloud_ibs(i)
2048 patch_ib(num_namelist_ibs + i)%gbl_patch_id = num_namelist_ibs + i
2049 end do
2050 num_ibs = num_gbl_ibs
2051 num_local_ibs = num_gbl_ibs
2052 do i = 1, num_gbl_ibs
2053 local_ib_patch_ids(i) = i
2054 end do
2055#endif
2056
2057#ifdef MFC_DEBUG
2058# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2059 block
2060# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2061 use iso_fortran_env, only: output_unit
2062# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2063
2064# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2065 print *, 'm_start_up.fpp:1300: ', '@:ALLOCATE(ib_gbl_idx_lookup(1:num_gbl_ibs))'
2066# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2067
2068# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2069 call flush (output_unit)
2070# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2071 end block
2072# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2073#endif
2074# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2075 allocate (ib_gbl_idx_lookup(1:num_gbl_ibs))
2076# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2077
2078# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2079
2080# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2081#if defined(MFC_OpenACC)
2082# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2083!$acc enter data create(ib_gbl_idx_lookup)
2084# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2085#elif defined(MFC_OpenMP)
2086# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2087!$omp target enter data map(always,alloc:ib_gbl_idx_lookup)
2088# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2089#endif
2090
2091 end subroutine s_reduce_ib_patch_array
2092
2093 !> Build ib_neighbor_ranks(-1:1,-1:1,-1:1): MPI ranks of all neighbor domains. Uses two rounds of MPI_SENDRECV cascades - face
2094 !! neighbors are known from bc_*, edge neighbors are obtained in round 1, and (3D) corner neighbors in round 2.
2096
2097 integer :: ax, k, nbr_idx, nreqs, sx, sy, sz, dx, dy, dz
2098 integer, allocatable :: send_table(:,:,:), recv_tables(:,:,:,:)
2099 integer, dimension(52) :: requests
2100
2101#ifdef MFC_MPI
2102 integer :: ierr
2103 integer, dimension(4) :: buf4, rbuf4
2104 integer, dimension(2) :: buf2, rbuf2
2105
2106 ax = ib_neighborhood_radius
2107
2108 if (allocated(ib_neighbor_ranks)) deallocate (ib_neighbor_ranks)
2109 allocate (ib_neighbor_ranks(-ax:ax,-ax:ax,-ax:ax))
2110 ib_neighbor_ranks = mpi_proc_null
2111 ib_neighbor_ranks(0, 0, 0) = proc_rank
2112
2113 ! Fill radius-1 entries: face neighbors are known from domain decomposition
2114 ib_neighbor_ranks(-1, 0, 0) = bc_x%beg
2115 ib_neighbor_ranks(+1, 0, 0) = bc_x%end
2116 if (num_dims >= 2) then
2117 ib_neighbor_ranks(0, -1, 0) = bc_y%beg
2118 ib_neighbor_ranks(0, +1, 0) = bc_y%end
2119 end if
2120 if (num_dims == 3) then
2121 ib_neighbor_ranks(0, 0, -1) = bc_z%beg
2122 ib_neighbor_ranks(0, 0, +1) = bc_z%end
2123 end if
2124
2125 if (num_dims >= 2) then
2126 ! Round 1a: exchange y/z face ranks with +/-x face neighbors -> xy and xz edge ranks
2127 buf4 = [bc_y%beg, bc_y%end, bc_z%beg, bc_z%end]
2128
2129 ! Send to -x, receive from +x -> edges (+1,+/-1,0) and (+1,0,+/-1)
2130 call mpi_sendrecv(buf4, 4, mpi_integer, merge(bc_x%beg, mpi_proc_null, bc_x%beg >= 0), 310, rbuf4, 4, mpi_integer, &
2131 & merge(bc_x%end, mpi_proc_null, bc_x%end >= 0), 310, mpi_comm_world, mpi_status_ignore, ierr)
2132 if (bc_x%end >= 0) then
2133 ib_neighbor_ranks(+1, -1, 0) = rbuf4(1)
2134 ib_neighbor_ranks(+1, +1, 0) = rbuf4(2)
2135 ib_neighbor_ranks(+1, 0, -1) = rbuf4(3)
2136 ib_neighbor_ranks(+1, 0, +1) = rbuf4(4)
2137 end if
2138
2139 call mpi_sendrecv(buf4, 4, mpi_integer, merge(bc_x%end, mpi_proc_null, bc_x%end >= 0), 311, rbuf4, 4, mpi_integer, &
2140 & merge(bc_x%beg, mpi_proc_null, bc_x%beg >= 0), 311, mpi_comm_world, mpi_status_ignore, ierr)
2141 if (bc_x%beg >= 0) then
2142 ib_neighbor_ranks(-1, -1, 0) = rbuf4(1)
2143 ib_neighbor_ranks(-1, +1, 0) = rbuf4(2)
2144 ib_neighbor_ranks(-1, 0, -1) = rbuf4(3)
2145 ib_neighbor_ranks(-1, 0, +1) = rbuf4(4)
2146 end if
2147 end if
2148
2149 if (num_dims == 3) then
2150 ! Round 1b: exchange z face ranks with +/-y face neighbors -> yz edge ranks
2151 buf2 = [bc_z%beg, bc_z%end]
2152
2153 call mpi_sendrecv(buf2, 2, mpi_integer, merge(bc_y%beg, mpi_proc_null, bc_y%beg >= 0), 312, rbuf2, 2, mpi_integer, &
2154 & merge(bc_y%end, mpi_proc_null, bc_y%end >= 0), 312, mpi_comm_world, mpi_status_ignore, ierr)
2155 if (bc_y%end >= 0) then
2156 ib_neighbor_ranks(0, +1, -1) = rbuf2(1)
2157 ib_neighbor_ranks(0, +1, +1) = rbuf2(2)
2158 end if
2159
2160 call mpi_sendrecv(buf2, 2, mpi_integer, merge(bc_y%end, mpi_proc_null, bc_y%end >= 0), 313, rbuf2, 2, mpi_integer, &
2161 & merge(bc_y%beg, mpi_proc_null, bc_y%beg >= 0), 313, mpi_comm_world, mpi_status_ignore, ierr)
2162 if (bc_y%beg >= 0) then
2163 ib_neighbor_ranks(0, -1, -1) = rbuf2(1)
2164 ib_neighbor_ranks(0, -1, +1) = rbuf2(2)
2165 end if
2166
2167 ! Round 2: exchange z face ranks with xy-diagonal edge neighbors -> corner ranks. Each of the 4 xy diagonals gives 2
2168 ! corners (the +/-z variants). Pattern: send buf2 to mirror diagonal, receive from this diagonal -> that edge's z face
2169 ! ranks.
2170# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2171 call mpi_sendrecv(buf2, 2, mpi_integer, merge(ib_neighbor_ranks(-1, -1, 0), mpi_proc_null, &
2172 & ib_neighbor_ranks(-1, -1, 0) >= 0), 320, rbuf2, 2, mpi_integer, &
2173 & merge(ib_neighbor_ranks(1, 1, 0), mpi_proc_null, ib_neighbor_ranks(1, 1, &
2174 & 0) >= 0), 320, mpi_comm_world, mpi_status_ignore, ierr)
2175 if (ib_neighbor_ranks(1, 1, 0) >= 0) then
2176 ib_neighbor_ranks(1, 1, -1) = rbuf2(1)
2177 ib_neighbor_ranks(1, 1, +1) = rbuf2(2)
2178 end if
2179# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2180 call mpi_sendrecv(buf2, 2, mpi_integer, merge(ib_neighbor_ranks(-1, 1, 0), mpi_proc_null, &
2181 & ib_neighbor_ranks(-1, 1, 0) >= 0), 321, rbuf2, 2, mpi_integer, &
2182 & merge(ib_neighbor_ranks(1, -1, 0), mpi_proc_null, ib_neighbor_ranks(1, -1, &
2183 & 0) >= 0), 321, mpi_comm_world, mpi_status_ignore, ierr)
2184 if (ib_neighbor_ranks(1, -1, 0) >= 0) then
2185 ib_neighbor_ranks(1, -1, -1) = rbuf2(1)
2186 ib_neighbor_ranks(1, -1, +1) = rbuf2(2)
2187 end if
2188# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2189 call mpi_sendrecv(buf2, 2, mpi_integer, merge(ib_neighbor_ranks(1, -1, 0), mpi_proc_null, &
2190 & ib_neighbor_ranks(1, -1, 0) >= 0), 322, rbuf2, 2, mpi_integer, &
2191 & merge(ib_neighbor_ranks(-1, 1, 0), mpi_proc_null, ib_neighbor_ranks(-1, 1, &
2192 & 0) >= 0), 322, mpi_comm_world, mpi_status_ignore, ierr)
2193 if (ib_neighbor_ranks(-1, 1, 0) >= 0) then
2194 ib_neighbor_ranks(-1, 1, -1) = rbuf2(1)
2195 ib_neighbor_ranks(-1, 1, +1) = rbuf2(2)
2196 end if
2197# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2198 call mpi_sendrecv(buf2, 2, mpi_integer, merge(ib_neighbor_ranks(1, 1, 0), mpi_proc_null, &
2199 & ib_neighbor_ranks(1, 1, 0) >= 0), 323, rbuf2, 2, mpi_integer, &
2200 & merge(ib_neighbor_ranks(-1, -1, 0), mpi_proc_null, ib_neighbor_ranks(-1, -1, &
2201 & 0) >= 0), 323, mpi_comm_world, mpi_status_ignore, ierr)
2202 if (ib_neighbor_ranks(-1, -1, 0) >= 0) then
2203 ib_neighbor_ranks(-1, -1, -1) = rbuf2(1)
2204 ib_neighbor_ranks(-1, -1, +1) = rbuf2(2)
2205 end if
2206# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2207 end if
2208
2209 ! For radius > 1: extend the table by iterative 26-neighbor full-table exchanges. In each round, every rank broadcasts its
2210 ! current table to all 26 immediate neighbors. Their entry at offset (dx,dy,dz) from them = our entry at
2211 ! (dx+sx,dy+sy,dz+sz). One extension round fills the entire next shell, so ax-1 rounds suffice.
2212 if (ax > 1) then
2213 allocate (send_table(-ax:ax,-ax:ax,-ax:ax))
2214 allocate (recv_tables(-ax:ax,-ax:ax,-ax:ax,1:26))
2215
2216 do k = 2, ax
2217 send_table = ib_neighbor_ranks
2218
2219 nreqs = 0
2220 nbr_idx = 0
2221 do sz = -1, 1
2222 do sy = -1, 1
2223 do sx = -1, 1
2224 if (sx == 0 .and. sy == 0 .and. sz == 0) cycle
2225 nbr_idx = nbr_idx + 1
2226 if (ib_neighbor_ranks(sx, sy, sz) < 0) cycle
2227 nreqs = nreqs + 1
2228 call mpi_irecv(recv_tables(:,:,:,nbr_idx), (2*ax + 1)**3, mpi_integer, ib_neighbor_ranks(sx, sy, sz), &
2229 & 400, mpi_comm_world, requests(nreqs), ierr)
2230 end do
2231 end do
2232 end do
2233
2234 do sz = -1, 1
2235 do sy = -1, 1
2236 do sx = -1, 1
2237 if (sx == 0 .and. sy == 0 .and. sz == 0) cycle
2238 if (ib_neighbor_ranks(sx, sy, sz) < 0) cycle
2239 nreqs = nreqs + 1
2240 call mpi_isend(send_table, (2*ax + 1)**3, mpi_integer, ib_neighbor_ranks(sx, sy, sz), 400, &
2241 & mpi_comm_world, requests(nreqs), ierr)
2242 end do
2243 end do
2244 end do
2245
2246 call mpi_waitall(nreqs, requests, mpi_statuses_ignore, ierr)
2247
2248 nbr_idx = 0
2249 do sz = -1, 1
2250 do sy = -1, 1
2251 do sx = -1, 1
2252 if (sx == 0 .and. sy == 0 .and. sz == 0) cycle
2253 nbr_idx = nbr_idx + 1
2254 if (ib_neighbor_ranks(sx, sy, sz) < 0) cycle
2255 do dz = -ax, ax
2256 do dy = -ax, ax
2257 do dx = -ax, ax
2258 if (recv_tables(dx, dy, dz, nbr_idx) == mpi_proc_null) cycle
2259 if (dx + sx < -ax .or. dx + sx > ax) cycle
2260 if (dy + sy < -ax .or. dy + sy > ax) cycle
2261 if (dz + sz < -ax .or. dz + sz > ax) cycle
2262 if (ib_neighbor_ranks(dx + sx, dy + sy, dz + sz) /= mpi_proc_null) cycle
2263 ib_neighbor_ranks(dx + sx, dy + sy, dz + sz) = recv_tables(dx, dy, dz, nbr_idx)
2264 end do
2265 end do
2266 end do
2267 end do
2268 end do
2269 end do
2270 end do
2271
2272 deallocate (send_table, recv_tables)
2273 end if
2274#endif
2275
2276 end subroutine s_compute_ib_neighbor_ranks
2277
2279
2280 real(wp) :: beg_val, end_val, recv_val
2281 integer :: k, send_neighbor, recv_neighbor, ierr
2282
2283 ! Default: unbounded in all directions (covers single-rank and no-MPI cases)
2284
2285 neighbor_domain_x%beg = -huge(0._wp)
2286 neighbor_domain_x%end = huge(0._wp)
2287 neighbor_domain_y%beg = -huge(0._wp)
2288 neighbor_domain_y%end = huge(0._wp)
2289 neighbor_domain_z%beg = -huge(0._wp)
2290 neighbor_domain_z%end = huge(0._wp)
2291
2292#ifdef MFC_MPI
2293 ! For each direction, propagate the left/right boundary edges outward ib_neighborhood_radius hops. After k rounds: beg_val =
2294 ! left edge of the rank k hops to the left; end_val = right edge of the rank k hops to the right.
2295# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2296 if (num_dims >= 1) then
2297 beg_val = x_cb(-1)
2298 end_val = x_cb(m)
2299 do k = 1, ib_neighborhood_radius
2300 send_neighbor = merge(bc_x%end, mpi_proc_null, bc_x%end >= 0)
2301 recv_neighbor = merge(bc_x%beg, mpi_proc_null, bc_x%beg >= 0)
2302 recv_val = -huge(0._wp)
2303 call mpi_sendrecv(beg_val, 1, mpi_p, send_neighbor, 100, recv_val, 1, mpi_p, recv_neighbor, 100, &
2304 & mpi_comm_world, mpi_status_ignore, ierr)
2305 beg_val = recv_val
2306
2307 send_neighbor = merge(bc_x%beg, mpi_proc_null, bc_x%beg >= 0)
2308 recv_neighbor = merge(bc_x%end, mpi_proc_null, bc_x%end >= 0)
2309 recv_val = huge(0._wp)
2310 call mpi_sendrecv(end_val, 1, mpi_p, send_neighbor, 101, recv_val, 1, mpi_p, recv_neighbor, &
2311 & 101, mpi_comm_world, mpi_status_ignore, ierr)
2312 end_val = recv_val
2313
2314 ! protect from looping back around on yourself multiple times
2315 if (f_approx_equal(beg_val, x_cb(m)) .or. f_approx_equal(end_val, x_cb(-1))) then
2316 beg_val = -huge(0._wp)
2317 end_val = huge(0._wp)
2318 exit
2319 end if
2320 end do
2321 neighbor_domain_x%beg = beg_val
2322 neighbor_domain_x%end = end_val
2323 end if
2324# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2325 if (num_dims >= 2) then
2326 beg_val = y_cb(-1)
2327 end_val = y_cb(n)
2328 do k = 1, ib_neighborhood_radius
2329 send_neighbor = merge(bc_y%end, mpi_proc_null, bc_y%end >= 0)
2330 recv_neighbor = merge(bc_y%beg, mpi_proc_null, bc_y%beg >= 0)
2331 recv_val = -huge(0._wp)
2332 call mpi_sendrecv(beg_val, 1, mpi_p, send_neighbor, 102, recv_val, 1, mpi_p, recv_neighbor, 102, &
2333 & mpi_comm_world, mpi_status_ignore, ierr)
2334 beg_val = recv_val
2335
2336 send_neighbor = merge(bc_y%beg, mpi_proc_null, bc_y%beg >= 0)
2337 recv_neighbor = merge(bc_y%end, mpi_proc_null, bc_y%end >= 0)
2338 recv_val = huge(0._wp)
2339 call mpi_sendrecv(end_val, 1, mpi_p, send_neighbor, 103, recv_val, 1, mpi_p, recv_neighbor, &
2340 & 103, mpi_comm_world, mpi_status_ignore, ierr)
2341 end_val = recv_val
2342
2343 ! protect from looping back around on yourself multiple times
2344 if (f_approx_equal(beg_val, y_cb(n)) .or. f_approx_equal(end_val, y_cb(-1))) then
2345 beg_val = -huge(0._wp)
2346 end_val = huge(0._wp)
2347 exit
2348 end if
2349 end do
2350 neighbor_domain_y%beg = beg_val
2351 neighbor_domain_y%end = end_val
2352 end if
2353# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2354 if (num_dims >= 3) then
2355 beg_val = z_cb(-1)
2356 end_val = z_cb(p)
2357 do k = 1, ib_neighborhood_radius
2358 send_neighbor = merge(bc_z%end, mpi_proc_null, bc_z%end >= 0)
2359 recv_neighbor = merge(bc_z%beg, mpi_proc_null, bc_z%beg >= 0)
2360 recv_val = -huge(0._wp)
2361 call mpi_sendrecv(beg_val, 1, mpi_p, send_neighbor, 104, recv_val, 1, mpi_p, recv_neighbor, 104, &
2362 & mpi_comm_world, mpi_status_ignore, ierr)
2363 beg_val = recv_val
2364
2365 send_neighbor = merge(bc_z%beg, mpi_proc_null, bc_z%beg >= 0)
2366 recv_neighbor = merge(bc_z%end, mpi_proc_null, bc_z%end >= 0)
2367 recv_val = huge(0._wp)
2368 call mpi_sendrecv(end_val, 1, mpi_p, send_neighbor, 105, recv_val, 1, mpi_p, recv_neighbor, &
2369 & 105, mpi_comm_world, mpi_status_ignore, ierr)
2370 end_val = recv_val
2371
2372 ! protect from looping back around on yourself multiple times
2373 if (f_approx_equal(beg_val, z_cb(p)) .or. f_approx_equal(end_val, z_cb(-1))) then
2374 beg_val = -huge(0._wp)
2375 end_val = huge(0._wp)
2376 exit
2377 end if
2378 end do
2379 neighbor_domain_z%beg = beg_val
2380 neighbor_domain_z%end = end_val
2381 end if
2382# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_start_up.fpp"
2383#endif
2384
2385 end subroutine get_neighbor_bounds
2386
2387end 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.
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.
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.
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 statistics for each bubble.
impure subroutine s_write_restart_lag_bubbles(t_step)
Write restart files for the Lagrangian bubble solver.
integer nbubs
Number of bubbles in the local domain.
impure subroutine s_initialize_bubbles_el_module(q_cons_vf)
Initializes the lagrangian subgrid bubble solver.
type(scalar_field), dimension(:), allocatable q_beta
Projection of the lagrangian particles in the Eulerian framework.
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)
Inquires on the existence of a directory.
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
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.
type(int_bounds_info), dimension(1:3) idwint
real(wp), dimension(:), allocatable, target z_cb
integer proc_rank
Rank of the local processor.
type(int_bounds_info), dimension(1:3) idwbuff
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
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(:), 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)
Updates 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.
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 by setting saturation curve coefficients for pT- or pTg-equilibriu...
Quadrature-based moment methods (QBMM) for polydisperse bubble moment inversion and transport.
impure subroutine, public s_initialize_qbmm_module
Initialize the QBMM module.
Assembles 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).