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