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