MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_mpi_common.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2!>
3!! @file
4!! @brief Contains module m_mpi_common
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/common/m_mpi_common.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# 145 "/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# 145 "/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# 145 "/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# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312! Allocate and create GPU device memory
313# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
314
315! Free GPU device memory and deallocate
316# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
317
318! Cray-specific GPU pointer setup for vector fields
319# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
320
321! Cray-specific GPU pointer setup for scalar fields
322# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
323
324! Cray-specific GPU pointer setup for acoustic source spatials
325# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
326
327# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
328
329# 163 "/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/common/m_mpi_common.fpp" 2
332
333!> @brief MPI communication layer: domain decomposition, halo exchange, reductions, and parallel I/O setup
334module m_mpi_common
335
336#ifdef MFC_MPI
337 use mpi !< message passing interface (mpi) module
338#endif
339
340 use m_derived_types
341 use m_global_parameters
342 use m_helper
343 use ieee_arithmetic
344 use m_nvtx
345 use m_constants, only: recon_type_weno, format_silo
346
347 implicit none
348
349 integer, private :: v_size
350
351# 25 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
352#if defined(MFC_OpenACC)
353# 25 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
354!$acc declare create(v_size)
355# 25 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
356#elif defined(MFC_OpenMP)
357# 25 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
358!$omp declare target (v_size)
359# 25 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
360#endif
361
362 real(wp), private, allocatable, dimension(:) :: buff_send !< Primitive variable send buffer for halo exchange
363 !> Primitive variable receive buffer for halo exchange Variables for EL bubbles communication
364 real(wp), private, allocatable, dimension(:) :: buff_recv
365 type(int_bounds_info) :: comm_coords(3)
366 integer :: comm_size(3)
367 !> q_beta indices to communicate: 1=void fraction, 2=d(beta)/dt, 5=energy source
368 integer :: beta_vars(1:3) = [1, 2, 5]
369
370# 34 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
371#if defined(MFC_OpenACC)
372# 34 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
373!$acc declare create(comm_coords, comm_size, beta_vars)
374# 34 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
375#elif defined(MFC_OpenMP)
376# 34 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
377!$omp declare target (comm_coords, comm_size, beta_vars)
378# 34 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
379#endif
380
381#ifndef __NVCOMPILER_GPU_UNIFIED_MEM
382
383# 37 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
384#if defined(MFC_OpenACC)
385# 37 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
386!$acc declare create(buff_send, buff_recv)
387# 37 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
388#elif defined(MFC_OpenMP)
389# 37 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
390!$omp declare target (buff_send, buff_recv)
391# 37 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
392#endif
393#endif
394
395 integer(kind=8) :: halo_size
396
397# 41 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
398#if defined(MFC_OpenACC)
399# 41 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
400!$acc declare create(halo_size)
401# 41 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
402#elif defined(MFC_OpenMP)
403# 41 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
404!$omp declare target (halo_size)
405# 41 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
406#endif
407
408contains
409
410 !> Initialize the module.
411 impure subroutine s_initialize_mpi_common_module
412
413#ifdef MFC_MPI
414 ! Allocating buff_send/recv and. Please note that for the sake of simplicity, both variables are provided sufficient storage
415 ! to hold the largest buffer in the computational domain.
416
417 if (qbmm .and. .not. polytropic) then
418 v_size = sys_size + 2*nb*nnode
419 else if (chemistry .and. chem_params%diffusion) then
420 v_size = sys_size + 1
421 else
422 v_size = sys_size
423 end if
424
425 if (n > 0) then
426 if (p > 0) then
427 halo_size = nint(-1._wp + 1._wp*buff_size*(v_size)*(m + 2*buff_size + 1)*(n + 2*buff_size + 1)*(p + 2*buff_size &
428 & + 1)/(cells_bounds%mnp_min + 2*buff_size + 1))
429 else
430 halo_size = -1 + buff_size*(v_size)*(cells_bounds%mn_max + 2*buff_size + 1)
431 end if
432 else
433 halo_size = -1 + buff_size*(v_size)
434 end if
435
436
437# 71 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
438#if defined(MFC_OpenACC)
439# 71 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
440!$acc update device(halo_size, v_size)
441# 71 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
442#elif defined(MFC_OpenMP)
443# 71 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
444!$omp target update to(halo_size, v_size)
445# 71 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
446#endif
447
448#ifndef __NVCOMPILER_GPU_UNIFIED_MEM
449#ifdef MFC_DEBUG
450# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
451 block
452# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
453 use iso_fortran_env, only: output_unit
454# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
455
456# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
457 print *, 'm_mpi_common.fpp:74: ', '@:ALLOCATE(buff_send(0:halo_size), buff_recv(0:halo_size))'
458# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
459
460# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
461 call flush (output_unit)
462# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
463 end block
464# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
465#endif
466# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
467 allocate (buff_send(0:halo_size), buff_recv(0:halo_size))
468# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
469
470# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
471
472# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
473
474# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
475#if defined(MFC_OpenACC)
476# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
477!$acc enter data create(buff_send, buff_recv)
478# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
479#elif defined(MFC_OpenMP)
480# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
481!$omp target enter data map(always,alloc:buff_send, buff_recv)
482# 74 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
483#endif
484#else
485 allocate (buff_send(0:halo_size), buff_recv(0:halo_size))
486
487# 77 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
488#if defined(MFC_OpenACC)
489# 77 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
490!$acc enter data create(capture:buff_send)
491# 77 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
492#elif defined(MFC_OpenMP)
493# 77 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
494!$omp target enter data map(always,alloc:capture:buff_send)
495# 77 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
496#endif
497
498# 78 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
499#if defined(MFC_OpenACC)
500# 78 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
501!$acc enter data create(capture:buff_recv)
502# 78 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
503#elif defined(MFC_OpenMP)
504# 78 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
505!$omp target enter data map(always,alloc:capture:buff_recv)
506# 78 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
507#endif
508#endif
509#endif
510
511
512# 82 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
513#if defined(MFC_OpenACC)
514# 82 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
515!$acc update device(beta_vars)
516# 82 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
517#elif defined(MFC_OpenMP)
518# 82 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
519!$omp target update to(beta_vars)
520# 82 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
521#endif
522
523 end subroutine s_initialize_mpi_common_module
524
525 !> Initialize the MPI execution environment and query the number of processors and local rank.
526 impure subroutine s_mpi_initialize
527
528#ifdef MFC_MPI
529 integer :: ierr !< Generic flag used to identify and report MPI errors
530
531 call mpi_init(ierr)
532
533 if (ierr /= mpi_success) then
534 print '(A)', 'Unable to initialize MPI environment. Exiting.'
535 call mpi_abort(mpi_comm_world, 1, ierr)
536 end if
537
538 call mpi_comm_size(mpi_comm_world, num_procs, ierr)
539
540 call mpi_comm_rank(mpi_comm_world, proc_rank, ierr)
541#else
542 num_procs = 1
543 proc_rank = 0
544#endif
545
546
547# 107 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
548#if defined(MFC_OpenACC)
549# 107 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
550!$acc update device(num_procs, proc_rank)
551# 107 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
552#elif defined(MFC_OpenMP)
553# 107 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
554!$omp target update to(num_procs, proc_rank)
555# 107 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
556#endif
557
558 end subroutine s_mpi_initialize
559
560 !> Set up MPI I/O data views and variable pointers for parallel file output.
561 impure subroutine s_initialize_mpi_data(q_cons_vf, ib_markers, beta)
562
563 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
564 type(integer_field), optional, intent(in) :: ib_markers
565 type(scalar_field), intent(in), optional :: beta
566 integer, dimension(num_dims) :: sizes_glb, sizes_loc
567
568#ifdef MFC_MPI
569 integer :: i, j
570 integer :: ierr !< Generic flag used to identify and report MPI errors
571 integer :: alt_sys
572
573 if (present(beta)) then
574 alt_sys = sys_size + 1
575 else
576 alt_sys = sys_size
577 end if
578
579 do i = 1, sys_size
580 mpi_io_data%var(i)%sf => q_cons_vf(i)%sf(0:m,0:n,0:p)
581 end do
582
583 if (present(beta)) then
584 mpi_io_data%var(alt_sys)%sf => beta%sf(0:m,0:n,0:p)
585 end if
586
587 ! Additional variables pb and mv for non-polytropic qbmm
588 if (qbmm .and. .not. polytropic) then
589 do i = 1, nb
590 do j = 1, nnode
591#ifdef MFC_PRE_PROCESS
592 mpi_io_data%var(sys_size + (i - 1)*nnode + j)%sf => pb%sf(0:m,0:n,0:p,j, i)
593 mpi_io_data%var(sys_size + (i - 1)*nnode + j + nb*nnode)%sf => mv%sf(0:m,0:n,0:p,j, i)
594#elif defined (MFC_SIMULATION)
595 mpi_io_data%var(sys_size + (i - 1)*nnode + j)%sf => pb_ts(1)%sf(0:m,0:n,0:p,j, i)
596 mpi_io_data%var(sys_size + (i - 1)*nnode + j + nb*nnode)%sf => mv_ts(1)%sf(0:m,0:n,0:p,j, i)
597#endif
598 end do
599 end do
600 end if
601
602 ! Define global(g) and local(l) sizes for flow variables
603 sizes_glb(1) = m_glb + 1; sizes_loc(1) = m + 1
604 if (n > 0) then
605 sizes_glb(2) = n_glb + 1; sizes_loc(2) = n + 1
606 if (p > 0) then
607 sizes_glb(num_dims) = p_glb + 1; sizes_loc(num_dims) = p + 1
608 end if
609 end if
610
611 ! Define the view for each variable
612 do i = 1, alt_sys
613 call mpi_type_create_subarray(num_dims, sizes_glb, sizes_loc, start_idx, mpi_order_fortran, mpi_p, &
614 & mpi_io_data%view(i), ierr)
615 call mpi_type_commit(mpi_io_data%view(i), ierr)
616 end do
617
618#ifndef MFC_POST_PROCESS
619 if (qbmm .and. .not. polytropic) then
620 do i = sys_size + 1, sys_size + 2*nb*nnode
621 call mpi_type_create_subarray(num_dims, sizes_glb, sizes_loc, start_idx, mpi_order_fortran, mpi_p, &
622 & mpi_io_data%view(i), ierr)
623 call mpi_type_commit(mpi_io_data%view(i), ierr)
624 end do
625 end if
626#endif
627
628#ifndef MFC_PRE_PROCESS
629 if (present(ib_markers)) then
630 mpi_io_ib_data%var%sf => ib_markers%sf(0:m,0:n,0:p)
631
632 call mpi_type_create_subarray(num_dims, sizes_glb, sizes_loc, start_idx, mpi_order_fortran, mpi_integer, &
633 & mpi_io_ib_data%view, ierr)
634 call mpi_type_commit(mpi_io_ib_data%view, ierr)
635 end if
636#endif
637#endif
638
639 end subroutine s_initialize_mpi_data
640
641 !> Set up MPI I/O data views for downsampled (coarsened) parallel file output.
642 subroutine s_initialize_mpi_data_ds(q_cons_vf)
643
644 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
645 integer, dimension(num_dims) :: sizes_loc
646 integer, dimension(3) :: sf_start_idx
647
648#ifdef MFC_MPI
649 integer :: i, m_ds, n_ds, p_ds, ierr
650
651 sf_start_idx = (/0, 0, 0/)
652
653#ifndef MFC_POST_PROCESS
654 m_ds = int((m + 1)/3) - 1
655 n_ds = int((n + 1)/3) - 1
656 p_ds = int((p + 1)/3) - 1
657#else
658 m_ds = m
659 n_ds = n
660 p_ds = p
661#endif
662
663#ifdef MFC_POST_PROCESS
664 do i = 1, sys_size
665 mpi_io_data%var(i)%sf => q_cons_vf(i)%sf(-1:m_ds + 1,-1:n_ds + 1,-1:p_ds + 1)
666 end do
667#endif
668 ! Define global(g) and local(l) sizes for flow variables
669 sizes_loc(1) = m_ds + 3
670 if (n > 0) then
671 sizes_loc(2) = n_ds + 3
672 if (p > 0) then
673 sizes_loc(num_dims) = p_ds + 3
674 end if
675 end if
676
677 ! Define the view for each variable
678 do i = 1, sys_size
679 call mpi_type_create_subarray(num_dims, sizes_loc, sizes_loc, sf_start_idx, mpi_order_fortran, mpi_p, &
680 & mpi_io_data%view(i), ierr)
681 call mpi_type_commit(mpi_io_data%view(i), ierr)
682 end do
683#endif
684
685 end subroutine s_initialize_mpi_data_ds
686
687 !> Gather variable-length real vectors from all MPI ranks onto the root process.
688 impure subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root)
689
690 integer, intent(in) :: counts !< Array of vector lengths for each process
691 real(wp), intent(in), dimension(counts) :: my_vector !< Input vector on each process
692 integer, intent(in) :: root !< Rank of the root process
693 real(wp), allocatable, intent(out) :: gathered_vector(:) !< Gathered vector on the root process
694 integer :: i
695 integer :: ierr !< Generic flag used to identify and report MPI errors
696 integer, allocatable :: recounts(:), displs(:)
697
698#ifdef MFC_MPI
699 allocate (recounts(num_procs))
700
701 call mpi_gather(counts, 1, mpi_integer, recounts, 1, mpi_integer, root, mpi_comm_world, ierr)
702
703 allocate (displs(size(recounts)))
704
705 displs(1) = 0
706
707 do i = 2, size(recounts)
708 displs(i) = displs(i - 1) + recounts(i - 1)
709 end do
710
711 allocate (gathered_vector(sum(recounts)))
712 call mpi_gatherv(my_vector, counts, mpi_p, gathered_vector, recounts, displs, mpi_p, root, mpi_comm_world, ierr)
713#endif
714
715 end subroutine s_mpi_gather_data
716
717 !> Gather per-rank time step wall-clock times onto rank 0 for performance reporting.
718 impure subroutine mpi_bcast_time_step_values(proc_time, time_avg)
719
720 real(wp), dimension(0:num_procs - 1), intent(inout) :: proc_time
721 real(wp), intent(inout) :: time_avg
722
723#ifdef MFC_MPI
724 integer :: ierr !< Generic flag used to identify and report MPI errors
725
726 call mpi_gather(time_avg, 1, mpi_p, proc_time(0), 1, mpi_p, 0, mpi_comm_world, ierr)
727#endif
728
729 end subroutine mpi_bcast_time_step_values
730
731 !> Print a case file error with the prohibited condition and message, then abort execution.
732 impure subroutine s_prohibit_abort(condition, message)
733
734 character(len=*), intent(in) :: condition, message
735
736 print *, ""
737 print *, "CASE FILE ERROR"
738 print *, " - Prohibited condition: ", trim(condition)
739 if (len_trim(message) > 0) then
740 print *, " - Note: ", trim(message)
741 end if
742 print *, ""
743 call s_mpi_abort(code=case_file_error_code)
744
745 end subroutine s_prohibit_abort
746
747 !> The goal of this subroutine is to determine the global extrema of the stability criteria in the computational domain. This is
748 !! performed by sifting through the local extrema of each stability criterion. Note that each of the local extrema is from a
749 !! single process, within its assigned section of the computational domain. Finally, note that the global extrema values are
750 !! only bookkeept on the rank 0 processor.
751 impure subroutine s_mpi_reduce_stability_criteria_extrema(icfl_max_loc, vcfl_max_loc, Rc_min_loc, bubs_loc, icfl_max_glb, &
752 & vcfl_max_glb, Rc_min_glb, bubs_glb, ccfl_max_loc, ccfl_max_glb)
753
754 real(wp), intent(in) :: icfl_max_loc
755 real(wp), intent(in) :: vcfl_max_loc
756 real(wp), intent(in) :: rc_min_loc
757 integer, intent(in) :: bubs_loc
758 real(wp), intent(out) :: icfl_max_glb
759 real(wp), intent(out) :: vcfl_max_glb
760 real(wp), intent(out) :: rc_min_glb
761 integer, intent(out) :: bubs_glb
762 real(wp), intent(in) :: ccfl_max_loc
763 real(wp), intent(out) :: ccfl_max_glb
764
765 icfl_max_glb = icfl_max_loc
766 vcfl_max_glb = vcfl_max_loc
767 rc_min_glb = rc_min_loc
768 ccfl_max_glb = ccfl_max_loc
769
770#ifdef MFC_SIMULATION
771#ifdef MFC_MPI
772 block
773 integer :: ierr
774
775 bubs_glb = 0
776 call mpi_reduce(icfl_max_loc, icfl_max_glb, 1, mpi_p, mpi_max, 0, mpi_comm_world, ierr)
777
778 if (viscous) then
779 call mpi_reduce(vcfl_max_loc, vcfl_max_glb, 1, mpi_p, mpi_max, 0, mpi_comm_world, ierr)
780 call mpi_reduce(rc_min_loc, rc_min_glb, 1, mpi_p, mpi_min, 0, mpi_comm_world, ierr)
781 end if
782
783 if (surface_tension) then
784 call mpi_reduce(ccfl_max_loc, ccfl_max_glb, 1, mpi_p, mpi_max, 0, mpi_comm_world, ierr)
785 end if
786
787 if (bubbles_lagrange) then
788 call mpi_reduce(bubs_loc, bubs_glb, 1, mpi_integer, mpi_sum, 0, mpi_comm_world, ierr)
789 end if
790 end block
791#else
792 icfl_max_glb = icfl_max_loc
793 bubs_glb = 0
794
795 if (viscous) then
796 vcfl_max_glb = vcfl_max_loc
797 rc_min_glb = rc_min_loc
798 end if
799
800 if (surface_tension) then
801 ccfl_max_glb = ccfl_max_loc
802 end if
803
804 if (bubbles_lagrange) bubs_glb = bubs_loc
805#endif
806#endif
807
808 end subroutine s_mpi_reduce_stability_criteria_extrema
809
810 !> Reduce a local integer value to its global sum across all MPI ranks.
811 subroutine s_mpi_reduce_int_sum(var_loc, sum)
812
813 integer, intent(in) :: var_loc
814 integer, intent(out) :: sum
815
816#ifdef MFC_MPI
817 integer :: ierr !< Generic flag used to identify and report MPI errors
818
819 call mpi_reduce(var_loc, sum, 1, mpi_integer, mpi_sum, 0, mpi_comm_world, ierr)
820#else
821 sum = var_loc
822#endif
823
824 end subroutine s_mpi_reduce_int_sum
825
826 !> Reduce a local real value to its global sum across all MPI ranks.
827 impure subroutine s_mpi_allreduce_sum(var_loc, var_glb)
828
829 real(wp), intent(in) :: var_loc
830 real(wp), intent(out) :: var_glb
831
832#ifdef MFC_MPI
833 integer :: ierr !< Generic flag used to identify and report MPI errors
834
835 call mpi_allreduce(var_loc, var_glb, 1, mpi_p, mpi_sum, mpi_comm_world, ierr)
836#endif
837
838 end subroutine s_mpi_allreduce_sum
839
840 !> Reduce an array of vectors to their global sums across all MPI ranks.
841 impure subroutine s_mpi_allreduce_vectors_sum(var_loc, var_glb, num_vectors, vector_length)
842
843 integer, intent(in) :: num_vectors, vector_length
844 real(wp), dimension(:,:), intent(in) :: var_loc
845 real(wp), dimension(:,:), intent(inout) :: var_glb
846
847#ifdef MFC_MPI
848 integer :: ierr !< Generic flag used to identify and report MPI errors
849
850 if (loc(var_loc) == loc(var_glb)) then
851 call mpi_allreduce(mpi_in_place, var_glb, num_vectors*vector_length, mpi_p, mpi_sum, mpi_comm_world, ierr)
852 else
853 call mpi_allreduce(var_loc, var_glb, num_vectors*vector_length, mpi_p, mpi_sum, mpi_comm_world, ierr)
854 end if
855#else
856 var_glb(1:num_vectors,1:vector_length) = var_loc(1:num_vectors,1:vector_length)
857#endif
858
859 end subroutine s_mpi_allreduce_vectors_sum
860
861 !> Reduce a local integer value to its global sum across all MPI ranks.
862 impure subroutine s_mpi_allreduce_integer_sum(var_loc, var_glb)
863
864 integer(kind=8), intent(in) :: var_loc
865 integer(kind=8), intent(out) :: var_glb
866
867#ifdef MFC_MPI
868 integer :: ierr !< Generic flag used to identify and report MPI errors
869
870 call mpi_allreduce(var_loc, var_glb, 1, mpi_integer8, mpi_sum, mpi_comm_world, ierr)
871#else
872 var_glb = var_loc
873#endif
874
875 end subroutine s_mpi_allreduce_integer_sum
876
877 !> Reduce a local real value to its global minimum across all MPI ranks.
878 impure subroutine s_mpi_allreduce_min(var_loc, var_glb)
879
880 real(wp), intent(in) :: var_loc
881 real(wp), intent(out) :: var_glb
882
883#ifdef MFC_MPI
884 integer :: ierr !< Generic flag used to identify and report MPI errors
885
886 call mpi_allreduce(var_loc, var_glb, 1, mpi_p, mpi_min, mpi_comm_world, ierr)
887#endif
888
889 end subroutine s_mpi_allreduce_min
890
891 !> Reduce a local real value to its global maximum across all MPI ranks.
892 impure subroutine s_mpi_allreduce_max(var_loc, var_glb)
893
894 real(wp), intent(in) :: var_loc
895 real(wp), intent(out) :: var_glb
896
897#ifdef MFC_MPI
898 integer :: ierr !< Generic flag used to identify and report MPI errors
899
900 call mpi_allreduce(var_loc, var_glb, 1, mpi_p, mpi_max, mpi_comm_world, ierr)
901#endif
902
903 end subroutine s_mpi_allreduce_max
904
905 !> Reduce a local real value to its global minimum across all ranks
906 impure subroutine s_mpi_reduce_min(var_loc)
907
908 real(wp), intent(inout) :: var_loc
909
910#ifdef MFC_MPI
911 integer :: ierr !< Generic flag used to identify and report MPI errors
912 real(wp) :: var_glb
913
914 call mpi_reduce(var_loc, var_glb, 1, mpi_p, mpi_min, 0, mpi_comm_world, ierr)
915
916 call mpi_bcast(var_glb, 1, mpi_p, 0, mpi_comm_world, ierr)
917
918 var_loc = var_glb
919#endif
920
921 end subroutine s_mpi_reduce_min
922
923 !> Reduce a 2-element variable to its global maximum value with the owning processor rank (MPI_MAXLOC).
924 !> Reduce a local value to its global maximum with location (rank) across all ranks
925 impure subroutine s_mpi_reduce_maxloc(var_loc)
926
927 real(wp), dimension(2), intent(inout) :: var_loc
928
929#ifdef MFC_MPI
930 integer :: ierr !< Generic flag used to identify and report MPI errors
931 real(wp), dimension(2) :: var_glb !< Reduced (max value, rank) pair
932 call mpi_reduce(var_loc, var_glb, 1, mpi_2p, mpi_maxloc, 0, mpi_comm_world, ierr)
933
934 call mpi_bcast(var_glb, 1, mpi_2p, 0, mpi_comm_world, ierr)
935
936 var_loc = var_glb
937#endif
938
939 end subroutine s_mpi_reduce_maxloc
940
941 !> The subroutine terminates the MPI execution environment.
942 impure subroutine s_mpi_abort(prnt, code)
943
944 character(len=*), intent(in), optional :: prnt
945 integer, intent(in), optional :: code
946
947#ifdef MFC_MPI
948 integer :: ierr !< Generic flag used to identify and report MPI errors
949#endif
950
951 if (present(prnt)) then
952 print *, prnt
953 call flush (6)
954 end if
955
956#ifndef MFC_MPI
957 if (present(code)) then
958 stop code
959 else
960 stop 1
961 end if
962#else
963 if (present(code)) then
964 call mpi_abort(mpi_comm_world, code, ierr)
965 else
966 call mpi_abort(mpi_comm_world, 1, ierr)
967 end if
968#endif
969
970 end subroutine s_mpi_abort
971
972 !> Halts all processes until all have reached barrier.
973 impure subroutine s_mpi_barrier
974
975#ifdef MFC_MPI
976 integer :: ierr !< Generic flag used to identify and report MPI errors
977
978 call mpi_barrier(mpi_comm_world, ierr)
979#endif
980
981 end subroutine s_mpi_barrier
982
983 !> The subroutine finalizes the MPI execution environment.
984 impure subroutine s_mpi_finalize
985
986#ifdef MFC_MPI
987 integer :: ierr !< Generic flag used to identify and report MPI errors
988
989 call mpi_finalize(ierr)
990#endif
991
992 end subroutine s_mpi_finalize
993
994 !> The goal of this procedure is to populate the buffers of the cell-average conservative variables by communicating with the
995 !! neighboring processors.
996 subroutine s_mpi_sendrecv_variables_buffers(q_comm, mpi_dir, pbc_loc, nVar, pb_in, mv_in, q_T_sf)
997
998 type(scalar_field), dimension(1:), intent(inout) :: q_comm
999 real(stp), optional, dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_in, mv_in
1000 integer, intent(in) :: mpi_dir, pbc_loc, nVar
1001 integer :: i, j, k, l, r, q !< Generic loop iterators
1002 integer :: buffer_counts(1:3), buffer_count
1003 type(int_bounds_info) :: boundary_conditions(1:3)
1004 integer :: beg_end(1:2), grid_dims(1:3)
1005 integer :: dst_proc, src_proc, recv_tag, send_tag
1006 logical :: beg_end_geq_0, qbmm_comm, chem_diff_comm
1007 integer :: pack_offset, unpack_offset
1008 type(scalar_field), optional, intent(inout) :: q_T_sf
1009
1010#ifdef MFC_MPI
1011 integer :: ierr !< Generic flag used to identify and report MPI errors
1012
1013 call nvtxstartrange("RHS-COMM-PACKBUF")
1014
1015 qbmm_comm = .false.
1016 chem_diff_comm = .false.
1017
1018 if (present(pb_in) .and. present(mv_in) .and. qbmm .and. .not. polytropic) then
1019 qbmm_comm = .true.
1020 v_size = nvar + 2*nb*nnode
1021 buffer_counts = (/buff_size*v_size*(n + 1)*(p + 1), buff_size*v_size*(m + 2*buff_size + 1)*(p + 1), &
1022 & buff_size*v_size*(m + 2*buff_size + 1)*(n + 2*buff_size + 1)/)
1023#ifdef MFC_SIMULATION
1024 else if (present(q_t_sf) .and. chemistry .and. chem_params%diffusion) then
1025#else
1026 else if (present(q_t_sf) .and. chemistry) then
1027 ! post_process converts cons->prim over the ghost-inclusive bounds, so the temperature
1028 ! Newton guess must be valid at rank seams for EVERY chemistry run (not only diffusion):
1029 ! an unexchanged seam ghost is an uninitialized guess -> NaN T/pres/c in the output
1030#endif
1031 chem_diff_comm = .true.
1032 v_size = nvar + 1
1033 buffer_counts = (/buff_size*v_size*(n + 1)*(p + 1), buff_size*v_size*(m + 2*buff_size + 1)*(p + 1), &
1034 & buff_size*v_size*(m + 2*buff_size + 1)*(n + 2*buff_size + 1)/)
1035 else
1036 v_size = nvar
1037 buffer_counts = (/buff_size*v_size*(n + 1)*(p + 1), buff_size*v_size*(m + 2*buff_size + 1)*(p + 1), &
1038 & buff_size*v_size*(m + 2*buff_size + 1)*(n + 2*buff_size + 1)/)
1039 end if
1040
1041
1042# 592 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1043#if defined(MFC_OpenACC)
1044# 592 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1045!$acc update device(v_size)
1046# 592 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1047#elif defined(MFC_OpenMP)
1048# 592 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1049!$omp target update to(v_size)
1050# 592 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1051#endif
1052
1053 buffer_count = buffer_counts(mpi_dir)
1054 boundary_conditions = (/bc_x, bc_y, bc_z/)
1055 beg_end = (/boundary_conditions(mpi_dir)%beg, boundary_conditions(mpi_dir)%end/)
1056 beg_end_geq_0 = beg_end(max(pbc_loc, 0) - pbc_loc + 1) >= 0
1057
1058 ! Implements: pbc_loc bc_x >= 0 -> [send/recv]_tag [dst/src]_proc -1 (=0) 0 -> [1,0] [0,0] | 0 0 [1,0] [beg,beg] -1 (=0) 1
1059 ! -> [0,0] [1,0] | 0 1 [0,0] [end,beg] +1 (=1) 0 -> [0,1] [1,1] | 1 0 [0,1] [end,end] +1 (=1) 1 -> [1,1] [0,1] | 1 1 [1,1]
1060 ! [beg,end]
1061
1062 send_tag = f_logical_to_int(.not. f_xor(beg_end_geq_0, pbc_loc == 1))
1063 recv_tag = f_logical_to_int(pbc_loc == 1)
1064
1065 dst_proc = beg_end(1 + f_logical_to_int(f_xor(pbc_loc == 1, beg_end_geq_0)))
1066 src_proc = beg_end(1 + f_logical_to_int(pbc_loc == 1))
1067
1068 grid_dims = (/m, n, p/)
1069
1070 pack_offset = 0
1071 if (f_xor(pbc_loc == 1, beg_end_geq_0)) then
1072 pack_offset = grid_dims(mpi_dir) - buff_size + 1
1073 end if
1074
1075 unpack_offset = 0
1076 if (pbc_loc == 1) then
1077 unpack_offset = grid_dims(mpi_dir) + buff_size + 1
1078 end if
1079
1080 ! Pack Buffer to Send
1081# 623 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1082 if (mpi_dir == 1) then
1083# 625 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1084
1085# 625 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1086
1087# 625 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1088#if defined(MFC_OpenACC)
1089# 625 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1090!$acc parallel loop collapse(4) gang vector default(present) private(r)
1091# 625 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1092#elif defined(MFC_OpenMP)
1093# 625 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1094
1095# 625 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1096
1097# 625 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1098
1099# 625 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1100!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1101# 625 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1102#endif
1103 do l = 0, p
1104 do k = 0, n
1105 do j = 0, buff_size - 1
1106 do i = 1, nvar
1107 r = (i - 1) + v_size*(j + buff_size*(k + (n + 1)*l))
1108 buff_send(r) = real(q_comm(i)%sf(j + pack_offset, k, l), kind=wp)
1109 end do
1110 end do
1111 end do
1112 end do
1113
1114# 636 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1115#if defined(MFC_OpenACC)
1116# 636 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1117!$acc end parallel loop
1118# 636 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1119#elif defined(MFC_OpenMP)
1120# 636 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1121
1122# 636 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1123!$omp end target teams loop
1124# 636 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1125#endif
1126
1127 if (chem_diff_comm) then
1128
1129# 639 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1130
1131# 639 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1132#if defined(MFC_OpenACC)
1133# 639 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1134!$acc parallel loop collapse(3) gang vector default(present) private(r)
1135# 639 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1136#elif defined(MFC_OpenMP)
1137# 639 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1138
1139# 639 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1140
1141# 639 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1142
1143# 639 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1144!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1145# 639 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1146#endif
1147 do l = 0, p
1148 do k = 0, n
1149 do j = 0, buff_size - 1
1150 r = nvar + v_size*(j + buff_size*(k + (n + 1)*l))
1151 buff_send(r) = real(q_t_sf%sf(j + pack_offset, k, l), kind=wp)
1152 end do
1153 end do
1154 end do
1155
1156# 648 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1157#if defined(MFC_OpenACC)
1158# 648 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1159!$acc end parallel loop
1160# 648 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1161#elif defined(MFC_OpenMP)
1162# 648 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1163
1164# 648 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1165!$omp end target teams loop
1166# 648 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1167#endif
1168 end if
1169
1170 if (qbmm_comm) then
1171
1172# 652 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1173
1174# 652 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1175#if defined(MFC_OpenACC)
1176# 652 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1177!$acc parallel loop collapse(4) gang vector default(present) private(r)
1178# 652 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1179#elif defined(MFC_OpenMP)
1180# 652 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1181
1182# 652 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1183
1184# 652 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1185
1186# 652 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1187!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1188# 652 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1189#endif
1190 do l = 0, p
1191 do k = 0, n
1192 do j = 0, buff_size - 1
1193 do i = nvar + 1, nvar + nnode
1194 do q = 1, nb
1195 r = (i - 1) + (q - 1)*nnode + v_size*(j + buff_size*(k + (n + 1)*l))
1196 buff_send(r) = real(pb_in(j + pack_offset, k, l, i - nvar, q), kind=wp)
1197 end do
1198 end do
1199 end do
1200 end do
1201 end do
1202
1203# 665 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1204#if defined(MFC_OpenACC)
1205# 665 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1206!$acc end parallel loop
1207# 665 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1208#elif defined(MFC_OpenMP)
1209# 665 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1210
1211# 665 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1212!$omp end target teams loop
1213# 665 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1214#endif
1215
1216
1217# 667 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1218
1219# 667 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1220#if defined(MFC_OpenACC)
1221# 667 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1222!$acc parallel loop collapse(5) gang vector default(present) private(r)
1223# 667 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1224#elif defined(MFC_OpenMP)
1225# 667 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1226
1227# 667 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1228
1229# 667 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1230
1231# 667 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1232!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(5) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1233# 667 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1234#endif
1235 do l = 0, p
1236 do k = 0, n
1237 do j = 0, buff_size - 1
1238 do i = nvar + 1, nvar + nnode
1239 do q = 1, nb
1240 r = (i - 1) + (q - 1)*nnode + nb*nnode + v_size*(j + buff_size*(k + (n + 1)*l))
1241 buff_send(r) = real(mv_in(j + pack_offset, k, l, i - nvar, q), kind=wp)
1242 end do
1243 end do
1244 end do
1245 end do
1246 end do
1247
1248# 680 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1249#if defined(MFC_OpenACC)
1250# 680 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1251!$acc end parallel loop
1252# 680 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1253#elif defined(MFC_OpenMP)
1254# 680 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1255
1256# 680 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1257!$omp end target teams loop
1258# 680 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1259#endif
1260 end if
1261# 805 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1262 end if
1263# 623 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1264 if (mpi_dir == 2) then
1265# 683 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1266
1267# 683 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1268
1269# 683 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1270#if defined(MFC_OpenACC)
1271# 683 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1272!$acc parallel loop collapse(4) gang vector default(present) private(r)
1273# 683 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1274#elif defined(MFC_OpenMP)
1275# 683 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1276
1277# 683 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1278
1279# 683 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1280
1281# 683 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1282!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1283# 683 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1284#endif
1285 do i = 1, nvar
1286 do l = 0, p
1287 do k = 0, buff_size - 1
1288 do j = -buff_size, m + buff_size
1289 r = (i - 1) + v_size*((j + buff_size) + (m + 2*buff_size + 1)*(k + buff_size*l))
1290 buff_send(r) = real(q_comm(i)%sf(j, k + pack_offset, l), kind=wp)
1291 end do
1292 end do
1293 end do
1294 end do
1295
1296# 694 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1297#if defined(MFC_OpenACC)
1298# 694 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1299!$acc end parallel loop
1300# 694 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1301#elif defined(MFC_OpenMP)
1302# 694 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1303
1304# 694 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1305!$omp end target teams loop
1306# 694 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1307#endif
1308
1309 if (chem_diff_comm) then
1310
1311# 697 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1312
1313# 697 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1314#if defined(MFC_OpenACC)
1315# 697 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1316!$acc parallel loop collapse(3) gang vector default(present) private(r)
1317# 697 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1318#elif defined(MFC_OpenMP)
1319# 697 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1320
1321# 697 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1322
1323# 697 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1324
1325# 697 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1326!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1327# 697 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1328#endif
1329 do l = 0, p
1330 do k = 0, buff_size - 1
1331 do j = -buff_size, m + buff_size
1332 r = nvar + v_size*((j + buff_size) + (m + 2*buff_size + 1)*(k + buff_size*l))
1333 buff_send(r) = real(q_t_sf%sf(j, k + pack_offset, l), kind=wp)
1334 end do
1335 end do
1336 end do
1337
1338# 706 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1339#if defined(MFC_OpenACC)
1340# 706 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1341!$acc end parallel loop
1342# 706 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1343#elif defined(MFC_OpenMP)
1344# 706 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1345
1346# 706 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1347!$omp end target teams loop
1348# 706 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1349#endif
1350 end if
1351
1352 if (qbmm_comm) then
1353
1354# 710 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1355
1356# 710 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1357#if defined(MFC_OpenACC)
1358# 710 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1359!$acc parallel loop collapse(5) gang vector default(present) private(r)
1360# 710 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1361#elif defined(MFC_OpenMP)
1362# 710 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1363
1364# 710 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1365
1366# 710 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1367
1368# 710 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1369!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(5) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1370# 710 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1371#endif
1372 do i = nvar + 1, nvar + nnode
1373 do l = 0, p
1374 do k = 0, buff_size - 1
1375 do j = -buff_size, m + buff_size
1376 do q = 1, nb
1377 r = (i - 1) + (q - 1)*nnode + v_size*((j + buff_size) + (m + 2*buff_size + 1)*(k &
1378 & + buff_size*l))
1379 buff_send(r) = real(pb_in(j, k + pack_offset, l, i - nvar, q), kind=wp)
1380 end do
1381 end do
1382 end do
1383 end do
1384 end do
1385
1386# 724 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1387#if defined(MFC_OpenACC)
1388# 724 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1389!$acc end parallel loop
1390# 724 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1391#elif defined(MFC_OpenMP)
1392# 724 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1393
1394# 724 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1395!$omp end target teams loop
1396# 724 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1397#endif
1398
1399
1400# 726 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1401
1402# 726 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1403#if defined(MFC_OpenACC)
1404# 726 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1405!$acc parallel loop collapse(5) gang vector default(present) private(r)
1406# 726 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1407#elif defined(MFC_OpenMP)
1408# 726 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1409
1410# 726 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1411
1412# 726 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1413
1414# 726 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1415!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(5) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1416# 726 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1417#endif
1418 do i = nvar + 1, nvar + nnode
1419 do l = 0, p
1420 do k = 0, buff_size - 1
1421 do j = -buff_size, m + buff_size
1422 do q = 1, nb
1423 r = (i - 1) + (q - 1)*nnode + nb*nnode + v_size*((j + buff_size) + (m + 2*buff_size &
1424 & + 1)*(k + buff_size*l))
1425 buff_send(r) = real(mv_in(j, k + pack_offset, l, i - nvar, q), kind=wp)
1426 end do
1427 end do
1428 end do
1429 end do
1430 end do
1431
1432# 740 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1433#if defined(MFC_OpenACC)
1434# 740 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1435!$acc end parallel loop
1436# 740 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1437#elif defined(MFC_OpenMP)
1438# 740 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1439
1440# 740 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1441!$omp end target teams loop
1442# 740 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1443#endif
1444 end if
1445# 805 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1446 end if
1447# 623 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1448 if (mpi_dir == 3) then
1449# 743 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1450
1451# 743 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1452
1453# 743 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1454#if defined(MFC_OpenACC)
1455# 743 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1456!$acc parallel loop collapse(4) gang vector default(present) private(r)
1457# 743 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1458#elif defined(MFC_OpenMP)
1459# 743 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1460
1461# 743 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1462
1463# 743 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1464
1465# 743 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1466!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1467# 743 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1468#endif
1469 do i = 1, nvar
1470 do l = 0, buff_size - 1
1471 do k = -buff_size, n + buff_size
1472 do j = -buff_size, m + buff_size
1473 r = (i - 1) + v_size*((j + buff_size) + (m + 2*buff_size + 1)*((k + buff_size) + (n &
1474 & + 2*buff_size + 1)*l))
1475 buff_send(r) = real(q_comm(i)%sf(j, k, l + pack_offset), kind=wp)
1476 end do
1477 end do
1478 end do
1479 end do
1480
1481# 755 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1482#if defined(MFC_OpenACC)
1483# 755 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1484!$acc end parallel loop
1485# 755 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1486#elif defined(MFC_OpenMP)
1487# 755 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1488
1489# 755 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1490!$omp end target teams loop
1491# 755 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1492#endif
1493
1494 if (chem_diff_comm) then
1495
1496# 758 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1497
1498# 758 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1499#if defined(MFC_OpenACC)
1500# 758 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1501!$acc parallel loop collapse(3) gang vector default(present) private(r)
1502# 758 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1503#elif defined(MFC_OpenMP)
1504# 758 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1505
1506# 758 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1507
1508# 758 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1509
1510# 758 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1511!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1512# 758 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1513#endif
1514 do l = 0, buff_size - 1
1515 do k = -buff_size, n + buff_size
1516 do j = -buff_size, m + buff_size
1517 r = nvar + v_size*((j + buff_size) + (m + 2*buff_size + 1)*((k + buff_size) + (n &
1518 & + 2*buff_size + 1)*l))
1519 buff_send(r) = real(q_t_sf%sf(j, k, l + pack_offset), kind=wp)
1520 end do
1521 end do
1522 end do
1523
1524# 768 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1525#if defined(MFC_OpenACC)
1526# 768 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1527!$acc end parallel loop
1528# 768 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1529#elif defined(MFC_OpenMP)
1530# 768 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1531
1532# 768 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1533!$omp end target teams loop
1534# 768 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1535#endif
1536 end if
1537
1538 if (qbmm_comm) then
1539
1540# 772 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1541
1542# 772 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1543#if defined(MFC_OpenACC)
1544# 772 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1545!$acc parallel loop collapse(5) gang vector default(present) private(r)
1546# 772 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1547#elif defined(MFC_OpenMP)
1548# 772 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1549
1550# 772 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1551
1552# 772 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1553
1554# 772 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1555!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(5) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1556# 772 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1557#endif
1558 do i = nvar + 1, nvar + nnode
1559 do l = 0, buff_size - 1
1560 do k = -buff_size, n + buff_size
1561 do j = -buff_size, m + buff_size
1562 do q = 1, nb
1563 r = (i - 1) + (q - 1)*nnode + v_size*((j + buff_size) + (m + 2*buff_size + 1)*((k &
1564 & + buff_size) + (n + 2*buff_size + 1)*l))
1565 buff_send(r) = real(pb_in(j, k, l + pack_offset, i - nvar, q), kind=wp)
1566 end do
1567 end do
1568 end do
1569 end do
1570 end do
1571
1572# 786 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1573#if defined(MFC_OpenACC)
1574# 786 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1575!$acc end parallel loop
1576# 786 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1577#elif defined(MFC_OpenMP)
1578# 786 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1579
1580# 786 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1581!$omp end target teams loop
1582# 786 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1583#endif
1584
1585
1586# 788 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1587
1588# 788 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1589#if defined(MFC_OpenACC)
1590# 788 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1591!$acc parallel loop collapse(5) gang vector default(present) private(r)
1592# 788 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1593#elif defined(MFC_OpenMP)
1594# 788 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1595
1596# 788 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1597
1598# 788 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1599
1600# 788 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1601!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(5) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1602# 788 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1603#endif
1604 do i = nvar + 1, nvar + nnode
1605 do l = 0, buff_size - 1
1606 do k = -buff_size, n + buff_size
1607 do j = -buff_size, m + buff_size
1608 do q = 1, nb
1609 r = (i - 1) + (q - 1)*nnode + nb*nnode + v_size*((j + buff_size) + (m + 2*buff_size &
1610 & + 1)*((k + buff_size) + (n + 2*buff_size + 1)*l))
1611 buff_send(r) = real(mv_in(j, k, l + pack_offset, i - nvar, q), kind=wp)
1612 end do
1613 end do
1614 end do
1615 end do
1616 end do
1617
1618# 802 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1619#if defined(MFC_OpenACC)
1620# 802 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1621!$acc end parallel loop
1622# 802 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1623#elif defined(MFC_OpenMP)
1624# 802 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1625
1626# 802 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1627!$omp end target teams loop
1628# 802 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1629#endif
1630 end if
1631# 805 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1632 end if
1633# 807 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1634 call nvtxendrange ! Packbuf
1635
1636 ! Send/Recv
1637#ifdef MFC_SIMULATION
1638# 812 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1639 if (rdma_mpi .eqv. .false.) then
1640# 824 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1641 call nvtxstartrange("RHS-COMM-DEV2HOST")
1642
1643# 825 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1644#if defined(MFC_OpenACC)
1645# 825 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1646!$acc update host(buff_send)
1647# 825 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1648#elif defined(MFC_OpenMP)
1649# 825 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1650!$omp target update from(buff_send)
1651# 825 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1652#endif
1653 call nvtxendrange
1654 call nvtxstartrange("RHS-COMM-SENDRECV-NO-RMDA")
1655
1656 call mpi_sendrecv(buff_send, buffer_count, mpi_p, dst_proc, send_tag, buff_recv, buffer_count, mpi_p, &
1657 & src_proc, recv_tag, mpi_comm_world, mpi_status_ignore, ierr)
1658
1659 call nvtxendrange ! RHS-MPI-SENDRECV-(NO)-RDMA
1660
1661 call nvtxstartrange("RHS-COMM-HOST2DEV")
1662
1663# 835 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1664#if defined(MFC_OpenACC)
1665# 835 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1666!$acc update device(buff_recv)
1667# 835 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1668#elif defined(MFC_OpenMP)
1669# 835 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1670!$omp target update to(buff_recv)
1671# 835 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1672#endif
1673 call nvtxendrange
1674# 838 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1675 end if
1676# 812 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1677 if (rdma_mpi .eqv. .true.) then
1678# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1679
1680# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1681#if defined(MFC_OpenACC)
1682# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1683!$acc host_data use_device(buff_send, buff_recv)
1684# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1685 call nvtxstartrange("RHS-COMM-SENDRECV-RDMA")
1686# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1687
1688# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1689 call mpi_sendrecv(buff_send, buffer_count, mpi_p, dst_proc, send_tag, buff_recv, buffer_count, mpi_p, &
1690# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1691 & src_proc, recv_tag, mpi_comm_world, mpi_status_ignore, ierr)
1692# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1693
1694# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1695 call nvtxendrange ! RHS-MPI-SENDRECV-(NO)-RDMA
1696# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1697!$acc end host_data
1698# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1699#elif defined(MFC_OpenMP)
1700# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1701!$omp target data use_device_addr(buff_send, buff_recv)
1702# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1703 call nvtxstartrange("RHS-COMM-SENDRECV-RDMA")
1704# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1705
1706# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1707 call mpi_sendrecv(buff_send, buffer_count, mpi_p, dst_proc, send_tag, buff_recv, buffer_count, mpi_p, &
1708# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1709 & src_proc, recv_tag, mpi_comm_world, mpi_status_ignore, ierr)
1710# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1711
1712# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1713 call nvtxendrange ! RHS-MPI-SENDRECV-(NO)-RDMA
1714# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1715!$omp end target data
1716# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1717#else
1718# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1719 call nvtxstartrange("RHS-COMM-SENDRECV-RDMA")
1720# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1721
1722# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1723 call mpi_sendrecv(buff_send, buffer_count, mpi_p, dst_proc, send_tag, buff_recv, buffer_count, mpi_p, &
1724# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1725 & src_proc, recv_tag, mpi_comm_world, mpi_status_ignore, ierr)
1726# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1727
1728# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1729 call nvtxendrange ! RHS-MPI-SENDRECV-(NO)-RDMA
1730# 814 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1731#endif
1732# 822 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1733
1734# 822 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1735#if defined(MFC_OpenACC)
1736# 822 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1737!$acc wait
1738# 822 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1739#elif defined(MFC_OpenMP)
1740# 822 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1741!$omp barrier
1742# 822 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1743#endif
1744# 838 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1745 end if
1746# 840 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1747#else
1748 call mpi_sendrecv(buff_send, buffer_count, mpi_p, dst_proc, send_tag, buff_recv, buffer_count, mpi_p, src_proc, recv_tag, &
1749 & mpi_comm_world, mpi_status_ignore, ierr)
1750#endif
1751
1752 ! Unpack Received Buffer
1753 call nvtxstartrange("RHS-COMM-UNPACKBUF")
1754# 848 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1755 if (mpi_dir == 1) then
1756# 850 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1757
1758# 850 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1759
1760# 850 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1761#if defined(MFC_OpenACC)
1762# 850 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1763!$acc parallel loop collapse(4) gang vector default(present) private(r)
1764# 850 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1765#elif defined(MFC_OpenMP)
1766# 850 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1767
1768# 850 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1769
1770# 850 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1771
1772# 850 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1773!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1774# 850 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1775#endif
1776 do l = 0, p
1777 do k = 0, n
1778 do j = -buff_size, -1
1779 do i = 1, nvar
1780 r = (i - 1) + v_size*(j + buff_size*((k + 1) + (n + 1)*l))
1781 q_comm(i)%sf(j + unpack_offset, k, l) = real(buff_recv(r), kind=stp)
1782#if defined(__INTEL_COMPILER)
1783 if (ieee_is_nan(q_comm(i)%sf(j + unpack_offset, k, l))) then
1784 print *, "Error", j, k, l, i
1785 call s_mpi_abort("NaN(s) in recv")
1786 end if
1787#endif
1788 end do
1789 end do
1790 end do
1791 end do
1792
1793# 867 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1794#if defined(MFC_OpenACC)
1795# 867 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1796!$acc end parallel loop
1797# 867 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1798#elif defined(MFC_OpenMP)
1799# 867 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1800
1801# 867 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1802!$omp end target teams loop
1803# 867 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1804#endif
1805
1806 if (chem_diff_comm) then
1807
1808# 870 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1809
1810# 870 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1811#if defined(MFC_OpenACC)
1812# 870 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1813!$acc parallel loop collapse(3) gang vector default(present) private(r)
1814# 870 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1815#elif defined(MFC_OpenMP)
1816# 870 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1817
1818# 870 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1819
1820# 870 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1821
1822# 870 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1823!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1824# 870 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1825#endif
1826 do l = 0, p
1827 do k = 0, n
1828 do j = -buff_size, -1
1829 r = nvar + v_size*(j + buff_size*((k + 1) + (n + 1)*l))
1830 q_t_sf%sf(j + unpack_offset, k, l) = real(buff_recv(r), kind=stp)
1831#if defined(__INTEL_COMPILER)
1832 if (ieee_is_nan(q_t_sf%sf(j + unpack_offset, k, l))) then
1833 print *, "Error", j, k, l
1834 call s_mpi_abort("NaN(s) in recv")
1835 end if
1836#endif
1837 end do
1838 end do
1839 end do
1840
1841# 885 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1842#if defined(MFC_OpenACC)
1843# 885 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1844!$acc end parallel loop
1845# 885 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1846#elif defined(MFC_OpenMP)
1847# 885 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1848
1849# 885 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1850!$omp end target teams loop
1851# 885 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1852#endif
1853 end if
1854
1855 if (qbmm_comm) then
1856
1857# 889 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1858
1859# 889 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1860#if defined(MFC_OpenACC)
1861# 889 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1862!$acc parallel loop collapse(5) gang vector default(present) private(r)
1863# 889 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1864#elif defined(MFC_OpenMP)
1865# 889 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1866
1867# 889 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1868
1869# 889 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1870
1871# 889 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1872!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(5) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1873# 889 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1874#endif
1875 do l = 0, p
1876 do k = 0, n
1877 do j = -buff_size, -1
1878 do i = nvar + 1, nvar + nnode
1879 do q = 1, nb
1880 r = (i - 1) + (q - 1)*nnode + v_size*(j + buff_size*((k + 1) + (n + 1)*l))
1881 pb_in(j + unpack_offset, k, l, i - nvar, q) = real(buff_recv(r), kind=stp)
1882 end do
1883 end do
1884 end do
1885 end do
1886 end do
1887
1888# 902 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1889#if defined(MFC_OpenACC)
1890# 902 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1891!$acc end parallel loop
1892# 902 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1893#elif defined(MFC_OpenMP)
1894# 902 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1895
1896# 902 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1897!$omp end target teams loop
1898# 902 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1899#endif
1900
1901
1902# 904 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1903
1904# 904 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1905#if defined(MFC_OpenACC)
1906# 904 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1907!$acc parallel loop collapse(5) gang vector default(present) private(r)
1908# 904 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1909#elif defined(MFC_OpenMP)
1910# 904 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1911
1912# 904 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1913
1914# 904 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1915
1916# 904 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1917!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(5) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1918# 904 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1919#endif
1920 do l = 0, p
1921 do k = 0, n
1922 do j = -buff_size, -1
1923 do i = nvar + 1, nvar + nnode
1924 do q = 1, nb
1925 r = (i - 1) + (q - 1)*nnode + nb*nnode + v_size*(j + buff_size*((k + 1) + (n + 1)*l))
1926 mv_in(j + unpack_offset, k, l, i - nvar, q) = real(buff_recv(r), kind=stp)
1927 end do
1928 end do
1929 end do
1930 end do
1931 end do
1932
1933# 917 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1934#if defined(MFC_OpenACC)
1935# 917 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1936!$acc end parallel loop
1937# 917 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1938#elif defined(MFC_OpenMP)
1939# 917 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1940
1941# 917 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1942!$omp end target teams loop
1943# 917 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1944#endif
1945 end if
1946# 1066 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1947 end if
1948# 848 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1949 if (mpi_dir == 2) then
1950# 920 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1951
1952# 920 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1953
1954# 920 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1955#if defined(MFC_OpenACC)
1956# 920 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1957!$acc parallel loop collapse(4) gang vector default(present) private(r)
1958# 920 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1959#elif defined(MFC_OpenMP)
1960# 920 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1961
1962# 920 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1963
1964# 920 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1965
1966# 920 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1967!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
1968# 920 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1969#endif
1970 do i = 1, nvar
1971 do l = 0, p
1972 do k = -buff_size, -1
1973 do j = -buff_size, m + buff_size
1974 r = (i - 1) + v_size*((j + buff_size) + (m + 2*buff_size + 1)*((k + buff_size) + buff_size*l))
1975 q_comm(i)%sf(j, k + unpack_offset, l) = real(buff_recv(r), kind=stp)
1976#if defined(__INTEL_COMPILER)
1977 if (ieee_is_nan(q_comm(i)%sf(j, k + unpack_offset, l))) then
1978 print *, "Error", j, k, l, i
1979 call s_mpi_abort("NaN(s) in recv")
1980 end if
1981#endif
1982 end do
1983 end do
1984 end do
1985 end do
1986
1987# 937 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1988#if defined(MFC_OpenACC)
1989# 937 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1990!$acc end parallel loop
1991# 937 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1992#elif defined(MFC_OpenMP)
1993# 937 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1994
1995# 937 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1996!$omp end target teams loop
1997# 937 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
1998#endif
1999
2000 if (chem_diff_comm) then
2001
2002# 940 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2003
2004# 940 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2005#if defined(MFC_OpenACC)
2006# 940 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2007!$acc parallel loop collapse(3) gang vector default(present) private(r)
2008# 940 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2009#elif defined(MFC_OpenMP)
2010# 940 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2011
2012# 940 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2013
2014# 940 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2015
2016# 940 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2017!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
2018# 940 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2019#endif
2020 do l = 0, p
2021 do k = -buff_size, -1
2022 do j = -buff_size, m + buff_size
2023 r = nvar + v_size*((j + buff_size) + (m + 2*buff_size + 1)*((k + buff_size) + buff_size*l))
2024 q_t_sf%sf(j, k + unpack_offset, l) = real(buff_recv(r), kind=stp)
2025#if defined(__INTEL_COMPILER)
2026 if (ieee_is_nan(q_t_sf%sf(j, k + unpack_offset, l))) then
2027 print *, "Error", j, k, l
2028 call s_mpi_abort("NaN(s) in recv")
2029 end if
2030#endif
2031 end do
2032 end do
2033 end do
2034
2035# 955 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2036#if defined(MFC_OpenACC)
2037# 955 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2038!$acc end parallel loop
2039# 955 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2040#elif defined(MFC_OpenMP)
2041# 955 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2042
2043# 955 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2044!$omp end target teams loop
2045# 955 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2046#endif
2047 end if
2048
2049 if (qbmm_comm) then
2050
2051# 959 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2052
2053# 959 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2054#if defined(MFC_OpenACC)
2055# 959 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2056!$acc parallel loop collapse(5) gang vector default(present) private(r)
2057# 959 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2058#elif defined(MFC_OpenMP)
2059# 959 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2060
2061# 959 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2062
2063# 959 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2064
2065# 959 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2066!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(5) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
2067# 959 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2068#endif
2069 do i = nvar + 1, nvar + nnode
2070 do l = 0, p
2071 do k = -buff_size, -1
2072 do j = -buff_size, m + buff_size
2073 do q = 1, nb
2074 r = (i - 1) + (q - 1)*nnode + v_size*((j + buff_size) + (m + 2*buff_size + 1)*((k &
2075 & + buff_size) + buff_size*l))
2076 pb_in(j, k + unpack_offset, l, i - nvar, q) = real(buff_recv(r), kind=stp)
2077 end do
2078 end do
2079 end do
2080 end do
2081 end do
2082
2083# 973 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2084#if defined(MFC_OpenACC)
2085# 973 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2086!$acc end parallel loop
2087# 973 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2088#elif defined(MFC_OpenMP)
2089# 973 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2090
2091# 973 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2092!$omp end target teams loop
2093# 973 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2094#endif
2095
2096
2097# 975 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2098
2099# 975 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2100#if defined(MFC_OpenACC)
2101# 975 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2102!$acc parallel loop collapse(5) gang vector default(present) private(r)
2103# 975 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2104#elif defined(MFC_OpenMP)
2105# 975 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2106
2107# 975 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2108
2109# 975 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2110
2111# 975 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2112!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(5) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
2113# 975 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2114#endif
2115 do i = nvar + 1, nvar + nnode
2116 do l = 0, p
2117 do k = -buff_size, -1
2118 do j = -buff_size, m + buff_size
2119 do q = 1, nb
2120 r = (i - 1) + (q - 1)*nnode + nb*nnode + v_size*((j + buff_size) + (m + 2*buff_size &
2121 & + 1)*((k + buff_size) + buff_size*l))
2122 mv_in(j, k + unpack_offset, l, i - nvar, q) = real(buff_recv(r), kind=stp)
2123 end do
2124 end do
2125 end do
2126 end do
2127 end do
2128
2129# 989 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2130#if defined(MFC_OpenACC)
2131# 989 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2132!$acc end parallel loop
2133# 989 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2134#elif defined(MFC_OpenMP)
2135# 989 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2136
2137# 989 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2138!$omp end target teams loop
2139# 989 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2140#endif
2141 end if
2142# 1066 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2143 end if
2144# 848 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2145 if (mpi_dir == 3) then
2146# 992 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2147
2148# 992 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2149
2150# 992 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2151#if defined(MFC_OpenACC)
2152# 992 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2153!$acc parallel loop collapse(4) gang vector default(present) private(r)
2154# 992 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2155#elif defined(MFC_OpenMP)
2156# 992 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2157
2158# 992 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2159
2160# 992 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2161
2162# 992 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2163!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
2164# 992 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2165#endif
2166 do i = 1, nvar
2167 do l = -buff_size, -1
2168 do k = -buff_size, n + buff_size
2169 do j = -buff_size, m + buff_size
2170 r = (i - 1) + v_size*((j + buff_size) + (m + 2*buff_size + 1)*((k + buff_size) + (n &
2171 & + 2*buff_size + 1)*(l + buff_size)))
2172 q_comm(i)%sf(j, k, l + unpack_offset) = real(buff_recv(r), kind=stp)
2173#if defined(__INTEL_COMPILER)
2174 if (ieee_is_nan(q_comm(i)%sf(j, k, l + unpack_offset))) then
2175 print *, "Error", j, k, l, i
2176 call s_mpi_abort("NaN(s) in recv")
2177 end if
2178#endif
2179 end do
2180 end do
2181 end do
2182 end do
2183
2184# 1010 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2185#if defined(MFC_OpenACC)
2186# 1010 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2187!$acc end parallel loop
2188# 1010 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2189#elif defined(MFC_OpenMP)
2190# 1010 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2191
2192# 1010 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2193!$omp end target teams loop
2194# 1010 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2195#endif
2196
2197 if (chem_diff_comm) then
2198
2199# 1013 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2200
2201# 1013 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2202#if defined(MFC_OpenACC)
2203# 1013 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2204!$acc parallel loop collapse(3) gang vector default(present) private(r)
2205# 1013 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2206#elif defined(MFC_OpenMP)
2207# 1013 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2208
2209# 1013 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2210
2211# 1013 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2212
2213# 1013 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2214!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
2215# 1013 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2216#endif
2217 do l = -buff_size, -1
2218 do k = -buff_size, n + buff_size
2219 do j = -buff_size, m + buff_size
2220 r = nvar + v_size*((j + buff_size) + (m + 2*buff_size + 1)*((k + buff_size) + (n &
2221 & + 2*buff_size + 1)*(l + buff_size)))
2222 q_t_sf%sf(j, k, l + unpack_offset) = real(buff_recv(r), kind=stp)
2223#if defined(__INTEL_COMPILER)
2224 if (ieee_is_nan(q_t_sf%sf(j, k, l + unpack_offset))) then
2225 print *, "Error", j, k, l
2226 call s_mpi_abort("NaN(s) in recv")
2227 end if
2228#endif
2229 end do
2230 end do
2231 end do
2232
2233# 1029 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2234#if defined(MFC_OpenACC)
2235# 1029 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2236!$acc end parallel loop
2237# 1029 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2238#elif defined(MFC_OpenMP)
2239# 1029 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2240
2241# 1029 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2242!$omp end target teams loop
2243# 1029 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2244#endif
2245 end if
2246
2247 if (qbmm_comm) then
2248
2249# 1033 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2250
2251# 1033 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2252#if defined(MFC_OpenACC)
2253# 1033 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2254!$acc parallel loop collapse(5) gang vector default(present) private(r)
2255# 1033 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2256#elif defined(MFC_OpenMP)
2257# 1033 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2258
2259# 1033 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2260
2261# 1033 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2262
2263# 1033 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2264!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(5) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
2265# 1033 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2266#endif
2267 do i = nvar + 1, nvar + nnode
2268 do l = -buff_size, -1
2269 do k = -buff_size, n + buff_size
2270 do j = -buff_size, m + buff_size
2271 do q = 1, nb
2272 r = (i - 1) + (q - 1)*nnode + v_size*((j + buff_size) + (m + 2*buff_size + 1)*((k &
2273 & + buff_size) + (n + 2*buff_size + 1)*(l + buff_size)))
2274 pb_in(j, k, l + unpack_offset, i - nvar, q) = real(buff_recv(r), kind=stp)
2275 end do
2276 end do
2277 end do
2278 end do
2279 end do
2280
2281# 1047 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2282#if defined(MFC_OpenACC)
2283# 1047 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2284!$acc end parallel loop
2285# 1047 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2286#elif defined(MFC_OpenMP)
2287# 1047 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2288
2289# 1047 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2290!$omp end target teams loop
2291# 1047 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2292#endif
2293
2294
2295# 1049 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2296
2297# 1049 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2298#if defined(MFC_OpenACC)
2299# 1049 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2300!$acc parallel loop collapse(5) gang vector default(present) private(r)
2301# 1049 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2302#elif defined(MFC_OpenMP)
2303# 1049 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2304
2305# 1049 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2306
2307# 1049 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2308
2309# 1049 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2310!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(5) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
2311# 1049 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2312#endif
2313 do i = nvar + 1, nvar + nnode
2314 do l = -buff_size, -1
2315 do k = -buff_size, n + buff_size
2316 do j = -buff_size, m + buff_size
2317 do q = 1, nb
2318 r = (i - 1) + (q - 1)*nnode + nb*nnode + v_size*((j + buff_size) + (m + 2*buff_size &
2319 & + 1)*((k + buff_size) + (n + 2*buff_size + 1)*(l + buff_size)))
2320 mv_in(j, k, l + unpack_offset, i - nvar, q) = real(buff_recv(r), kind=stp)
2321 end do
2322 end do
2323 end do
2324 end do
2325 end do
2326
2327# 1063 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2328#if defined(MFC_OpenACC)
2329# 1063 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2330!$acc end parallel loop
2331# 1063 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2332#elif defined(MFC_OpenMP)
2333# 1063 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2334
2335# 1063 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2336!$omp end target teams loop
2337# 1063 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2338#endif
2339 end if
2340# 1066 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2341 end if
2342# 1068 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2343 call nvtxendrange
2344#endif
2345
2346 end subroutine s_mpi_sendrecv_variables_buffers
2347
2348 !> The goal of this procedure is to populate the buffers of the cell-average conservative variables by communicating with the
2349 !! neighboring processors.
2350 !! @param q_cons_vf Cell-average conservative variables
2351 !! @param mpi_dir MPI communication coordinate direction
2352 !! @param pbc_loc Processor boundary condition (PBC) location
2353 subroutine s_mpi_reduce_beta_variables_buffers(q_comm, kahan_comp, mpi_dir, pbc_loc, nVar)
2354
2355 type(scalar_field), dimension(1:), intent(inout) :: q_comm
2356 type(scalar_field), dimension(1:), intent(inout) :: kahan_comp
2357 integer, intent(in) :: mpi_dir, pbc_loc, nVar
2358 integer :: i, j, k, l, r, q !< Generic loop iterators
2359 integer :: lb_size
2360 integer :: buffer_counts(1:3), buffer_count
2361 type(int_bounds_info) :: boundary_conditions(1:3)
2362 integer :: beg_end(1:2), grid_dims(1:3)
2363 integer :: dst_proc, src_proc, recv_tag, send_tag
2364 logical :: replace_buff
2365 integer :: pack_offset, unpack_offset
2366 real(wp) :: y_kahan, t_kahan
2367
2368#ifdef MFC_MPI
2369 integer :: ierr !< Generic flag used to identify and report MPI errors
2370
2371 call nvtxstartrange("BETA-COMM-PACKBUF")
2372
2373 ! Set bounds for each dimension Always include the full buffer range for each existing dimension. The Gaussian smearing
2374 ! kernel writes to buffer cells even at physical boundaries, and these contributions must be communicated to neighbors in
2375 ! other directions via ADD operations.
2376 comm_coords(1)%beg = -mapcells - 1
2377 comm_coords(1)%end = m + mapcells + 1
2378 comm_coords(2)%beg = merge(-mapcells - 1, 0, n > 0)
2379 comm_coords(2)%end = merge(n + mapcells + 1, n, n > 0)
2380 comm_coords(3)%beg = merge(-mapcells - 1, 0, p > 0)
2381 comm_coords(3)%end = merge(p + mapcells + 1, p, p > 0)
2382
2383 ! Compute sizes
2384 comm_size(1) = comm_coords(1)%end - comm_coords(1)%beg + 1
2385 comm_size(2) = comm_coords(2)%end - comm_coords(2)%beg + 1
2386 comm_size(3) = comm_coords(3)%end - comm_coords(3)%beg + 1
2387
2388 ! Buffer counts using the conditional sizes
2389 v_size = nvar
2390 lb_size = 2*(mapcells + 1) ! Size of the buffer region for beta variables (-mapcells - 1, mapcells)
2391 buffer_counts = (/lb_size*v_size*comm_size(2)*comm_size(3), lb_size*v_size*comm_size(1)*comm_size(3), &
2392 & lb_size*v_size*comm_size(1)*comm_size(2)/)
2393
2394
2395# 1119 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2396#if defined(MFC_OpenACC)
2397# 1119 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2398!$acc update device(v_size, comm_coords, comm_size)
2399# 1119 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2400#elif defined(MFC_OpenMP)
2401# 1119 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2402!$omp target update to(v_size, comm_coords, comm_size)
2403# 1119 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2404#endif
2405
2406 buffer_count = buffer_counts(mpi_dir)
2407 boundary_conditions = (/bc_x, bc_y, bc_z/)
2408 beg_end = (/boundary_conditions(mpi_dir)%beg, boundary_conditions(mpi_dir)%end/)
2409 grid_dims = (/m, n, p/)
2410
2411 if (pbc_loc == -1) then ! PBC at the beginning
2412 ! Phase 1: Rightward accumulation Send END buffer to right neighbor, recv from left into BEG, ADD
2413 pack_offset = grid_dims(mpi_dir) + 1
2414 unpack_offset = 0
2415 dst_proc = merge(beg_end(2), mpi_proc_null, beg_end(2) >= 0)
2416 src_proc = merge(beg_end(1), mpi_proc_null, beg_end(1) >= 0)
2417 send_tag = 0
2418 recv_tag = 0
2419 replace_buff = .false.
2420 else
2421 ! Phase 2: Leftward distribution Send BEG buffer to left neighbor, recv from right into END, REPLACE
2422 pack_offset = 0
2423 unpack_offset = grid_dims(mpi_dir) + 1
2424 dst_proc = merge(beg_end(1), mpi_proc_null, beg_end(1) >= 0)
2425 src_proc = merge(beg_end(2), mpi_proc_null, beg_end(2) >= 0)
2426 send_tag = 1
2427 recv_tag = 1
2428 replace_buff = .true.
2429 end if
2430
2431 ! Pack Buffer to Send
2432# 1148 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2433 if (mpi_dir == 1) then
2434# 1150 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2435
2436# 1150 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2437
2438# 1150 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2439#if defined(MFC_OpenACC)
2440# 1150 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2441!$acc parallel loop collapse(4) gang vector default(present) private(r)
2442# 1150 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2443#elif defined(MFC_OpenMP)
2444# 1150 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2445
2446# 1150 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2447
2448# 1150 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2449
2450# 1150 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2451!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
2452# 1150 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2453#endif
2454 do l = comm_coords(3)%beg, comm_coords(3)%end
2455 do k = comm_coords(2)%beg, comm_coords(2)%end
2456 do j = -mapcells - 1, mapcells
2457 do i = 1, v_size
2458 r = (i - 1) + v_size*((j + mapcells + 1) + lb_size*((k - comm_coords(2)%beg) + comm_size(2) &
2459 & *(l - comm_coords(3)%beg)))
2460 buff_send(r) = real(q_comm(beta_vars(i))%sf(j + pack_offset, k, l), &
2461 & kind=wp) - real(kahan_comp(beta_vars(i))%sf(j + pack_offset, k, l), kind=wp)
2462 end do
2463 end do
2464 end do
2465 end do
2466
2467# 1163 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2468#if defined(MFC_OpenACC)
2469# 1163 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2470!$acc end parallel loop
2471# 1163 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2472#elif defined(MFC_OpenMP)
2473# 1163 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2474
2475# 1163 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2476!$omp end target teams loop
2477# 1163 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2478#endif
2479# 1195 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2480 end if
2481# 1148 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2482 if (mpi_dir == 2) then
2483# 1165 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2484
2485# 1165 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2486
2487# 1165 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2488#if defined(MFC_OpenACC)
2489# 1165 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2490!$acc parallel loop collapse(4) gang vector default(present) private(r)
2491# 1165 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2492#elif defined(MFC_OpenMP)
2493# 1165 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2494
2495# 1165 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2496
2497# 1165 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2498
2499# 1165 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2500!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
2501# 1165 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2502#endif
2503 do i = 1, v_size
2504 do l = comm_coords(3)%beg, comm_coords(3)%end
2505 do k = -mapcells - 1, mapcells
2506 do j = comm_coords(1)%beg, comm_coords(1)%end
2507 r = (i - 1) + v_size*((j - comm_coords(1)%beg) + comm_size(1)*((k + mapcells + 1) &
2508 & + lb_size*(l - comm_coords(3)%beg)))
2509 buff_send(r) = real(q_comm(beta_vars(i))%sf(j, k + pack_offset, l), &
2510 & kind=wp) - real(kahan_comp(beta_vars(i))%sf(j, k + pack_offset, l), kind=wp)
2511 end do
2512 end do
2513 end do
2514 end do
2515
2516# 1178 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2517#if defined(MFC_OpenACC)
2518# 1178 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2519!$acc end parallel loop
2520# 1178 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2521#elif defined(MFC_OpenMP)
2522# 1178 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2523
2524# 1178 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2525!$omp end target teams loop
2526# 1178 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2527#endif
2528# 1195 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2529 end if
2530# 1148 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2531 if (mpi_dir == 3) then
2532# 1180 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2533
2534# 1180 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2535
2536# 1180 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2537#if defined(MFC_OpenACC)
2538# 1180 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2539!$acc parallel loop collapse(4) gang vector default(present) private(r)
2540# 1180 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2541#elif defined(MFC_OpenMP)
2542# 1180 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2543
2544# 1180 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2545
2546# 1180 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2547
2548# 1180 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2549!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(r)
2550# 1180 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2551#endif
2552 do i = 1, v_size
2553 do l = -mapcells - 1, mapcells
2554 do k = comm_coords(2)%beg, comm_coords(2)%end
2555 do j = comm_coords(1)%beg, comm_coords(1)%end
2556 r = (i - 1) + v_size*((j - comm_coords(1)%beg) + comm_size(1)*((k - comm_coords(2)%beg) &
2557 & + comm_size(2)*(l + mapcells + 1)))
2558 buff_send(r) = real(q_comm(beta_vars(i))%sf(j, k, l + pack_offset), &
2559 & kind=wp) - real(kahan_comp(beta_vars(i))%sf(j, k, l + pack_offset), kind=wp)
2560 end do
2561 end do
2562 end do
2563 end do
2564
2565# 1193 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2566#if defined(MFC_OpenACC)
2567# 1193 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2568!$acc end parallel loop
2569# 1193 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2570#elif defined(MFC_OpenMP)
2571# 1193 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2572
2573# 1193 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2574!$omp end target teams loop
2575# 1193 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2576#endif
2577# 1195 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2578 end if
2579# 1197 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2580 call nvtxendrange ! Packbuf
2581
2582 ! Send/Recv
2583#ifdef MFC_SIMULATION
2584# 1202 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2585 if (rdma_mpi .eqv. .false.) then
2586# 1214 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2587 call nvtxstartrange("BETA-COMM-DEV2HOST")
2588
2589# 1215 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2590#if defined(MFC_OpenACC)
2591# 1215 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2592!$acc update host(buff_send)
2593# 1215 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2594#elif defined(MFC_OpenMP)
2595# 1215 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2596!$omp target update from(buff_send)
2597# 1215 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2598#endif
2599 call nvtxendrange
2600 call nvtxstartrange("BETA-COMM-SENDRECV-NO-RMDA")
2601
2602 call mpi_sendrecv(buff_send, buffer_count, mpi_p, dst_proc, send_tag, buff_recv, buffer_count, mpi_p, &
2603 & src_proc, recv_tag, mpi_comm_world, mpi_status_ignore, ierr)
2604
2605 call nvtxendrange ! BETA-MPI-SENDRECV-(NO)-RDMA
2606
2607 call nvtxstartrange("BETA-COMM-HOST2DEV")
2608
2609# 1225 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2610#if defined(MFC_OpenACC)
2611# 1225 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2612!$acc update device(buff_recv)
2613# 1225 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2614#elif defined(MFC_OpenMP)
2615# 1225 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2616!$omp target update to(buff_recv)
2617# 1225 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2618#endif
2619 call nvtxendrange
2620# 1228 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2621 end if
2622# 1202 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2623 if (rdma_mpi .eqv. .true.) then
2624# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2625
2626# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2627#if defined(MFC_OpenACC)
2628# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2629!$acc host_data use_device(buff_send, buff_recv)
2630# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2631 call nvtxstartrange("BETA-COMM-SENDRECV-RDMA")
2632# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2633
2634# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2635 call mpi_sendrecv(buff_send, buffer_count, mpi_p, dst_proc, send_tag, buff_recv, buffer_count, mpi_p, &
2636# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2637 & src_proc, recv_tag, mpi_comm_world, mpi_status_ignore, ierr)
2638# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2639
2640# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2641 call nvtxendrange ! BETA-MPI-SENDRECV-(NO)-RDMA
2642# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2643!$acc end host_data
2644# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2645#elif defined(MFC_OpenMP)
2646# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2647!$omp target data use_device_addr(buff_send, buff_recv)
2648# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2649 call nvtxstartrange("BETA-COMM-SENDRECV-RDMA")
2650# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2651
2652# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2653 call mpi_sendrecv(buff_send, buffer_count, mpi_p, dst_proc, send_tag, buff_recv, buffer_count, mpi_p, &
2654# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2655 & src_proc, recv_tag, mpi_comm_world, mpi_status_ignore, ierr)
2656# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2657
2658# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2659 call nvtxendrange ! BETA-MPI-SENDRECV-(NO)-RDMA
2660# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2661!$omp end target data
2662# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2663#else
2664# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2665 call nvtxstartrange("BETA-COMM-SENDRECV-RDMA")
2666# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2667
2668# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2669 call mpi_sendrecv(buff_send, buffer_count, mpi_p, dst_proc, send_tag, buff_recv, buffer_count, mpi_p, &
2670# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2671 & src_proc, recv_tag, mpi_comm_world, mpi_status_ignore, ierr)
2672# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2673
2674# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2675 call nvtxendrange ! BETA-MPI-SENDRECV-(NO)-RDMA
2676# 1204 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2677#endif
2678# 1212 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2679
2680# 1212 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2681#if defined(MFC_OpenACC)
2682# 1212 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2683!$acc wait
2684# 1212 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2685#elif defined(MFC_OpenMP)
2686# 1212 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2687!$omp barrier
2688# 1212 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2689#endif
2690# 1228 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2691 end if
2692# 1230 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2693#else
2694 call mpi_sendrecv(buff_send, buffer_count, mpi_p, dst_proc, send_tag, buff_recv, buffer_count, mpi_p, src_proc, recv_tag, &
2695 & mpi_comm_world, mpi_status_ignore, ierr)
2696#endif
2697
2698 ! Unpack Received Buffer (skip if no source rank)
2699 call nvtxstartrange("BETA-COMM-UNPACKBUF")
2700 if (src_proc /= mpi_proc_null) then
2701# 1239 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2702 if (mpi_dir == 1) then
2703# 1241 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2704
2705# 1241 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2706
2707# 1241 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2708#if defined(MFC_OpenACC)
2709# 1241 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2710!$acc parallel loop collapse(4) gang vector default(present) private(r, y_kahan, t_kahan) copyin(replace_buff)
2711# 1241 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2712#elif defined(MFC_OpenMP)
2713# 1241 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2714
2715# 1241 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2716
2717# 1241 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2718
2719# 1241 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2720!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
2721# 1241 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2722!$omp& private(r, y_kahan, t_kahan) map(to:replace_buff)
2723# 1241 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2724#endif
2725 do l = comm_coords(3)%beg, comm_coords(3)%end
2726 do k = comm_coords(2)%beg, comm_coords(2)%end
2727 do j = -mapcells - 1, mapcells
2728 do i = 1, v_size
2729 r = (i - 1) + v_size*((j + mapcells + 1) + lb_size*((k - comm_coords(2)%beg) &
2730 & + comm_size(2)*(l - comm_coords(3)%beg)))
2731 if (replace_buff) then
2732 q_comm(beta_vars(i))%sf(j + unpack_offset, k, l) = real(buff_recv(r), kind=stp)
2733 kahan_comp(beta_vars(i))%sf(j + unpack_offset, k, &
2734 & l) = real(q_comm(beta_vars(i))%sf(j + unpack_offset, k, l), &
2735 & kind=wp) - buff_recv(r)
2736 else
2737 y_kahan = buff_recv(r) - real(kahan_comp(beta_vars(i))%sf(j + unpack_offset, k, l), &
2738 & kind=wp)
2739 t_kahan = real(q_comm(beta_vars(i))%sf(j + unpack_offset, k, l), kind=wp) + y_kahan
2740 kahan_comp(beta_vars(i))%sf(j + unpack_offset, k, &
2741 & l) = (t_kahan - q_comm(beta_vars(i))%sf(j + unpack_offset, k, l)) - y_kahan
2742 q_comm(beta_vars(i))%sf(j + unpack_offset, k, l) = t_kahan
2743 end if
2744 end do
2745 end do
2746 end do
2747 end do
2748
2749# 1265 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2750#if defined(MFC_OpenACC)
2751# 1265 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2752!$acc end parallel loop
2753# 1265 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2754#elif defined(MFC_OpenMP)
2755# 1265 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2756
2757# 1265 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2758!$omp end target teams loop
2759# 1265 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2760#endif
2761# 1320 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2762 end if
2763# 1239 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2764 if (mpi_dir == 2) then
2765# 1267 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2766
2767# 1267 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2768
2769# 1267 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2770#if defined(MFC_OpenACC)
2771# 1267 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2772!$acc parallel loop collapse(4) gang vector default(present) private(r, y_kahan, t_kahan) copyin(replace_buff)
2773# 1267 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2774#elif defined(MFC_OpenMP)
2775# 1267 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2776
2777# 1267 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2778
2779# 1267 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2780
2781# 1267 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2782!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
2783# 1267 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2784!$omp& private(r, y_kahan, t_kahan) map(to:replace_buff)
2785# 1267 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2786#endif
2787 do i = 1, v_size
2788 do l = comm_coords(3)%beg, comm_coords(3)%end
2789 do k = -mapcells - 1, mapcells
2790 do j = comm_coords(1)%beg, comm_coords(1)%end
2791 r = (i - 1) + v_size*((j - comm_coords(1)%beg) + comm_size(1)*((k + mapcells + 1) &
2792 & + lb_size*(l - comm_coords(3)%beg)))
2793 if (replace_buff) then
2794 q_comm(beta_vars(i))%sf(j, k + unpack_offset, l) = real(buff_recv(r), kind=stp)
2795 kahan_comp(beta_vars(i))%sf(j, k + unpack_offset, &
2796 & l) = real(q_comm(beta_vars(i))%sf(j, k + unpack_offset, l), &
2797 & kind=wp) - buff_recv(r)
2798 else
2799 y_kahan = buff_recv(r) - real(kahan_comp(beta_vars(i))%sf(j, k + unpack_offset, l), &
2800 & kind=wp)
2801 t_kahan = real(q_comm(beta_vars(i))%sf(j, k + unpack_offset, l), kind=wp) + y_kahan
2802 kahan_comp(beta_vars(i))%sf(j, k + unpack_offset, &
2803 & l) = (t_kahan - q_comm(beta_vars(i))%sf(j, k + unpack_offset, l)) - y_kahan
2804 q_comm(beta_vars(i))%sf(j, k + unpack_offset, l) = t_kahan
2805 end if
2806 end do
2807 end do
2808 end do
2809 end do
2810
2811# 1291 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2812#if defined(MFC_OpenACC)
2813# 1291 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2814!$acc end parallel loop
2815# 1291 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2816#elif defined(MFC_OpenMP)
2817# 1291 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2818
2819# 1291 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2820!$omp end target teams loop
2821# 1291 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2822#endif
2823# 1320 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2824 end if
2825# 1239 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2826 if (mpi_dir == 3) then
2827# 1293 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2828
2829# 1293 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2830
2831# 1293 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2832#if defined(MFC_OpenACC)
2833# 1293 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2834!$acc parallel loop collapse(4) gang vector default(present) private(r, y_kahan, t_kahan) copyin(replace_buff)
2835# 1293 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2836#elif defined(MFC_OpenMP)
2837# 1293 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2838
2839# 1293 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2840
2841# 1293 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2842
2843# 1293 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2844!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
2845# 1293 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2846!$omp& private(r, y_kahan, t_kahan) map(to:replace_buff)
2847# 1293 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2848#endif
2849 do i = 1, v_size
2850 do l = -mapcells - 1, mapcells
2851 do k = comm_coords(2)%beg, comm_coords(2)%end
2852 do j = comm_coords(1)%beg, comm_coords(1)%end
2853 r = (i - 1) + v_size*((j - comm_coords(1)%beg) + comm_size(1)*((k - comm_coords(2)%beg) &
2854 & + comm_size(2)*(l + mapcells + 1)))
2855 if (replace_buff) then
2856 q_comm(beta_vars(i))%sf(j, k, l + unpack_offset) = real(buff_recv(r), kind=stp)
2857 kahan_comp(beta_vars(i))%sf(j, k, &
2858 & l + unpack_offset) = real(q_comm(beta_vars(i))%sf(j, k, &
2859 & l + unpack_offset), kind=wp) - buff_recv(r)
2860 else
2861 y_kahan = buff_recv(r) - real(kahan_comp(beta_vars(i))%sf(j, k, l + unpack_offset), &
2862 & kind=wp)
2863 t_kahan = real(q_comm(beta_vars(i))%sf(j, k, l + unpack_offset), kind=wp) + y_kahan
2864 kahan_comp(beta_vars(i))%sf(j, k, &
2865 & l + unpack_offset) = (t_kahan - q_comm(beta_vars(i))%sf(j, k, &
2866 & l + unpack_offset)) - y_kahan
2867 q_comm(beta_vars(i))%sf(j, k, l + unpack_offset) = t_kahan
2868 end if
2869 end do
2870 end do
2871 end do
2872 end do
2873
2874# 1318 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2875#if defined(MFC_OpenACC)
2876# 1318 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2877!$acc end parallel loop
2878# 1318 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2879#elif defined(MFC_OpenMP)
2880# 1318 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2881
2882# 1318 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2883!$omp end target teams loop
2884# 1318 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2885#endif
2886# 1320 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2887 end if
2888# 1322 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
2889 end if
2890 call nvtxendrange
2891#endif
2892
2893 end subroutine s_mpi_reduce_beta_variables_buffers
2894
2895 !> The purpose of this procedure is to optimally decompose the computational domain among the available processors. This is
2896 !! performed by attempting to award each processor, in each of the coordinate directions, approximately the same number of
2897 !! cells, and then recomputing the affected global parameters.
2898 subroutine s_mpi_decompose_computational_domain
2899
2900#ifdef MFC_MPI
2901 !> Non-optimal number of processors in the x-, y- and z-directions
2902 real(wp) :: tmp_num_procs_x, tmp_num_procs_y, tmp_num_procs_z
2903 real(wp) :: fct_min !< Processor factorization (fct) minimization parameter
2904 integer :: MPI_COMM_CART !< Cartesian processor topology communicator
2905 integer :: rem_cells !< Remaining cells after distribution among processors
2906 integer :: recon_order !< WENO or MUSCL reconstruction order
2907 integer :: i, j, k !< Generic loop iterators
2908 integer :: ierr !< Generic flag used to identify and report MPI errors
2909
2910 ! temp array to store neighbor rank coordinates
2911 integer, dimension(1:num_dims) :: neighbor_coords
2912
2913 ! Zeroing out communication needs for moving EL bubbles/particles
2914 nidx(1)%beg = 0; nidx(1)%end = 0
2915 nidx(2)%beg = 0; nidx(2)%end = 0
2916 nidx(3)%beg = 0; nidx(3)%end = 0
2917
2918 if (recon_type == recon_type_weno) then
2919 recon_order = weno_order
2920 else
2921 recon_order = muscl_order
2922 end if
2923
2924 if (num_procs == 1 .and. parallel_io) then
2925 do i = 1, num_dims
2926 start_idx(i) = 0
2927 end do
2928 return
2929 end if
2930
2931 if (igr) then
2932 recon_order = igr_order
2933 end if
2934
2935 ! 3D Cartesian Processor Topology
2936 if (n > 0) then
2937 if (p > 0) then
2938 if (fft_wrt) then
2939 ! Initial estimate of optimal processor topology
2940 num_procs_x = 1
2941 num_procs_y = 1
2942 num_procs_z = num_procs
2943 ierr = -1
2944
2945 ! Benchmarking the quality of this initial guess
2946 tmp_num_procs_y = num_procs_y
2947 tmp_num_procs_z = num_procs_z
2948 fct_min = 10._wp*abs((n + 1)/tmp_num_procs_y - (p + 1)/tmp_num_procs_z)
2949
2950 ! Optimization of the initial processor topology
2951 do i = 1, num_procs
2952 if (mod(num_procs, i) == 0 .and. (n + 1)/i >= num_stcls_min*recon_order) then
2953 tmp_num_procs_y = i
2954 tmp_num_procs_z = num_procs/i
2955
2956 if (fct_min >= abs((n + 1)/tmp_num_procs_y - (p + 1)/tmp_num_procs_z) .and. (p + 1) &
2957 & /tmp_num_procs_z >= num_stcls_min*recon_order) then
2958 num_procs_y = i
2959 num_procs_z = num_procs/i
2960 fct_min = abs((n + 1)/tmp_num_procs_y - (p + 1)/tmp_num_procs_z)
2961 ierr = 0
2962 end if
2963 end if
2964 end do
2965 else
2966 if (cyl_coord .and. p > 0) then
2967 ! Pencil blocking for cylindrical coordinates (Fourier filter near axis)
2968
2969 ! Initial values of the processor factorization optimization
2970 num_procs_x = 1
2971 num_procs_y = num_procs
2972 num_procs_z = 1
2973 ierr = -1
2974
2975 ! Computing minimization variable for these initial values
2976 tmp_num_procs_x = num_procs_x
2977 tmp_num_procs_y = num_procs_y
2978 tmp_num_procs_z = num_procs_z
2979 fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x - (n + 1)/tmp_num_procs_y)
2980
2981 ! Searching for optimal computational domain distribution
2982 do i = 1, num_procs
2983 if (mod(num_procs, i) == 0 .and. (m + 1)/i >= num_stcls_min*recon_order) then
2984 tmp_num_procs_x = i
2985 tmp_num_procs_y = num_procs/i
2986
2987 if (fct_min >= abs((m + 1)/tmp_num_procs_x - (n + 1)/tmp_num_procs_y) .and. (n + 1) &
2988 & /tmp_num_procs_y >= num_stcls_min*recon_order) then
2989 num_procs_x = i
2990 num_procs_y = num_procs/i
2991 fct_min = abs((m + 1)/tmp_num_procs_x - (n + 1)/tmp_num_procs_y)
2992 ierr = 0
2993 end if
2994 end if
2995 end do
2996 else
2997 ! Initial estimate of optimal processor topology
2998 num_procs_x = 1
2999 num_procs_y = 1
3000 num_procs_z = num_procs
3001 ierr = -1
3002
3003 ! Benchmarking the quality of this initial guess
3004 tmp_num_procs_x = num_procs_x
3005 tmp_num_procs_y = num_procs_y
3006 tmp_num_procs_z = num_procs_z
3007 fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x - (n + 1)/tmp_num_procs_y) + 10._wp*abs((n + 1) &
3008 & /tmp_num_procs_y - (p + 1)/tmp_num_procs_z)
3009
3010 ! Optimization of the initial processor topology
3011 do i = 1, num_procs
3012 if (mod(num_procs, i) == 0 .and. (m + 1)/i >= num_stcls_min*recon_order) then
3013 do j = 1, num_procs/i
3014 if (mod(num_procs/i, j) == 0 .and. (n + 1)/j >= num_stcls_min*recon_order) then
3015 tmp_num_procs_x = i
3016 tmp_num_procs_y = j
3017 tmp_num_procs_z = num_procs/(i*j)
3018
3019 if (fct_min >= abs((m + 1)/tmp_num_procs_x - (n + 1)/tmp_num_procs_y) + abs((n + 1) &
3020 & /tmp_num_procs_y - (p + 1)/tmp_num_procs_z) .and. (p + 1) &
3021 & /tmp_num_procs_z >= num_stcls_min*recon_order) then
3022 num_procs_x = i
3023 num_procs_y = j
3024 num_procs_z = num_procs/(i*j)
3025 fct_min = abs((m + 1)/tmp_num_procs_x - (n + 1)/tmp_num_procs_y) + abs((n + 1) &
3026 & /tmp_num_procs_y - (p + 1)/tmp_num_procs_z)
3027 ierr = 0
3028 end if
3029 end if
3030 end do
3031 end if
3032 end do
3033 end if
3034 end if
3035
3036 ! Verifying that a valid decomposition of the computational domain has been established. If not, the simulation
3037 ! exits.
3038 if (proc_rank == 0 .and. ierr == -1) then
3039 call s_mpi_abort('Unsupported combination of values ' // 'of num_procs, m, n, p and ' &
3040 & // 'weno/muscl/igr_order. Exiting.')
3041 end if
3042
3043 ! Creating new communicator using the Cartesian topology
3044 call mpi_cart_create(mpi_comm_world, 3, (/num_procs_x, num_procs_y, num_procs_z/), (/.true., .true., .true./), &
3045 & .false., mpi_comm_cart, ierr)
3046
3047 ! Finding the Cartesian coordinates of the local process
3048 call mpi_cart_coords(mpi_comm_cart, proc_rank, 3, proc_coords, ierr)
3049
3050 ! Global Parameters for z-direction
3051
3052 ! Number of remaining cells
3053 rem_cells = mod(p + 1, num_procs_z)
3054
3055 ! Optimal number of cells per processor
3056 p = (p + 1)/num_procs_z - 1
3057
3058 ! Distributing the remaining cells
3059 do i = 1, rem_cells
3060 if (proc_coords(3) == i - 1) then
3061 p = p + 1; exit
3062 end if
3063 end do
3064
3065 ! Boundary condition at the beginning
3066 if (proc_coords(3) > 0 .or. (bc_z%beg == bc_periodic .and. num_procs_z > 1)) then
3067 proc_coords(3) = proc_coords(3) - 1
3068 call mpi_cart_rank(mpi_comm_cart, proc_coords, bc_z%beg, ierr)
3069 proc_coords(3) = proc_coords(3) + 1
3070 nidx(3)%beg = -1
3071 end if
3072
3073 ! Boundary condition at the end
3074 if (proc_coords(3) < num_procs_z - 1 .or. (bc_z%end == bc_periodic .and. num_procs_z > 1)) then
3075 proc_coords(3) = proc_coords(3) + 1
3076 call mpi_cart_rank(mpi_comm_cart, proc_coords, bc_z%end, ierr)
3077 proc_coords(3) = proc_coords(3) - 1
3078 nidx(3)%end = 1
3079 end if
3080
3081#ifdef MFC_POST_PROCESS
3082 ! Ghost zone at the beginning
3083 if (proc_coords(3) > 0 .and. format == format_silo) then
3084 offset_z%beg = 2
3085 else
3086 offset_z%beg = 0
3087 end if
3088
3089 ! Ghost zone at the end
3090 if (proc_coords(3) < num_procs_z - 1 .and. format == format_silo) then
3091 offset_z%end = 2
3092 else
3093 offset_z%end = 0
3094 end if
3095#endif
3096
3097 ! Beginning and end sub-domain boundary locations
3098 if (parallel_io) then
3099 if (proc_coords(3) < rem_cells) then
3100 start_idx(3) = (p + 1)*proc_coords(3)
3101 else
3102 start_idx(3) = (p + 1)*proc_coords(3) + rem_cells
3103 end if
3104 else
3105#ifdef MFC_PRE_PROCESS
3106 if (old_grid .neqv. .true.) then
3107 dz = (z_domain%end - z_domain%beg)/real(p_glb + 1, wp)
3108
3109 if (proc_coords(3) < rem_cells) then
3110 z_domain%beg = z_domain%beg + dz*real((p + 1)*proc_coords(3))
3111 z_domain%end = z_domain%end - dz*real((p + 1)*(num_procs_z - proc_coords(3) - 1) - (num_procs_z &
3112 & - rem_cells))
3113 else
3114 z_domain%beg = z_domain%beg + dz*real((p + 1)*proc_coords(3) + rem_cells)
3115 z_domain%end = z_domain%end - dz*real((p + 1)*(num_procs_z - proc_coords(3) - 1))
3116 end if
3117 end if
3118#endif
3119 end if
3120
3121 ! 2D Cartesian Processor Topology
3122 else
3123 ! Initial estimate of optimal processor topology
3124 num_procs_x = 1
3125 num_procs_y = num_procs
3126 ierr = -1
3127
3128 ! Benchmarking the quality of this initial guess
3129 tmp_num_procs_x = num_procs_x
3130 tmp_num_procs_y = num_procs_y
3131 fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x - (n + 1)/tmp_num_procs_y)
3132
3133 ! Optimization of the initial processor topology
3134 do i = 1, num_procs
3135 if (mod(num_procs, i) == 0 .and. (m + 1)/i >= num_stcls_min*recon_order) then
3136 tmp_num_procs_x = i
3137 tmp_num_procs_y = num_procs/i
3138
3139 if (fct_min >= abs((m + 1)/tmp_num_procs_x - (n + 1)/tmp_num_procs_y) .and. (n + 1) &
3140 & /tmp_num_procs_y >= num_stcls_min*recon_order) then
3141 num_procs_x = i
3142 num_procs_y = num_procs/i
3143 fct_min = abs((m + 1)/tmp_num_procs_x - (n + 1)/tmp_num_procs_y)
3144 ierr = 0
3145 end if
3146 end if
3147 end do
3148
3149 ! Verifying that a valid decomposition of the computational domain has been established. If not, the simulation
3150 ! exits.
3151 if (proc_rank == 0 .and. ierr == -1) then
3152 call s_mpi_abort('Unsupported combination of values ' // 'of num_procs, m, n and ' &
3153 & // 'weno/muscl/igr_order. Exiting.')
3154 end if
3155
3156 ! Creating new communicator using the Cartesian topology
3157 call mpi_cart_create(mpi_comm_world, 2, (/num_procs_x, num_procs_y/), (/.true., .true./), .false., mpi_comm_cart, &
3158 & ierr)
3159
3160 ! Finding the Cartesian coordinates of the local process
3161 call mpi_cart_coords(mpi_comm_cart, proc_rank, 2, proc_coords, ierr)
3162 end if
3163
3164 ! Global Parameters for y-direction
3165
3166 ! Number of remaining cells
3167 rem_cells = mod(n + 1, num_procs_y)
3168
3169 ! Optimal number of cells per processor
3170 n = (n + 1)/num_procs_y - 1
3171
3172 ! Distributing the remaining cells
3173 do i = 1, rem_cells
3174 if (proc_coords(2) == i - 1) then
3175 n = n + 1; exit
3176 end if
3177 end do
3178
3179 ! Boundary condition at the beginning
3180 if (proc_coords(2) > 0 .or. (bc_y%beg == bc_periodic .and. num_procs_y > 1)) then
3181 proc_coords(2) = proc_coords(2) - 1
3182 call mpi_cart_rank(mpi_comm_cart, proc_coords, bc_y%beg, ierr)
3183 proc_coords(2) = proc_coords(2) + 1
3184 nidx(2)%beg = -1
3185 end if
3186
3187 ! Boundary condition at the end
3188 if (proc_coords(2) < num_procs_y - 1 .or. (bc_y%end == bc_periodic .and. num_procs_y > 1)) then
3189 proc_coords(2) = proc_coords(2) + 1
3190 call mpi_cart_rank(mpi_comm_cart, proc_coords, bc_y%end, ierr)
3191 proc_coords(2) = proc_coords(2) - 1
3192 nidx(2)%end = 1
3193 end if
3194
3195#ifdef MFC_POST_PROCESS
3196 ! Ghost zone at the beginning
3197 if (proc_coords(2) > 0 .and. format == format_silo) then
3198 offset_y%beg = 2
3199 else
3200 offset_y%beg = 0
3201 end if
3202
3203 ! Ghost zone at the end
3204 if (proc_coords(2) < num_procs_y - 1 .and. format == format_silo) then
3205 offset_y%end = 2
3206 else
3207 offset_y%end = 0
3208 end if
3209#endif
3210
3211 ! Beginning and end sub-domain boundary locations
3212 if (parallel_io) then
3213 if (proc_coords(2) < rem_cells) then
3214 start_idx(2) = (n + 1)*proc_coords(2)
3215 else
3216 start_idx(2) = (n + 1)*proc_coords(2) + rem_cells
3217 end if
3218 else
3219#ifdef MFC_PRE_PROCESS
3220 if (old_grid .neqv. .true.) then
3221 dy = (y_domain%end - y_domain%beg)/real(n_glb + 1, wp)
3222
3223 if (proc_coords(2) < rem_cells) then
3224 y_domain%beg = y_domain%beg + dy*real((n + 1)*proc_coords(2))
3225 y_domain%end = y_domain%end - dy*real((n + 1)*(num_procs_y - proc_coords(2) - 1) - (num_procs_y &
3226 & - rem_cells))
3227 else
3228 y_domain%beg = y_domain%beg + dy*real((n + 1)*proc_coords(2) + rem_cells)
3229 y_domain%end = y_domain%end - dy*real((n + 1)*(num_procs_y - proc_coords(2) - 1))
3230 end if
3231 end if
3232#endif
3233 end if
3234
3235 ! 1D Cartesian Processor Topology
3236 else
3237 ! Optimal processor topology
3238 num_procs_x = num_procs
3239
3240 ! Creating new communicator using the Cartesian topology
3241 call mpi_cart_create(mpi_comm_world, 1, (/num_procs_x/), (/.true./), .false., mpi_comm_cart, ierr)
3242
3243 ! Finding the Cartesian coordinates of the local process
3244 call mpi_cart_coords(mpi_comm_cart, proc_rank, 1, proc_coords, ierr)
3245 end if
3246
3247 ! Global Parameters for x-direction
3248
3249 ! Number of remaining cells
3250 rem_cells = mod(m + 1, num_procs_x)
3251
3252 ! Optimal number of cells per processor
3253 m = (m + 1)/num_procs_x - 1
3254
3255 ! Distributing the remaining cells
3256 do i = 1, rem_cells
3257 if (proc_coords(1) == i - 1) then
3258 m = m + 1; exit
3259 end if
3260 end do
3261
3262 call s_update_cell_bounds(cells_bounds, m, n, p)
3263
3264 ! Boundary condition at the beginning
3265 if (proc_coords(1) > 0 .or. (bc_x%beg == bc_periodic .and. num_procs_x > 1)) then
3266 proc_coords(1) = proc_coords(1) - 1
3267 call mpi_cart_rank(mpi_comm_cart, proc_coords, bc_x%beg, ierr)
3268 proc_coords(1) = proc_coords(1) + 1
3269 nidx(1)%beg = -1
3270 end if
3271
3272 ! Boundary condition at the end
3273 if (proc_coords(1) < num_procs_x - 1 .or. (bc_x%end == bc_periodic .and. num_procs_x > 1)) then
3274 proc_coords(1) = proc_coords(1) + 1
3275 call mpi_cart_rank(mpi_comm_cart, proc_coords, bc_x%end, ierr)
3276 proc_coords(1) = proc_coords(1) - 1
3277 nidx(1)%end = 1
3278 end if
3279
3280#ifdef MFC_POST_PROCESS
3281 ! Ghost zone at the beginning
3282 if (proc_coords(1) > 0 .and. format == format_silo) then
3283 offset_x%beg = 2
3284 else
3285 offset_x%beg = 0
3286 end if
3287
3288 ! Ghost zone at the end
3289 if (proc_coords(1) < num_procs_x - 1 .and. format == format_silo) then
3290 offset_x%end = 2
3291 else
3292 offset_x%end = 0
3293 end if
3294#endif
3295
3296 ! Beginning and end sub-domain boundary locations
3297 if (parallel_io) then
3298 if (proc_coords(1) < rem_cells) then
3299 start_idx(1) = (m + 1)*proc_coords(1)
3300 else
3301 start_idx(1) = (m + 1)*proc_coords(1) + rem_cells
3302 end if
3303 else
3304#ifdef MFC_PRE_PROCESS
3305 if (old_grid .neqv. .true.) then
3306 dx = (x_domain%end - x_domain%beg)/real(m_glb + 1, wp)
3307
3308 if (proc_coords(1) < rem_cells) then
3309 x_domain%beg = x_domain%beg + dx*real((m + 1)*proc_coords(1))
3310 x_domain%end = x_domain%end - dx*real((m + 1)*(num_procs_x - proc_coords(1) - 1) - (num_procs_x - rem_cells))
3311 else
3312 x_domain%beg = x_domain%beg + dx*real((m + 1)*proc_coords(1) + rem_cells)
3313 x_domain%end = x_domain%end - dx*real((m + 1)*(num_procs_x - proc_coords(1) - 1))
3314 end if
3315 end if
3316#endif
3317 end if
3318
3319#ifdef MFC_DEBUG
3320# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3321 block
3322# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3323 use iso_fortran_env, only: output_unit
3324# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3325
3326# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3327 print *, 'm_mpi_common.fpp:1752: ', '@:ALLOCATE(neighbor_ranks(nidx(1)%beg:nidx(1)%end, nidx(2)%beg:nidx(2)%end, nidx(3)%beg:nidx(3)%end))'
3328# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3329
3330# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3331 call flush (output_unit)
3332# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3333 end block
3334# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3335#endif
3336# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3337 allocate (neighbor_ranks(nidx(1)%beg:nidx(1)%end, nidx(2)%beg:nidx(2)%end, nidx(3)%beg:nidx(3)%end))
3338# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3339
3340# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3341
3342# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3343#if defined(MFC_OpenACC)
3344# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3345!$acc enter data create(neighbor_ranks)
3346# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3347#elif defined(MFC_OpenMP)
3348# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3349!$omp target enter data map(always,alloc:neighbor_ranks)
3350# 1752 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3351#endif
3352 do k = nidx(3)%beg, nidx(3)%end
3353 do j = nidx(2)%beg, nidx(2)%end
3354 do i = nidx(1)%beg, nidx(1)%end
3355 if (abs(i) + abs(j) + abs(k) > 0) then
3356 neighbor_coords(1) = proc_coords(1) + i
3357 if (num_dims > 1) neighbor_coords(2) = proc_coords(2) + j
3358 if (num_dims > 2) neighbor_coords(3) = proc_coords(3) + k
3359 call mpi_cart_rank(mpi_comm_cart, neighbor_coords, neighbor_ranks(i, j, k), ierr)
3360 end if
3361 end do
3362 end do
3363 end do
3364#endif
3365
3366 end subroutine s_mpi_decompose_computational_domain
3367
3368 !> The goal of this procedure is to populate the buffers of the grid variables by communicating with the neighboring processors.
3369 !! Note that only the buffers of the cell-width distributions are handled in such a way. This is because the buffers of
3370 !! cell-boundary locations may be calculated directly from those of the cell-width distributions.
3371#ifndef MFC_PRE_PROCESS
3372 subroutine s_mpi_sendrecv_grid_variables_buffers(mpi_dir, pbc_loc, offset)
3373
3374 integer, intent(in) :: mpi_dir
3375 integer, intent(in) :: pbc_loc
3376 !> Ghost layers for cell-boundary arrays (buff_size in simulation, module offset_* in post-process)
3377 type(int_bounds_info), intent(in) :: offset
3378
3379#ifdef MFC_MPI
3380 integer :: ierr !< Generic flag used to identify and report MPI errors
3381 integer :: i
3382
3383 if (mpi_dir == 1) then
3384 if (pbc_loc == -1) then ! PBC at the beginning
3385 if (bc_x%end >= 0) then ! PBC at the beginning and end
3386 call mpi_sendrecv(dx(m - buff_size + 1), buff_size, mpi_p, bc_x%end, 0, dx(-buff_size), buff_size, mpi_p, &
3387 & bc_x%beg, 0, mpi_comm_world, mpi_status_ignore, ierr)
3388 else ! PBC at the beginning only
3389 call mpi_sendrecv(dx(0), buff_size, mpi_p, bc_x%beg, 1, dx(-buff_size), buff_size, mpi_p, bc_x%beg, 0, &
3390 & mpi_comm_world, mpi_status_ignore, ierr)
3391 end if
3392 do i = 1, offset%beg
3393 x_cb(-1 - i) = x_cb(-i) - dx(-i)
3394 end do
3395 do i = 1, buff_size
3396 x_cc(-i) = x_cc(1 - i) - (dx(1 - i) + dx(-i))/2._wp
3397 end do
3398 else ! PBC at the end
3399 if (bc_x%beg >= 0) then ! PBC at the end and beginning
3400 call mpi_sendrecv(dx(0), buff_size, mpi_p, bc_x%beg, 1, dx(m + 1), buff_size, mpi_p, bc_x%end, 1, &
3401 & mpi_comm_world, mpi_status_ignore, ierr)
3402 else ! PBC at the end only
3403 call mpi_sendrecv(dx(m - buff_size + 1), buff_size, mpi_p, bc_x%end, 0, dx(m + 1), buff_size, mpi_p, &
3404 & bc_x%end, 1, mpi_comm_world, mpi_status_ignore, ierr)
3405 end if
3406 do i = 1, offset%end
3407 x_cb(m + i) = x_cb(m + (i - 1)) + dx(m + i)
3408 end do
3409 do i = 1, buff_size
3410 x_cc(m + i) = x_cc(m + (i - 1)) + (dx(m + (i - 1)) + dx(m + i))/2._wp
3411 end do
3412 end if
3413 else if (mpi_dir == 2) then
3414 if (pbc_loc == -1) then ! PBC at the beginning
3415 if (bc_y%end >= 0) then ! PBC at the beginning and end
3416 call mpi_sendrecv(dy(n - buff_size + 1), buff_size, mpi_p, bc_y%end, 0, dy(-buff_size), buff_size, mpi_p, &
3417 & bc_y%beg, 0, mpi_comm_world, mpi_status_ignore, ierr)
3418 else ! PBC at the beginning only
3419 call mpi_sendrecv(dy(0), buff_size, mpi_p, bc_y%beg, 1, dy(-buff_size), buff_size, mpi_p, bc_y%beg, 0, &
3420 & mpi_comm_world, mpi_status_ignore, ierr)
3421 end if
3422 do i = 1, offset%beg
3423 y_cb(-1 - i) = y_cb(-i) - dy(-i)
3424 end do
3425 do i = 1, buff_size
3426 y_cc(-i) = y_cc(1 - i) - (dy(1 - i) + dy(-i))/2._wp
3427 end do
3428 else ! PBC at the end
3429 if (bc_y%beg >= 0) then ! PBC at the end and beginning
3430 call mpi_sendrecv(dy(0), buff_size, mpi_p, bc_y%beg, 1, dy(n + 1), buff_size, mpi_p, bc_y%end, 1, &
3431 & mpi_comm_world, mpi_status_ignore, ierr)
3432 else ! PBC at the end only
3433 call mpi_sendrecv(dy(n - buff_size + 1), buff_size, mpi_p, bc_y%end, 0, dy(n + 1), buff_size, mpi_p, &
3434 & bc_y%end, 1, mpi_comm_world, mpi_status_ignore, ierr)
3435 end if
3436 do i = 1, offset%end
3437 y_cb(n + i) = y_cb(n + (i - 1)) + dy(n + i)
3438 end do
3439 do i = 1, buff_size
3440 y_cc(n + i) = y_cc(n + (i - 1)) + (dy(n + (i - 1)) + dy(n + i))/2._wp
3441 end do
3442 end if
3443 else
3444 if (pbc_loc == -1) then ! PBC at the beginning
3445 if (bc_z%end >= 0) then ! PBC at the beginning and end
3446 call mpi_sendrecv(dz(p - buff_size + 1), buff_size, mpi_p, bc_z%end, 0, dz(-buff_size), buff_size, mpi_p, &
3447 & bc_z%beg, 0, mpi_comm_world, mpi_status_ignore, ierr)
3448 else ! PBC at the beginning only
3449 call mpi_sendrecv(dz(0), buff_size, mpi_p, bc_z%beg, 1, dz(-buff_size), buff_size, mpi_p, bc_z%beg, 0, &
3450 & mpi_comm_world, mpi_status_ignore, ierr)
3451 end if
3452 do i = 1, offset%beg
3453 z_cb(-1 - i) = z_cb(-i) - dz(-i)
3454 end do
3455 do i = 1, buff_size
3456 z_cc(-i) = z_cc(1 - i) - (dz(1 - i) + dz(-i))/2._wp
3457 end do
3458 else ! PBC at the end
3459 if (bc_z%beg >= 0) then ! PBC at the end and beginning
3460 call mpi_sendrecv(dz(0), buff_size, mpi_p, bc_z%beg, 1, dz(p + 1), buff_size, mpi_p, bc_z%end, 1, &
3461 & mpi_comm_world, mpi_status_ignore, ierr)
3462 else ! PBC at the end only
3463 call mpi_sendrecv(dz(p - buff_size + 1), buff_size, mpi_p, bc_z%end, 0, dz(p + 1), buff_size, mpi_p, &
3464 & bc_z%end, 1, mpi_comm_world, mpi_status_ignore, ierr)
3465 end if
3466 do i = 1, offset%end
3467 z_cb(p + i) = z_cb(p + (i - 1)) + dz(p + i)
3468 end do
3469 do i = 1, buff_size
3470 z_cc(p + i) = z_cc(p + (i - 1)) + (dz(p + (i - 1)) + dz(p + i))/2._wp
3471 end do
3472 end if
3473 end if
3474#endif
3475
3476 end subroutine s_mpi_sendrecv_grid_variables_buffers
3477
3478 !> Populate the local cell-boundary, cell-center, and cell-width arrays in one direction directly from the global cell-boundary
3479 !! array. This guarantees that every rank sees bitwise-identical values at any shared physical cell or boundary
3480 subroutine s_apply_grid_from_global_dim(x_cb_glb, m_dim_glb, m_dim, sidx, bc_beg, bc_end, cb_lo, cb_hi, cw_lo, cw_hi, &
3481 & x_cb_loc, x_cc_loc, dx_loc)
3482
3483 integer, intent(in) :: m_dim_glb, m_dim, sidx, bc_beg, bc_end
3484 integer, intent(in) :: cb_lo, cb_hi, cw_lo, cw_hi
3485 real(wp), intent(in) :: x_cb_glb(-1:m_dim_glb)
3486 real(wp), intent(inout) :: x_cb_loc(-1 - cb_lo:m_dim + cb_hi)
3487 real(wp), intent(inout) :: x_cc_loc(-cw_lo:m_dim + cw_hi)
3488 real(wp), intent(inout) :: dx_loc(-cw_lo:m_dim + cw_hi)
3489 real(wp) :: domain_len
3490 integer :: i, gidx, lo, hi
3491
3492 domain_len = x_cb_glb(m_dim_glb) - x_cb_glb(-1)
3493
3494 ! Interior cell boundaries sliced directly from the global list
3495 do i = -1, m_dim
3496 x_cb_loc(i) = x_cb_glb(sidx + i)
3497 end do
3498
3499 ! Left ghost cell boundaries
3500 if (bc_beg >= 0) then
3501 if (sidx == 0) then
3502 ! Leftmost rank with a neighbor -> periodic+multirank, so wrap from the global right end
3503 do i = 1, cb_lo
3504 x_cb_loc(-1 - i) = x_cb_glb(m_dim_glb - i) - domain_len
3505 end do
3506 else
3507 do i = 1, cb_lo
3508 gidx = sidx - 1 - i
3509 if (gidx >= -1) then
3510 x_cb_loc(-1 - i) = x_cb_glb(gidx)
3511 else
3512 x_cb_loc(-1 - i) = x_cb_glb(m_dim_glb + 1 + gidx) - domain_len
3513 end if
3514 end do
3515 end if
3516 end if
3517
3518 ! Right ghost cell boundaries
3519 if (bc_end >= 0) then
3520 if (sidx + m_dim == m_dim_glb) then
3521 ! Rightmost rank with a neighbor -> periodic+multirank, wrap from the global left end
3522 do i = 1, cb_hi
3523 x_cb_loc(m_dim + i) = x_cb_glb(i - 1) + domain_len
3524 end do
3525 else
3526 do i = 1, cb_hi
3527 gidx = sidx + m_dim + i
3528 if (gidx <= m_dim_glb) then
3529 x_cb_loc(m_dim + i) = x_cb_glb(gidx)
3530 else
3531 x_cb_loc(m_dim + i) = x_cb_glb(gidx - m_dim_glb - 1) + domain_len
3532 end if
3533 end do
3534 end if
3535 end if
3536
3537 ! Recompute dx and x_cc over the range where x_cb is now valid using one formula so values are bitwise-identical
3538 if (bc_beg >= 0) then
3539 lo = -min(cw_lo, cb_lo)
3540 else
3541 lo = 0
3542 end if
3543
3544 if (bc_end >= 0) then
3545 hi = m_dim + min(cw_hi, cb_hi)
3546 else
3547 hi = m_dim
3548 end if
3549
3550 do i = lo, hi
3551 dx_loc(i) = x_cb_loc(i) - x_cb_loc(i - 1)
3552 x_cc_loc(i) = (x_cb_loc(i) + x_cb_loc(i - 1))/2._wp
3553 end do
3554
3555 end subroutine s_apply_grid_from_global_dim
3556#endif
3557
3558 !> Module deallocation and/or disassociation procedures
3559 impure subroutine s_finalize_mpi_common_module
3560
3561#ifdef MFC_MPI
3562#ifndef __NVCOMPILER_GPU_UNIFIED_MEM
3563#ifdef MFC_DEBUG
3564# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3565 block
3566# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3567 use iso_fortran_env, only: output_unit
3568# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3569
3570# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3571 print *, 'm_mpi_common.fpp:1964: ', '@:DEALLOCATE(buff_send, buff_recv)'
3572# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3573
3574# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3575 call flush (output_unit)
3576# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3577 end block
3578# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3579#endif
3580# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3581
3582# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3583#if defined(MFC_OpenACC)
3584# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3585!$acc exit data delete(buff_send, buff_recv)
3586# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3587#elif defined(MFC_OpenMP)
3588# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3589!$omp target exit data map(release:buff_send, buff_recv)
3590# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3591#endif
3592# 1964 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3593 deallocate (buff_send, buff_recv)
3594#else
3595
3596# 1966 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3597#if defined(MFC_OpenACC)
3598# 1966 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3599!$acc exit data delete(buff_send, buff_recv)
3600# 1966 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3601#elif defined(MFC_OpenMP)
3602# 1966 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3603!$omp target exit data map(release:buff_send, buff_recv)
3604# 1966 "/home/runner/work/MFC/MFC/src/common/m_mpi_common.fpp"
3605#endif
3606 deallocate (buff_send, buff_recv)
3607#endif
3608#endif
3609
3610 end subroutine s_finalize_mpi_common_module
3611
3612end module m_mpi_common
q_cons_vf
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
Definition m_phase_change.fpp.f90:988
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:990
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:990
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::format_silo
integer, parameter format_silo
Definition m_constants.fpp.f90:133
m_constants::nnode
integer, parameter nnode
Number of QBMM nodes.
Definition m_constants.fpp.f90:40
m_constants::recon_type_weno
integer, parameter recon_type_weno
Definition m_constants.fpp.f90:152
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:323
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:334
m_global_parameters::buff_size
integer buff_size
Number of ghost cells for boundary condition storage.
Definition m_global_parameters.fpp.f90:767
m_global_parameters::cells_bounds
type(cell_num_bounds) cells_bounds
Definition m_global_parameters.fpp.f90:369
m_global_parameters::nb
integer nb
Definition m_global_parameters.fpp.f90:844
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:334
m_mpi_common
MPI communication layer: domain decomposition, halo exchange, reductions, and parallel I/O setup.
Definition m_mpi_common.fpp.f90:334
m_mpi_common::s_mpi_abort
impure subroutine s_mpi_abort(prnt, code)
The subroutine terminates the MPI execution environment.
Definition m_mpi_common.fpp.f90:943
m_mpi_common::s_initialize_mpi_common_module
impure subroutine s_initialize_mpi_common_module
Initialize the module.
Definition m_mpi_common.fpp.f90:412
m_mpi_common::s_mpi_gather_data
impure subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root)
Gather variable-length real vectors from all MPI ranks onto the root process.
Definition m_mpi_common.fpp.f90:689
m_mpi_common::s_mpi_barrier
impure subroutine s_mpi_barrier
Halts all processes until all have reached barrier.
Definition m_mpi_common.fpp.f90:974
m_mpi_common::s_mpi_initialize
impure subroutine s_mpi_initialize
Initialize the MPI execution environment and query the number of processors and local rank.
Definition m_mpi_common.fpp.f90:527
m_mpi_common::s_mpi_allreduce_vectors_sum
impure subroutine s_mpi_allreduce_vectors_sum(var_loc, var_glb, num_vectors, vector_length)
Reduce an array of vectors to their global sums across all MPI ranks.
Definition m_mpi_common.fpp.f90:842
m_mpi_common::buff_recv
real(wp), dimension(:), allocatable, private buff_recv
Primitive variable receive buffer for halo exchange Variables for EL bubbles communication.
Definition m_mpi_common.fpp.f90:364
m_mpi_common::s_mpi_reduce_stability_criteria_extrema
impure subroutine s_mpi_reduce_stability_criteria_extrema(icfl_max_loc, vcfl_max_loc, rc_min_loc, bubs_loc, icfl_max_glb, vcfl_max_glb, rc_min_glb, bubs_glb, ccfl_max_loc, ccfl_max_glb)
The goal of this subroutine is to determine the global extrema of the stability criteria in the compu...
Definition m_mpi_common.fpp.f90:753
m_mpi_common::s_initialize_mpi_data
impure subroutine s_initialize_mpi_data(q_cons_vf, ib_markers, beta)
Set up MPI I/O data views and variable pointers for parallel file output.
Definition m_mpi_common.fpp.f90:562
m_mpi_common::s_mpi_reduce_maxloc
impure subroutine s_mpi_reduce_maxloc(var_loc)
Reduce a 2-element variable to its global maximum value with the owning processor rank (MPI_MAXLOC)....
Definition m_mpi_common.fpp.f90:926
m_mpi_common::beta_vars
integer, dimension(1:3) beta_vars
q_beta indices to communicate: 1=void fraction, 2=d(beta)/dt, 5=energy source
Definition m_mpi_common.fpp.f90:368
m_mpi_common::s_mpi_allreduce_sum
impure subroutine s_mpi_allreduce_sum(var_loc, var_glb)
Reduce a local real value to its global sum across all MPI ranks.
Definition m_mpi_common.fpp.f90:828
m_mpi_common::buff_send
real(wp), dimension(:), allocatable, private buff_send
Primitive variable send buffer for halo exchange.
Definition m_mpi_common.fpp.f90:362
m_mpi_common::s_mpi_allreduce_min
impure subroutine s_mpi_allreduce_min(var_loc, var_glb)
Reduce a local real value to its global minimum across all MPI ranks.
Definition m_mpi_common.fpp.f90:879
m_mpi_common::s_mpi_reduce_int_sum
subroutine s_mpi_reduce_int_sum(var_loc, sum)
Reduce a local integer value to its global sum across all MPI ranks.
Definition m_mpi_common.fpp.f90:812
m_mpi_common::s_mpi_sendrecv_grid_variables_buffers
subroutine s_mpi_sendrecv_grid_variables_buffers(mpi_dir, pbc_loc, offset)
The goal of this procedure is to populate the buffers of the grid variables by communicating with the...
Definition m_mpi_common.fpp.f90:3373
m_mpi_common::s_prohibit_abort
impure subroutine s_prohibit_abort(condition, message)
Print a case file error with the prohibited condition and message, then abort execution.
Definition m_mpi_common.fpp.f90:733
m_mpi_common::s_mpi_finalize
impure subroutine s_mpi_finalize
The subroutine finalizes the MPI execution environment.
Definition m_mpi_common.fpp.f90:985
m_mpi_common::s_initialize_mpi_data_ds
subroutine s_initialize_mpi_data_ds(q_cons_vf)
Set up MPI I/O data views for downsampled (coarsened) parallel file output.
Definition m_mpi_common.fpp.f90:643
m_mpi_common::s_apply_grid_from_global_dim
subroutine s_apply_grid_from_global_dim(x_cb_glb, m_dim_glb, m_dim, sidx, bc_beg, bc_end, cb_lo, cb_hi, cw_lo, cw_hi, x_cb_loc, x_cc_loc, dx_loc)
Populate the local cell-boundary, cell-center, and cell-width arrays in one direction directly from t...
Definition m_mpi_common.fpp.f90:3482
m_mpi_common::s_mpi_allreduce_max
impure subroutine s_mpi_allreduce_max(var_loc, var_glb)
Reduce a local real value to its global maximum across all MPI ranks.
Definition m_mpi_common.fpp.f90:893
m_mpi_common::s_mpi_allreduce_integer_sum
impure subroutine s_mpi_allreduce_integer_sum(var_loc, var_glb)
Reduce a local integer value to its global sum across all MPI ranks.
Definition m_mpi_common.fpp.f90:863
m_mpi_common::s_mpi_sendrecv_variables_buffers
subroutine s_mpi_sendrecv_variables_buffers(q_comm, mpi_dir, pbc_loc, nvar, pb_in, mv_in, q_t_sf)
The goal of this procedure is to populate the buffers of the cell-average conservative variables by c...
Definition m_mpi_common.fpp.f90:997
m_mpi_common::v_size
integer, private v_size
Definition m_mpi_common.fpp.f90:349
m_mpi_common::mpi_bcast_time_step_values
impure subroutine mpi_bcast_time_step_values(proc_time, time_avg)
Gather per-rank time step wall-clock times onto rank 0 for performance reporting.
Definition m_mpi_common.fpp.f90:719
m_mpi_common::s_mpi_reduce_min
impure subroutine s_mpi_reduce_min(var_loc)
Reduce a local real value to its global minimum across all ranks.
Definition m_mpi_common.fpp.f90:907
m_mpi_common::s_finalize_mpi_common_module
impure subroutine s_finalize_mpi_common_module
Module deallocation and/or disassociation procedures.
Definition m_mpi_common.fpp.f90:3560
m_mpi_common::comm_size
integer, dimension(3) comm_size
Definition m_mpi_common.fpp.f90:366
m_mpi_common::s_mpi_reduce_beta_variables_buffers
subroutine s_mpi_reduce_beta_variables_buffers(q_comm, kahan_comp, mpi_dir, pbc_loc, nvar)
The goal of this procedure is to populate the buffers of the cell-average conservative variables by c...
Definition m_mpi_common.fpp.f90:2354
m_mpi_common::comm_coords
type(int_bounds_info), dimension(3) comm_coords
Definition m_mpi_common.fpp.f90:365
m_mpi_common::halo_size
integer(kind=8) halo_size
Definition m_mpi_common.fpp.f90:395
m_mpi_common::s_mpi_decompose_computational_domain
subroutine s_mpi_decompose_computational_domain
The purpose of this procedure is to optimally decompose the computational domain among the available ...
Definition m_mpi_common.fpp.f90:2899
m_nvtx
NVIDIA NVTX profiling API bindings for GPU performance instrumentation.
Definition m_nvtx.f90:6
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:417