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