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# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
98
99# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
100
101# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
102
103# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
104
105# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
106
107# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
108
109# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
110
111# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
112
113# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151
152# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
153! New line at end of file is required for FYPP
154# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
155# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
156# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
157# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162
163# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
164# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166
167# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
168
169# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170
171# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172
173# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
174
175# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176
177# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
178
179# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
180
181# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
182! New line at end of file is required for FYPP
183# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
184
185# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
186
187# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
188
189# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
190
191# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
192
193# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
194
195# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
196
197# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
198
199# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
200
201# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
202
203# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
204
205# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
206
207# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236
237# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
238
239# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
240! New line at end of file is required for FYPP
241# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
242
243! GPU parallel region (scalar reductions, maxval/minval)
244# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
245
246! GPU parallel loop over threads (most common GPU macro)
247# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
248
249! Required closing for GPU_PARALLEL_LOOP
250# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
251
252! Mark routine for device compilation
253# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
254
255! Declare device-resident data
256# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
257
258! Inner loop within a GPU parallel region
259# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
260
261! Scoped GPU data region
262# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
263
264! Host code with device pointers (for MPI with GPU buffers)
265# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
266
267! Allocate device memory (unscoped)
268# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
269
270! Free device memory
271# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
272
273! Atomic operation on device
274# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
275
276! End atomic capture block
277# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
278
279! Copy data between host and device
280# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
281
282! Synchronization barrier
283# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
284
285! Import GPU library module (openacc or omp_lib)
286# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
287
288! Emit code only for AMD compiler
289# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
290
291! Emit code for non-Cray compilers
292# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
293
294! Emit code only for Cray compiler
295# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
296
297! Emit code for non-NVIDIA compilers
298# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
299
300# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
301# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
302! New line at end of file is required for FYPP
303# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
304
305# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
306
307! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
308! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
309! example see misc/nvidia_uvm/bind.sh.
310# 55 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312! Allocate and create GPU device memory
313# 75 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
314
315! Free GPU device memory and deallocate
316# 83 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
317
318! Cray-specific GPU pointer setup for vector fields
319# 107 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
320
321! Cray-specific GPU pointer setup for scalar fields
322# 123 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
323
324! Cray-specific GPU pointer setup for acoustic source spatials
325# 148 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
326
327# 154 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
328
329# 161 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
330! New line at end of file is required for FYPP
331# 7 "/home/runner/work/MFC/MFC/src/simulation/m_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_integrals, 1, mpi_integer, 0, mpi_comm_world, ierr)
590 call mpi_bcast(num_particle_clouds, 1, mpi_integer, 0, mpi_comm_world, ierr)
591 call mpi_bcast(num_probes, 1, mpi_integer, 0, mpi_comm_world, ierr)
592 call mpi_bcast(num_source, 1, mpi_integer, 0, mpi_comm_world, ierr)
593 call mpi_bcast(num_stl_models, 1, mpi_integer, 0, mpi_comm_world, ierr)
594 call mpi_bcast(num_turbulent_sources, 1, mpi_integer, 0, mpi_comm_world, ierr)
595 call mpi_bcast(nv_uvm_igr_temps_on_gpu, 1, mpi_integer, 0, mpi_comm_world, ierr)
596 call mpi_bcast(p, 1, mpi_integer, 0, mpi_comm_world, ierr)
597 call mpi_bcast(precision, 1, mpi_integer, 0, mpi_comm_world, ierr)
598 call mpi_bcast(relax_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
599 call mpi_bcast(riemann_solver, 1, mpi_integer, 0, mpi_comm_world, ierr)
600 call mpi_bcast(synth_n_shells, 1, mpi_integer, 0, mpi_comm_world, ierr)
601 call mpi_bcast(synth_seed, 1, mpi_integer, 0, mpi_comm_world, ierr)
602 call mpi_bcast(t_step_old, 1, mpi_integer, 0, mpi_comm_world, ierr)
603 call mpi_bcast(t_step_print, 1, mpi_integer, 0, mpi_comm_world, ierr)
604 call mpi_bcast(t_step_save, 1, mpi_integer, 0, mpi_comm_world, ierr)
605 call mpi_bcast(t_step_start, 1, mpi_integer, 0, mpi_comm_world, ierr)
606 call mpi_bcast(t_step_stop, 1, mpi_integer, 0, mpi_comm_world, ierr)
607 call mpi_bcast(thermal, 1, mpi_integer, 0, mpi_comm_world, ierr)
608 call mpi_bcast(time_stepper, 1, mpi_integer, 0, mpi_comm_world, ierr)
609 call mpi_bcast(wave_speeds, 1, mpi_integer, 0, mpi_comm_world, ierr)
610
611 ! Logical scalars
612 call mpi_bcast(acoustic_source, 1, mpi_logical, 0, mpi_comm_world, ierr)
613 call mpi_bcast(adap_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
614 call mpi_bcast(adv_n, 1, mpi_logical, 0, mpi_comm_world, ierr)
615 call mpi_bcast(alt_soundspeed, 1, mpi_logical, 0, mpi_comm_world, ierr)
616 call mpi_bcast(bf_spatial_support, 1, mpi_logical, 0, mpi_comm_world, ierr)
617 call mpi_bcast(bf_x, 1, mpi_logical, 0, mpi_comm_world, ierr)
618 call mpi_bcast(bf_y, 1, mpi_logical, 0, mpi_comm_world, ierr)
619 call mpi_bcast(bf_z, 1, mpi_logical, 0, mpi_comm_world, ierr)
620 call mpi_bcast(bubbles_euler, 1, mpi_logical, 0, mpi_comm_world, ierr)
621 call mpi_bcast(bubbles_lagrange, 1, mpi_logical, 0, mpi_comm_world, ierr)
622 call mpi_bcast(cfl_adap_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
623 call mpi_bcast(cfl_const_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
624 call mpi_bcast(cont_damage, 1, mpi_logical, 0, mpi_comm_world, ierr)
625 call mpi_bcast(cyl_coord, 1, mpi_logical, 0, mpi_comm_world, ierr)
626 call mpi_bcast(down_sample, 1, mpi_logical, 0, mpi_comm_world, ierr)
627 call mpi_bcast(fft_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
628 call mpi_bcast(file_per_process, 1, mpi_logical, 0, mpi_comm_world, ierr)
629 call mpi_bcast(hll_u_interface, 1, mpi_logical, 0, mpi_comm_world, ierr)
630 call mpi_bcast(hyper_cleaning, 1, mpi_logical, 0, mpi_comm_world, ierr)
631 call mpi_bcast(hypo_hll_interface_rhs, 1, mpi_logical, 0, mpi_comm_world, ierr)
632 call mpi_bcast(hypoelasticity, 1, mpi_logical, 0, mpi_comm_world, ierr)
633 call mpi_bcast(ib, 1, mpi_logical, 0, mpi_comm_world, ierr)
634 call mpi_bcast(ib_state_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
635 call mpi_bcast(integral_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
636 call mpi_bcast(many_ib_patch_parallelism, 1, mpi_logical, 0, mpi_comm_world, ierr)
637 call mpi_bcast(mixture_err, 1, mpi_logical, 0, mpi_comm_world, ierr)
638 call mpi_bcast(mp_weno, 1, mpi_logical, 0, mpi_comm_world, ierr)
639 call mpi_bcast(mpp_lim, 1, mpi_logical, 0, mpi_comm_world, ierr)
640 call mpi_bcast(null_weights, 1, mpi_logical, 0, mpi_comm_world, ierr)
641 call mpi_bcast(nv_uvm_out_of_core, 1, mpi_logical, 0, mpi_comm_world, ierr)
642 call mpi_bcast(nv_uvm_pref_gpu, 1, mpi_logical, 0, mpi_comm_world, ierr)
643 call mpi_bcast(parallel_io, 1, mpi_logical, 0, mpi_comm_world, ierr)
644 call mpi_bcast(polydisperse, 1, mpi_logical, 0, mpi_comm_world, ierr)
645 call mpi_bcast(polytropic, 1, mpi_logical, 0, mpi_comm_world, ierr)
646 call mpi_bcast(prim_vars_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
647 call mpi_bcast(probe_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
648 call mpi_bcast(qbmm, 1, mpi_logical, 0, mpi_comm_world, ierr)
649 call mpi_bcast(rdma_mpi, 1, mpi_logical, 0, mpi_comm_world, ierr)
650 call mpi_bcast(reactive_burn, 1, mpi_logical, 0, mpi_comm_world, ierr)
651 call mpi_bcast(relax, 1, mpi_logical, 0, mpi_comm_world, ierr)
652 call mpi_bcast(riemann_hypo_adc, 1, mpi_logical, 0, mpi_comm_world, ierr)
653 call mpi_bcast(run_time_info, 1, mpi_logical, 0, mpi_comm_world, ierr)
654 call mpi_bcast(surface_tension, 1, mpi_logical, 0, mpi_comm_world, ierr)
655 call mpi_bcast(synthetic_turbulence, 1, mpi_logical, 0, mpi_comm_world, ierr)
656 call mpi_bcast(weno_re_flux, 1, mpi_logical, 0, mpi_comm_world, ierr)
657 call mpi_bcast(weno_avg, 1, mpi_logical, 0, mpi_comm_world, ierr)
658
659 ! Real scalars
660 call mpi_bcast(adc_kappa, 1, mpi_p, 0, mpi_comm_world, ierr)
661 call mpi_bcast(bx0, 1, mpi_p, 0, mpi_comm_world, ierr)
662 call mpi_bcast(ca, 1, mpi_p, 0, mpi_comm_world, ierr)
663 call mpi_bcast(r0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
664 call mpi_bcast(re_inv, 1, mpi_p, 0, mpi_comm_world, ierr)
665 call mpi_bcast(web, 1, mpi_p, 0, mpi_comm_world, ierr)
666 call mpi_bcast(adap_dt_tol, 1, mpi_p, 0, mpi_comm_world, ierr)
667 call mpi_bcast(alf_factor, 1, mpi_p, 0, mpi_comm_world, ierr)
668 call mpi_bcast(alpha_bar, 1, mpi_p, 0, mpi_comm_world, ierr)
669 call mpi_bcast(cfl_target, 1, mpi_p, 0, mpi_comm_world, ierr)
670 call mpi_bcast(coefficient_of_restitution, 1, mpi_p, 0, mpi_comm_world, ierr)
671 call mpi_bcast(collision_time, 1, mpi_p, 0, mpi_comm_world, ierr)
672 call mpi_bcast(cont_damage_s, 1, mpi_p, 0, mpi_comm_world, ierr)
673 call mpi_bcast(dt, 1, mpi_p, 0, mpi_comm_world, ierr)
674 call mpi_bcast(g_x, 1, mpi_p, 0, mpi_comm_world, ierr)
675 call mpi_bcast(g_y, 1, mpi_p, 0, mpi_comm_world, ierr)
676 call mpi_bcast(g_z, 1, mpi_p, 0, mpi_comm_world, ierr)
677 call mpi_bcast(hyper_cleaning_speed, 1, mpi_p, 0, mpi_comm_world, ierr)
678 call mpi_bcast(hyper_cleaning_tau, 1, mpi_p, 0, mpi_comm_world, ierr)
679 call mpi_bcast(ib_coefficient_of_friction, 1, mpi_p, 0, mpi_comm_world, ierr)
680 call mpi_bcast(ic_beta, 1, mpi_p, 0, mpi_comm_world, ierr)
681 call mpi_bcast(ic_eps, 1, mpi_p, 0, mpi_comm_world, ierr)
682 call mpi_bcast(k_x, 1, mpi_p, 0, mpi_comm_world, ierr)
683 call mpi_bcast(k_y, 1, mpi_p, 0, mpi_comm_world, ierr)
684 call mpi_bcast(k_z, 1, mpi_p, 0, mpi_comm_world, ierr)
685 call mpi_bcast(muscl_eps, 1, mpi_p, 0, mpi_comm_world, ierr)
686 call mpi_bcast(p_x, 1, mpi_p, 0, mpi_comm_world, ierr)
687 call mpi_bcast(p_y, 1, mpi_p, 0, mpi_comm_world, ierr)
688 call mpi_bcast(p_z, 1, mpi_p, 0, mpi_comm_world, ierr)
689 call mpi_bcast(palpha_eps, 1, mpi_p, 0, mpi_comm_world, ierr)
690 call mpi_bcast(pi_fac, 1, mpi_p, 0, mpi_comm_world, ierr)
691 call mpi_bcast(poly_sigma, 1, mpi_p, 0, mpi_comm_world, ierr)
692 call mpi_bcast(ptgalpha_eps, 1, mpi_p, 0, mpi_comm_world, ierr)
693 call mpi_bcast(sigma, 1, mpi_p, 0, mpi_comm_world, ierr)
694 call mpi_bcast(synth_u_inf, 1, mpi_p, 0, mpi_comm_world, ierr)
695 call mpi_bcast(t_save, 1, mpi_p, 0, mpi_comm_world, ierr)
696 call mpi_bcast(t_stop, 1, mpi_p, 0, mpi_comm_world, ierr)
697 call mpi_bcast(tau_star, 1, mpi_p, 0, mpi_comm_world, ierr)
698 call mpi_bcast(teno_ct, 1, mpi_p, 0, mpi_comm_world, ierr)
699 call mpi_bcast(w_x, 1, mpi_p, 0, mpi_comm_world, ierr)
700 call mpi_bcast(w_y, 1, mpi_p, 0, mpi_comm_world, ierr)
701 call mpi_bcast(w_z, 1, mpi_p, 0, mpi_comm_world, ierr)
702 call mpi_bcast(weno_eps, 1, mpi_p, 0, mpi_comm_world, ierr)
703
704 ! Case-optimization scalars (absent when constants are baked in)
705# 139 "/home/runner/work/MFC/MFC/build/include/simulation/generated_bcast.fpp"
706 call mpi_bcast(igr_iter_solver, 1, mpi_integer, 0, mpi_comm_world, ierr)
707 call mpi_bcast(igr_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
708 call mpi_bcast(muscl_lim, 1, mpi_integer, 0, mpi_comm_world, ierr)
709 call mpi_bcast(muscl_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
710 call mpi_bcast(nb, 1, mpi_integer, 0, mpi_comm_world, ierr)
711 call mpi_bcast(num_fluids, 1, mpi_integer, 0, mpi_comm_world, ierr)
712 call mpi_bcast(recon_type, 1, mpi_integer, 0, mpi_comm_world, ierr)
713 call mpi_bcast(weno_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
714 call mpi_bcast(igr, 1, mpi_logical, 0, mpi_comm_world, ierr)
715 call mpi_bcast(igr_pres_lim, 1, mpi_logical, 0, mpi_comm_world, ierr)
716 call mpi_bcast(mapped_weno, 1, mpi_logical, 0, mpi_comm_world, ierr)
717 call mpi_bcast(mhd, 1, mpi_logical, 0, mpi_comm_world, ierr)
718 call mpi_bcast(relativity, 1, mpi_logical, 0, mpi_comm_world, ierr)
719 call mpi_bcast(teno, 1, mpi_logical, 0, mpi_comm_world, ierr)
720 call mpi_bcast(viscous, 1, mpi_logical, 0, mpi_comm_world, ierr)
721 call mpi_bcast(wenoz, 1, mpi_logical, 0, mpi_comm_world, ierr)
722 call mpi_bcast(wenoz_q, 1, mpi_p, 0, mpi_comm_world, ierr)
723# 157 "/home/runner/work/MFC/MFC/build/include/simulation/generated_bcast.fpp"
724
725 ! fluid_pp member loop
726 do i = 1, num_fluids_max
727 call mpi_bcast(fluid_pp(i)%G, 1, mpi_p, 0, mpi_comm_world, ierr)
728 call mpi_bcast(fluid_pp(i)%K, 1, mpi_p, 0, mpi_comm_world, ierr)
729 call mpi_bcast(fluid_pp(i)%cv, 1, mpi_p, 0, mpi_comm_world, ierr)
730 call mpi_bcast(fluid_pp(i)%gamma, 1, mpi_p, 0, mpi_comm_world, ierr)
731 call mpi_bcast(fluid_pp(i)%hb_m, 1, mpi_p, 0, mpi_comm_world, ierr)
732 call mpi_bcast(fluid_pp(i)%mu_bulk, 1, mpi_p, 0, mpi_comm_world, ierr)
733 call mpi_bcast(fluid_pp(i)%mu_max, 1, mpi_p, 0, mpi_comm_world, ierr)
734 call mpi_bcast(fluid_pp(i)%mu_min, 1, mpi_p, 0, mpi_comm_world, ierr)
735 call mpi_bcast(fluid_pp(i)%nn, 1, mpi_p, 0, mpi_comm_world, ierr)
736 call mpi_bcast(fluid_pp(i)%non_newtonian, 1, mpi_logical, 0, mpi_comm_world, ierr)
737 call mpi_bcast(fluid_pp(i)%pi_inf, 1, mpi_p, 0, mpi_comm_world, ierr)
738 call mpi_bcast(fluid_pp(i)%qv, 1, mpi_p, 0, mpi_comm_world, ierr)
739 call mpi_bcast(fluid_pp(i)%qvp, 1, mpi_p, 0, mpi_comm_world, ierr)
740 call mpi_bcast(fluid_pp(i)%tau0, 1, mpi_p, 0, mpi_comm_world, ierr)
741 call mpi_bcast(fluid_pp(i)%Re(1), 2, mpi_p, 0, mpi_comm_world, ierr)
742 end do
743
744 ! bub_pp members (under bubbles guard)
745 if (bubbles_euler .or. bubbles_lagrange) then
746 call mpi_bcast(bub_pp%M_g, 1, mpi_p, 0, mpi_comm_world, ierr)
747 call mpi_bcast(bub_pp%M_v, 1, mpi_p, 0, mpi_comm_world, ierr)
748 call mpi_bcast(bub_pp%R0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
749 call mpi_bcast(bub_pp%R_g, 1, mpi_p, 0, mpi_comm_world, ierr)
750 call mpi_bcast(bub_pp%R_v, 1, mpi_p, 0, mpi_comm_world, ierr)
751 call mpi_bcast(bub_pp%T0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
752 call mpi_bcast(bub_pp%cp_g, 1, mpi_p, 0, mpi_comm_world, ierr)
753 call mpi_bcast(bub_pp%cp_v, 1, mpi_p, 0, mpi_comm_world, ierr)
754 call mpi_bcast(bub_pp%gam_g, 1, mpi_p, 0, mpi_comm_world, ierr)
755 call mpi_bcast(bub_pp%gam_v, 1, mpi_p, 0, mpi_comm_world, ierr)
756 call mpi_bcast(bub_pp%k_g, 1, mpi_p, 0, mpi_comm_world, ierr)
757 call mpi_bcast(bub_pp%k_v, 1, mpi_p, 0, mpi_comm_world, ierr)
758 call mpi_bcast(bub_pp%mu_g, 1, mpi_p, 0, mpi_comm_world, ierr)
759 call mpi_bcast(bub_pp%mu_l, 1, mpi_p, 0, mpi_comm_world, ierr)
760 call mpi_bcast(bub_pp%mu_v, 1, mpi_p, 0, mpi_comm_world, ierr)
761 call mpi_bcast(bub_pp%p0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
762 call mpi_bcast(bub_pp%pv, 1, mpi_p, 0, mpi_comm_world, ierr)
763 call mpi_bcast(bub_pp%rho0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
764 call mpi_bcast(bub_pp%ss, 1, mpi_p, 0, mpi_comm_world, ierr)
765 call mpi_bcast(bub_pp%vd, 1, mpi_p, 0, mpi_comm_world, ierr)
766 end if
767
768 ! lag_params members (under bubbles_lagrange guard)
769 if (bubbles_lagrange) then
770 call mpi_bcast(lag_params%gravity_force, 1, mpi_logical, 0, mpi_comm_world, ierr)
771 call mpi_bcast(lag_params%heatTransfer_model, 1, mpi_logical, 0, mpi_comm_world, ierr)
772 call mpi_bcast(lag_params%kahan_summation, 1, mpi_logical, 0, mpi_comm_world, ierr)
773 call mpi_bcast(lag_params%massTransfer_model, 1, mpi_logical, 0, mpi_comm_world, ierr)
774 call mpi_bcast(lag_params%pressure_corrector, 1, mpi_logical, 0, mpi_comm_world, ierr)
775 call mpi_bcast(lag_params%pressure_force, 1, mpi_logical, 0, mpi_comm_world, ierr)
776 call mpi_bcast(lag_params%write_bubbles, 1, mpi_logical, 0, mpi_comm_world, ierr)
777 call mpi_bcast(lag_params%write_bubbles_stats, 1, mpi_logical, 0, mpi_comm_world, ierr)
778 call mpi_bcast(lag_params%write_void_evol, 1, mpi_logical, 0, mpi_comm_world, ierr)
779 call mpi_bcast(lag_params%charNz, 1, mpi_integer, 0, mpi_comm_world, ierr)
780 call mpi_bcast(lag_params%cluster_type, 1, mpi_integer, 0, mpi_comm_world, ierr)
781 call mpi_bcast(lag_params%drag_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
782 call mpi_bcast(lag_params%nBubs_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
783 call mpi_bcast(lag_params%smooth_type, 1, mpi_integer, 0, mpi_comm_world, ierr)
784 call mpi_bcast(lag_params%solver_approach, 1, mpi_integer, 0, mpi_comm_world, ierr)
785 call mpi_bcast(lag_params%vel_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
786 call mpi_bcast(lag_params%charwidth, 1, mpi_p, 0, mpi_comm_world, ierr)
787 call mpi_bcast(lag_params%epsilonb, 1, mpi_p, 0, mpi_comm_world, ierr)
788 call mpi_bcast(lag_params%valmaxvoid, 1, mpi_p, 0, mpi_comm_world, ierr)
789 call mpi_bcast(lag_params%input_path, len(lag_params%input_path), mpi_character, 0, mpi_comm_world, ierr)
790 end if
791
792 ! chem_params members (under chemistry guard)
793 if (chemistry) then
794 call mpi_bcast(chem_params%adap_substeps, 1, mpi_logical, 0, mpi_comm_world, ierr)
795 call mpi_bcast(chem_params%diffusion, 1, mpi_logical, 0, mpi_comm_world, ierr)
796 call mpi_bcast(chem_params%reactions, 1, mpi_logical, 0, mpi_comm_world, ierr)
797 call mpi_bcast(chem_params%gamma_method, 1, mpi_integer, 0, mpi_comm_world, ierr)
798 call mpi_bcast(chem_params%reaction_substeps, 1, mpi_integer, 0, mpi_comm_world, ierr)
799 call mpi_bcast(chem_params%reaction_substeps_max, 1, mpi_integer, 0, mpi_comm_world, ierr)
800 call mpi_bcast(chem_params%transport_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
801 end if
802
803 ! rburn members (under reactive_burn guard)
804 if (reactive_burn) then
805 call mpi_bcast(rburn%k, 1, mpi_p, 0, mpi_comm_world, ierr)
806 call mpi_bcast(rburn%n, 1, mpi_p, 0, mpi_comm_world, ierr)
807 call mpi_bcast(rburn%pign, 1, mpi_p, 0, mpi_comm_world, ierr)
808 call mpi_bcast(rburn%pref, 1, mpi_p, 0, mpi_comm_world, ierr)
809 call mpi_bcast(rburn%ta, 1, mpi_p, 0, mpi_comm_world, ierr)
810 end if
811
812# 113 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp" 2
813
814 ! manual: m_glb, n_glb, p_glb (computed in s_read_input_file, not namelist-bound)
815 call mpi_bcast(m_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
816 call mpi_bcast(n_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
817 call mpi_bcast(p_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
818
819 ! manual: bc_x/y/z member broadcasts (struct members not in NAMELIST_VARS)
820# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
821 call mpi_bcast(bc_x%beg, 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_x%end, 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%beg, 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_y%end, 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%beg, 1, mpi_integer, 0, mpi_comm_world, ierr)
830# 121 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
831 call mpi_bcast(bc_z%end, 1, mpi_integer, 0, mpi_comm_world, ierr)
832# 123 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
833
834# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
835 call mpi_bcast(bc_x%grcbc_in, 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_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_x%grcbc_vel_out, 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_in, 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_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_y%grcbc_vel_out, 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_in, 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_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_z%grcbc_vel_out, 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_x%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_y%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_z%isothermal_in, 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_x%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_y%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
862# 129 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
863 call mpi_bcast(bc_z%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
864# 131 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
865
866# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
867 call mpi_bcast(bc_x%vb1, 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%vb2, 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%vb3, 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%ve1, 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%ve2, 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_x%ve3, 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%vb1, 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%vb2, 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%vb3, 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%ve1, 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%ve2, 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_y%ve3, 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%vb1, 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%vb2, 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%vb3, 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%ve1, 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%ve2, 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_z%ve3, 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_in, 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_x%pres_out, 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_in, 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_y%pres_out, 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_in, 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_z%pres_out, 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_in, 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_x%Twall_out, 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_in, 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_y%Twall_out, 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_in, 1, mpi_p, 0, mpi_comm_world, ierr)
924# 139 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
925 call mpi_bcast(bc_z%Twall_out, 1, mpi_p, 0, mpi_comm_world, ierr)
926# 141 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
927
928 do i = 1, 3
929# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
930 call mpi_bcast(bc_x%vel_in (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_x%vel_out (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_in (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_y%vel_out (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_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
939# 145 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
940 call mpi_bcast(bc_z%vel_out (i), 1, mpi_p, 0, mpi_comm_world, ierr)
941# 147 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
942 end do
943
944 ! manual: cfl_dt (runtime-computed logical), bc_io (BC-file existence)
945 call mpi_bcast(cfl_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
946 call mpi_bcast(bc_io, 1, mpi_logical, 0, mpi_comm_world, ierr)
947
948 ! manual: shear_stress, bulk_stress (derived from Re_size post-init on all ranks),
949 ! bodyForces (derived from bf_x/y/z)
950 call mpi_bcast(shear_stress, 1, mpi_logical, 0, mpi_comm_world, ierr)
951 call mpi_bcast(bulk_stress, 1, mpi_logical, 0, mpi_comm_world, ierr)
952 call mpi_bcast(bodyforces, 1, mpi_logical, 0, mpi_comm_world, ierr)
953
954 ! manual: bc_x per-fluid inflow arrays (loop over num_fluids_max)
955 do i = 1, num_fluids_max
956# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
957 call mpi_bcast(bc_x%alpha_rho_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_x%alpha_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_rho_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_y%alpha_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_rho_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
966# 163 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
967 call mpi_bcast(bc_z%alpha_in (i), 1, mpi_p, 0, mpi_comm_world, ierr)
968# 165 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
969 end do
970
971 ! manual: patch_ib (sim member subset differs from pre; uses count=3, adds mass/moving_ibm)
972 do i = 1, num_ibs
973# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
974 call mpi_bcast(patch_ib(i)%radius, 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_x, 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_y, 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)%length_z, 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)%x_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)%y_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)%z_centroid, 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)%slip, 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)%mass, 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)%v_blow, 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_exp, 1, mpi_p, 0, mpi_comm_world, ierr)
995# 172 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
996 call mpi_bcast(patch_ib(i)%burn_rate_pref, 1, mpi_p, 0, mpi_comm_world, ierr)
997# 174 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
998# 175 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
999 call mpi_bcast(patch_ib(i)%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)%angular_vel, 3, mpi_p, 0, mpi_comm_world, ierr)
1002# 175 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1003 call mpi_bcast(patch_ib(i)%angles, 3, mpi_p, 0, mpi_comm_world, ierr)
1004# 177 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1005 call mpi_bcast(patch_ib(i)%geometry, 1, mpi_integer, 0, mpi_comm_world, ierr)
1006 call mpi_bcast(patch_ib(i)%moving_ibm, 1, mpi_integer, 0, mpi_comm_world, ierr)
1007 call mpi_bcast(patch_ib(i)%airfoil_id, 1, mpi_integer, 0, mpi_comm_world, ierr)
1008 call mpi_bcast(patch_ib(i)%model_id, 1, mpi_integer, 0, mpi_comm_world, ierr)
1009 call mpi_bcast(patch_ib(i)%inj_species, 1, mpi_integer, 0, mpi_comm_world, ierr)
1010 end do
1011
1012 ! manual: ib_airfoil (kept manual alongside patch_ib)
1013 do i = 1, num_ib_airfoils_max
1014# 187 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1015 call mpi_bcast(ib_airfoil(i)%c, 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)%p, 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)%t, 1, mpi_p, 0, mpi_comm_world, ierr)
1020# 187 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1021 call mpi_bcast(ib_airfoil(i)%m, 1, mpi_p, 0, mpi_comm_world, ierr)
1022# 189 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1023 end do
1024
1025 ! manual: stl_models loop (num_stl_models scalar is generated; grouped array members)
1026 do i = 1, num_stl_models_max
1027 call mpi_bcast(stl_models(i)%model_filepath, len(stl_models(i)%model_filepath), mpi_character, 0, mpi_comm_world, ierr)
1028 call mpi_bcast(stl_models(i)%model_threshold, 1, 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_translate, 3, mpi_p, 0, mpi_comm_world, ierr)
1031# 196 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1032 call mpi_bcast(stl_models(i)%model_scale, 3, mpi_p, 0, mpi_comm_world, ierr)
1033# 198 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1034 end do
1035
1036 ! manual: particle_cloud (runtime loop to num_particle_clouds; irregular member subset)
1037 do i = 1, num_particle_clouds
1038# 204 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1039 call mpi_bcast(particle_cloud(i)%x_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)%y_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)%z_centroid, 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_x, 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_y, 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)%length_z, 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)%radius, 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)%mass, 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)%min_spacing, 1, mpi_p, 0, mpi_comm_world, ierr)
1056# 206 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1057 call mpi_bcast(particle_cloud(i)%num_particles, 1, mpi_integer, 0, mpi_comm_world, ierr)
1058 call mpi_bcast(particle_cloud(i)%moving_ibm, 1, mpi_integer, 0, mpi_comm_world, ierr)
1059 call mpi_bcast(particle_cloud(i)%seed, 1, mpi_integer, 0, mpi_comm_world, ierr)
1060 call mpi_bcast(particle_cloud(i)%packing_method, 1, mpi_integer, 0, mpi_comm_world, ierr)
1061 end do
1062
1063 ! manual: acoustic/probe/integral (combined loop; complex acoustic member set)
1064 do j = 1, num_probes_max
1065 do i = 1, 3
1066 call mpi_bcast(acoustic(j)%loc(i), 1, mpi_p, 0, mpi_comm_world, ierr)
1067 end do
1068
1069 call mpi_bcast(acoustic(j)%dipole, 1, mpi_logical, 0, mpi_comm_world, ierr)
1070
1071# 221 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1072 call mpi_bcast(acoustic(j)%pulse, 1, mpi_integer, 0, mpi_comm_world, ierr)
1073# 221 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1074 call mpi_bcast(acoustic(j)%support, 1, mpi_integer, 0, mpi_comm_world, ierr)
1075# 221 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1076 call mpi_bcast(acoustic(j)%num_elements, 1, mpi_integer, 0, mpi_comm_world, ierr)
1077# 221 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1078 call mpi_bcast(acoustic(j)%element_on, 1, mpi_integer, 0, mpi_comm_world, ierr)
1079# 221 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1080 call mpi_bcast(acoustic(j)%bb_num_freq, 1, mpi_integer, 0, mpi_comm_world, ierr)
1081# 223 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1082
1083# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1084 call mpi_bcast(acoustic(j)%mag, 1, mpi_p, 0, mpi_comm_world, ierr)
1085# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1086 call mpi_bcast(acoustic(j)%length, 1, mpi_p, 0, mpi_comm_world, ierr)
1087# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1088 call mpi_bcast(acoustic(j)%height, 1, mpi_p, 0, mpi_comm_world, ierr)
1089# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1090 call mpi_bcast(acoustic(j)%wavelength, 1, mpi_p, 0, mpi_comm_world, ierr)
1091# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1092 call mpi_bcast(acoustic(j)%frequency, 1, mpi_p, 0, mpi_comm_world, ierr)
1093# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1094 call mpi_bcast(acoustic(j)%gauss_sigma_dist, 1, mpi_p, 0, mpi_comm_world, ierr)
1095# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1096 call mpi_bcast(acoustic(j)%gauss_sigma_time, 1, mpi_p, 0, mpi_comm_world, ierr)
1097# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1098 call mpi_bcast(acoustic(j)%npulse, 1, mpi_p, 0, mpi_comm_world, ierr)
1099# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1100 call mpi_bcast(acoustic(j)%dir, 1, mpi_p, 0, mpi_comm_world, ierr)
1101# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1102 call mpi_bcast(acoustic(j)%delay, 1, mpi_p, 0, mpi_comm_world, ierr)
1103# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1104 call mpi_bcast(acoustic(j)%foc_length, 1, mpi_p, 0, mpi_comm_world, ierr)
1105# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1106 call mpi_bcast(acoustic(j)%aperture, 1, mpi_p, 0, mpi_comm_world, ierr)
1107# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1108 call mpi_bcast(acoustic(j)%element_spacing_angle, 1, mpi_p, 0, mpi_comm_world, ierr)
1109# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1110 call mpi_bcast(acoustic(j)%element_polygon_ratio, 1, mpi_p, 0, mpi_comm_world, ierr)
1111# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1112 call mpi_bcast(acoustic(j)%rotate_angle, 1, mpi_p, 0, mpi_comm_world, ierr)
1113# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1114 call mpi_bcast(acoustic(j)%bb_bandwidth, 1, mpi_p, 0, mpi_comm_world, ierr)
1115# 229 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1116 call mpi_bcast(acoustic(j)%bb_lowest_freq, 1, mpi_p, 0, mpi_comm_world, ierr)
1117# 231 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1118
1119# 233 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1120 call mpi_bcast(probe(j)%x, 1, mpi_p, 0, mpi_comm_world, ierr)
1121# 233 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1122 call mpi_bcast(probe(j)%y, 1, mpi_p, 0, mpi_comm_world, ierr)
1123# 233 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1124 call mpi_bcast(probe(j)%z, 1, mpi_p, 0, mpi_comm_world, ierr)
1125# 235 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1126
1127# 237 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1128 call mpi_bcast(integral(j)%xmin, 1, mpi_p, 0, mpi_comm_world, ierr)
1129# 237 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1130 call mpi_bcast(integral(j)%xmax, 1, mpi_p, 0, mpi_comm_world, ierr)
1131# 237 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1132 call mpi_bcast(integral(j)%ymin, 1, mpi_p, 0, mpi_comm_world, ierr)
1133# 237 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1134 call mpi_bcast(integral(j)%ymax, 1, mpi_p, 0, mpi_comm_world, ierr)
1135# 237 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1136 call mpi_bcast(integral(j)%zmin, 1, mpi_p, 0, mpi_comm_world, ierr)
1137# 237 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1138 call mpi_bcast(integral(j)%zmax, 1, mpi_p, 0, mpi_comm_world, ierr)
1139# 239 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1140 end do
1141
1142 ! manual: spatial-support body-force derived-type members (the bf_spatial_support toggle is broadcast by
1143 ! generated_bcast.fpp)
1144# 244 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1145 call mpi_bcast(spatial_bf%amp, 1, mpi_p, 0, mpi_comm_world, ierr)
1146# 244 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1147 call mpi_bcast(spatial_bf%x_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1148# 244 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1149 call mpi_bcast(spatial_bf%y_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
1150# 244 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1151 call mpi_bcast(spatial_bf%sigma, 1, mpi_p, 0, mpi_comm_world, ierr)
1152# 244 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1153 call mpi_bcast(spatial_bf%conv_vel, 1, mpi_p, 0, mpi_comm_world, ierr)
1154# 246 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1155 call mpi_bcast(spatial_bf%freq, 8, mpi_p, 0, mpi_comm_world, ierr)
1156 call mpi_bcast(spatial_bf%phase, 8, mpi_p, 0, mpi_comm_world, ierr)
1157
1158 ! manual: synthetic turbulence namelist arrays (registered as indexed
1159 ! variants only; scalars are broadcast by generated_bcast.fpp)
1160 call mpi_bcast(synth_n_waves_per_shell, num_synth_shells_max, mpi_integer, 0, mpi_comm_world, ierr)
1161 call mpi_bcast(synth_k_shell, num_synth_shells_max, mpi_p, 0, mpi_comm_world, ierr)
1162 call mpi_bcast(synth_amp_shell, num_synth_shells_max, mpi_p, 0, mpi_comm_world, ierr)
1163 call mpi_bcast(turb_pos, num_turb_sources_max*3, mpi_p, 0, mpi_comm_world, ierr)
1164 call mpi_bcast(synth_l, num_turb_sources_max*3, mpi_p, 0, mpi_comm_world, ierr)
1165#endif
1166
1167 end subroutine s_mpi_bcast_user_inputs
1168
1169 !> Adds particles to the transfer list for the MPI communication.
1170 !! @param nBub Current LOCAL number of bubbles
1171 !! @param pos Current position of each bubble
1172 !! @param posPrev Previous position of each bubble (optional, not used
1173 !! for communication of initial condition)
1174 impure subroutine s_add_particles_to_transfer_list(nBub, pos, posPrev)
1175
1176 integer, intent(in) :: nbub
1177 real(wp), dimension(:,:), intent(in) :: pos, posprev
1178 integer :: bubid
1179 integer :: i, j, k
1180 integer :: dx, dy, dz
1181
1182 do k = nidx(3)%beg, nidx(3)%end
1183 do j = nidx(2)%beg, nidx(2)%end
1184 do i = nidx(1)%beg, nidx(1)%end
1185 p_send_counts(i, j, k) = 0
1186 end do
1187 end do
1188 end do
1189
1190 do k = 1, nbub
1191 dx = 0; dy = 0; dz = 0
1192 if (f_crosses_boundary(k, 1, -1, pos, posprev)) then
1193 dx = -1
1194 else if (f_crosses_boundary(k, 1, 1, pos, posprev)) then
1195 dx = 1
1196 end if
1197 if (n > 0) then
1198 if (f_crosses_boundary(k, 2, -1, pos, posprev)) then
1199 dy = -1
1200 else if (f_crosses_boundary(k, 2, 1, pos, posprev)) then
1201 dy = 1
1202 end if
1203 end if
1204 if (p > 0) then
1205 if (f_crosses_boundary(k, 3, -1, pos, posprev)) then
1206 dz = -1
1207 else if (f_crosses_boundary(k, 3, 1, pos, posprev)) then
1208 dz = 1
1209 end if
1210 end if
1211 if (abs(dx) + abs(dy) + abs(dz) /= 0) then
1212 call s_add_particle_to_direction(k, dx, dy, dz)
1213 end if
1214 end do
1215
1216 contains
1217
1218 logical function f_crosses_boundary(particle_id, dir, loc, pos, posPrev)
1219
1220 integer, intent(in) :: particle_id, dir, loc
1221 real(wp), dimension(:,:), intent(in) :: pos
1222 real(wp), dimension(:,:), optional, intent(in) :: posprev
1223
1224 if (loc == -1) then ! Beginning of the domain
1225 if (nidx(dir)%beg == 0) then
1226 f_crosses_boundary = .false.
1227 return
1228 end if
1229
1230 f_crosses_boundary = (posprev(particle_id, dir) >= pcomm_coords(dir)%beg .and. pos(particle_id, &
1231 & dir) < pcomm_coords(dir)%beg)
1232 else if (loc == 1) then ! End of the domain
1233 if (nidx(dir)%end == 0) then
1234 f_crosses_boundary = .false.
1235 return
1236 end if
1237
1238 f_crosses_boundary = (posprev(particle_id, dir) <= pcomm_coords(dir)%end .and. pos(particle_id, &
1239 & dir) > pcomm_coords(dir)%end)
1240 end if
1241
1242 end function f_crosses_boundary
1243
1244 subroutine s_add_particle_to_direction(particle_id, dir_x, dir_y, dir_z)
1245
1246 integer, intent(in) :: particle_id, dir_x, dir_y, dir_z
1247
1248 p_send_ids(dir_x, dir_y, dir_z, p_send_counts(dir_x, dir_y, dir_z)) = particle_id
1249 p_send_counts(dir_x, dir_y, dir_z) = p_send_counts(dir_x, dir_y, dir_z) + 1
1250
1251 end subroutine s_add_particle_to_direction
1252
1254
1255 !> Perform the MPI communication for lagrangian particles/bubbles.
1256 impure subroutine s_mpi_sendrecv_particles(bub_R0, Rmax_stats, Rmin_stats, gas_mg, gas_betaT, gas_betaC, bub_dphidt, lag_id, &
1257 & gas_p, gas_mv, rad, rvel, pos, posPrev, vel, scoord, drad, drvel, dgasp, dgasmv, dpos, dvel, lag_num_ts, nbubs, dest)
1258
1259 real(wp), dimension(:) :: bub_r0, rmax_stats, rmin_stats, gas_mg, gas_betat, gas_betac, bub_dphidt
1260 integer, dimension(:,:) :: lag_id
1261 real(wp), dimension(:,:) :: gas_p, gas_mv, rad, rvel, drad, drvel, dgasp, dgasmv
1262 real(wp), dimension(:,:,:) :: pos, posprev, vel, scoord, dpos, dvel
1263 integer :: position, bub_id, lag_num_ts, tag, partner, send_tag, recv_tag, nbubs, p_recv_size, dest
1264 integer :: i, j, k, l, q, r
1265 integer :: req_send, req_recv, ierr !< Generic flag used to identify and report MPI errors
1266 integer :: send_count, send_offset, recv_count, recv_offset
1267
1268#ifdef MFC_MPI
1269 ! Phase 1: Exchange particle counts using non-blocking communication
1270 send_count = 0
1271 recv_count = 0
1272
1273 ! Post all receives first
1274 do l = 1, n_neighbors
1275 i = neighbor_list(l, 1)
1276 j = neighbor_list(l, 2)
1277 k = neighbor_list(l, 3)
1278 partner = neighbor_ranks(i, j, k)
1279 recv_tag = neighbor_tag(i, j, k)
1280
1281 recv_count = recv_count + 1
1282 call mpi_irecv(p_recv_counts(i, j, k), 1, mpi_integer, partner, recv_tag, mpi_comm_world, recv_requests(recv_count), &
1283 & ierr)
1284 end do
1285
1286 ! Post all sends
1287 do l = 1, n_neighbors
1288 i = neighbor_list(l, 1)
1289 j = neighbor_list(l, 2)
1290 k = neighbor_list(l, 3)
1291 partner = neighbor_ranks(i, j, k)
1292 send_tag = neighbor_tag(-i, -j, -k)
1293
1294 send_count = send_count + 1
1295 call mpi_isend(p_send_counts(i, j, k), 1, mpi_integer, partner, send_tag, mpi_comm_world, send_requests(send_count), &
1296 & ierr)
1297 end do
1298
1299 ! Wait for all count exchanges to complete
1300 if (recv_count > 0) then
1301 call mpi_waitall(recv_count, recv_requests(1:recv_count), mpi_statuses_ignore, ierr)
1302 end if
1303 if (send_count > 0) then
1304 call mpi_waitall(send_count, send_requests(1:send_count), mpi_statuses_ignore, ierr)
1305 end if
1306
1307 ! Phase 2: Exchange particle data using non-blocking communication
1308 send_count = 0
1309 recv_count = 0
1310
1311 ! Post all receives for particle data first
1312 recv_offset = 1
1313 do l = 1, n_neighbors
1314 i = neighbor_list(l, 1)
1315 j = neighbor_list(l, 2)
1316 k = neighbor_list(l, 3)
1317
1318 if (p_recv_counts(i, j, k) > 0) then
1319 partner = neighbor_ranks(i, j, k)
1320 p_recv_size = p_recv_counts(i, j, k)*p_var_size
1321 recv_tag = neighbor_tag(i, j, k)
1322
1323 recv_count = recv_count + 1
1324 call mpi_irecv(p_recv_buff(recv_offset), p_recv_size, mpi_packed, partner, recv_tag, mpi_comm_world, &
1325 & recv_requests(recv_count), ierr)
1326 recv_offsets(l) = recv_offset
1327 recv_offset = recv_offset + p_recv_size
1328 end if
1329 end do
1330
1331 ! Pack and send particle data
1332 send_offset = 0
1333 do l = 1, n_neighbors
1334 i = neighbor_list(l, 1)
1335 j = neighbor_list(l, 2)
1336 k = neighbor_list(l, 3)
1337
1338 if (p_send_counts(i, j, k) > 0 .and. abs(i) + abs(j) + abs(k) /= 0) then
1339 partner = neighbor_ranks(i, j, k)
1340 send_tag = neighbor_tag(-i, -j, -k)
1341
1342 ! Pack data for sending
1343 position = 0
1344 do q = 0, p_send_counts(i, j, k) - 1
1345 bub_id = p_send_ids(i, j, k, q)
1346
1347 call mpi_pack(lag_id(bub_id, 1), 1, mpi_integer, p_send_buff(send_offset), p_buff_size, position, &
1348 & mpi_comm_world, ierr)
1349 call mpi_pack(bub_r0(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, ierr)
1350 call mpi_pack(rmax_stats(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1351 & ierr)
1352 call mpi_pack(rmin_stats(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1353 & ierr)
1354 call mpi_pack(gas_mg(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, ierr)
1355 call mpi_pack(gas_betat(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1356 & ierr)
1357 call mpi_pack(gas_betac(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1358 & ierr)
1359 call mpi_pack(bub_dphidt(bub_id), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1360 & ierr)
1361 do r = 1, 2
1362 call mpi_pack(gas_p(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1363 & mpi_comm_world, ierr)
1364 call mpi_pack(gas_mv(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1365 & mpi_comm_world, ierr)
1366 call mpi_pack(rad(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1367 & ierr)
1368 call mpi_pack(rvel(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1369 & ierr)
1370 call mpi_pack(pos(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1371 & ierr)
1372 call mpi_pack(posprev(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1373 & mpi_comm_world, ierr)
1374 call mpi_pack(vel(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1375 & ierr)
1376 call mpi_pack(scoord(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1377 & mpi_comm_world, ierr)
1378 end do
1379 do r = 1, lag_num_ts
1380 call mpi_pack(drad(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, mpi_comm_world, &
1381 & ierr)
1382 call mpi_pack(drvel(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1383 & mpi_comm_world, ierr)
1384 call mpi_pack(dgasp(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1385 & mpi_comm_world, ierr)
1386 call mpi_pack(dgasmv(bub_id, r), 1, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1387 & mpi_comm_world, ierr)
1388 call mpi_pack(dpos(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1389 & mpi_comm_world, ierr)
1390 call mpi_pack(dvel(bub_id,:,r), 3, mpi_p, p_send_buff(send_offset), p_buff_size, position, &
1391 & mpi_comm_world, ierr)
1392 end do
1393 end do
1394
1395 send_count = send_count + 1
1396 call mpi_isend(p_send_buff(send_offset), position, mpi_packed, partner, send_tag, mpi_comm_world, &
1397 & send_requests(send_count), ierr)
1398 send_offset = send_offset + position
1399 end if
1400 end do
1401
1402 ! Wait for all recvs for contiguous data to complete
1403 call mpi_waitall(recv_count, recv_requests(1:recv_count), mpi_statuses_ignore, ierr)
1404
1405 ! Process received data as it arrives
1406 do l = 1, n_neighbors
1407 i = neighbor_list(l, 1)
1408 j = neighbor_list(l, 2)
1409 k = neighbor_list(l, 3)
1410
1411 if (p_recv_counts(i, j, k) > 0 .and. abs(i) + abs(j) + abs(k) /= 0) then
1412 p_recv_size = p_recv_counts(i, j, k)*p_var_size
1413 recv_offset = recv_offsets(l)
1414
1415 position = 0
1416 ! Unpack received data
1417 do q = 0, p_recv_counts(i, j, k) - 1
1418 nbubs = nbubs + 1
1419 bub_id = nbubs
1420 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, lag_id(bub_id, 1), 1, mpi_integer, &
1421 & mpi_comm_world, ierr)
1422 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, bub_r0(bub_id), 1, mpi_p, mpi_comm_world, ierr)
1423 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, rmax_stats(bub_id), 1, mpi_p, &
1424 & mpi_comm_world, ierr)
1425 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, rmin_stats(bub_id), 1, mpi_p, &
1426 & mpi_comm_world, ierr)
1427 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_mg(bub_id), 1, mpi_p, mpi_comm_world, ierr)
1428 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_betat(bub_id), 1, mpi_p, mpi_comm_world, &
1429 & ierr)
1430 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_betac(bub_id), 1, mpi_p, mpi_comm_world, &
1431 & ierr)
1432 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, bub_dphidt(bub_id), 1, mpi_p, &
1433 & mpi_comm_world, ierr)
1434 do r = 1, 2
1435 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_p(bub_id, r), 1, mpi_p, &
1436 & mpi_comm_world, ierr)
1437 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, gas_mv(bub_id, r), 1, mpi_p, &
1438 & mpi_comm_world, ierr)
1439 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, rad(bub_id, r), 1, mpi_p, &
1440 & mpi_comm_world, ierr)
1441 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, rvel(bub_id, r), 1, mpi_p, &
1442 & mpi_comm_world, ierr)
1443 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, pos(bub_id,:,r), 3, mpi_p, &
1444 & mpi_comm_world, ierr)
1445 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, posprev(bub_id,:,r), 3, mpi_p, &
1446 & mpi_comm_world, ierr)
1447 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, vel(bub_id,:,r), 3, mpi_p, &
1448 & mpi_comm_world, ierr)
1449 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, scoord(bub_id,:,r), 3, mpi_p, &
1450 & mpi_comm_world, ierr)
1451 end do
1452 do r = 1, lag_num_ts
1453 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, drad(bub_id, r), 1, mpi_p, &
1454 & mpi_comm_world, ierr)
1455 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, drvel(bub_id, r), 1, mpi_p, &
1456 & mpi_comm_world, ierr)
1457 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, dgasp(bub_id, r), 1, mpi_p, &
1458 & mpi_comm_world, ierr)
1459 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, dgasmv(bub_id, r), 1, mpi_p, &
1460 & mpi_comm_world, ierr)
1461 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, dpos(bub_id,:,r), 3, mpi_p, &
1462 & mpi_comm_world, ierr)
1463 call mpi_unpack(p_recv_buff(recv_offset), p_recv_size, position, dvel(bub_id,:,r), 3, mpi_p, &
1464 & mpi_comm_world, ierr)
1465 end do
1466 lag_id(bub_id, 2) = bub_id
1467 end do
1468 recv_offset = recv_offset + p_recv_size
1469 end if
1470 end do
1471
1472 ! Wait for all sends to complete
1473 if (send_count > 0) then
1474 call mpi_waitall(send_count, send_requests(1:send_count), mpi_statuses_ignore, ierr)
1475 end if
1476#endif
1477
1478 if (any(periodic_bc)) then
1479 call s_wrap_particle_positions(pos, posprev, nbubs, dest)
1480 end if
1481
1482 end subroutine s_mpi_sendrecv_particles
1483
1484 !> Return a unique tag for each neighbor based on its position relative to the current process.
1485 integer function neighbor_tag(i, j, k) result(tag)
1486
1487 integer, intent(in) :: i, j, k
1488
1489 tag = (k + 1)*9 + (j + 1)*3 + (i + 1)
1490
1491 end function neighbor_tag
1492
1493 subroutine s_wrap_particle_positions(pos, posPrev, nbubs, dest)
1494
1495 real(wp), dimension(:,:,:) :: pos, posPrev
1496 integer :: nbubs, dest
1497 integer :: i, q
1498 real(wp) :: offset
1499
1500 do i = 1, nbubs
1501 if (periodic_bc(1)) then
1502 offset = glb_bounds(1)%end - glb_bounds(1)%beg
1503 if (pos(i, 1, dest) > x_cb(m + buff_size)) then
1504 do q = 1, 2
1505 pos(i, 1, q) = pos(i, 1, q) - offset
1506 posprev(i, 1, q) = posprev(i, 1, q) - offset
1507 end do
1508 end if
1509 if (pos(i, 1, dest) < x_cb(-1 - buff_size)) then
1510 do q = 1, 2
1511 pos(i, 1, q) = pos(i, 1, q) + offset
1512 posprev(i, 1, q) = posprev(i, 1, q) + offset
1513 end do
1514 end if
1515 end if
1516
1517 if (periodic_bc(2)) then
1518 offset = glb_bounds(2)%end - glb_bounds(2)%beg
1519 if (pos(i, 2, dest) > y_cb(n + buff_size)) then
1520 do q = 1, 2
1521 pos(i, 2, q) = pos(i, 2, q) - offset
1522 posprev(i, 2, q) = posprev(i, 2, q) - offset
1523 end do
1524 end if
1525 if (pos(i, 2, dest) < y_cb(-buff_size - 1)) then
1526 do q = 1, 2
1527 pos(i, 2, q) = pos(i, 2, q) + offset
1528 posprev(i, 2, q) = posprev(i, 2, q) + offset
1529 end do
1530 end if
1531 end if
1532
1533 if (periodic_bc(3)) then
1534 offset = glb_bounds(3)%end - glb_bounds(3)%beg
1535 if (pos(i, 3, dest) > z_cb(p + buff_size)) then
1536 do q = 1, 2
1537 pos(i, 3, q) = pos(i, 3, q) - offset
1538 posprev(i, 3, q) = posprev(i, 3, q) - offset
1539 end do
1540 end if
1541 if (pos(i, 3, dest) < z_cb(-1 - buff_size)) then
1542 do q = 1, 2
1543 pos(i, 3, q) = pos(i, 3, q) + offset
1544 posprev(i, 3, q) = posprev(i, 3, q) + offset
1545 end do
1546 end if
1547 end if
1548 end do
1549
1550 end subroutine s_wrap_particle_positions
1551
1552 !> Broadcast random phase numbers from rank 0 to all MPI processes
1553 impure subroutine s_mpi_send_random_number(phi_rn, num_freq)
1554
1555 integer, intent(in) :: num_freq
1556 real(wp), intent(inout), dimension(1:num_freq) :: phi_rn
1557
1558#ifdef MFC_MPI
1559 integer :: ierr !< Generic flag used to identify and report MPI errors
1560 call mpi_bcast(phi_rn, num_freq, mpi_p, 0, mpi_comm_world, ierr)
1561#endif
1562
1563 end subroutine s_mpi_send_random_number
1564
1565 !> Finalize the MPI proxy module
1567
1568#ifdef MFC_MPI
1569 if (ib) then
1570#ifdef MFC_DEBUG
1571# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1572 block
1573# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1574 use iso_fortran_env, only: output_unit
1575# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1576
1577# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1578 print *, 'm_mpi_proxy.fpp:661: ', '@:DEALLOCATE(ib_buff_send, ib_buff_recv)'
1579# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1580
1581# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1582 call flush (output_unit)
1583# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1584 end block
1585# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1586#endif
1587# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1588
1589# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1590#if defined(MFC_OpenACC)
1591# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1592!$acc exit data delete(ib_buff_send, ib_buff_recv)
1593# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1594#elif defined(MFC_OpenMP)
1595# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1596!$omp target exit data map(release:ib_buff_send, ib_buff_recv)
1597# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1598#endif
1599# 661 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1600 deallocate (ib_buff_send, ib_buff_recv)
1601 end if
1602
1603 if (allocated(p_send_buff)) then
1604#ifdef MFC_DEBUG
1605# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1606 block
1607# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1608 use iso_fortran_env, only: output_unit
1609# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1610
1611# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1612 print *, 'm_mpi_proxy.fpp:665: ', '@:DEALLOCATE(p_send_buff, p_recv_buff)'
1613# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1614
1615# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1616 call flush (output_unit)
1617# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1618 end block
1619# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1620#endif
1621# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1622
1623# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1624#if defined(MFC_OpenACC)
1625# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1626!$acc exit data delete(p_send_buff, p_recv_buff)
1627# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1628#elif defined(MFC_OpenMP)
1629# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1630!$omp target exit data map(release:p_send_buff, p_recv_buff)
1631# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1632#endif
1633# 665 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1634 deallocate (p_send_buff, p_recv_buff)
1635#ifdef MFC_DEBUG
1636# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1637 block
1638# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1639 use iso_fortran_env, only: output_unit
1640# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1641
1642# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1643 print *, 'm_mpi_proxy.fpp:666: ', '@:DEALLOCATE(p_send_ids)'
1644# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1645
1646# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1647 call flush (output_unit)
1648# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1649 end block
1650# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1651#endif
1652# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1653
1654# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1655#if defined(MFC_OpenACC)
1656# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1657!$acc exit data delete(p_send_ids)
1658# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1659#elif defined(MFC_OpenMP)
1660# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1661!$omp target exit data map(release:p_send_ids)
1662# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1663#endif
1664# 666 "/home/runner/work/MFC/MFC/src/simulation/m_mpi_proxy.fpp"
1665 deallocate (p_send_ids)
1666 end if
1667#endif
1668
1669 end subroutine s_finalize_mpi_proxy_module
1670
1671end 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