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