MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_mpi_proxy.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
2!>
3!! @file
4!! @brief Contains module m_mpi_proxy
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_mpi_proxy.fpp" 2
17# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
18# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
19# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
20# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
21# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
23# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
25
26# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
27# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29
30# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31
32# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
33
34# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
35
36# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37
38# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39
40# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45! New line at end of file is required for FYPP
46# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
47# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
48# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
49# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54
55# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58
59# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60
61# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
62
63# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
64
65# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
66
67# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68
69# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
70
71# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
72
73# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
74! New line at end of file is required for FYPP
75# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
76
77# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
78# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
80# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
82
83# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
84
85# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
86
87# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
88
89# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90
91# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
92
93# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
94
95# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
96
97# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
98
99# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
100
101# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
102
103# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
104
105# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
106
107# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
108
109# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
110
111# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
112
113# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 126 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 156 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 197 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 211 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 236 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 247 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 249 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128# 260 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 310 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 320 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 356 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 366 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 373 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 379 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 385 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 391 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 397 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151
152# 403 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
153! New line at end of file is required for FYPP
154# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
155# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
156# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
157# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162
163# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
164# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166
167# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
168
169# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170
171# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172
173# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
174
175# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176
177# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
178
179# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
180
181# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
182! New line at end of file is required for FYPP
183# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
184
185# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
186
187# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
188
189# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
190
191# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
192
193# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
194
195# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
196
197# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
198
199# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
200
201# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
202
203# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
204
205# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
206
207# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236
237# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
238
239# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
240! New line at end of file is required for FYPP
241# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
242
243! GPU parallel region (scalar reductions, maxval/minval)
244# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
245
246! GPU parallel loop over threads (most common GPU macro)
247# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
248
249! Required closing for GPU_PARALLEL_LOOP
250# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
251
252! Mark routine for device compilation
253# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
254
255! Declare device-resident data
256# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
257
258! Inner loop within a GPU parallel region
259# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
260
261! Scoped GPU data region
262# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
263
264! Host code with device pointers (for MPI with GPU buffers)
265# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
266
267! Allocate device memory (unscoped)
268# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
269
270! Free device memory
271# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
272
273! Atomic operation on device
274# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
275
276! End atomic capture block
277# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
278
279! Copy data between host and device
280# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
281
282! Synchronization barrier
283# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
284
285! Import GPU library module (openacc or omp_lib)
286# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
287
288! Emit code only for AMD compiler
289# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
290
291! Emit code for non-Cray compilers
292# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
293
294! Emit code only for Cray compiler
295# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
296
297! Emit code for non-NVIDIA compilers
298# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
299
300# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
301# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
302! New line at end of file is required for FYPP
303# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
304
305# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
306
307! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
308! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
309! example see misc/nvidia_uvm/bind.sh.
310# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312! Allocate and create GPU device memory
313# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
314
315! Free GPU device memory and deallocate
316# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
317
318! Cray-specific GPU pointer setup for vector fields
319# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
320
321! Cray-specific GPU pointer setup for scalar fields
322# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
323
324! Cray-specific GPU pointer setup for acoustic source spatials
325# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
326
327# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
328
329# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
330! New line at end of file is required for FYPP
331# 7 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp" 2
332
333!> @brief MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver
335
336#ifdef MFC_MPI
337 use mpi !< message passing interface (mpi) module
338#endif
339
341 use m_helper
344 use m_mpi_common
345 use m_nvtx
346 use ieee_arithmetic
347
348 implicit none
349
350 integer, private, allocatable, dimension(:) :: ib_buff_send !< IB marker send buffer for halo exchange
351 integer, private, allocatable, dimension(:) :: ib_buff_recv !< IB marker receive buffer for halo exchange
352 integer :: i_halo_size
353
354# 28 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
355#if defined(MFC_OpenACC)
356# 28 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
357!$acc declare create(i_halo_size)
358# 28 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
359#elif defined(MFC_OpenMP)
360# 28 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
361!$omp declare target (i_halo_size)
362# 28 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
363#endif
364
365 integer, dimension(-1:1,-1:1,-1:1) :: p_send_counts, p_recv_counts
366 integer, dimension(:,:,:,:), allocatable :: p_send_ids
367 character(len=1), dimension(:), allocatable :: p_send_buff, p_recv_buff
369 !! EL Bubbles communication variables
370 integer, parameter :: max_neighbors = 27
374 integer :: n_neighbors
375
376# 40 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
377#if defined(MFC_OpenACC)
378# 40 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
379!$acc declare create(p_send_counts)
380# 40 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
381#elif defined(MFC_OpenMP)
382# 40 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
383!$omp declare target (p_send_counts)
384# 40 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
385#endif
386
387contains
388
389 !> Initialize the MPI proxy module
391
392#ifdef MFC_MPI
393 if (ib) then
394 if (n > 0) then
395 if (p > 0) then
396 i_halo_size = -1 + buff_size*(m + 2*buff_size + 1)*(n + 2*buff_size + 1)*(p + 2*buff_size + 1) &
397 & /(cells_bounds%mnp_min + 2*buff_size + 1)
398 else
399 i_halo_size = -1 + buff_size*(cells_bounds%mn_max + 2*buff_size + 1)
400 end if
401 else
403 end if
404
405
406# 60 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
407#if defined(MFC_OpenACC)
408# 60 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
409!$acc update device(i_halo_size)
410# 60 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
411#elif defined(MFC_OpenMP)
412# 60 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
413!$omp target update to(i_halo_size)
414# 60 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
415#endif
416#ifdef MFC_DEBUG
417# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
418 block
419# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
420 use iso_fortran_env, only: output_unit
421# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
422
423# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
424 print *, 'm_mpi_proxy.fpp:61: ', '@:ALLOCATE(ib_buff_send(0:i_halo_size), ib_buff_recv(0:i_halo_size))'
425# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
426
427# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
428 call flush (output_unit)
429# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
430 end block
431# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
432#endif
433# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
435# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
436
437# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
438
439# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
440
441# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
442#if defined(MFC_OpenACC)
443# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
444!$acc enter data create(ib_buff_send, ib_buff_recv)
445# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
446#elif defined(MFC_OpenMP)
447# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
448!$omp target enter data map(always,alloc:ib_buff_send, ib_buff_recv)
449# 61 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
450#endif
451 end if
452#endif
453
454 end subroutine s_initialize_mpi_proxy_module
455
456 !! Initialize the MPI buffers and variables required for the particle communication.
457 subroutine s_initialize_particles_mpi(lag_num_ts)
458
459 integer, intent(in) :: lag_num_ts
460 integer :: i, j, k
461 integer :: real_size, int_size, nReal
462 integer :: ierr !< Generic flag used to identify and report MPI errors
463
464#ifdef MFC_MPI
465 call mpi_pack_size(1, mpi_p, mpi_comm_world, real_size, ierr)
466 call mpi_pack_size(1, mpi_integer, mpi_comm_world, int_size, ierr)
467 nreal = 7 + 16*2 + 10*lag_num_ts
468 p_var_size = nreal*real_size + int_size
469 p_buff_size = lag_params%nBubs_glb*p_var_size
470#ifdef MFC_DEBUG
471# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
472 block
473# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
474 use iso_fortran_env, only: output_unit
475# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
476
477# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
478 print *, 'm_mpi_proxy.fpp:81: ', '@:ALLOCATE(p_send_buff(0:p_buff_size), p_recv_buff(0:p_buff_size))'
479# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
480
481# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
482 call flush (output_unit)
483# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
484 end block
485# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
486#endif
487# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
489# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
490
491# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
492
493# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
494
495# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
496#if defined(MFC_OpenACC)
497# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
498!$acc enter data create(p_send_buff, p_recv_buff)
499# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
500#elif defined(MFC_OpenMP)
501# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
502!$omp target enter data map(always,alloc:p_send_buff, p_recv_buff)
503# 81 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
504#endif
505#ifdef MFC_DEBUG
506# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
507 block
508# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
509 use iso_fortran_env, only: output_unit
510# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
511
512# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
513 print *, 'm_mpi_proxy.fpp:82: ', '@:ALLOCATE(p_send_ids(nidx(1)%beg:nidx(1)%end, nidx(2)%beg:nidx(2)%end, nidx(3)%beg:nidx(3)%end, 0:lag_params%nBubs_glb))'
514# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
515
516# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
517 call flush (output_unit)
518# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
519 end block
520# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
521#endif
522# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
523 allocate (p_send_ids(nidx(1)%beg:nidx(1)%end, nidx(2)%beg:nidx(2)%end, nidx(3)%beg:nidx(3)%end, 0:lag_params%nBubs_glb))
524# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
525
526# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
527
528# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
529#if defined(MFC_OpenACC)
530# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
531!$acc enter data create(p_send_ids)
532# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
533#elif defined(MFC_OpenMP)
534# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
535!$omp target enter data map(always,alloc:p_send_ids)
536# 82 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
537#endif
538 ! First, collect all neighbor information
539 n_neighbors = 0
540 do k = nidx(3)%beg, nidx(3)%end
541 do j = nidx(2)%beg, nidx(2)%end
542 do i = nidx(1)%beg, nidx(1)%end
543 if (abs(i) + abs(j) + abs(k) /= 0) then
548 end if
549 end do
550 end do
551 end do
552#endif
553
554 end subroutine s_initialize_particles_mpi
555
556 !> Since only the processor with rank 0 reads and verifies the consistency of user inputs, these are initially not available to
557 !! the other processors. Then, the purpose of this subroutine is to distribute the user inputs to the remaining processors in
558 !! the communicator.
559 impure subroutine s_mpi_bcast_user_inputs()
560
561#ifdef MFC_MPI
562 integer :: i, j !< Generic loop iterator
563 integer :: ierr !< Generic flag used to identify and report MPI errors
564
565 ! Generated: case_dir, namelist scalars (INT/LOG/REAL), CASE_OPT guard, fluid_pp loop,
566 ! bub_pp guard, lag_params guard, chem_params guard
567# 1 "/home/runner/work/MFC/MFC/build/include/simulation/generated_bcast.fpp" 1
568! AUTO-GENERATED - do not edit directly. Regenerate: cmake reconfigure
569!
570 call mpi_bcast(case_dir, len(case_dir), mpi_character, 0, mpi_comm_world, ierr)
571
572 ! Integer scalars
573 call mpi_bcast(adap_dt_max_iters, 1, mpi_integer, 0, mpi_comm_world, ierr)
574 call mpi_bcast(avg_state, 1, mpi_integer, 0, mpi_comm_world, ierr)
575 call mpi_bcast(bubble_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
576 call mpi_bcast(collision_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
577 call mpi_bcast(fd_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
578 call mpi_bcast(ib_neighborhood_radius, 1, mpi_integer, 0, mpi_comm_world, ierr)
579 call mpi_bcast(int_comp, 1, mpi_integer, 0, mpi_comm_world, ierr)
580 call mpi_bcast(low_mach, 1, mpi_integer, 0, mpi_comm_world, ierr)
581 call mpi_bcast(m, 1, mpi_integer, 0, mpi_comm_world, ierr)
582 call mpi_bcast(model_eqns, 1, mpi_integer, 0, mpi_comm_world, ierr)
583 call mpi_bcast(n, 1, mpi_integer, 0, mpi_comm_world, ierr)
584 call mpi_bcast(n_start, 1, mpi_integer, 0, mpi_comm_world, ierr)
585 call mpi_bcast(num_bc_patches, 1, mpi_integer, 0, mpi_comm_world, ierr)
586 call mpi_bcast(num_ibs, 1, mpi_integer, 0, mpi_comm_world, ierr)
587 call mpi_bcast(num_igr_iters, 1, mpi_integer, 0, mpi_comm_world, ierr)
588 call mpi_bcast(num_igr_warm_start_iters, 1, mpi_integer, 0, mpi_comm_world, ierr)
589 call mpi_bcast(num_particle_clouds, 1, mpi_integer, 0, mpi_comm_world, ierr)
590 call mpi_bcast(num_probes, 1, mpi_integer, 0, mpi_comm_world, ierr)
591 call mpi_bcast(num_source, 1, mpi_integer, 0, mpi_comm_world, ierr)
592 call mpi_bcast(num_stl_models, 1, mpi_integer, 0, mpi_comm_world, ierr)
593 call mpi_bcast(num_turbulent_sources, 1, mpi_integer, 0, mpi_comm_world, ierr)
594 call mpi_bcast(nv_uvm_igr_temps_on_gpu, 1, mpi_integer, 0, mpi_comm_world, ierr)
595 call mpi_bcast(p, 1, mpi_integer, 0, mpi_comm_world, ierr)
596 call mpi_bcast(precision, 1, mpi_integer, 0, mpi_comm_world, ierr)
597 call mpi_bcast(relax_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
598 call mpi_bcast(riemann_solver, 1, mpi_integer, 0, mpi_comm_world, ierr)
599 call mpi_bcast(synth_n_shells, 1, mpi_integer, 0, mpi_comm_world, ierr)
600 call mpi_bcast(synth_seed, 1, mpi_integer, 0, mpi_comm_world, ierr)
601 call mpi_bcast(t_step_old, 1, mpi_integer, 0, mpi_comm_world, ierr)
602 call mpi_bcast(t_step_print, 1, mpi_integer, 0, mpi_comm_world, ierr)
603 call mpi_bcast(t_step_save, 1, mpi_integer, 0, mpi_comm_world, ierr)
604 call mpi_bcast(t_step_start, 1, mpi_integer, 0, mpi_comm_world, ierr)
605 call mpi_bcast(t_step_stop, 1, mpi_integer, 0, mpi_comm_world, ierr)
606 call mpi_bcast(thermal, 1, mpi_integer, 0, mpi_comm_world, ierr)
607 call mpi_bcast(time_stepper, 1, mpi_integer, 0, mpi_comm_world, ierr)
608 call mpi_bcast(wave_speeds, 1, mpi_integer, 0, mpi_comm_world, ierr)
609
610 ! Logical scalars
611 call mpi_bcast(acoustic_source, 1, mpi_logical, 0, mpi_comm_world, ierr)
612 call mpi_bcast(adap_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
613 call mpi_bcast(adv_n, 1, mpi_logical, 0, mpi_comm_world, ierr)
614 call mpi_bcast(alt_soundspeed, 1, mpi_logical, 0, mpi_comm_world, ierr)
615 call mpi_bcast(bf_spatial_support, 1, mpi_logical, 0, mpi_comm_world, ierr)
616 call mpi_bcast(bf_x, 1, mpi_logical, 0, mpi_comm_world, ierr)
617 call mpi_bcast(bf_y, 1, mpi_logical, 0, mpi_comm_world, ierr)
618 call mpi_bcast(bf_z, 1, mpi_logical, 0, mpi_comm_world, ierr)
619 call mpi_bcast(bubbles_euler, 1, mpi_logical, 0, mpi_comm_world, ierr)
620 call mpi_bcast(bubbles_lagrange, 1, mpi_logical, 0, mpi_comm_world, ierr)
621 call mpi_bcast(cfl_adap_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
622 call mpi_bcast(cfl_const_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
623 call mpi_bcast(cont_damage, 1, mpi_logical, 0, mpi_comm_world, ierr)
624 call mpi_bcast(cyl_coord, 1, mpi_logical, 0, mpi_comm_world, ierr)
625 call mpi_bcast(down_sample, 1, mpi_logical, 0, mpi_comm_world, ierr)
626 call mpi_bcast(fft_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
627 call mpi_bcast(file_per_process, 1, mpi_logical, 0, mpi_comm_world, ierr)
628 call mpi_bcast(hll_u_interface, 1, mpi_logical, 0, mpi_comm_world, ierr)
629 call mpi_bcast(hyper_cleaning, 1, mpi_logical, 0, mpi_comm_world, ierr)
630 call mpi_bcast(hypo_hll_interface_rhs, 1, mpi_logical, 0, mpi_comm_world, ierr)
631 call mpi_bcast(hypoelasticity, 1, mpi_logical, 0, mpi_comm_world, ierr)
632 call mpi_bcast(ib, 1, mpi_logical, 0, mpi_comm_world, ierr)
633 call mpi_bcast(ib_state_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
634 call mpi_bcast(many_ib_patch_parallelism, 1, mpi_logical, 0, mpi_comm_world, ierr)
635 call mpi_bcast(mixture_err, 1, mpi_logical, 0, mpi_comm_world, ierr)
636 call mpi_bcast(mp_weno, 1, mpi_logical, 0, mpi_comm_world, ierr)
637 call mpi_bcast(mpp_lim, 1, mpi_logical, 0, mpi_comm_world, ierr)
638 call mpi_bcast(null_weights, 1, mpi_logical, 0, mpi_comm_world, ierr)
639 call mpi_bcast(nv_uvm_out_of_core, 1, mpi_logical, 0, mpi_comm_world, ierr)
640 call mpi_bcast(nv_uvm_pref_gpu, 1, mpi_logical, 0, mpi_comm_world, ierr)
641 call mpi_bcast(parallel_io, 1, mpi_logical, 0, mpi_comm_world, ierr)
642 call mpi_bcast(polydisperse, 1, mpi_logical, 0, mpi_comm_world, ierr)
643 call mpi_bcast(polytropic, 1, mpi_logical, 0, mpi_comm_world, ierr)
644 call mpi_bcast(prim_vars_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
645 call mpi_bcast(probe_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
646 call mpi_bcast(qbmm, 1, mpi_logical, 0, mpi_comm_world, ierr)
647 call mpi_bcast(rdma_mpi, 1, mpi_logical, 0, mpi_comm_world, ierr)
648 call mpi_bcast(reactive_burn, 1, mpi_logical, 0, mpi_comm_world, ierr)
649 call mpi_bcast(relax, 1, mpi_logical, 0, mpi_comm_world, ierr)
650 call mpi_bcast(riemann_hypo_adc, 1, mpi_logical, 0, mpi_comm_world, ierr)
651 call mpi_bcast(run_time_info, 1, mpi_logical, 0, mpi_comm_world, ierr)
652 call mpi_bcast(surface_tension, 1, mpi_logical, 0, mpi_comm_world, ierr)
653 call mpi_bcast(synthetic_turbulence, 1, mpi_logical, 0, mpi_comm_world, ierr)
654 call mpi_bcast(weno_re_flux, 1, mpi_logical, 0, mpi_comm_world, ierr)
655 call mpi_bcast(weno_avg, 1, mpi_logical, 0, mpi_comm_world, ierr)
656
657 ! Real scalars
658 call mpi_bcast(adc_kappa, 1, mpi_p, 0, mpi_comm_world, ierr)
659 call mpi_bcast(bx0, 1, mpi_p, 0, mpi_comm_world, ierr)
660 call mpi_bcast(ca, 1, mpi_p, 0, mpi_comm_world, ierr)
661 call mpi_bcast(r0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
662 call mpi_bcast(re_inv, 1, mpi_p, 0, mpi_comm_world, ierr)
663 call mpi_bcast(web, 1, mpi_p, 0, mpi_comm_world, ierr)
664 call mpi_bcast(adap_dt_tol, 1, mpi_p, 0, mpi_comm_world, ierr)
665 call mpi_bcast(alf_factor, 1, mpi_p, 0, mpi_comm_world, ierr)
666 call mpi_bcast(alpha_bar, 1, mpi_p, 0, mpi_comm_world, ierr)
667 call mpi_bcast(cfl_target, 1, mpi_p, 0, mpi_comm_world, ierr)
668 call mpi_bcast(coefficient_of_restitution, 1, mpi_p, 0, mpi_comm_world, ierr)
669 call mpi_bcast(collision_time, 1, mpi_p, 0, mpi_comm_world, ierr)
670 call mpi_bcast(cont_damage_s, 1, mpi_p, 0, mpi_comm_world, ierr)
671 call mpi_bcast(dt, 1, mpi_p, 0, mpi_comm_world, ierr)
672 call mpi_bcast(g_x, 1, mpi_p, 0, mpi_comm_world, ierr)
673 call mpi_bcast(g_y, 1, mpi_p, 0, mpi_comm_world, ierr)
674 call mpi_bcast(g_z, 1, mpi_p, 0, mpi_comm_world, ierr)
675 call mpi_bcast(hyper_cleaning_speed, 1, mpi_p, 0, mpi_comm_world, ierr)
676 call mpi_bcast(hyper_cleaning_tau, 1, mpi_p, 0, mpi_comm_world, ierr)
677 call mpi_bcast(ib_coefficient_of_friction, 1, mpi_p, 0, mpi_comm_world, ierr)
678 call mpi_bcast(ic_beta, 1, mpi_p, 0, mpi_comm_world, ierr)
679 call mpi_bcast(ic_eps, 1, mpi_p, 0, mpi_comm_world, ierr)
680 call mpi_bcast(k_x, 1, mpi_p, 0, mpi_comm_world, ierr)
681 call mpi_bcast(k_y, 1, mpi_p, 0, mpi_comm_world, ierr)
682 call mpi_bcast(k_z, 1, mpi_p, 0, mpi_comm_world, ierr)
683 call mpi_bcast(muscl_eps, 1, mpi_p, 0, mpi_comm_world, ierr)
684 call mpi_bcast(p_x, 1, mpi_p, 0, mpi_comm_world, ierr)
685 call mpi_bcast(p_y, 1, mpi_p, 0, mpi_comm_world, ierr)
686 call mpi_bcast(p_z, 1, mpi_p, 0, mpi_comm_world, ierr)
687 call mpi_bcast(palpha_eps, 1, mpi_p, 0, mpi_comm_world, ierr)
688 call mpi_bcast(pi_fac, 1, mpi_p, 0, mpi_comm_world, ierr)
689 call mpi_bcast(poly_sigma, 1, mpi_p, 0, mpi_comm_world, ierr)
690 call mpi_bcast(ptgalpha_eps, 1, mpi_p, 0, mpi_comm_world, ierr)
691 call mpi_bcast(sigma, 1, mpi_p, 0, mpi_comm_world, ierr)
692 call mpi_bcast(synth_u_inf, 1, mpi_p, 0, mpi_comm_world, ierr)
693 call mpi_bcast(t_save, 1, mpi_p, 0, mpi_comm_world, ierr)
694 call mpi_bcast(t_stop, 1, mpi_p, 0, mpi_comm_world, ierr)
695 call mpi_bcast(tau_star, 1, mpi_p, 0, mpi_comm_world, ierr)
696 call mpi_bcast(teno_ct, 1, mpi_p, 0, mpi_comm_world, ierr)
697 call mpi_bcast(w_x, 1, mpi_p, 0, mpi_comm_world, ierr)
698 call mpi_bcast(w_y, 1, mpi_p, 0, mpi_comm_world, ierr)
699 call mpi_bcast(w_z, 1, mpi_p, 0, mpi_comm_world, ierr)
700 call mpi_bcast(weno_eps, 1, mpi_p, 0, mpi_comm_world, ierr)
701
702 ! Case-optimization scalars (absent when constants are baked in)
703# 137 "/home/runner/work/MFC/MFC/build/include/simulation/generated_bcast.fpp"
704 call mpi_bcast(igr_iter_solver, 1, mpi_integer, 0, mpi_comm_world, ierr)
705 call mpi_bcast(igr_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
706 call mpi_bcast(muscl_lim, 1, mpi_integer, 0, mpi_comm_world, ierr)
707 call mpi_bcast(muscl_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
708 call mpi_bcast(nb, 1, mpi_integer, 0, mpi_comm_world, ierr)
709 call mpi_bcast(num_fluids, 1, mpi_integer, 0, mpi_comm_world, ierr)
710 call mpi_bcast(recon_type, 1, mpi_integer, 0, mpi_comm_world, ierr)
711 call mpi_bcast(weno_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
712 call mpi_bcast(igr, 1, mpi_logical, 0, mpi_comm_world, ierr)
713 call mpi_bcast(igr_pres_lim, 1, mpi_logical, 0, mpi_comm_world, ierr)
714 call mpi_bcast(mapped_weno, 1, mpi_logical, 0, mpi_comm_world, ierr)
715 call mpi_bcast(mhd, 1, mpi_logical, 0, mpi_comm_world, ierr)
716 call mpi_bcast(relativity, 1, mpi_logical, 0, mpi_comm_world, ierr)
717 call mpi_bcast(teno, 1, mpi_logical, 0, mpi_comm_world, ierr)
718 call mpi_bcast(viscous, 1, mpi_logical, 0, mpi_comm_world, ierr)
719 call mpi_bcast(wenoz, 1, mpi_logical, 0, mpi_comm_world, ierr)
720 call mpi_bcast(wenoz_q, 1, mpi_p, 0, mpi_comm_world, ierr)
721# 155 "/home/runner/work/MFC/MFC/build/include/simulation/generated_bcast.fpp"
722
723 ! fluid_pp member loop
724 do i = 1, num_fluids_max
725 call mpi_bcast(fluid_pp(i)%G, 1, mpi_p, 0, mpi_comm_world, ierr)
726 call mpi_bcast(fluid_pp(i)%K, 1, mpi_p, 0, mpi_comm_world, ierr)
727 call mpi_bcast(fluid_pp(i)%cv, 1, mpi_p, 0, mpi_comm_world, ierr)
728 call mpi_bcast(fluid_pp(i)%eos, 1, mpi_integer, 0, mpi_comm_world, ierr)
729 call mpi_bcast(fluid_pp(i)%gamma, 1, mpi_p, 0, mpi_comm_world, ierr)
730 call mpi_bcast(fluid_pp(i)%hb_m, 1, mpi_p, 0, mpi_comm_world, ierr)
731 call mpi_bcast(fluid_pp(i)%mu_bulk, 1, mpi_p, 0, mpi_comm_world, ierr)
732 call mpi_bcast(fluid_pp(i)%mu_max, 1, mpi_p, 0, mpi_comm_world, ierr)
733 call mpi_bcast(fluid_pp(i)%mu_min, 1, mpi_p, 0, mpi_comm_world, ierr)
734 call mpi_bcast(fluid_pp(i)%nn, 1, mpi_p, 0, mpi_comm_world, ierr)
735 call mpi_bcast(fluid_pp(i)%non_newtonian, 1, mpi_logical, 0, mpi_comm_world, ierr)
736 call mpi_bcast(fluid_pp(i)%pi_inf, 1, mpi_p, 0, mpi_comm_world, ierr)
737 call mpi_bcast(fluid_pp(i)%qv, 1, mpi_p, 0, mpi_comm_world, ierr)
738 call mpi_bcast(fluid_pp(i)%qvp, 1, mpi_p, 0, mpi_comm_world, ierr)
739 call mpi_bcast(fluid_pp(i)%tau0, 1, mpi_p, 0, mpi_comm_world, ierr)
740 call mpi_bcast(fluid_pp(i)%Re(1), 2, mpi_p, 0, mpi_comm_world, ierr)
741 end do
742
743 ! bub_pp members (under bubbles guard)
744 if (bubbles_euler .or. bubbles_lagrange) then
745 call mpi_bcast(bub_pp%M_g, 1, mpi_p, 0, mpi_comm_world, ierr)
746 call mpi_bcast(bub_pp%M_v, 1, mpi_p, 0, mpi_comm_world, ierr)
747 call mpi_bcast(bub_pp%R0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
748 call mpi_bcast(bub_pp%R_g, 1, mpi_p, 0, mpi_comm_world, ierr)
749 call mpi_bcast(bub_pp%R_v, 1, mpi_p, 0, mpi_comm_world, ierr)
750 call mpi_bcast(bub_pp%T0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
751 call mpi_bcast(bub_pp%cp_g, 1, mpi_p, 0, mpi_comm_world, ierr)
752 call mpi_bcast(bub_pp%cp_v, 1, mpi_p, 0, mpi_comm_world, ierr)
753 call mpi_bcast(bub_pp%gam_g, 1, mpi_p, 0, mpi_comm_world, ierr)
754 call mpi_bcast(bub_pp%gam_v, 1, mpi_p, 0, mpi_comm_world, ierr)
755 call mpi_bcast(bub_pp%k_g, 1, mpi_p, 0, mpi_comm_world, ierr)
756 call mpi_bcast(bub_pp%k_v, 1, mpi_p, 0, mpi_comm_world, ierr)
757 call mpi_bcast(bub_pp%mu_g, 1, mpi_p, 0, mpi_comm_world, ierr)
758 call mpi_bcast(bub_pp%mu_l, 1, mpi_p, 0, mpi_comm_world, ierr)
759 call mpi_bcast(bub_pp%mu_v, 1, mpi_p, 0, mpi_comm_world, ierr)
760 call mpi_bcast(bub_pp%p0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
761 call mpi_bcast(bub_pp%pv, 1, mpi_p, 0, mpi_comm_world, ierr)
762 call mpi_bcast(bub_pp%rho0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
763 call mpi_bcast(bub_pp%ss, 1, mpi_p, 0, mpi_comm_world, ierr)
764 call mpi_bcast(bub_pp%vd, 1, mpi_p, 0, mpi_comm_world, ierr)
765 end if
766
767 ! lag_params members (under bubbles_lagrange guard)
768 if (bubbles_lagrange) then
769 call mpi_bcast(lag_params%gravity_force, 1, mpi_logical, 0, mpi_comm_world, ierr)
770 call mpi_bcast(lag_params%heatTransfer_model, 1, mpi_logical, 0, mpi_comm_world, ierr)
771 call mpi_bcast(lag_params%kahan_summation, 1, mpi_logical, 0, mpi_comm_world, ierr)
772 call mpi_bcast(lag_params%massTransfer_model, 1, mpi_logical, 0, mpi_comm_world, ierr)
773 call mpi_bcast(lag_params%pressure_corrector, 1, mpi_logical, 0, mpi_comm_world, ierr)
774 call mpi_bcast(lag_params%pressure_force, 1, mpi_logical, 0, mpi_comm_world, ierr)
775 call mpi_bcast(lag_params%write_bubbles, 1, mpi_logical, 0, mpi_comm_world, ierr)
776 call mpi_bcast(lag_params%write_bubbles_stats, 1, mpi_logical, 0, mpi_comm_world, ierr)
777 call mpi_bcast(lag_params%write_void_evol, 1, mpi_logical, 0, mpi_comm_world, ierr)
778 call mpi_bcast(lag_params%charNz, 1, mpi_integer, 0, mpi_comm_world, ierr)
779 call mpi_bcast(lag_params%cluster_type, 1, mpi_integer, 0, mpi_comm_world, ierr)
780 call mpi_bcast(lag_params%drag_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
781 call mpi_bcast(lag_params%nBubs_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
782 call mpi_bcast(lag_params%smooth_type, 1, mpi_integer, 0, mpi_comm_world, ierr)
783 call mpi_bcast(lag_params%solver_approach, 1, mpi_integer, 0, mpi_comm_world, ierr)
784 call mpi_bcast(lag_params%vel_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
785 call mpi_bcast(lag_params%charwidth, 1, mpi_p, 0, mpi_comm_world, ierr)
786 call mpi_bcast(lag_params%epsilonb, 1, mpi_p, 0, mpi_comm_world, ierr)
787 call mpi_bcast(lag_params%valmaxvoid, 1, mpi_p, 0, mpi_comm_world, ierr)
788 call mpi_bcast(lag_params%input_path, len(lag_params%input_path), mpi_character, 0, mpi_comm_world, ierr)
789 end if
790
791 ! chem_params members (under chemistry guard)
792 if (chemistry) then
793 call mpi_bcast(chem_params%adap_substeps, 1, mpi_logical, 0, mpi_comm_world, ierr)
794 call mpi_bcast(chem_params%diffusion, 1, mpi_logical, 0, mpi_comm_world, ierr)
795 call mpi_bcast(chem_params%reactions, 1, mpi_logical, 0, mpi_comm_world, ierr)
796 call mpi_bcast(chem_params%gamma_method, 1, mpi_integer, 0, mpi_comm_world, ierr)
797 call mpi_bcast(chem_params%reaction_substeps, 1, mpi_integer, 0, mpi_comm_world, ierr)
798 call mpi_bcast(chem_params%reaction_substeps_max, 1, mpi_integer, 0, mpi_comm_world, ierr)
799 call mpi_bcast(chem_params%transport_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
800 end if
801
802 ! rburn members (under reactive_burn guard)
803 if (reactive_burn) then
804 call mpi_bcast(rburn%k, 1, mpi_p, 0, mpi_comm_world, ierr)
805 call mpi_bcast(rburn%n, 1, mpi_p, 0, mpi_comm_world, ierr)
806 call mpi_bcast(rburn%pign, 1, mpi_p, 0, mpi_comm_world, ierr)
807 call mpi_bcast(rburn%pref, 1, mpi_p, 0, mpi_comm_world, ierr)
808 call mpi_bcast(rburn%ta, 1, mpi_p, 0, mpi_comm_world, ierr)
809 end if
810
811# 113 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp" 2
812
813 ! manual: m_glb, n_glb, p_glb (computed in s_read_input_file, not namelist-bound)
814 call mpi_bcast(m_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
815 call mpi_bcast(n_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
816 call mpi_bcast(p_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
817
818 ! manual: bc_x/y/z member broadcasts (struct members not in NAMELIST_VARS)
819# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
820 call mpi_bcast(bc_x%beg, 1, mpi_integer, 0, mpi_comm_world, ierr)
821# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
822 call mpi_bcast(bc_x%end, 1, mpi_integer, 0, mpi_comm_world, ierr)
823# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
824 call mpi_bcast(bc_y%beg, 1, mpi_integer, 0, mpi_comm_world, ierr)
825# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
826 call mpi_bcast(bc_y%end, 1, mpi_integer, 0, mpi_comm_world, ierr)
827# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
828 call mpi_bcast(bc_z%beg, 1, mpi_integer, 0, mpi_comm_world, ierr)
829# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
830 call mpi_bcast(bc_z%end, 1, mpi_integer, 0, mpi_comm_world, ierr)
831# 123 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
832
833# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
834 call mpi_bcast(bc_x%grcbc_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
835# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
836 call mpi_bcast(bc_x%grcbc_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
837# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
838 call mpi_bcast(bc_x%grcbc_vel_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
839# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
840 call mpi_bcast(bc_y%grcbc_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
841# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
842 call mpi_bcast(bc_y%grcbc_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
843# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
844 call mpi_bcast(bc_y%grcbc_vel_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
845# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
846 call mpi_bcast(bc_z%grcbc_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
847# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
848 call mpi_bcast(bc_z%grcbc_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
849# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
850 call mpi_bcast(bc_z%grcbc_vel_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
851# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
852 call mpi_bcast(bc_x%isothermal_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
853# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
854 call mpi_bcast(bc_y%isothermal_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
855# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
856 call mpi_bcast(bc_z%isothermal_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
857# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
858 call mpi_bcast(bc_x%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
859# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
860 call mpi_bcast(bc_y%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
861# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
862 call mpi_bcast(bc_z%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
863# 131 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
864
865# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
866 call mpi_bcast(bc_x%vb1, 1, mpi_p, 0, mpi_comm_world, ierr)
867# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
868 call mpi_bcast(bc_x%vb2, 1, mpi_p, 0, mpi_comm_world, ierr)
869# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
870 call mpi_bcast(bc_x%vb3, 1, mpi_p, 0, mpi_comm_world, ierr)
871# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
872 call mpi_bcast(bc_x%ve1, 1, mpi_p, 0, mpi_comm_world, ierr)
873# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
874 call mpi_bcast(bc_x%ve2, 1, mpi_p, 0, mpi_comm_world, ierr)
875# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
876 call mpi_bcast(bc_x%ve3, 1, mpi_p, 0, mpi_comm_world, ierr)
877# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
878 call mpi_bcast(bc_y%vb1, 1, mpi_p, 0, mpi_comm_world, ierr)
879# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
880 call mpi_bcast(bc_y%vb2, 1, mpi_p, 0, mpi_comm_world, ierr)
881# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
882 call mpi_bcast(bc_y%vb3, 1, mpi_p, 0, mpi_comm_world, ierr)
883# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
884 call mpi_bcast(bc_y%ve1, 1, mpi_p, 0, mpi_comm_world, ierr)
885# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
886 call mpi_bcast(bc_y%ve2, 1, mpi_p, 0, mpi_comm_world, ierr)
887# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
888 call mpi_bcast(bc_y%ve3, 1, mpi_p, 0, mpi_comm_world, ierr)
889# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
890 call mpi_bcast(bc_z%vb1, 1, mpi_p, 0, mpi_comm_world, ierr)
891# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
892 call mpi_bcast(bc_z%vb2, 1, mpi_p, 0, mpi_comm_world, ierr)
893# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
894 call mpi_bcast(bc_z%vb3, 1, mpi_p, 0, mpi_comm_world, ierr)
895# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
896 call mpi_bcast(bc_z%ve1, 1, mpi_p, 0, mpi_comm_world, ierr)
897# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
898 call mpi_bcast(bc_z%ve2, 1, mpi_p, 0, mpi_comm_world, ierr)
899# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
900 call mpi_bcast(bc_z%ve3, 1, mpi_p, 0, mpi_comm_world, ierr)
901# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
902 call mpi_bcast(bc_x%pres_in, 1, mpi_p, 0, mpi_comm_world, ierr)
903# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
904 call mpi_bcast(bc_x%pres_out, 1, mpi_p, 0, mpi_comm_world, ierr)
905# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
906 call mpi_bcast(bc_y%pres_in, 1, mpi_p, 0, mpi_comm_world, ierr)
907# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
908 call mpi_bcast(bc_y%pres_out, 1, mpi_p, 0, mpi_comm_world, ierr)
909# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
910 call mpi_bcast(bc_z%pres_in, 1, mpi_p, 0, mpi_comm_world, ierr)
911# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
912 call mpi_bcast(bc_z%pres_out, 1, mpi_p, 0, mpi_comm_world, ierr)
913# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
914 call mpi_bcast(bc_x%Twall_in, 1, mpi_p, 0, mpi_comm_world, ierr)
915# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
916 call mpi_bcast(bc_x%Twall_out, 1, mpi_p, 0, mpi_comm_world, ierr)
917# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
918 call mpi_bcast(bc_y%Twall_in, 1, mpi_p, 0, mpi_comm_world, ierr)
919# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
920 call mpi_bcast(bc_y%Twall_out, 1, mpi_p, 0, mpi_comm_world, ierr)
921# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
922 call mpi_bcast(bc_z%Twall_in, 1, mpi_p, 0, mpi_comm_world, ierr)
923# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
924 call mpi_bcast(bc_z%Twall_out, 1, mpi_p, 0, mpi_comm_world, ierr)
925# 141 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
926
927 do i = 1, 3
928# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
929 call mpi_bcast(bc_x%vel_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
930# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
931 call mpi_bcast(bc_x%vel_out (i), 1, mpi_p, 0, mpi_comm_world, ierr)
932# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
933 call mpi_bcast(bc_y%vel_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
934# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
935 call mpi_bcast(bc_y%vel_out (i), 1, mpi_p, 0, mpi_comm_world, ierr)
936# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
937 call mpi_bcast(bc_z%vel_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
938# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
939 call mpi_bcast(bc_z%vel_out (i), 1, mpi_p, 0, mpi_comm_world, ierr)
940# 147 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
941 end do
942
943 ! manual: cfl_dt (runtime-computed logical), bc_io (BC-file existence)
944 call mpi_bcast(cfl_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
945 call mpi_bcast(bc_io, 1, mpi_logical, 0, mpi_comm_world, ierr)
946
947 ! manual: shear_stress, bulk_stress (derived from Re_size post-init on all ranks),
948 ! bodyForces (derived from bf_x/y/z)
949 call mpi_bcast(shear_stress, 1, mpi_logical, 0, mpi_comm_world, ierr)
950 call mpi_bcast(bulk_stress, 1, mpi_logical, 0, mpi_comm_world, ierr)
951 call mpi_bcast(bodyforces, 1, mpi_logical, 0, mpi_comm_world, ierr)
952
953 ! manual: bc_x per-fluid inflow arrays (loop over num_fluids_max)
954 do i = 1, num_fluids_max
955# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
956 call mpi_bcast(bc_x%alpha_rho_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
957# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
958 call mpi_bcast(bc_x%alpha_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
959# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
960 call mpi_bcast(bc_y%alpha_rho_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
961# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
962 call mpi_bcast(bc_y%alpha_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
963# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
964 call mpi_bcast(bc_z%alpha_rho_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
965# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
966 call mpi_bcast(bc_z%alpha_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
967# 165 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
968 end do
969
970 ! manual: patch_ib (sim member subset differs from pre; uses count=3, adds mass/moving_ibm)
971 do i = 1, num_ibs
972# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
973 call mpi_bcast(patch_ib(i)%radius, 1, mpi_p, 0, mpi_comm_world, ierr)
974# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
975 call mpi_bcast(patch_ib(i)%length_x, 1, mpi_p, 0, mpi_comm_world, ierr)
976# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
977 call mpi_bcast(patch_ib(i)%length_y, 1, mpi_p, 0, mpi_comm_world, ierr)
978# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
979 call mpi_bcast(patch_ib(i)%length_z, 1, mpi_p, 0, mpi_comm_world, ierr)
980# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
981 call mpi_bcast(patch_ib(i)%x_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
982# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
983 call mpi_bcast(patch_ib(i)%y_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
984# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
985 call mpi_bcast(patch_ib(i)%z_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
986# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
987 call mpi_bcast(patch_ib(i)%slip, 1, mpi_p, 0, mpi_comm_world, ierr)
988# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
989 call mpi_bcast(patch_ib(i)%mass, 1, mpi_p, 0, mpi_comm_world, ierr)
990# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
991 call mpi_bcast(patch_ib(i)%v_blow, 1, mpi_p, 0, mpi_comm_world, ierr)
992# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
993 call mpi_bcast(patch_ib(i)%burn_rate_exp, 1, mpi_p, 0, mpi_comm_world, ierr)
994# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
995 call mpi_bcast(patch_ib(i)%burn_rate_pref, 1, mpi_p, 0, mpi_comm_world, ierr)
996# 174 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
997# 175 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
998 call mpi_bcast(patch_ib(i)%vel, 3, mpi_p, 0, mpi_comm_world, ierr)
999# 175 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1000 call mpi_bcast(patch_ib(i)%angular_vel, 3, mpi_p, 0, mpi_comm_world, ierr)
1001# 175 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1002 call mpi_bcast(patch_ib(i)%angles, 3, mpi_p, 0, mpi_comm_world, ierr)
1003# 177 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1004 call mpi_bcast(patch_ib(i)%geometry, 1, mpi_integer, 0, mpi_comm_world, ierr)
1005 call mpi_bcast(patch_ib(i)%moving_ibm, 1, mpi_integer, 0, mpi_comm_world, ierr)
1006 call mpi_bcast(patch_ib(i)%airfoil_id, 1, mpi_integer, 0, mpi_comm_world, ierr)
1007 call mpi_bcast(patch_ib(i)%model_id, 1, mpi_integer, 0, mpi_comm_world, ierr)
1008 call mpi_bcast(patch_ib(i)%inj_species, 1, mpi_integer, 0, mpi_comm_world, ierr)
1009 end do
1010
1011 ! manual: ib_airfoil (kept manual alongside patch_ib)
1012 do i = 1, num_ib_airfoils_max
1013# 187 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1014 call mpi_bcast(ib_airfoil(i)%c, 1, mpi_p, 0, mpi_comm_world, ierr)
1015# 187 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1016 call mpi_bcast(ib_airfoil(i)%p, 1, mpi_p, 0, mpi_comm_world, ierr)
1017# 187 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1018 call mpi_bcast(ib_airfoil(i)%t, 1, mpi_p, 0, mpi_comm_world, ierr)
1019# 187 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1020 call mpi_bcast(ib_airfoil(i)%m, 1, mpi_p, 0, mpi_comm_world, ierr)
1021# 189 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1022 end do
1023
1024 ! manual: stl_models loop (num_stl_models scalar is generated; grouped array members)
1025 do i = 1, num_stl_models_max
1026 call mpi_bcast(stl_models(i)%model_filepath, len(stl_models(i)%model_filepath), mpi_character, 0, mpi_comm_world, ierr)
1027 call mpi_bcast(stl_models(i)%model_threshold, 1, mpi_p, 0, mpi_comm_world, ierr)
1028# 196 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1029 call mpi_bcast(stl_models(i)%model_translate, 3, mpi_p, 0, mpi_comm_world, ierr)
1030# 196 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1031 call mpi_bcast(stl_models(i)%model_scale, 3, mpi_p, 0, mpi_comm_world, ierr)
1032# 198 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1033 end do
1034
1035 ! manual: particle_cloud (runtime loop to num_particle_clouds; irregular member subset)
1036 do i = 1, num_particle_clouds
1037# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1038 call mpi_bcast(particle_cloud(i)%x_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1039# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1040 call mpi_bcast(particle_cloud(i)%y_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1041# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1042 call mpi_bcast(particle_cloud(i)%z_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1043# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1044 call mpi_bcast(particle_cloud(i)%length_x, 1, mpi_p, 0, mpi_comm_world, ierr)
1045# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1046 call mpi_bcast(particle_cloud(i)%length_y, 1, mpi_p, 0, mpi_comm_world, ierr)
1047# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1048 call mpi_bcast(particle_cloud(i)%length_z, 1, mpi_p, 0, mpi_comm_world, ierr)
1049# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1050 call mpi_bcast(particle_cloud(i)%radius, 1, mpi_p, 0, mpi_comm_world, ierr)
1051# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1052 call mpi_bcast(particle_cloud(i)%mass, 1, mpi_p, 0, mpi_comm_world, ierr)
1053# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1054 call mpi_bcast(particle_cloud(i)%min_spacing, 1, mpi_p, 0, mpi_comm_world, ierr)
1055# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1056 call mpi_bcast(particle_cloud(i)%shell_inner_radius, 1, mpi_p, 0, mpi_comm_world, ierr)
1057# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1058 call mpi_bcast(particle_cloud(i)%shell_outer_radius, 1, mpi_p, 0, mpi_comm_world, ierr)
1059# 206 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1060 call mpi_bcast(particle_cloud(i)%num_particles, 1, mpi_integer, 0, mpi_comm_world, ierr)
1061 call mpi_bcast(particle_cloud(i)%moving_ibm, 1, mpi_integer, 0, mpi_comm_world, ierr)
1062 call mpi_bcast(particle_cloud(i)%seed, 1, mpi_integer, 0, mpi_comm_world, ierr)
1063 call mpi_bcast(particle_cloud(i)%cloud_geometry, 1, mpi_integer, 0, mpi_comm_world, ierr)
1064 call mpi_bcast(particle_cloud(i)%packing_method, 1, mpi_integer, 0, mpi_comm_world, ierr)
1065 call mpi_bcast(particle_cloud(i)%periodic, 1, mpi_integer, 0, mpi_comm_world, ierr)
1066 end do
1067
1068 ! manual: acoustic/probe (combined loop; complex acoustic member set)
1069 do j = 1, num_probes_max
1070 do i = 1, 3
1071 call mpi_bcast(acoustic(j)%loc(i), 1, mpi_p, 0, mpi_comm_world, ierr)
1072 end do
1073
1074 call mpi_bcast(acoustic(j)%dipole, 1, mpi_logical, 0, mpi_comm_world, ierr)
1075
1076# 223 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1077 call mpi_bcast(acoustic(j)%pulse, 1, mpi_integer, 0, mpi_comm_world, ierr)
1078# 223 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1079 call mpi_bcast(acoustic(j)%support, 1, mpi_integer, 0, mpi_comm_world, ierr)
1080# 223 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1081 call mpi_bcast(acoustic(j)%num_elements, 1, mpi_integer, 0, mpi_comm_world, ierr)
1082# 223 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1083 call mpi_bcast(acoustic(j)%element_on, 1, mpi_integer, 0, mpi_comm_world, ierr)
1084# 223 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1085 call mpi_bcast(acoustic(j)%bb_num_freq, 1, mpi_integer, 0, mpi_comm_world, ierr)
1086# 225 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1087
1088# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1089 call mpi_bcast(acoustic(j)%mag, 1, mpi_p, 0, mpi_comm_world, ierr)
1090# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1091 call mpi_bcast(acoustic(j)%length, 1, mpi_p, 0, mpi_comm_world, ierr)
1092# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1093 call mpi_bcast(acoustic(j)%height, 1, mpi_p, 0, mpi_comm_world, ierr)
1094# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1095 call mpi_bcast(acoustic(j)%wavelength, 1, mpi_p, 0, mpi_comm_world, ierr)
1096# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1097 call mpi_bcast(acoustic(j)%frequency, 1, mpi_p, 0, mpi_comm_world, ierr)
1098# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1099 call mpi_bcast(acoustic(j)%gauss_sigma_dist, 1, mpi_p, 0, mpi_comm_world, ierr)
1100# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1101 call mpi_bcast(acoustic(j)%gauss_sigma_time, 1, mpi_p, 0, mpi_comm_world, ierr)
1102# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1103 call mpi_bcast(acoustic(j)%npulse, 1, mpi_p, 0, mpi_comm_world, ierr)
1104# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1105 call mpi_bcast(acoustic(j)%dir, 1, mpi_p, 0, mpi_comm_world, ierr)
1106# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1107 call mpi_bcast(acoustic(j)%delay, 1, mpi_p, 0, mpi_comm_world, ierr)
1108# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1109 call mpi_bcast(acoustic(j)%foc_length, 1, mpi_p, 0, mpi_comm_world, ierr)
1110# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1111 call mpi_bcast(acoustic(j)%aperture, 1, mpi_p, 0, mpi_comm_world, ierr)
1112# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1113 call mpi_bcast(acoustic(j)%element_spacing_angle, 1, mpi_p, 0, mpi_comm_world, ierr)
1114# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1115 call mpi_bcast(acoustic(j)%element_polygon_ratio, 1, mpi_p, 0, mpi_comm_world, ierr)
1116# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1117 call mpi_bcast(acoustic(j)%rotate_angle, 1, mpi_p, 0, mpi_comm_world, ierr)
1118# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1119 call mpi_bcast(acoustic(j)%bb_bandwidth, 1, mpi_p, 0, mpi_comm_world, ierr)
1120# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1121 call mpi_bcast(acoustic(j)%bb_lowest_freq, 1, mpi_p, 0, mpi_comm_world, ierr)
1122# 233 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1123
1124# 235 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1125 call mpi_bcast(probe(j)%x, 1, mpi_p, 0, mpi_comm_world, ierr)
1126# 235 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1127 call mpi_bcast(probe(j)%y, 1, mpi_p, 0, mpi_comm_world, ierr)
1128# 235 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1129 call mpi_bcast(probe(j)%z, 1, mpi_p, 0, mpi_comm_world, ierr)
1130# 237 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1131 end do
1132
1133 ! manual: spatial-support body-force derived-type members (the bf_spatial_support toggle is broadcast by
1134 ! generated_bcast.fpp)
1135# 242 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1136 call mpi_bcast(spatial_bf%amp, 1, mpi_p, 0, mpi_comm_world, ierr)
1137# 242 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1138 call mpi_bcast(spatial_bf%x_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1139# 242 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1140 call mpi_bcast(spatial_bf%y_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1141# 242 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1142 call mpi_bcast(spatial_bf%sigma, 1, mpi_p, 0, mpi_comm_world, ierr)
1143# 242 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1144 call mpi_bcast(spatial_bf%conv_vel, 1, mpi_p, 0, mpi_comm_world, ierr)
1145# 244 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1146 call mpi_bcast(spatial_bf%freq, 8, mpi_p, 0, mpi_comm_world, ierr)
1147 call mpi_bcast(spatial_bf%phase, 8, mpi_p, 0, mpi_comm_world, ierr)
1148
1149 ! manual: synthetic turbulence namelist arrays (registered as indexed
1150 ! variants only; scalars are broadcast by generated_bcast.fpp)
1151 call mpi_bcast(synth_n_waves_per_shell, num_synth_shells_max, mpi_integer, 0, mpi_comm_world, ierr)
1152 call mpi_bcast(synth_k_shell, num_synth_shells_max, mpi_p, 0, mpi_comm_world, ierr)
1153 call mpi_bcast(synth_amp_shell, num_synth_shells_max, mpi_p, 0, mpi_comm_world, ierr)
1154 call mpi_bcast(turb_pos, num_turb_sources_max*3, mpi_p, 0, mpi_comm_world, ierr)
1155 call mpi_bcast(synth_l, num_turb_sources_max*3, mpi_p, 0, mpi_comm_world, ierr)
1156#endif
1157
1158 end subroutine s_mpi_bcast_user_inputs
1159
1160 !> Adds particles to the transfer list for the MPI communication.
1161 !! @param nBub Current LOCAL number of bubbles
1162 !! @param pos Current position of each bubble
1163 !! @param posPrev Previous position of each bubble (optional, not used
1164 !! for communication of initial condition)
1165 impure subroutine s_add_particles_to_transfer_list(nBub, pos, posPrev)
1166
1167 integer, intent(in) :: nbub
1168 real(wp), dimension(:,:), intent(in) :: pos, posprev
1169 integer :: bubid
1170 integer :: i, j, k
1171 integer :: dx, dy, dz
1172
1173 do k = nidx(3)%beg, nidx(3)%end
1174 do j = nidx(2)%beg, nidx(2)%end
1175 do i = nidx(1)%beg, nidx(1)%end
1176 p_send_counts(i, j, k) = 0
1177 end do
1178 end do
1179 end do
1180
1181 do k = 1, nbub
1182 dx = 0; dy = 0; dz = 0
1183 if (f_crosses_boundary(k, 1, -1, pos, posprev)) then
1184 dx = -1
1185 else if (f_crosses_boundary(k, 1, 1, pos, posprev)) then
1186 dx = 1
1187 end if
1188 if (n > 0) then
1189 if (f_crosses_boundary(k, 2, -1, pos, posprev)) then
1190 dy = -1
1191 else if (f_crosses_boundary(k, 2, 1, pos, posprev)) then
1192 dy = 1
1193 end if
1194 end if
1195 if (p > 0) then
1196 if (f_crosses_boundary(k, 3, -1, pos, posprev)) then
1197 dz = -1
1198 else if (f_crosses_boundary(k, 3, 1, pos, posprev)) then
1199 dz = 1
1200 end if
1201 end if
1202 if (abs(dx) + abs(dy) + abs(dz) /= 0) then
1203 call s_add_particle_to_direction(k, dx, dy, dz)
1204 end if
1205 end do
1206
1207 contains
1208
1209 logical function f_crosses_boundary(particle_id, dir, loc, pos, posPrev)
1210
1211 integer, intent(in) :: particle_id, dir, loc
1212 real(wp), dimension(:,:), intent(in) :: pos
1213 real(wp), dimension(:,:), optional, intent(in) :: posprev
1214
1215 if (loc == -1) then ! Beginning of the domain
1216 if (nidx(dir)%beg == 0) then
1217 f_crosses_boundary = .false.
1218 return
1219 end if
1220
1221 f_crosses_boundary = (posprev(particle_id, dir) >= pcomm_coords(dir)%beg .and. pos(particle_id, &
1222 & dir) < pcomm_coords(dir)%beg)
1223 else if (loc == 1) then ! End of the domain
1224 if (nidx(dir)%end == 0) then
1225 f_crosses_boundary = .false.
1226 return
1227 end if
1228
1229 f_crosses_boundary = (posprev(particle_id, dir) <= pcomm_coords(dir)%end .and. pos(particle_id, &
1230 & dir) > pcomm_coords(dir)%end)
1231 end if
1232
1233 end function f_crosses_boundary
1234
1235 subroutine s_add_particle_to_direction(particle_id, dir_x, dir_y, dir_z)
1236
1237 integer, intent(in) :: particle_id, dir_x, dir_y, dir_z
1238
1239 p_send_ids(dir_x, dir_y, dir_z, p_send_counts(dir_x, dir_y, dir_z)) = particle_id
1240 p_send_counts(dir_x, dir_y, dir_z) = p_send_counts(dir_x, dir_y, dir_z) + 1
1241
1242 end subroutine s_add_particle_to_direction
1243
1245
1246 !> Perform the MPI communication for lagrangian particles/bubbles.
1247 impure subroutine s_mpi_sendrecv_particles(bub_R0, Rmax_stats, Rmin_stats, gas_mg, gas_betaT, gas_betaC, bub_dphidt, lag_id, &
1248 & gas_p, gas_mv, rad, rvel, pos, posPrev, vel, scoord, drad, drvel, dgasp, dgasmv, dpos, dvel, lag_num_ts, nbubs, dest)
1249
1250 real(wp), dimension(:) :: bub_r0, rmax_stats, rmin_stats, gas_mg, gas_betat, gas_betac, bub_dphidt
1251 integer, dimension(:,:) :: lag_id
1252 real(wp), dimension(:,:) :: gas_p, gas_mv, rad, rvel, drad, drvel, dgasp, dgasmv
1253 real(wp), dimension(:,:,:) :: pos, posprev, vel, scoord, dpos, dvel
1254 integer :: position, bub_id, lag_num_ts, tag, partner, send_tag, recv_tag, nbubs, p_recv_size, dest
1255 integer :: i, j, k, l, q, r
1256 integer :: req_send, req_recv, ierr !< Generic flag used to identify and report MPI errors
1257 integer :: send_count, send_offset, recv_count, recv_offset
1258
1259#ifdef MFC_MPI
1260 ! Phase 1: Exchange particle counts using non-blocking communication
1261 send_count = 0
1262 recv_count = 0
1263
1264 ! Post all receives first
1265 do l = 1, n_neighbors
1266 i = neighbor_list(l, 1)
1267 j = neighbor_list(l, 2)
1268 k = neighbor_list(l, 3)
1269 partner = neighbor_ranks(i, j, k)
1270 recv_tag = neighbor_tag(i, j, k)
1271
1272 recv_count = recv_count + 1
1273 call mpi_irecv(p_recv_counts(i, j, k), 1, mpi_integer, partner, recv_tag, mpi_comm_world, recv_requests(recv_count), &
1274 & ierr)
1275 end do
1276
1277 ! Post all sends
1278 do l = 1, n_neighbors
1279 i = neighbor_list(l, 1)
1280 j = neighbor_list(l, 2)
1281 k = neighbor_list(l, 3)
1282 partner = neighbor_ranks(i, j, k)
1283 send_tag = neighbor_tag(-i, -j, -k)
1284
1285 send_count = send_count + 1
1286 call mpi_isend(p_send_counts(i, j, k), 1, mpi_integer, partner, send_tag, mpi_comm_world, send_requests(send_count), &
1287 & ierr)
1288 end do
1289
1290 ! Wait for all count exchanges to complete
1291 if (recv_count > 0) then
1292 call mpi_waitall(recv_count, recv_requests(1:recv_count), mpi_statuses_ignore, ierr)
1293 end if
1294 if (send_count > 0) then
1295 call mpi_waitall(send_count, send_requests(1:send_count), mpi_statuses_ignore, ierr)
1296 end if
1297
1298 ! Phase 2: Exchange particle data using non-blocking communication
1299 send_count = 0
1300 recv_count = 0
1301
1302 ! Post all receives for particle data first
1303 recv_offset = 1
1304 do l = 1, n_neighbors
1305 i = neighbor_list(l, 1)
1306 j = neighbor_list(l, 2)
1307 k = neighbor_list(l, 3)
1308
1309 if (p_recv_counts(i, j, k) > 0) then
1310 partner = neighbor_ranks(i, j, k)
1311 p_recv_size = p_recv_counts(i, j, k)*p_var_size
1312 recv_tag = neighbor_tag(i, j, k)
1313
1314 recv_count = recv_count + 1
1315 call mpi_irecv(p_recv_buff(recv_offset), p_recv_size, mpi_packed, partner, recv_tag, mpi_comm_world, &
1316 & recv_requests(recv_count), ierr)
1317 recv_offsets(l) = recv_offset
1318 recv_offset = recv_offset + p_recv_size
1319 end if
1320 end do
1321
1322 ! Pack and send particle data
1323 send_offset = 0
1324 do l = 1, n_neighbors
1325 i = neighbor_list(l, 1)
1326 j = neighbor_list(l, 2)
1327 k = neighbor_list(l, 3)
1328
1329 if (p_send_counts(i, j, k) > 0 .and. abs(i) + abs(j) + abs(k) /= 0) then
1330 partner = neighbor_ranks(i, j, k)
1331 send_tag = neighbor_tag(-i, -j, -k)
1332
1333 ! Pack data for sending
1334 position = 0
1335 do q = 0, p_send_counts(i, j, k) - 1
1336 bub_id = p_send_ids(i, j, k, q)
1337
1338 call mpi_pack(lag_id(bub_id, 1), 1, mpi_integer, p_send_buff(send_offset), p_buff_size, position, &
1339 & mpi_comm_world, ierr)
1340 call mpi_pack(bub_r0(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, ierr)
1341 call mpi_pack(rmax_stats(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1342 & ierr)
1343 call mpi_pack(rmin_stats(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1344 & ierr)
1345 call mpi_pack(gas_mg(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, ierr)
1346 call mpi_pack(gas_betat(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1347 & ierr)
1348 call mpi_pack(gas_betac(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1349 & ierr)
1350 call mpi_pack(bub_dphidt(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1351 & ierr)
1352 do r = 1, 2
1353 call mpi_pack(gas_p(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1354 & mpi_comm_world, ierr)
1355 call mpi_pack(gas_mv(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1356 & mpi_comm_world, ierr)
1357 call mpi_pack(rad(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1358 & ierr)
1359 call mpi_pack(rvel(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1360 & ierr)
1361 call mpi_pack(pos(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1362 & ierr)
1363 call mpi_pack(posprev(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1364 & mpi_comm_world, ierr)
1365 call mpi_pack(vel(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1366 & ierr)
1367 call mpi_pack(scoord(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1368 & mpi_comm_world, ierr)
1369 end do
1370 do r = 1, lag_num_ts
1371 call mpi_pack(drad(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1372 & ierr)
1373 call mpi_pack(drvel(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1374 & mpi_comm_world, ierr)
1375 call mpi_pack(dgasp(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1376 & mpi_comm_world, ierr)
1377 call mpi_pack(dgasmv(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1378 & mpi_comm_world, ierr)
1379 call mpi_pack(dpos(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1380 & mpi_comm_world, ierr)
1381 call mpi_pack(dvel(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1382 & mpi_comm_world, ierr)
1383 end do
1384 end do
1385
1386 send_count = send_count + 1
1387 call mpi_isend(p_send_buff(send_offset), position, mpi_packed, partner, send_tag, mpi_comm_world, &
1388 & send_requests(send_count), ierr)
1389 send_offset = send_offset + position
1390 end if
1391 end do
1392
1393 ! Wait for all recvs for contiguous data to complete
1394 call mpi_waitall(recv_count, recv_requests(1:recv_count), mpi_statuses_ignore, ierr)
1395
1396 ! Process received data as it arrives
1397 do l = 1, n_neighbors
1398 i = neighbor_list(l, 1)
1399 j = neighbor_list(l, 2)
1400 k = neighbor_list(l, 3)
1401
1402 if (p_recv_counts(i, j, k) > 0 .and. abs(i) + abs(j) + abs(k) /= 0) then
1403 p_recv_size = p_recv_counts(i, j, k)*p_var_size
1404 recv_offset = recv_offsets(l)
1405
1406 position = 0
1407 ! Unpack received data
1408 do q = 0, p_recv_counts(i, j, k) - 1
1409 nbubs = nbubs + 1
1410 bub_id = nbubs
1411 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, lag_id(bub_id, 1), 1, mpi_integer, &
1412 & mpi_comm_world, ierr)
1413 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, bub_r0(bub_id), 1, mpi_p, mpi_comm_world, ierr)
1414 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, rmax_stats(bub_id), 1, mpi_p, &
1415 & mpi_comm_world, ierr)
1416 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, rmin_stats(bub_id), 1, mpi_p, &
1417 & mpi_comm_world, ierr)
1418 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_mg(bub_id), 1, mpi_p, mpi_comm_world, ierr)
1419 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_betat(bub_id), 1, mpi_p, mpi_comm_world, &
1420 & ierr)
1421 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_betac(bub_id), 1, mpi_p, mpi_comm_world, &
1422 & ierr)
1423 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, bub_dphidt(bub_id), 1, mpi_p, &
1424 & mpi_comm_world, ierr)
1425 do r = 1, 2
1426 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_p(bub_id, r), 1, mpi_p, &
1427 & mpi_comm_world, ierr)
1428 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_mv(bub_id, r), 1, mpi_p, &
1429 & mpi_comm_world, ierr)
1430 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, rad(bub_id, r), 1, mpi_p, &
1431 & mpi_comm_world, ierr)
1432 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, rvel(bub_id, r), 1, mpi_p, &
1433 & mpi_comm_world, ierr)
1434 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, pos(bub_id,:,r), 3, mpi_p, &
1435 & mpi_comm_world, ierr)
1436 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, posprev(bub_id,:,r), 3, mpi_p, &
1437 & mpi_comm_world, ierr)
1438 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, vel(bub_id,:,r), 3, mpi_p, &
1439 & mpi_comm_world, ierr)
1440 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, scoord(bub_id,:,r), 3, mpi_p, &
1441 & mpi_comm_world, ierr)
1442 end do
1443 do r = 1, lag_num_ts
1444 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, drad(bub_id, r), 1, mpi_p, &
1445 & mpi_comm_world, ierr)
1446 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, drvel(bub_id, r), 1, mpi_p, &
1447 & mpi_comm_world, ierr)
1448 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, dgasp(bub_id, r), 1, mpi_p, &
1449 & mpi_comm_world, ierr)
1450 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, dgasmv(bub_id, r), 1, mpi_p, &
1451 & mpi_comm_world, ierr)
1452 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, dpos(bub_id,:,r), 3, mpi_p, &
1453 & mpi_comm_world, ierr)
1454 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, dvel(bub_id,:,r), 3, mpi_p, &
1455 & mpi_comm_world, ierr)
1456 end do
1457 lag_id(bub_id, 2) = bub_id
1458 end do
1459 recv_offset = recv_offset + p_recv_size
1460 end if
1461 end do
1462
1463 ! Wait for all sends to complete
1464 if (send_count > 0) then
1465 call mpi_waitall(send_count, send_requests(1:send_count), mpi_statuses_ignore, ierr)
1466 end if
1467#endif
1468
1469 if (any(periodic_bc)) then
1470 call s_wrap_particle_positions(pos, posprev, nbubs, dest)
1471 end if
1472
1473 end subroutine s_mpi_sendrecv_particles
1474
1475 !> Return a unique tag for each neighbor based on its position relative to the current process.
1476 integer function neighbor_tag(i, j, k) result(tag)
1477
1478 integer, intent(in) :: i, j, k
1479
1480 tag = (k + 1)*9 + (j + 1)*3 + (i + 1)
1481
1482 end function neighbor_tag
1483
1484 subroutine s_wrap_particle_positions(pos, posPrev, nbubs, dest)
1485
1486 real(wp), dimension(:,:,:) :: pos, posPrev
1487 integer :: nbubs, dest
1488 integer :: i, q
1489 real(wp) :: offset
1490
1491 do i = 1, nbubs
1492 if (periodic_bc(1)) then
1493 offset = glb_bounds(1)%end - glb_bounds(1)%beg
1494 if (pos(i, 1, dest) > x_cb(m + buff_size)) then
1495 do q = 1, 2
1496 pos(i, 1, q) = pos(i, 1, q) - offset
1497 posprev(i, 1, q) = posprev(i, 1, q) - offset
1498 end do
1499 end if
1500 if (pos(i, 1, dest) < x_cb(-1 - buff_size)) then
1501 do q = 1, 2
1502 pos(i, 1, q) = pos(i, 1, q) + offset
1503 posprev(i, 1, q) = posprev(i, 1, q) + offset
1504 end do
1505 end if
1506 end if
1507
1508 if (periodic_bc(2)) then
1509 offset = glb_bounds(2)%end - glb_bounds(2)%beg
1510 if (pos(i, 2, dest) > y_cb(n + buff_size)) then
1511 do q = 1, 2
1512 pos(i, 2, q) = pos(i, 2, q) - offset
1513 posprev(i, 2, q) = posprev(i, 2, q) - offset
1514 end do
1515 end if
1516 if (pos(i, 2, dest) < y_cb(-buff_size - 1)) then
1517 do q = 1, 2
1518 pos(i, 2, q) = pos(i, 2, q) + offset
1519 posprev(i, 2, q) = posprev(i, 2, q) + offset
1520 end do
1521 end if
1522 end if
1523
1524 if (periodic_bc(3)) then
1525 offset = glb_bounds(3)%end - glb_bounds(3)%beg
1526 if (pos(i, 3, dest) > z_cb(p + buff_size)) then
1527 do q = 1, 2
1528 pos(i, 3, q) = pos(i, 3, q) - offset
1529 posprev(i, 3, q) = posprev(i, 3, q) - offset
1530 end do
1531 end if
1532 if (pos(i, 3, dest) < z_cb(-1 - buff_size)) then
1533 do q = 1, 2
1534 pos(i, 3, q) = pos(i, 3, q) + offset
1535 posprev(i, 3, q) = posprev(i, 3, q) + offset
1536 end do
1537 end if
1538 end if
1539 end do
1540
1541 end subroutine s_wrap_particle_positions
1542
1543 !> Broadcast random phase numbers from rank 0 to all MPI processes
1544 impure subroutine s_mpi_send_random_number(phi_rn, num_freq)
1545
1546 integer, intent(in) :: num_freq
1547 real(wp), intent(inout), dimension(1:num_freq) :: phi_rn
1548
1549#ifdef MFC_MPI
1550 integer :: ierr !< Generic flag used to identify and report MPI errors
1551 call mpi_bcast(phi_rn, num_freq, mpi_p, 0, mpi_comm_world, ierr)
1552#endif
1553
1554 end subroutine s_mpi_send_random_number
1555
1556 !> Finalize the MPI proxy module
1558
1559#ifdef MFC_MPI
1560 if (ib) then
1561#ifdef MFC_DEBUG
1562# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1563 block
1564# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1565 use iso_fortran_env, only: output_unit
1566# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1567
1568# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1569 print *, 'm_mpi_proxy.fpp:659: ', '@:DEALLOCATE(ib_buff_send, ib_buff_recv)'
1570# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1571
1572# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1573 call flush (output_unit)
1574# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1575 end block
1576# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1577#endif
1578# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1579
1580# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1581#if defined(MFC_OpenACC)
1582# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1583!$acc exit data delete(ib_buff_send, ib_buff_recv)
1584# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1585#elif defined(MFC_OpenMP)
1586# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1587!$omp target exit data map(release:ib_buff_send, ib_buff_recv)
1588# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1589#endif
1590# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1591 deallocate (ib_buff_send, ib_buff_recv)
1592 end if
1593
1594 if (allocated(p_send_buff)) then
1595#ifdef MFC_DEBUG
1596# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1597 block
1598# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1599 use iso_fortran_env, only: output_unit
1600# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1601
1602# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1603 print *, 'm_mpi_proxy.fpp:663: ', '@:DEALLOCATE(p_send_buff, p_recv_buff)'
1604# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1605
1606# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1607 call flush (output_unit)
1608# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1609 end block
1610# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1611#endif
1612# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1613
1614# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1615#if defined(MFC_OpenACC)
1616# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1617!$acc exit data delete(p_send_buff, p_recv_buff)
1618# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1619#elif defined(MFC_OpenMP)
1620# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1621!$omp target exit data map(release:p_send_buff, p_recv_buff)
1622# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1623#endif
1624# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1625 deallocate (p_send_buff, p_recv_buff)
1626#ifdef MFC_DEBUG
1627# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1628 block
1629# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1630 use iso_fortran_env, only: output_unit
1631# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1632
1633# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1634 print *, 'm_mpi_proxy.fpp:664: ', '@:DEALLOCATE(p_send_ids)'
1635# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1636
1637# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1638 call flush (output_unit)
1639# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1640 end block
1641# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1642#endif
1643# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1644
1645# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1646#if defined(MFC_OpenACC)
1647# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1648!$acc exit data delete(p_send_ids)
1649# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1650#elif defined(MFC_OpenMP)
1651# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1652!$omp target exit data map(release:p_send_ids)
1653# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1654#endif
1655# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1656 deallocate (p_send_ids)
1657 end if
1658#endif
1659
1660 end subroutine s_finalize_mpi_proxy_module
1661
1662end module m_mpi_proxy
subroutine s_add_particle_to_direction(particle_id, dir_x, dir_y, dir_z)
logical function f_crosses_boundary(particle_id, dir, loc, pos, posprev)
integer, intent(in) k
integer, intent(in) j
integer, intent(in) l
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
integer buff_size
Number of ghost cells for boundary condition storage.
type(cell_num_bounds) cells_bounds
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
MPI communication layer: domain decomposition, halo exchange, reductions, and parallel I/O setup.
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
subroutine s_initialize_mpi_proxy_module()
Initialize the MPI proxy module.
integer function neighbor_tag(i, j, k)
Return a unique tag for each neighbor based on its position relative to the current process.
integer, dimension(max_neighbors) recv_offsets
integer, dimension(:), allocatable, private ib_buff_send
IB marker send buffer for halo exchange.
character(len=1), dimension(:), allocatable p_recv_buff
character(len=1), dimension(:), allocatable p_send_buff
integer, dimension(:), allocatable, private ib_buff_recv
IB marker receive buffer for halo exchange.
integer, dimension(max_neighbors, 3) neighbor_list
integer, dimension(-1:1,-1:1,-1:1) p_recv_counts
impure subroutine s_add_particles_to_transfer_list(nbub, pos, posprev)
Adds particles to the transfer list for the MPI communication.
impure subroutine s_mpi_send_random_number(phi_rn, num_freq)
Broadcast random phase numbers from rank 0 to all MPI processes.
integer, dimension(max_neighbors) recv_requests
subroutine s_initialize_particles_mpi(lag_num_ts)
subroutine s_wrap_particle_positions(pos, posprev, nbubs, dest)
integer, dimension(-1:1,-1:1,-1:1) p_send_counts
impure subroutine s_mpi_sendrecv_particles(bub_r0, rmax_stats, rmin_stats, gas_mg, gas_betat, gas_betac, bub_dphidt, lag_id, gas_p, gas_mv, rad, rvel, pos, posprev, vel, scoord, drad, drvel, dgasp, dgasmv, dpos, dvel, lag_num_ts, nbubs, dest)
Perform the MPI communication for lagrangian particles/bubbles.
integer, dimension(max_neighbors) send_requests
integer, parameter max_neighbors
subroutine s_finalize_mpi_proxy_module()
Finalize the MPI proxy module.
impure subroutine s_mpi_bcast_user_inputs()
Since only the processor with rank 0 reads and verifies the consistency of user inputs,...
integer, dimension(:,:,:,:), allocatable p_send_ids
NVIDIA NVTX profiling API bindings for GPU performance instrumentation.
Definition m_nvtx.f90:6