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