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# 55 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312! Allocate and create GPU device memory
313# 75 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
314
315! Free GPU device memory and deallocate
316# 83 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
317
318! Cray-specific GPU pointer setup for vector fields
319# 107 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
320
321! Cray-specific GPU pointer setup for scalar fields
322# 123 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
323
324! Cray-specific GPU pointer setup for acoustic source spatials
325# 148 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
326
327# 154 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
328
329# 161 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
330! New line at end of file is required for FYPP
331# 7 "/home/runner/work/MFC/MFC/src/simulation/m_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)%gamma, 1, mpi_p, 0, mpi_comm_world, ierr)
729 call mpi_bcast(fluid_pp(i)%hb_m, 1, mpi_p, 0, mpi_comm_world, ierr)
730 call mpi_bcast(fluid_pp(i)%mu_bulk, 1, mpi_p, 0, mpi_comm_world, ierr)
731 call mpi_bcast(fluid_pp(i)%mu_max, 1, mpi_p, 0, mpi_comm_world, ierr)
732 call mpi_bcast(fluid_pp(i)%mu_min, 1, mpi_p, 0, mpi_comm_world, ierr)
733 call mpi_bcast(fluid_pp(i)%nn, 1, mpi_p, 0, mpi_comm_world, ierr)
734 call mpi_bcast(fluid_pp(i)%non_newtonian, 1, mpi_logical, 0, mpi_comm_world, ierr)
735 call mpi_bcast(fluid_pp(i)%pi_inf, 1, mpi_p, 0, mpi_comm_world, ierr)
736 call mpi_bcast(fluid_pp(i)%qv, 1, mpi_p, 0, mpi_comm_world, ierr)
737 call mpi_bcast(fluid_pp(i)%qvp, 1, mpi_p, 0, mpi_comm_world, ierr)
738 call mpi_bcast(fluid_pp(i)%tau0, 1, mpi_p, 0, mpi_comm_world, ierr)
739 call mpi_bcast(fluid_pp(i)%Re(1), 2, mpi_p, 0, mpi_comm_world, ierr)
740 end do
741
742 ! bub_pp members (under bubbles guard)
743 if (bubbles_euler .or. bubbles_lagrange) then
744 call mpi_bcast(bub_pp%M_g, 1, mpi_p, 0, mpi_comm_world, ierr)
745 call mpi_bcast(bub_pp%M_v, 1, mpi_p, 0, mpi_comm_world, ierr)
746 call mpi_bcast(bub_pp%R0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
747 call mpi_bcast(bub_pp%R_g, 1, mpi_p, 0, mpi_comm_world, ierr)
748 call mpi_bcast(bub_pp%R_v, 1, mpi_p, 0, mpi_comm_world, ierr)
749 call mpi_bcast(bub_pp%T0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
750 call mpi_bcast(bub_pp%cp_g, 1, mpi_p, 0, mpi_comm_world, ierr)
751 call mpi_bcast(bub_pp%cp_v, 1, mpi_p, 0, mpi_comm_world, ierr)
752 call mpi_bcast(bub_pp%gam_g, 1, mpi_p, 0, mpi_comm_world, ierr)
753 call mpi_bcast(bub_pp%gam_v, 1, mpi_p, 0, mpi_comm_world, ierr)
754 call mpi_bcast(bub_pp%k_g, 1, mpi_p, 0, mpi_comm_world, ierr)
755 call mpi_bcast(bub_pp%k_v, 1, mpi_p, 0, mpi_comm_world, ierr)
756 call mpi_bcast(bub_pp%mu_g, 1, mpi_p, 0, mpi_comm_world, ierr)
757 call mpi_bcast(bub_pp%mu_l, 1, mpi_p, 0, mpi_comm_world, ierr)
758 call mpi_bcast(bub_pp%mu_v, 1, mpi_p, 0, mpi_comm_world, ierr)
759 call mpi_bcast(bub_pp%p0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
760 call mpi_bcast(bub_pp%pv, 1, mpi_p, 0, mpi_comm_world, ierr)
761 call mpi_bcast(bub_pp%rho0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
762 call mpi_bcast(bub_pp%ss, 1, mpi_p, 0, mpi_comm_world, ierr)
763 call mpi_bcast(bub_pp%vd, 1, mpi_p, 0, mpi_comm_world, ierr)
764 end if
765
766 ! lag_params members (under bubbles_lagrange guard)
767 if (bubbles_lagrange) then
768 call mpi_bcast(lag_params%gravity_force, 1, mpi_logical, 0, mpi_comm_world, ierr)
769 call mpi_bcast(lag_params%heatTransfer_model, 1, mpi_logical, 0, mpi_comm_world, ierr)
770 call mpi_bcast(lag_params%kahan_summation, 1, mpi_logical, 0, mpi_comm_world, ierr)
771 call mpi_bcast(lag_params%massTransfer_model, 1, mpi_logical, 0, mpi_comm_world, ierr)
772 call mpi_bcast(lag_params%pressure_corrector, 1, mpi_logical, 0, mpi_comm_world, ierr)
773 call mpi_bcast(lag_params%pressure_force, 1, mpi_logical, 0, mpi_comm_world, ierr)
774 call mpi_bcast(lag_params%write_bubbles, 1, mpi_logical, 0, mpi_comm_world, ierr)
775 call mpi_bcast(lag_params%write_bubbles_stats, 1, mpi_logical, 0, mpi_comm_world, ierr)
776 call mpi_bcast(lag_params%write_void_evol, 1, mpi_logical, 0, mpi_comm_world, ierr)
777 call mpi_bcast(lag_params%charNz, 1, mpi_integer, 0, mpi_comm_world, ierr)
778 call mpi_bcast(lag_params%cluster_type, 1, mpi_integer, 0, mpi_comm_world, ierr)
779 call mpi_bcast(lag_params%drag_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
780 call mpi_bcast(lag_params%nBubs_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
781 call mpi_bcast(lag_params%smooth_type, 1, mpi_integer, 0, mpi_comm_world, ierr)
782 call mpi_bcast(lag_params%solver_approach, 1, mpi_integer, 0, mpi_comm_world, ierr)
783 call mpi_bcast(lag_params%vel_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
784 call mpi_bcast(lag_params%charwidth, 1, mpi_p, 0, mpi_comm_world, ierr)
785 call mpi_bcast(lag_params%epsilonb, 1, mpi_p, 0, mpi_comm_world, ierr)
786 call mpi_bcast(lag_params%valmaxvoid, 1, mpi_p, 0, mpi_comm_world, ierr)
787 call mpi_bcast(lag_params%input_path, len(lag_params%input_path), mpi_character, 0, mpi_comm_world, ierr)
788 end if
789
790 ! chem_params members (under chemistry guard)
791 if (chemistry) then
792 call mpi_bcast(chem_params%adap_substeps, 1, mpi_logical, 0, mpi_comm_world, ierr)
793 call mpi_bcast(chem_params%diffusion, 1, mpi_logical, 0, mpi_comm_world, ierr)
794 call mpi_bcast(chem_params%reactions, 1, mpi_logical, 0, mpi_comm_world, ierr)
795 call mpi_bcast(chem_params%gamma_method, 1, mpi_integer, 0, mpi_comm_world, ierr)
796 call mpi_bcast(chem_params%reaction_substeps, 1, mpi_integer, 0, mpi_comm_world, ierr)
797 call mpi_bcast(chem_params%reaction_substeps_max, 1, mpi_integer, 0, mpi_comm_world, ierr)
798 call mpi_bcast(chem_params%transport_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
799 end if
800
801 ! rburn members (under reactive_burn guard)
802 if (reactive_burn) then
803 call mpi_bcast(rburn%k, 1, mpi_p, 0, mpi_comm_world, ierr)
804 call mpi_bcast(rburn%n, 1, mpi_p, 0, mpi_comm_world, ierr)
805 call mpi_bcast(rburn%pign, 1, mpi_p, 0, mpi_comm_world, ierr)
806 call mpi_bcast(rburn%pref, 1, mpi_p, 0, mpi_comm_world, ierr)
807 call mpi_bcast(rburn%ta, 1, mpi_p, 0, mpi_comm_world, ierr)
808 end if
809
810# 113 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp" 2
811
812 ! manual: m_glb, n_glb, p_glb (computed in s_read_input_file, not namelist-bound)
813 call mpi_bcast(m_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
814 call mpi_bcast(n_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
815 call mpi_bcast(p_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
816
817 ! manual: bc_x/y/z member broadcasts (struct members not in NAMELIST_VARS)
818# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
819 call mpi_bcast(bc_x%beg, 1, mpi_integer, 0, mpi_comm_world, ierr)
820# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
821 call mpi_bcast(bc_x%end, 1, mpi_integer, 0, mpi_comm_world, ierr)
822# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
823 call mpi_bcast(bc_y%beg, 1, mpi_integer, 0, mpi_comm_world, ierr)
824# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
825 call mpi_bcast(bc_y%end, 1, mpi_integer, 0, mpi_comm_world, ierr)
826# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
827 call mpi_bcast(bc_z%beg, 1, mpi_integer, 0, mpi_comm_world, ierr)
828# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
829 call mpi_bcast(bc_z%end, 1, mpi_integer, 0, mpi_comm_world, ierr)
830# 123 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
831
832# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
833 call mpi_bcast(bc_x%grcbc_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
834# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
835 call mpi_bcast(bc_x%grcbc_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
836# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
837 call mpi_bcast(bc_x%grcbc_vel_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
838# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
839 call mpi_bcast(bc_y%grcbc_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
840# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
841 call mpi_bcast(bc_y%grcbc_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
842# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
843 call mpi_bcast(bc_y%grcbc_vel_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
844# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
845 call mpi_bcast(bc_z%grcbc_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
846# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
847 call mpi_bcast(bc_z%grcbc_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
848# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
849 call mpi_bcast(bc_z%grcbc_vel_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
850# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
851 call mpi_bcast(bc_x%isothermal_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
852# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
853 call mpi_bcast(bc_y%isothermal_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
854# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
855 call mpi_bcast(bc_z%isothermal_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
856# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
857 call mpi_bcast(bc_x%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
858# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
859 call mpi_bcast(bc_y%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
860# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
861 call mpi_bcast(bc_z%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
862# 131 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
863
864# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
865 call mpi_bcast(bc_x%vb1, 1, mpi_p, 0, mpi_comm_world, ierr)
866# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
867 call mpi_bcast(bc_x%vb2, 1, mpi_p, 0, mpi_comm_world, ierr)
868# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
869 call mpi_bcast(bc_x%vb3, 1, mpi_p, 0, mpi_comm_world, ierr)
870# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
871 call mpi_bcast(bc_x%ve1, 1, mpi_p, 0, mpi_comm_world, ierr)
872# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
873 call mpi_bcast(bc_x%ve2, 1, mpi_p, 0, mpi_comm_world, ierr)
874# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
875 call mpi_bcast(bc_x%ve3, 1, mpi_p, 0, mpi_comm_world, ierr)
876# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
877 call mpi_bcast(bc_y%vb1, 1, mpi_p, 0, mpi_comm_world, ierr)
878# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
879 call mpi_bcast(bc_y%vb2, 1, mpi_p, 0, mpi_comm_world, ierr)
880# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
881 call mpi_bcast(bc_y%vb3, 1, mpi_p, 0, mpi_comm_world, ierr)
882# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
883 call mpi_bcast(bc_y%ve1, 1, mpi_p, 0, mpi_comm_world, ierr)
884# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
885 call mpi_bcast(bc_y%ve2, 1, mpi_p, 0, mpi_comm_world, ierr)
886# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
887 call mpi_bcast(bc_y%ve3, 1, mpi_p, 0, mpi_comm_world, ierr)
888# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
889 call mpi_bcast(bc_z%vb1, 1, mpi_p, 0, mpi_comm_world, ierr)
890# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
891 call mpi_bcast(bc_z%vb2, 1, mpi_p, 0, mpi_comm_world, ierr)
892# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
893 call mpi_bcast(bc_z%vb3, 1, mpi_p, 0, mpi_comm_world, ierr)
894# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
895 call mpi_bcast(bc_z%ve1, 1, mpi_p, 0, mpi_comm_world, ierr)
896# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
897 call mpi_bcast(bc_z%ve2, 1, mpi_p, 0, mpi_comm_world, ierr)
898# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
899 call mpi_bcast(bc_z%ve3, 1, mpi_p, 0, mpi_comm_world, ierr)
900# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
901 call mpi_bcast(bc_x%pres_in, 1, mpi_p, 0, mpi_comm_world, ierr)
902# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
903 call mpi_bcast(bc_x%pres_out, 1, mpi_p, 0, mpi_comm_world, ierr)
904# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
905 call mpi_bcast(bc_y%pres_in, 1, mpi_p, 0, mpi_comm_world, ierr)
906# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
907 call mpi_bcast(bc_y%pres_out, 1, mpi_p, 0, mpi_comm_world, ierr)
908# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
909 call mpi_bcast(bc_z%pres_in, 1, mpi_p, 0, mpi_comm_world, ierr)
910# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
911 call mpi_bcast(bc_z%pres_out, 1, mpi_p, 0, mpi_comm_world, ierr)
912# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
913 call mpi_bcast(bc_x%Twall_in, 1, mpi_p, 0, mpi_comm_world, ierr)
914# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
915 call mpi_bcast(bc_x%Twall_out, 1, mpi_p, 0, mpi_comm_world, ierr)
916# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
917 call mpi_bcast(bc_y%Twall_in, 1, mpi_p, 0, mpi_comm_world, ierr)
918# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
919 call mpi_bcast(bc_y%Twall_out, 1, mpi_p, 0, mpi_comm_world, ierr)
920# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
921 call mpi_bcast(bc_z%Twall_in, 1, mpi_p, 0, mpi_comm_world, ierr)
922# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
923 call mpi_bcast(bc_z%Twall_out, 1, mpi_p, 0, mpi_comm_world, ierr)
924# 141 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
925
926 do i = 1, 3
927# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
928 call mpi_bcast(bc_x%vel_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
929# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
930 call mpi_bcast(bc_x%vel_out (i), 1, mpi_p, 0, mpi_comm_world, ierr)
931# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
932 call mpi_bcast(bc_y%vel_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
933# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
934 call mpi_bcast(bc_y%vel_out (i), 1, mpi_p, 0, mpi_comm_world, ierr)
935# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
936 call mpi_bcast(bc_z%vel_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
937# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
938 call mpi_bcast(bc_z%vel_out (i), 1, mpi_p, 0, mpi_comm_world, ierr)
939# 147 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
940 end do
941
942 ! manual: cfl_dt (runtime-computed logical), bc_io (BC-file existence)
943 call mpi_bcast(cfl_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
944 call mpi_bcast(bc_io, 1, mpi_logical, 0, mpi_comm_world, ierr)
945
946 ! manual: shear_stress, bulk_stress (derived from Re_size post-init on all ranks),
947 ! bodyForces (derived from bf_x/y/z)
948 call mpi_bcast(shear_stress, 1, mpi_logical, 0, mpi_comm_world, ierr)
949 call mpi_bcast(bulk_stress, 1, mpi_logical, 0, mpi_comm_world, ierr)
950 call mpi_bcast(bodyforces, 1, mpi_logical, 0, mpi_comm_world, ierr)
951
952 ! manual: bc_x per-fluid inflow arrays (loop over num_fluids_max)
953 do i = 1, num_fluids_max
954# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
955 call mpi_bcast(bc_x%alpha_rho_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
956# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
957 call mpi_bcast(bc_x%alpha_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
958# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
959 call mpi_bcast(bc_y%alpha_rho_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
960# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
961 call mpi_bcast(bc_y%alpha_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
962# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
963 call mpi_bcast(bc_z%alpha_rho_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
964# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
965 call mpi_bcast(bc_z%alpha_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
966# 165 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
967 end do
968
969 ! manual: patch_ib (sim member subset differs from pre; uses count=3, adds mass/moving_ibm)
970 do i = 1, num_ibs
971# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
972 call mpi_bcast(patch_ib(i)%radius, 1, mpi_p, 0, mpi_comm_world, ierr)
973# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
974 call mpi_bcast(patch_ib(i)%length_x, 1, mpi_p, 0, mpi_comm_world, ierr)
975# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
976 call mpi_bcast(patch_ib(i)%length_y, 1, mpi_p, 0, mpi_comm_world, ierr)
977# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
978 call mpi_bcast(patch_ib(i)%length_z, 1, mpi_p, 0, mpi_comm_world, ierr)
979# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
980 call mpi_bcast(patch_ib(i)%x_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
981# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
982 call mpi_bcast(patch_ib(i)%y_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
983# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
984 call mpi_bcast(patch_ib(i)%z_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
985# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
986 call mpi_bcast(patch_ib(i)%slip, 1, mpi_p, 0, mpi_comm_world, ierr)
987# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
988 call mpi_bcast(patch_ib(i)%mass, 1, mpi_p, 0, mpi_comm_world, ierr)
989# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
990 call mpi_bcast(patch_ib(i)%v_blow, 1, mpi_p, 0, mpi_comm_world, ierr)
991# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
992 call mpi_bcast(patch_ib(i)%burn_rate_exp, 1, mpi_p, 0, mpi_comm_world, ierr)
993# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
994 call mpi_bcast(patch_ib(i)%burn_rate_pref, 1, mpi_p, 0, mpi_comm_world, ierr)
995# 174 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
996# 175 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
997 call mpi_bcast(patch_ib(i)%vel, 3, mpi_p, 0, mpi_comm_world, ierr)
998# 175 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
999 call mpi_bcast(patch_ib(i)%angular_vel, 3, mpi_p, 0, mpi_comm_world, ierr)
1000# 175 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1001 call mpi_bcast(patch_ib(i)%angles, 3, mpi_p, 0, mpi_comm_world, ierr)
1002# 177 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1003 call mpi_bcast(patch_ib(i)%geometry, 1, mpi_integer, 0, mpi_comm_world, ierr)
1004 call mpi_bcast(patch_ib(i)%moving_ibm, 1, mpi_integer, 0, mpi_comm_world, ierr)
1005 call mpi_bcast(patch_ib(i)%airfoil_id, 1, mpi_integer, 0, mpi_comm_world, ierr)
1006 call mpi_bcast(patch_ib(i)%model_id, 1, mpi_integer, 0, mpi_comm_world, ierr)
1007 call mpi_bcast(patch_ib(i)%inj_species, 1, mpi_integer, 0, mpi_comm_world, ierr)
1008 end do
1009
1010 ! manual: ib_airfoil (kept manual alongside patch_ib)
1011 do i = 1, num_ib_airfoils_max
1012# 187 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1013 call mpi_bcast(ib_airfoil(i)%c, 1, mpi_p, 0, mpi_comm_world, ierr)
1014# 187 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1015 call mpi_bcast(ib_airfoil(i)%p, 1, mpi_p, 0, mpi_comm_world, ierr)
1016# 187 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1017 call mpi_bcast(ib_airfoil(i)%t, 1, mpi_p, 0, mpi_comm_world, ierr)
1018# 187 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1019 call mpi_bcast(ib_airfoil(i)%m, 1, mpi_p, 0, mpi_comm_world, ierr)
1020# 189 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1021 end do
1022
1023 ! manual: stl_models loop (num_stl_models scalar is generated; grouped array members)
1024 do i = 1, num_stl_models_max
1025 call mpi_bcast(stl_models(i)%model_filepath, len(stl_models(i)%model_filepath), mpi_character, 0, mpi_comm_world, ierr)
1026 call mpi_bcast(stl_models(i)%model_threshold, 1, mpi_p, 0, mpi_comm_world, ierr)
1027# 196 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1028 call mpi_bcast(stl_models(i)%model_translate, 3, mpi_p, 0, mpi_comm_world, ierr)
1029# 196 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1030 call mpi_bcast(stl_models(i)%model_scale, 3, mpi_p, 0, mpi_comm_world, ierr)
1031# 198 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1032 end do
1033
1034 ! manual: particle_cloud (runtime loop to num_particle_clouds; irregular member subset)
1035 do i = 1, num_particle_clouds
1036# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1037 call mpi_bcast(particle_cloud(i)%x_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1038# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1039 call mpi_bcast(particle_cloud(i)%y_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1040# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1041 call mpi_bcast(particle_cloud(i)%z_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1042# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1043 call mpi_bcast(particle_cloud(i)%length_x, 1, mpi_p, 0, mpi_comm_world, ierr)
1044# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1045 call mpi_bcast(particle_cloud(i)%length_y, 1, mpi_p, 0, mpi_comm_world, ierr)
1046# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1047 call mpi_bcast(particle_cloud(i)%length_z, 1, mpi_p, 0, mpi_comm_world, ierr)
1048# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1049 call mpi_bcast(particle_cloud(i)%radius, 1, mpi_p, 0, mpi_comm_world, ierr)
1050# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1051 call mpi_bcast(particle_cloud(i)%mass, 1, mpi_p, 0, mpi_comm_world, ierr)
1052# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1053 call mpi_bcast(particle_cloud(i)%min_spacing, 1, mpi_p, 0, mpi_comm_world, ierr)
1054# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1055 call mpi_bcast(particle_cloud(i)%shell_inner_radius, 1, mpi_p, 0, mpi_comm_world, ierr)
1056# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1057 call mpi_bcast(particle_cloud(i)%shell_outer_radius, 1, mpi_p, 0, mpi_comm_world, ierr)
1058# 206 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1059 call mpi_bcast(particle_cloud(i)%num_particles, 1, mpi_integer, 0, mpi_comm_world, ierr)
1060 call mpi_bcast(particle_cloud(i)%moving_ibm, 1, mpi_integer, 0, mpi_comm_world, ierr)
1061 call mpi_bcast(particle_cloud(i)%seed, 1, mpi_integer, 0, mpi_comm_world, ierr)
1062 call mpi_bcast(particle_cloud(i)%cloud_geometry, 1, mpi_integer, 0, mpi_comm_world, ierr)
1063 call mpi_bcast(particle_cloud(i)%packing_method, 1, mpi_integer, 0, mpi_comm_world, ierr)
1064 call mpi_bcast(particle_cloud(i)%periodic, 1, mpi_integer, 0, mpi_comm_world, ierr)
1065 end do
1066
1067 ! manual: acoustic/probe (combined loop; complex acoustic member set)
1068 do j = 1, num_probes_max
1069 do i = 1, 3
1070 call mpi_bcast(acoustic(j)%loc(i), 1, mpi_p, 0, mpi_comm_world, ierr)
1071 end do
1072
1073 call mpi_bcast(acoustic(j)%dipole, 1, mpi_logical, 0, mpi_comm_world, ierr)
1074
1075# 223 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1076 call mpi_bcast(acoustic(j)%pulse, 1, mpi_integer, 0, mpi_comm_world, ierr)
1077# 223 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1078 call mpi_bcast(acoustic(j)%support, 1, mpi_integer, 0, mpi_comm_world, ierr)
1079# 223 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1080 call mpi_bcast(acoustic(j)%num_elements, 1, mpi_integer, 0, mpi_comm_world, ierr)
1081# 223 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1082 call mpi_bcast(acoustic(j)%element_on, 1, mpi_integer, 0, mpi_comm_world, ierr)
1083# 223 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1084 call mpi_bcast(acoustic(j)%bb_num_freq, 1, mpi_integer, 0, mpi_comm_world, ierr)
1085# 225 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1086
1087# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1088 call mpi_bcast(acoustic(j)%mag, 1, mpi_p, 0, mpi_comm_world, ierr)
1089# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1090 call mpi_bcast(acoustic(j)%length, 1, mpi_p, 0, mpi_comm_world, ierr)
1091# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1092 call mpi_bcast(acoustic(j)%height, 1, mpi_p, 0, mpi_comm_world, ierr)
1093# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1094 call mpi_bcast(acoustic(j)%wavelength, 1, mpi_p, 0, mpi_comm_world, ierr)
1095# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1096 call mpi_bcast(acoustic(j)%frequency, 1, mpi_p, 0, mpi_comm_world, ierr)
1097# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1098 call mpi_bcast(acoustic(j)%gauss_sigma_dist, 1, mpi_p, 0, mpi_comm_world, ierr)
1099# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1100 call mpi_bcast(acoustic(j)%gauss_sigma_time, 1, mpi_p, 0, mpi_comm_world, ierr)
1101# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1102 call mpi_bcast(acoustic(j)%npulse, 1, mpi_p, 0, mpi_comm_world, ierr)
1103# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1104 call mpi_bcast(acoustic(j)%dir, 1, mpi_p, 0, mpi_comm_world, ierr)
1105# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1106 call mpi_bcast(acoustic(j)%delay, 1, mpi_p, 0, mpi_comm_world, ierr)
1107# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1108 call mpi_bcast(acoustic(j)%foc_length, 1, mpi_p, 0, mpi_comm_world, ierr)
1109# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1110 call mpi_bcast(acoustic(j)%aperture, 1, mpi_p, 0, mpi_comm_world, ierr)
1111# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1112 call mpi_bcast(acoustic(j)%element_spacing_angle, 1, mpi_p, 0, mpi_comm_world, ierr)
1113# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1114 call mpi_bcast(acoustic(j)%element_polygon_ratio, 1, mpi_p, 0, mpi_comm_world, ierr)
1115# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1116 call mpi_bcast(acoustic(j)%rotate_angle, 1, mpi_p, 0, mpi_comm_world, ierr)
1117# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1118 call mpi_bcast(acoustic(j)%bb_bandwidth, 1, mpi_p, 0, mpi_comm_world, ierr)
1119# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1120 call mpi_bcast(acoustic(j)%bb_lowest_freq, 1, mpi_p, 0, mpi_comm_world, ierr)
1121# 233 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1122
1123# 235 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1124 call mpi_bcast(probe(j)%x, 1, mpi_p, 0, mpi_comm_world, ierr)
1125# 235 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1126 call mpi_bcast(probe(j)%y, 1, mpi_p, 0, mpi_comm_world, ierr)
1127# 235 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1128 call mpi_bcast(probe(j)%z, 1, mpi_p, 0, mpi_comm_world, ierr)
1129# 237 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1130 end do
1131
1132 ! manual: spatial-support body-force derived-type members (the bf_spatial_support toggle is broadcast by
1133 ! generated_bcast.fpp)
1134# 242 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1135 call mpi_bcast(spatial_bf%amp, 1, mpi_p, 0, mpi_comm_world, ierr)
1136# 242 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1137 call mpi_bcast(spatial_bf%x_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1138# 242 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1139 call mpi_bcast(spatial_bf%y_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1140# 242 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1141 call mpi_bcast(spatial_bf%sigma, 1, mpi_p, 0, mpi_comm_world, ierr)
1142# 242 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1143 call mpi_bcast(spatial_bf%conv_vel, 1, mpi_p, 0, mpi_comm_world, ierr)
1144# 244 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1145 call mpi_bcast(spatial_bf%freq, 8, mpi_p, 0, mpi_comm_world, ierr)
1146 call mpi_bcast(spatial_bf%phase, 8, mpi_p, 0, mpi_comm_world, ierr)
1147
1148 ! manual: synthetic turbulence namelist arrays (registered as indexed
1149 ! variants only; scalars are broadcast by generated_bcast.fpp)
1150 call mpi_bcast(synth_n_waves_per_shell, num_synth_shells_max, mpi_integer, 0, mpi_comm_world, ierr)
1151 call mpi_bcast(synth_k_shell, num_synth_shells_max, mpi_p, 0, mpi_comm_world, ierr)
1152 call mpi_bcast(synth_amp_shell, num_synth_shells_max, mpi_p, 0, mpi_comm_world, ierr)
1153 call mpi_bcast(turb_pos, num_turb_sources_max*3, mpi_p, 0, mpi_comm_world, ierr)
1154 call mpi_bcast(synth_l, num_turb_sources_max*3, mpi_p, 0, mpi_comm_world, ierr)
1155#endif
1156
1157 end subroutine s_mpi_bcast_user_inputs
1158
1159 !> Adds particles to the transfer list for the MPI communication.
1160 !! @param nBub Current LOCAL number of bubbles
1161 !! @param pos Current position of each bubble
1162 !! @param posPrev Previous position of each bubble (optional, not used
1163 !! for communication of initial condition)
1164 impure subroutine s_add_particles_to_transfer_list(nBub, pos, posPrev)
1165
1166 integer, intent(in) :: nbub
1167 real(wp), dimension(:,:), intent(in) :: pos, posprev
1168 integer :: bubid
1169 integer :: i, j, k
1170 integer :: dx, dy, dz
1171
1172 do k = nidx(3)%beg, nidx(3)%end
1173 do j = nidx(2)%beg, nidx(2)%end
1174 do i = nidx(1)%beg, nidx(1)%end
1175 p_send_counts(i, j, k) = 0
1176 end do
1177 end do
1178 end do
1179
1180 do k = 1, nbub
1181 dx = 0; dy = 0; dz = 0
1182 if (f_crosses_boundary(k, 1, -1, pos, posprev)) then
1183 dx = -1
1184 else if (f_crosses_boundary(k, 1, 1, pos, posprev)) then
1185 dx = 1
1186 end if
1187 if (n > 0) then
1188 if (f_crosses_boundary(k, 2, -1, pos, posprev)) then
1189 dy = -1
1190 else if (f_crosses_boundary(k, 2, 1, pos, posprev)) then
1191 dy = 1
1192 end if
1193 end if
1194 if (p > 0) then
1195 if (f_crosses_boundary(k, 3, -1, pos, posprev)) then
1196 dz = -1
1197 else if (f_crosses_boundary(k, 3, 1, pos, posprev)) then
1198 dz = 1
1199 end if
1200 end if
1201 if (abs(dx) + abs(dy) + abs(dz) /= 0) then
1202 call s_add_particle_to_direction(k, dx, dy, dz)
1203 end if
1204 end do
1205
1206 contains
1207
1208 logical function f_crosses_boundary(particle_id, dir, loc, pos, posPrev)
1209
1210 integer, intent(in) :: particle_id, dir, loc
1211 real(wp), dimension(:,:), intent(in) :: pos
1212 real(wp), dimension(:,:), optional, intent(in) :: posprev
1213
1214 if (loc == -1) then ! Beginning of the domain
1215 if (nidx(dir)%beg == 0) then
1216 f_crosses_boundary = .false.
1217 return
1218 end if
1219
1220 f_crosses_boundary = (posprev(particle_id, dir) >= pcomm_coords(dir)%beg .and. pos(particle_id, &
1221 & dir) < pcomm_coords(dir)%beg)
1222 else if (loc == 1) then ! End of the domain
1223 if (nidx(dir)%end == 0) then
1224 f_crosses_boundary = .false.
1225 return
1226 end if
1227
1228 f_crosses_boundary = (posprev(particle_id, dir) <= pcomm_coords(dir)%end .and. pos(particle_id, &
1229 & dir) > pcomm_coords(dir)%end)
1230 end if
1231
1232 end function f_crosses_boundary
1233
1234 subroutine s_add_particle_to_direction(particle_id, dir_x, dir_y, dir_z)
1235
1236 integer, intent(in) :: particle_id, dir_x, dir_y, dir_z
1237
1238 p_send_ids(dir_x, dir_y, dir_z, p_send_counts(dir_x, dir_y, dir_z)) = particle_id
1239 p_send_counts(dir_x, dir_y, dir_z) = p_send_counts(dir_x, dir_y, dir_z) + 1
1240
1241 end subroutine s_add_particle_to_direction
1242
1244
1245 !> Perform the MPI communication for lagrangian particles/bubbles.
1246 impure subroutine s_mpi_sendrecv_particles(bub_R0, Rmax_stats, Rmin_stats, gas_mg, gas_betaT, gas_betaC, bub_dphidt, lag_id, &
1247 & gas_p, gas_mv, rad, rvel, pos, posPrev, vel, scoord, drad, drvel, dgasp, dgasmv, dpos, dvel, lag_num_ts, nbubs, dest)
1248
1249 real(wp), dimension(:) :: bub_r0, rmax_stats, rmin_stats, gas_mg, gas_betat, gas_betac, bub_dphidt
1250 integer, dimension(:,:) :: lag_id
1251 real(wp), dimension(:,:) :: gas_p, gas_mv, rad, rvel, drad, drvel, dgasp, dgasmv
1252 real(wp), dimension(:,:,:) :: pos, posprev, vel, scoord, dpos, dvel
1253 integer :: position, bub_id, lag_num_ts, tag, partner, send_tag, recv_tag, nbubs, p_recv_size, dest
1254 integer :: i, j, k, l, q, r
1255 integer :: req_send, req_recv, ierr !< Generic flag used to identify and report MPI errors
1256 integer :: send_count, send_offset, recv_count, recv_offset
1257
1258#ifdef MFC_MPI
1259 ! Phase 1: Exchange particle counts using non-blocking communication
1260 send_count = 0
1261 recv_count = 0
1262
1263 ! Post all receives first
1264 do l = 1, n_neighbors
1265 i = neighbor_list(l, 1)
1266 j = neighbor_list(l, 2)
1267 k = neighbor_list(l, 3)
1268 partner = neighbor_ranks(i, j, k)
1269 recv_tag = neighbor_tag(i, j, k)
1270
1271 recv_count = recv_count + 1
1272 call mpi_irecv(p_recv_counts(i, j, k), 1, mpi_integer, partner, recv_tag, mpi_comm_world, recv_requests(recv_count), &
1273 & ierr)
1274 end do
1275
1276 ! Post all sends
1277 do l = 1, n_neighbors
1278 i = neighbor_list(l, 1)
1279 j = neighbor_list(l, 2)
1280 k = neighbor_list(l, 3)
1281 partner = neighbor_ranks(i, j, k)
1282 send_tag = neighbor_tag(-i, -j, -k)
1283
1284 send_count = send_count + 1
1285 call mpi_isend(p_send_counts(i, j, k), 1, mpi_integer, partner, send_tag, mpi_comm_world, send_requests(send_count), &
1286 & ierr)
1287 end do
1288
1289 ! Wait for all count exchanges to complete
1290 if (recv_count > 0) then
1291 call mpi_waitall(recv_count, recv_requests(1:recv_count), mpi_statuses_ignore, ierr)
1292 end if
1293 if (send_count > 0) then
1294 call mpi_waitall(send_count, send_requests(1:send_count), mpi_statuses_ignore, ierr)
1295 end if
1296
1297 ! Phase 2: Exchange particle data using non-blocking communication
1298 send_count = 0
1299 recv_count = 0
1300
1301 ! Post all receives for particle data first
1302 recv_offset = 1
1303 do l = 1, n_neighbors
1304 i = neighbor_list(l, 1)
1305 j = neighbor_list(l, 2)
1306 k = neighbor_list(l, 3)
1307
1308 if (p_recv_counts(i, j, k) > 0) then
1309 partner = neighbor_ranks(i, j, k)
1310 p_recv_size = p_recv_counts(i, j, k)*p_var_size
1311 recv_tag = neighbor_tag(i, j, k)
1312
1313 recv_count = recv_count + 1
1314 call mpi_irecv(p_recv_buff(recv_offset), p_recv_size, mpi_packed, partner, recv_tag, mpi_comm_world, &
1315 & recv_requests(recv_count), ierr)
1316 recv_offsets(l) = recv_offset
1317 recv_offset = recv_offset + p_recv_size
1318 end if
1319 end do
1320
1321 ! Pack and send particle data
1322 send_offset = 0
1323 do l = 1, n_neighbors
1324 i = neighbor_list(l, 1)
1325 j = neighbor_list(l, 2)
1326 k = neighbor_list(l, 3)
1327
1328 if (p_send_counts(i, j, k) > 0 .and. abs(i) + abs(j) + abs(k) /= 0) then
1329 partner = neighbor_ranks(i, j, k)
1330 send_tag = neighbor_tag(-i, -j, -k)
1331
1332 ! Pack data for sending
1333 position = 0
1334 do q = 0, p_send_counts(i, j, k) - 1
1335 bub_id = p_send_ids(i, j, k, q)
1336
1337 call mpi_pack(lag_id(bub_id, 1), 1, mpi_integer, p_send_buff(send_offset), p_buff_size, position, &
1338 & mpi_comm_world, ierr)
1339 call mpi_pack(bub_r0(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, ierr)
1340 call mpi_pack(rmax_stats(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1341 & ierr)
1342 call mpi_pack(rmin_stats(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1343 & ierr)
1344 call mpi_pack(gas_mg(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, ierr)
1345 call mpi_pack(gas_betat(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1346 & ierr)
1347 call mpi_pack(gas_betac(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1348 & ierr)
1349 call mpi_pack(bub_dphidt(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1350 & ierr)
1351 do r = 1, 2
1352 call mpi_pack(gas_p(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1353 & mpi_comm_world, ierr)
1354 call mpi_pack(gas_mv(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1355 & mpi_comm_world, ierr)
1356 call mpi_pack(rad(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1357 & ierr)
1358 call mpi_pack(rvel(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1359 & ierr)
1360 call mpi_pack(pos(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1361 & ierr)
1362 call mpi_pack(posprev(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1363 & mpi_comm_world, ierr)
1364 call mpi_pack(vel(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1365 & ierr)
1366 call mpi_pack(scoord(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1367 & mpi_comm_world, ierr)
1368 end do
1369 do r = 1, lag_num_ts
1370 call mpi_pack(drad(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1371 & ierr)
1372 call mpi_pack(drvel(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1373 & mpi_comm_world, ierr)
1374 call mpi_pack(dgasp(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1375 & mpi_comm_world, ierr)
1376 call mpi_pack(dgasmv(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1377 & mpi_comm_world, ierr)
1378 call mpi_pack(dpos(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1379 & mpi_comm_world, ierr)
1380 call mpi_pack(dvel(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1381 & mpi_comm_world, ierr)
1382 end do
1383 end do
1384
1385 send_count = send_count + 1
1386 call mpi_isend(p_send_buff(send_offset), position, mpi_packed, partner, send_tag, mpi_comm_world, &
1387 & send_requests(send_count), ierr)
1388 send_offset = send_offset + position
1389 end if
1390 end do
1391
1392 ! Wait for all recvs for contiguous data to complete
1393 call mpi_waitall(recv_count, recv_requests(1:recv_count), mpi_statuses_ignore, ierr)
1394
1395 ! Process received data as it arrives
1396 do l = 1, n_neighbors
1397 i = neighbor_list(l, 1)
1398 j = neighbor_list(l, 2)
1399 k = neighbor_list(l, 3)
1400
1401 if (p_recv_counts(i, j, k) > 0 .and. abs(i) + abs(j) + abs(k) /= 0) then
1402 p_recv_size = p_recv_counts(i, j, k)*p_var_size
1403 recv_offset = recv_offsets(l)
1404
1405 position = 0
1406 ! Unpack received data
1407 do q = 0, p_recv_counts(i, j, k) - 1
1408 nbubs = nbubs + 1
1409 bub_id = nbubs
1410 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, lag_id(bub_id, 1), 1, mpi_integer, &
1411 & mpi_comm_world, ierr)
1412 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, bub_r0(bub_id), 1, mpi_p, mpi_comm_world, ierr)
1413 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, rmax_stats(bub_id), 1, mpi_p, &
1414 & mpi_comm_world, ierr)
1415 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, rmin_stats(bub_id), 1, mpi_p, &
1416 & mpi_comm_world, ierr)
1417 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_mg(bub_id), 1, mpi_p, mpi_comm_world, ierr)
1418 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_betat(bub_id), 1, mpi_p, mpi_comm_world, &
1419 & ierr)
1420 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_betac(bub_id), 1, mpi_p, mpi_comm_world, &
1421 & ierr)
1422 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, bub_dphidt(bub_id), 1, mpi_p, &
1423 & mpi_comm_world, ierr)
1424 do r = 1, 2
1425 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_p(bub_id, r), 1, mpi_p, &
1426 & mpi_comm_world, ierr)
1427 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_mv(bub_id, r), 1, mpi_p, &
1428 & mpi_comm_world, ierr)
1429 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, rad(bub_id, r), 1, mpi_p, &
1430 & mpi_comm_world, ierr)
1431 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, rvel(bub_id, r), 1, mpi_p, &
1432 & mpi_comm_world, ierr)
1433 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, pos(bub_id,:,r), 3, mpi_p, &
1434 & mpi_comm_world, ierr)
1435 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, posprev(bub_id,:,r), 3, mpi_p, &
1436 & mpi_comm_world, ierr)
1437 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, vel(bub_id,:,r), 3, mpi_p, &
1438 & mpi_comm_world, ierr)
1439 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, scoord(bub_id,:,r), 3, mpi_p, &
1440 & mpi_comm_world, ierr)
1441 end do
1442 do r = 1, lag_num_ts
1443 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, drad(bub_id, r), 1, mpi_p, &
1444 & mpi_comm_world, ierr)
1445 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, drvel(bub_id, r), 1, mpi_p, &
1446 & mpi_comm_world, ierr)
1447 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, dgasp(bub_id, r), 1, mpi_p, &
1448 & mpi_comm_world, ierr)
1449 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, dgasmv(bub_id, r), 1, mpi_p, &
1450 & mpi_comm_world, ierr)
1451 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, dpos(bub_id,:,r), 3, mpi_p, &
1452 & mpi_comm_world, ierr)
1453 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, dvel(bub_id,:,r), 3, mpi_p, &
1454 & mpi_comm_world, ierr)
1455 end do
1456 lag_id(bub_id, 2) = bub_id
1457 end do
1458 recv_offset = recv_offset + p_recv_size
1459 end if
1460 end do
1461
1462 ! Wait for all sends to complete
1463 if (send_count > 0) then
1464 call mpi_waitall(send_count, send_requests(1:send_count), mpi_statuses_ignore, ierr)
1465 end if
1466#endif
1467
1468 if (any(periodic_bc)) then
1469 call s_wrap_particle_positions(pos, posprev, nbubs, dest)
1470 end if
1471
1472 end subroutine s_mpi_sendrecv_particles
1473
1474 !> Return a unique tag for each neighbor based on its position relative to the current process.
1475 integer function neighbor_tag(i, j, k) result(tag)
1476
1477 integer, intent(in) :: i, j, k
1478
1479 tag = (k + 1)*9 + (j + 1)*3 + (i + 1)
1480
1481 end function neighbor_tag
1482
1483 subroutine s_wrap_particle_positions(pos, posPrev, nbubs, dest)
1484
1485 real(wp), dimension(:,:,:) :: pos, posPrev
1486 integer :: nbubs, dest
1487 integer :: i, q
1488 real(wp) :: offset
1489
1490 do i = 1, nbubs
1491 if (periodic_bc(1)) then
1492 offset = glb_bounds(1)%end - glb_bounds(1)%beg
1493 if (pos(i, 1, dest) > x_cb(m + buff_size)) then
1494 do q = 1, 2
1495 pos(i, 1, q) = pos(i, 1, q) - offset
1496 posprev(i, 1, q) = posprev(i, 1, q) - offset
1497 end do
1498 end if
1499 if (pos(i, 1, dest) < x_cb(-1 - buff_size)) then
1500 do q = 1, 2
1501 pos(i, 1, q) = pos(i, 1, q) + offset
1502 posprev(i, 1, q) = posprev(i, 1, q) + offset
1503 end do
1504 end if
1505 end if
1506
1507 if (periodic_bc(2)) then
1508 offset = glb_bounds(2)%end - glb_bounds(2)%beg
1509 if (pos(i, 2, dest) > y_cb(n + buff_size)) then
1510 do q = 1, 2
1511 pos(i, 2, q) = pos(i, 2, q) - offset
1512 posprev(i, 2, q) = posprev(i, 2, q) - offset
1513 end do
1514 end if
1515 if (pos(i, 2, dest) < y_cb(-buff_size - 1)) then
1516 do q = 1, 2
1517 pos(i, 2, q) = pos(i, 2, q) + offset
1518 posprev(i, 2, q) = posprev(i, 2, q) + offset
1519 end do
1520 end if
1521 end if
1522
1523 if (periodic_bc(3)) then
1524 offset = glb_bounds(3)%end - glb_bounds(3)%beg
1525 if (pos(i, 3, dest) > z_cb(p + buff_size)) then
1526 do q = 1, 2
1527 pos(i, 3, q) = pos(i, 3, q) - offset
1528 posprev(i, 3, q) = posprev(i, 3, q) - offset
1529 end do
1530 end if
1531 if (pos(i, 3, dest) < z_cb(-1 - buff_size)) then
1532 do q = 1, 2
1533 pos(i, 3, q) = pos(i, 3, q) + offset
1534 posprev(i, 3, q) = posprev(i, 3, q) + offset
1535 end do
1536 end if
1537 end if
1538 end do
1539
1540 end subroutine s_wrap_particle_positions
1541
1542 !> Broadcast random phase numbers from rank 0 to all MPI processes
1543 impure subroutine s_mpi_send_random_number(phi_rn, num_freq)
1544
1545 integer, intent(in) :: num_freq
1546 real(wp), intent(inout), dimension(1:num_freq) :: phi_rn
1547
1548#ifdef MFC_MPI
1549 integer :: ierr !< Generic flag used to identify and report MPI errors
1550 call mpi_bcast(phi_rn, num_freq, mpi_p, 0, mpi_comm_world, ierr)
1551#endif
1552
1553 end subroutine s_mpi_send_random_number
1554
1555 !> Finalize the MPI proxy module
1557
1558#ifdef MFC_MPI
1559 if (ib) then
1560#ifdef MFC_DEBUG
1561# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1562 block
1563# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1564 use iso_fortran_env, only: output_unit
1565# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1566
1567# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1568 print *, 'm_mpi_proxy.fpp:659: ', '@:DEALLOCATE(ib_buff_send, ib_buff_recv)'
1569# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1570
1571# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1572 call flush (output_unit)
1573# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1574 end block
1575# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1576#endif
1577# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1578
1579# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1580#if defined(MFC_OpenACC)
1581# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1582!$acc exit data delete(ib_buff_send, ib_buff_recv)
1583# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1584#elif defined(MFC_OpenMP)
1585# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1586!$omp target exit data map(release:ib_buff_send, ib_buff_recv)
1587# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1588#endif
1589# 659 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1590 deallocate (ib_buff_send, ib_buff_recv)
1591 end if
1592
1593 if (allocated(p_send_buff)) then
1594#ifdef MFC_DEBUG
1595# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1596 block
1597# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1598 use iso_fortran_env, only: output_unit
1599# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1600
1601# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1602 print *, 'm_mpi_proxy.fpp:663: ', '@:DEALLOCATE(p_send_buff, p_recv_buff)'
1603# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1604
1605# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1606 call flush (output_unit)
1607# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1608 end block
1609# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1610#endif
1611# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1612
1613# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1614#if defined(MFC_OpenACC)
1615# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1616!$acc exit data delete(p_send_buff, p_recv_buff)
1617# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1618#elif defined(MFC_OpenMP)
1619# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1620!$omp target exit data map(release:p_send_buff, p_recv_buff)
1621# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1622#endif
1623# 663 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1624 deallocate (p_send_buff, p_recv_buff)
1625#ifdef MFC_DEBUG
1626# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1627 block
1628# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1629 use iso_fortran_env, only: output_unit
1630# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1631
1632# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1633 print *, 'm_mpi_proxy.fpp:664: ', '@:DEALLOCATE(p_send_ids)'
1634# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1635
1636# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1637 call flush (output_unit)
1638# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1639 end block
1640# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1641#endif
1642# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1643
1644# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1645#if defined(MFC_OpenACC)
1646# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1647!$acc exit data delete(p_send_ids)
1648# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1649#elif defined(MFC_OpenMP)
1650# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1651!$omp target exit data map(release:p_send_ids)
1652# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1653#endif
1654# 664 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1655 deallocate (p_send_ids)
1656 end if
1657#endif
1658
1659 end subroutine s_finalize_mpi_proxy_module
1660
1661end 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