MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_boundary_common.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
2!>
3!! @file
4!! @brief Contains module m_boundary_common
5
6!> @brief Noncharacteristic and processor boundary condition application for ghost cells and buffer regions
7# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
8! This file exists so that Fypp can be run without generating case.fpp files for
9! each target. This is useful when generating documentation, for example. This
10! should also let MFC be built with CMake directly, without invoking mfc.sh.
11
12! For pre-process.
13# 8 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
14
15! For moving immersed boundaries in simulation
16# 12 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
17# 7 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp" 2
18# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
19# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
20# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
21# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
23# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
25# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26
27# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30
31# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32
33# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
34
35# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
36
37# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38
39# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40
41# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42
43# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44
45# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
46! New line at end of file is required for FYPP
47# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
48# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
49# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
50# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63
64# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67
68# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73
74# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
75! New line at end of file is required for FYPP
76# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
77
78# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
80# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
82# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154! New line at end of file is required for FYPP
155# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
156# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
157# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
158# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171
172# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175
176# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179
180# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
181
182# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
183! New line at end of file is required for FYPP
184# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
185
186# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233
234# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
235
236# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
237
238# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
239
240# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
241! New line at end of file is required for FYPP
242# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
243
244! GPU parallel region (scalar reductions, maxval/minval)
245# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247! GPU parallel loop over threads (most common GPU macro)
248# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250! Required closing for GPU_PARALLEL_LOOP
251# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253! Mark routine for device compilation
254# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256! Declare device-resident data
257# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259! Inner loop within a GPU parallel region
260# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262! Scoped GPU data region
263# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265! Host code with device pointers (for MPI with GPU buffers)
266# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! Allocate device memory (unscoped)
269# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Free device memory
272# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Atomic operation on device
275# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! End atomic capture block
278# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Copy data between host and device
281# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Synchronization barrier
284# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Import GPU library module (openacc or omp_lib)
287# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Emit code only for AMD compiler
290# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Emit code for non-Cray compilers
293# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Emit code only for Cray compiler
296# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! Emit code for non-NVIDIA compilers
299# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
302# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303! New line at end of file is required for FYPP
304# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
305
306# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
307
308! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
309! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
310! example see misc/nvidia_uvm/bind.sh.
311# 55 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
312
313! Allocate and create GPU device memory
314# 75 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
315
316! Free GPU device memory and deallocate
317# 83 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
318
319! Cray-specific GPU pointer setup for vector fields
320# 107 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
321
322! Cray-specific GPU pointer setup for scalar fields
323# 123 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
324
325! Cray-specific GPU pointer setup for acoustic source spatials
326# 148 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
327
328# 154 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
329
330# 161 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
331! New line at end of file is required for FYPP
332# 8 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp" 2
333
335
338 use m_mpi_proxy
339 use m_mpi_common
340 use m_constants
342 use m_boundary_io
343
344 implicit none
345
348
349 public :: bc_buffers
350
351#ifdef MFC_MPI
353#endif
354
355 !> Lagrangian-bubble beta (void-fraction) buffer bounds (#1290)
356 type(int_bounds_info), dimension(3) :: beta_bc_bounds
357
358# 32 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
359#if defined(MFC_OpenACC)
360# 32 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
361!$acc declare create(beta_bc_bounds)
362# 32 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
363#elif defined(MFC_OpenMP)
364# 32 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
365!$omp declare target (beta_bc_bounds)
366# 32 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
367#endif
368
369contains
370
371 !> Allocate and set up boundary condition buffer arrays for all coordinate directions.
372 impure subroutine s_initialize_boundary_common_module(use_dirichlet_buffers)
373
374 integer :: i, j, sys_size_alloc
375 logical, intent(in), optional :: use_dirichlet_buffers
376
377 dirichlet_from_buffers = .false.
378 if (present(use_dirichlet_buffers)) dirichlet_from_buffers = use_dirichlet_buffers
379
380# 44 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
381#if defined(MFC_OpenACC)
382# 44 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
383!$acc update device(dirichlet_from_buffers)
384# 44 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
385#elif defined(MFC_OpenMP)
386# 44 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
387!$omp target update to(dirichlet_from_buffers)
388# 44 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
389#endif
390
391#ifdef MFC_DEBUG
392# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
393 block
394# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
395 use iso_fortran_env, only: output_unit
396# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
397
398# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
399 print *, 'm_boundary_common.fpp:46: ', '@:ALLOCATE(bc_buffers(1:3, 1:2))'
400# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
401
402# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
403 call flush (output_unit)
404# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
405 end block
406# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
407#endif
408# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
409 allocate (bc_buffers(1:3, 1:2))
410# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
411
412# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
413
414# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
415#if defined(MFC_OpenACC)
416# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
417!$acc enter data create(bc_buffers)
418# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
419#elif defined(MFC_OpenMP)
420# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
421!$omp target enter data map(always,alloc:bc_buffers)
422# 46 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
423#endif
424
425 if (bc_io) then
426 sys_size_alloc = sys_size
427 if (chemistry) sys_size_alloc = sys_size + 1
428
429#ifdef MFC_DEBUG
430# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
431 block
432# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
433 use iso_fortran_env, only: output_unit
434# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
435
436# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
437 print *, 'm_boundary_common.fpp:52: ', '@:ALLOCATE(bc_buffers(1, 1)%sf(1:sys_size_alloc, 0:n, 0:p))'
438# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
439
440# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
441 call flush (output_unit)
442# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
443 end block
444# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
445#endif
446# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
447 allocate (bc_buffers(1, 1)%sf(1:sys_size_alloc, 0:n, 0:p))
448# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
449
450# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
451
452# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
453#if defined(MFC_OpenACC)
454# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
455!$acc enter data create(bc_buffers(1, 1)%sf)
456# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
457#elif defined(MFC_OpenMP)
458# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
459!$omp target enter data map(always,alloc:bc_buffers(1, 1)%sf)
460# 52 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
461#endif
462#ifdef MFC_DEBUG
463# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
464 block
465# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
466 use iso_fortran_env, only: output_unit
467# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
468
469# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
470 print *, 'm_boundary_common.fpp:53: ', '@:ALLOCATE(bc_buffers(1, 2)%sf(1:sys_size_alloc, 0:n, 0:p))'
471# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
472
473# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
474 call flush (output_unit)
475# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
476 end block
477# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
478#endif
479# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
480 allocate (bc_buffers(1, 2)%sf(1:sys_size_alloc, 0:n, 0:p))
481# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
482
483# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
484
485# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
486#if defined(MFC_OpenACC)
487# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
488!$acc enter data create(bc_buffers(1, 2)%sf)
489# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
490#elif defined(MFC_OpenMP)
491# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
492!$omp target enter data map(always,alloc:bc_buffers(1, 2)%sf)
493# 53 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
494#endif
495# 55 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
496 if (n > 0) then
497#ifdef MFC_DEBUG
498# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
499 block
500# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
501 use iso_fortran_env, only: output_unit
502# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
503
504# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
505 print *, 'm_boundary_common.fpp:56: ', '@:ALLOCATE(bc_buffers(2,1)%sf(-buff_size:m+buff_size,1:sys_size_alloc,0:p))'
506# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
507
508# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
509 call flush (output_unit)
510# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
511 end block
512# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
513#endif
514# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
515 allocate (bc_buffers(2,1)%sf(-buff_size:m+buff_size,1:sys_size_alloc,0:p))
516# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
517
518# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
519
520# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
521#if defined(MFC_OpenACC)
522# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
523!$acc enter data create(bc_buffers(2,1)%sf)
524# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
525#elif defined(MFC_OpenMP)
526# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
527!$omp target enter data map(always,alloc:bc_buffers(2,1)%sf)
528# 56 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
529#endif
530#ifdef MFC_DEBUG
531# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
532 block
533# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
534 use iso_fortran_env, only: output_unit
535# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
536
537# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
538 print *, 'm_boundary_common.fpp:57: ', '@:ALLOCATE(bc_buffers(2,2)%sf(-buff_size:m+buff_size,1:sys_size_alloc,0:p))'
539# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
540
541# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
542 call flush (output_unit)
543# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
544 end block
545# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
546#endif
547# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
548 allocate (bc_buffers(2,2)%sf(-buff_size:m+buff_size,1:sys_size_alloc,0:p))
549# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
550
551# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
552
553# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
554#if defined(MFC_OpenACC)
555# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
556!$acc enter data create(bc_buffers(2,2)%sf)
557# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
558#elif defined(MFC_OpenMP)
559# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
560!$omp target enter data map(always,alloc:bc_buffers(2,2)%sf)
561# 57 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
562#endif
563# 59 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
564 if (p > 0) then
565#ifdef MFC_DEBUG
566# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
567 block
568# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
569 use iso_fortran_env, only: output_unit
570# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
571
572# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
573 print *, 'm_boundary_common.fpp:60: ', '@:ALLOCATE(bc_buffers(3,1)%sf(-buff_size:m+buff_size,-buff_size:n+buff_size,1:sys_size_alloc))'
574# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
575
576# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
577 call flush (output_unit)
578# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
579 end block
580# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
581#endif
582# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
583 allocate (bc_buffers(3,1)%sf(-buff_size:m+buff_size,-buff_size:n+buff_size,1:sys_size_alloc))
584# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
585
586# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
587
588# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
589#if defined(MFC_OpenACC)
590# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
591!$acc enter data create(bc_buffers(3,1)%sf)
592# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
593#elif defined(MFC_OpenMP)
594# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
595!$omp target enter data map(always,alloc:bc_buffers(3,1)%sf)
596# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
597#endif
598#ifdef MFC_DEBUG
599# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
600 block
601# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
602 use iso_fortran_env, only: output_unit
603# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
604
605# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
606 print *, 'm_boundary_common.fpp:61: ', '@:ALLOCATE(bc_buffers(3,2)%sf(-buff_size:m+buff_size,-buff_size:n+buff_size,1:sys_size_alloc))'
607# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
608
609# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
610 call flush (output_unit)
611# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
612 end block
613# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
614#endif
615# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
616 allocate (bc_buffers(3,2)%sf(-buff_size:m+buff_size,-buff_size:n+buff_size,1:sys_size_alloc))
617# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
618
619# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
620
621# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
622#if defined(MFC_OpenACC)
623# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
624!$acc enter data create(bc_buffers(3,2)%sf)
625# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
626#elif defined(MFC_OpenMP)
627# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
628!$omp target enter data map(always,alloc:bc_buffers(3,2)%sf)
629# 61 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
630#endif
631 end if
632# 64 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
633 end if
634# 66 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
635 do i = 1, num_dims
636 do j = 1, 2
637#ifdef _CRAYFTN
638# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
639 block
640# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
641#ifdef MFC_DEBUG
642# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
643 block
644# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
645 use iso_fortran_env, only: output_unit
646# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
647
648# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
649 print *, 'm_boundary_common.fpp:68: ', '@:ACC_SETUP_SFs(bc_buffers(i,j))'
650# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
651
652# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
653 call flush (output_unit)
654# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
655 end block
656# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
657#endif
658# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
659
660# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
661
662# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
663#if defined(MFC_OpenACC)
664# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
665!$acc enter data copyin(bc_buffers(i,j))
666# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
667#elif defined(MFC_OpenMP)
668# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
669!$omp target enter data map(to:bc_buffers(i,j))
670# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
671#endif
672# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
673 if (associated(bc_buffers(i,j)%sf)) then
674# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
675
676# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
677#if defined(MFC_OpenACC)
678# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
679!$acc enter data copyin(bc_buffers(i,j)%sf)
680# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
681#elif defined(MFC_OpenMP)
682# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
683!$omp target enter data map(to:bc_buffers(i,j)%sf)
684# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
685#endif
686# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
687 end if
688# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
689 end block
690# 68 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
691#endif
692 end do
693 end do
694 end if
695
696 if (bubbles_lagrange) then
697 beta_bc_bounds(1)%beg = -mapcells - 1
698 beta_bc_bounds(1)%end = m + mapcells + 1
699 ! n > 0 always for bubbles_lagrange
700 beta_bc_bounds(2)%beg = -mapcells - 1
701 beta_bc_bounds(2)%end = n + mapcells + 1
702 if (p == 0) then
703 beta_bc_bounds(3)%beg = 0
704 beta_bc_bounds(3)%end = 0
705 else
706 beta_bc_bounds(3)%beg = -mapcells - 1
707 beta_bc_bounds(3)%end = p + mapcells + 1
708 end if
709 end if
710
711# 87 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
712#if defined(MFC_OpenACC)
713# 87 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
714!$acc update device(beta_bc_bounds)
715# 87 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
716#elif defined(MFC_OpenMP)
717# 87 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
718!$omp target update to(beta_bc_bounds)
719# 87 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
720#endif
721
723
724 !> Populate the buffers of the primitive variables based on the selected boundary conditions.
725 impure subroutine s_populate_variables_buffers(bc_type, q_prim_vf, pb_in, mv_in, q_T_sf)
726
727 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
728 real(stp), optional, dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_in, mv_in
729 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
730 type(scalar_field), optional, intent(inout) :: q_t_sf
731
732 call s_populate_bc_direction(1, -1, bc_x, bc_type(1, 1), q_prim_vf, pb_in, mv_in, q_t_sf)
733 call s_populate_bc_direction(1, 1, bc_x, bc_type(1, 2), q_prim_vf, pb_in, mv_in, q_t_sf)
734
735 if (n == 0) return
736
737# 105 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
738 call s_populate_bc_direction(2, -1, bc_y, bc_type(2, 1), q_prim_vf, pb_in, mv_in, q_t_sf)
739 call s_populate_bc_direction(2, 1, bc_y, bc_type(2, 2), q_prim_vf, pb_in, mv_in, q_t_sf)
740# 108 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
741
742 if (p == 0) return
743
744# 112 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
745 call s_populate_bc_direction(3, -1, bc_z, bc_type(3, 1), q_prim_vf, pb_in, mv_in, q_t_sf)
746 call s_populate_bc_direction(3, 1, bc_z, bc_type(3, 2), q_prim_vf, pb_in, mv_in, q_t_sf)
747# 115 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
748
749 end subroutine s_populate_variables_buffers
750
751 !> Populate the variable buffers along one direction and location, via MPI exchange for processor boundaries or by dispatching
752 !! the per-cell BC routines over the boundary face.
753 impure subroutine s_populate_bc_direction(bc_dir, bc_loc, bc_bounds, bc_type_edge, q_prim_vf, pb_in, mv_in, q_T_sf)
754
755 integer, intent(in) :: bc_dir, bc_loc
756 type(int_bounds_info), intent(in) :: bc_bounds
757 type(integer_field), intent(in) :: bc_type_edge
758 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
759 real(stp), optional, dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_in, mv_in
760 type(scalar_field), optional, intent(inout) :: q_t_sf
761 integer :: bc_edge, k_beg, k_end, l_beg, l_end
762 integer :: bc_code, k, l
763
764 if (bc_loc == -1) then
765 bc_edge = bc_bounds%beg
766 else
767 bc_edge = bc_bounds%end
768 end if
769
770 ! BC type codes defined in m_constants.fpp; non-negative values are MPI boundaries
771 if (bc_edge >= 0) then
772 call s_mpi_sendrecv_variables_buffers(q_prim_vf, bc_dir, bc_loc, sys_size, pb_in, mv_in, q_t_sf)
773 return
774 end if
775
776 if (bc_dir == 1) then
777 k_beg = 0; k_end = n; l_beg = 0; l_end = p
778 else if (bc_dir == 2) then
779 k_beg = -buff_size; k_end = m + buff_size; l_beg = 0; l_end = p
780 else
781 k_beg = -buff_size; k_end = m + buff_size; l_beg = -buff_size; l_end = n + buff_size
782 end if
783
784
785# 151 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
786
787# 151 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
788#if defined(MFC_OpenACC)
789# 151 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
790!$acc parallel loop collapse(2) gang vector default(present) private(l, k, bc_code)
791# 151 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
792#elif defined(MFC_OpenMP)
793# 151 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
794
795# 151 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
796
797# 151 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
798
799# 151 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
800!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k, bc_code)
801# 151 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
802#endif
803 do l = l_beg, l_end
804 do k = k_beg, k_end
805 if (bc_dir == 1) then
806 bc_code = int(bc_type_edge%sf(0, k, l))
807 else if (bc_dir == 2) then
808 bc_code = int(bc_type_edge%sf(k, 0, l))
809 else
810 bc_code = int(bc_type_edge%sf(k, l, 0))
811 end if
812
813 select case (bc_code)
814 case (bc_char_sup_outflow:bc_ghost_extrap)
815 call s_ghost_cell_extrapolation(q_prim_vf, bc_dir, bc_loc, k, l, q_t_sf)
816 case (bc_axis)
817 if (bc_dir == 2 .and. bc_loc == -1) call s_axis(q_prim_vf, pb_in, mv_in, k, l)
818 case (bc_reflective)
819 call s_symmetry(q_prim_vf, bc_dir, bc_loc, k, l, pb_in, mv_in, q_t_sf)
820 case (bc_periodic)
821 call s_periodic(q_prim_vf, bc_dir, bc_loc, k, l, pb_in, mv_in, q_t_sf)
822 case (bc_slip_wall)
823 call s_slip_wall(q_prim_vf, bc_dir, bc_loc, k, l, q_t_sf)
824 case (bc_no_slip_wall)
825 call s_no_slip_wall(q_prim_vf, bc_dir, bc_loc, k, l, q_t_sf)
826 case (bc_dirichlet)
827 call s_dirichlet(q_prim_vf, bc_dir, bc_loc, k, l, q_t_sf)
828 end select
829
830 if (qbmm .and. (.not. polytropic) .and. present(pb_in) .and. present(mv_in) .and. (bc_code <= bc_ghost_extrap) &
831 & .and. .not. (bc_dir == 2 .and. bc_loc == -1 .and. bc_code == bc_axis)) then
832 call s_qbmm_extrapolation(bc_dir, bc_loc, k, l, pb_in, mv_in)
833 end if
834 end do
835 end do
836
837# 185 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
838#if defined(MFC_OpenACC)
839# 185 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
840!$acc end parallel loop
841# 185 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
842#elif defined(MFC_OpenMP)
843# 185 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
844
845# 185 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
846!$omp end target teams loop
847# 185 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
848#endif
849
850 end subroutine s_populate_bc_direction
851
852 !> Populate ghost cell buffers for the color function and its divergence used in capillary surface tension.
853 impure subroutine s_populate_capillary_buffers(c_divs, bc_type, bc)
854
855 type(scalar_field), dimension(num_dims + 1), intent(inout) :: c_divs
856 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
857 type(bc_xyz_info), intent(in) :: bc
858
859 call s_populate_capillary_bc_direction(1, -1, bc%x, bc_type(1, 1), c_divs)
860 call s_populate_capillary_bc_direction(1, 1, bc%x, bc_type(1, 2), c_divs)
861
862 if (n == 0) return
863
864# 202 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
865 call s_populate_capillary_bc_direction(2, -1, bc%y, bc_type(2, 1), c_divs)
866 call s_populate_capillary_bc_direction(2, 1, bc%y, bc_type(2, 2), c_divs)
867# 205 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
868
869 if (p == 0) return
870
871# 209 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
872 call s_populate_capillary_bc_direction(3, -1, bc%z, bc_type(3, 1), c_divs)
873 call s_populate_capillary_bc_direction(3, 1, bc%z, bc_type(3, 2), c_divs)
874# 212 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
875
876 end subroutine s_populate_capillary_buffers
877
878 !> Populate ghost cell buffers for one capillary BC direction and location, via MPI exchange for processor boundaries or by
879 !! dispatching the per-cell capillary BC routines over the boundary face.
880 impure subroutine s_populate_capillary_bc_direction(bc_dir, bc_loc, bc_bounds, bc_type_edge, c_divs)
881
882 integer, intent(in) :: bc_dir, bc_loc
883 type(int_bounds_info), intent(in) :: bc_bounds
884 type(scalar_field), dimension(num_dims + 1), intent(inout) :: c_divs
885 type(integer_field), intent(in) :: bc_type_edge
886 integer :: bc_edge, k_beg, k_end, l_beg, l_end, k, l, bc_code
887
888 if (bc_loc == -1) then
889 bc_edge = bc_bounds%beg
890 else
891 bc_edge = bc_bounds%end
892 end if
893
894 if (bc_edge >= 0) then
895 call s_mpi_sendrecv_variables_buffers(c_divs, bc_dir, bc_loc, num_dims + 1)
896 return
897 end if
898
899 if (bc_dir == 1) then
900 k_beg = 0; k_end = n; l_beg = 0; l_end = p
901 else if (bc_dir == 2) then
902 k_beg = -buff_size; k_end = m + buff_size; l_beg = 0; l_end = p
903 else
904 k_beg = -buff_size; k_end = m + buff_size; l_beg = -buff_size; l_end = n + buff_size
905 end if
906
907
908# 244 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
909
910# 244 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
911#if defined(MFC_OpenACC)
912# 244 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
913!$acc parallel loop collapse(2) gang vector default(present) private(l, k, bc_code)
914# 244 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
915#elif defined(MFC_OpenMP)
916# 244 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
917
918# 244 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
919
920# 244 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
921
922# 244 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
923!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k, bc_code)
924# 244 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
925#endif
926 do l = l_beg, l_end
927 do k = k_beg, k_end
928 if (bc_dir == 1) then
929 bc_code = int(bc_type_edge%sf(0, k, l))
930 else if (bc_dir == 2) then
931 bc_code = int(bc_type_edge%sf(k, 0, l))
932 else
933 bc_code = int(bc_type_edge%sf(k, l, 0))
934 end if
935
936 select case (bc_code)
937 case (bc_periodic)
938 call s_color_function_periodic(c_divs, bc_dir, bc_loc, k, l)
939 case (bc_reflective)
940 call s_color_function_reflective(c_divs, bc_dir, bc_loc, k, l)
941 case default
942 call s_color_function_ghost_cell_extrapolation(c_divs, bc_dir, bc_loc, k, l)
943 end select
944 end do
945 end do
946
947# 265 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
948#if defined(MFC_OpenACC)
949# 265 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
950!$acc end parallel loop
951# 265 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
952#elif defined(MFC_OpenMP)
953# 265 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
954
955# 265 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
956!$omp end target teams loop
957# 265 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
958#endif
959
961
962 !> Populate ghost cell buffers for the Jacobian scalar field used in the IGR elliptic solver.
963 impure subroutine s_populate_f_igr_buffers(bc_type, jac_sf)
964
965 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
966 type(scalar_field), dimension(1:), intent(inout) :: jac_sf
967
968 call s_populate_f_igr_bc_direction(1, -1, bc_x, bc_type(1, 1), jac_sf)
969 call s_populate_f_igr_bc_direction(1, 1, bc_x, bc_type(1, 2), jac_sf)
970
971 if (n == 0) return
972
973# 281 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
974 call s_populate_f_igr_bc_direction(2, -1, bc_y, bc_type(2, 1), jac_sf)
975 call s_populate_f_igr_bc_direction(2, 1, bc_y, bc_type(2, 2), jac_sf)
976# 284 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
977
978 if (p == 0) return
979
980# 288 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
981 call s_populate_f_igr_bc_direction(3, -1, bc_z, bc_type(3, 1), jac_sf)
982 call s_populate_f_igr_bc_direction(3, 1, bc_z, bc_type(3, 2), jac_sf)
983# 291 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
984
985 end subroutine s_populate_f_igr_buffers
986
987 !> Populate ghost cell buffers for one IGR Jacobian BC direction and location, via MPI exchange for processor boundaries or by
988 !! dispatching the per-cell IGR Jacobian BC routines over the boundary face.
989 impure subroutine s_populate_f_igr_bc_direction(bc_dir, bc_loc, bc_bounds, bc_type_edge, jac_sf)
990
991 integer, intent(in) :: bc_dir, bc_loc
992 type(int_bounds_info), intent(in) :: bc_bounds
993 type(integer_field), intent(in) :: bc_type_edge
994 type(scalar_field), dimension(1:), intent(inout) :: jac_sf
995 integer :: bc_edge, k_beg, k_end, l_beg, l_end, k, l, j, bc_code
996
997 if (bc_loc == -1) then
998 bc_edge = bc_bounds%beg
999 else
1000 bc_edge = bc_bounds%end
1001 end if
1002
1003 if (bc_edge >= 0) then
1004 call s_mpi_sendrecv_variables_buffers(jac_sf, bc_dir, bc_loc, 1)
1005 return
1006 end if
1007
1008 if (bc_dir == 1) then
1009 k_beg = 0; k_end = n; l_beg = 0; l_end = p
1010 else if (bc_dir == 2) then
1011 k_beg = idwbuff(1)%beg; k_end = idwbuff(1)%end; l_beg = 0; l_end = p
1012 else
1013 k_beg = idwbuff(1)%beg; k_end = idwbuff(1)%end; l_beg = idwbuff(2)%beg; l_end = idwbuff(2)%end
1014 end if
1015
1016
1017# 323 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1018
1019# 323 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1020#if defined(MFC_OpenACC)
1021# 323 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1022!$acc parallel loop collapse(2) gang vector default(present) private(l, k, bc_code)
1023# 323 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1024#elif defined(MFC_OpenMP)
1025# 323 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1026
1027# 323 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1028
1029# 323 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1030
1031# 323 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1032!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k, bc_code)
1033# 323 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1034#endif
1035 do l = l_beg, l_end
1036 do k = k_beg, k_end
1037 if (bc_dir == 1) then
1038 bc_code = int(bc_type_edge%sf(0, k, l))
1039 else if (bc_dir == 2) then
1040 bc_code = int(bc_type_edge%sf(k, 0, l))
1041 else
1042 bc_code = int(bc_type_edge%sf(k, l, 0))
1043 end if
1044
1045 select case (bc_code)
1046 case (bc_periodic)
1047 call s_f_igr_periodic(jac_sf, bc_dir, bc_loc, k, l)
1048 case (bc_reflective)
1049 call s_f_igr_reflective(jac_sf, bc_dir, bc_loc, k, l)
1050 case default
1051 call s_f_igr_ghost_cell_extrapolation(jac_sf, bc_dir, bc_loc, k, l)
1052 end select
1053 end do
1054 end do
1055
1056# 344 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1057#if defined(MFC_OpenACC)
1058# 344 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1059!$acc end parallel loop
1060# 344 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1061#elif defined(MFC_OpenMP)
1062# 344 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1063
1064# 344 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1065!$omp end target teams loop
1066# 344 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1067#endif
1068
1069 end subroutine s_populate_f_igr_bc_direction
1070
1071 !> Populate the buffers of the grid variables, which are constituted of the cell-boundary locations and cell-width
1072 !! distributions, based on the boundary conditions.
1073 subroutine s_populate_grid_variables_buffers(x_cb_in, x_cc_in, dx_in, x_offset, y_offset, z_offset, y_cb_in, y_cc_in, dy_in, &
1074 & z_cb_in, z_cc_in, dz_in, global_bounds)
1075
1076 type(int_bounds_info), intent(in) :: x_offset, y_offset, z_offset
1077 real(wp), contiguous, intent(inout) :: x_cb_in(-1 - x_offset%beg:)
1078 real(wp), contiguous, intent(inout) :: x_cc_in(-buff_size:), dx_in(-buff_size:)
1079 real(wp), optional, contiguous, intent(inout) :: y_cb_in(-1 - y_offset%beg:), z_cb_in(-1 - z_offset%beg:)
1080 real(wp), optional, contiguous, intent(inout) :: y_cc_in(-buff_size:), dy_in(-buff_size:)
1081 real(wp), optional, contiguous, intent(inout) :: z_cc_in(-buff_size:), dz_in(-buff_size:)
1082 type(bounds_info), optional, dimension(3), intent(inout) :: global_bounds
1083
1084 if (present(global_bounds)) then
1085#ifdef MFC_MPI
1086 call s_mpi_allreduce_min(x_cb_in(-1), global_bounds(1)%beg)
1087 call s_mpi_allreduce_max(x_cb_in(m), global_bounds(1)%end)
1088 if (n > 0) then
1089 call s_mpi_allreduce_min(y_cb_in(-1), global_bounds(2)%beg)
1090 call s_mpi_allreduce_max(y_cb_in(n), global_bounds(2)%end)
1091 if (p > 0) then
1092 call s_mpi_allreduce_min(z_cb_in(-1), global_bounds(3)%beg)
1093 call s_mpi_allreduce_max(z_cb_in(p), global_bounds(3)%end)
1094 end if
1095 end if
1096#else
1097 global_bounds(1)%beg = x_cb_in(-1); global_bounds(1)%end = x_cb_in(m)
1098 if (n > 0) then
1099 global_bounds(2)%beg = y_cb_in(-1); global_bounds(2)%end = y_cb_in(n)
1100 if (p > 0) then
1101 global_bounds(3)%beg = z_cb_in(-1); global_bounds(3)%end = z_cb_in(p)
1102 end if
1103 end if
1104#endif
1105 end if
1106
1107 call s_populate_grid_bc_direction(x_cb_in, x_cc_in, dx_in, m, 1, -1, bc_x, x_offset)
1108 call s_populate_grid_bc_direction(x_cb_in, x_cc_in, dx_in, m, 1, 1, bc_x, x_offset)
1109
1110 if (n == 0) return
1111
1112# 390 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1113 call s_populate_grid_bc_direction(y_cb_in, y_cc_in, dy_in, n, 2, -1, bc_y, y_offset)
1114 call s_populate_grid_bc_direction(y_cb_in, y_cc_in, dy_in, n, 2, 1, bc_y, y_offset)
1115# 393 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1116
1117 if (p == 0) return
1118
1119# 397 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1120 call s_populate_grid_bc_direction(z_cb_in, z_cc_in, dz_in, p, 3, -1, bc_z, z_offset)
1121 call s_populate_grid_bc_direction(z_cb_in, z_cc_in, dz_in, p, 3, 1, bc_z, z_offset)
1122# 400 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1123
1125
1126 !> Populate cell-boundary, cell-center, and cell-width buffers for one coordinate direction.
1127 subroutine s_populate_grid_bc_direction(cell_boundaries, cell_centers, cell_widths, num_cells, bc_dir, bc_loc, bc_bounds, &
1128 & offset)
1129
1130 integer, intent(in) :: num_cells, bc_dir, bc_loc
1131 type(int_bounds_info), intent(in) :: bc_bounds, offset
1132 real(wp), contiguous, intent(inout) :: cell_boundaries(-1 - offset%beg:)
1133 real(wp), contiguous, intent(inout) :: cell_centers(-buff_size:), cell_widths(-buff_size:)
1134 integer :: bc_edge, i, source_index
1135
1136 if (bc_loc == -1) then
1137 bc_edge = bc_bounds%beg
1138 else
1139 bc_edge = bc_bounds%end
1140 end if
1141
1142 if (bc_edge >= 0) then
1143 call s_mpi_sendrecv_grid_variable_buffer(cell_boundaries, cell_centers, cell_widths, num_cells, bc_bounds, bc_loc, &
1144 & offset)
1145 return
1146 end if
1147
1148 if (bc_edge == bc_axis .and. (bc_dir /= 2 .or. bc_loc == 1)) return
1149
1150 do i = 1, buff_size
1151 if (bc_loc == -1) then
1152 select case (bc_edge)
1153 case (bc_periodic)
1154 source_index = num_cells - i + 1
1155 case (bc_reflective, bc_axis)
1156 source_index = i - 1
1157 case default
1158 source_index = 0
1159 end select
1160 cell_widths(-i) = cell_widths(source_index)
1161 else
1162 select case (bc_edge)
1163 case (bc_periodic)
1164 source_index = i - 1
1165 case (bc_reflective)
1166 source_index = num_cells - i + 1
1167 case default
1168 source_index = num_cells
1169 end select
1170 cell_widths(num_cells + i) = cell_widths(source_index)
1171 end if
1172 end do
1173
1174 if (bc_loc == -1) then
1175 do i = 1, offset%beg
1176 cell_boundaries(-1 - i) = cell_boundaries(-i) - cell_widths(-i)
1177 end do
1178 do i = 1, buff_size
1179 cell_centers(-i) = cell_centers(1 - i) - (cell_widths(1 - i) + cell_widths(-i))/2._wp
1180 end do
1181 else
1182 do i = 1, offset%end
1183 cell_boundaries(num_cells + i) = cell_boundaries(num_cells + i - 1) + cell_widths(num_cells + i)
1184 end do
1185 do i = 1, buff_size
1186 cell_centers(num_cells + i) = cell_centers(num_cells + i - 1) + (cell_widths(num_cells + i - 1) &
1187 & + cell_widths(num_cells + i))/2._wp
1188 end do
1189 end if
1190
1191 end subroutine s_populate_grid_bc_direction
1192
1193 !> Deallocate boundary condition buffer arrays allocated during module initialization.
1195
1196 if (bc_io) then
1197#ifdef MFC_DEBUG
1198# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1199 block
1200# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1201 use iso_fortran_env, only: output_unit
1202# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1203
1204# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1205 print *, 'm_boundary_common.fpp:474: ', '@:DEALLOCATE(bc_buffers(1, 1)%sf)'
1206# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1207
1208# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1209 call flush (output_unit)
1210# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1211 end block
1212# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1213#endif
1214# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1215
1216# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1217#if defined(MFC_OpenACC)
1218# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1219!$acc exit data delete(bc_buffers(1, 1)%sf)
1220# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1221#elif defined(MFC_OpenMP)
1222# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1223!$omp target exit data map(release:bc_buffers(1, 1)%sf)
1224# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1225#endif
1226# 474 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1227 deallocate (bc_buffers(1, 1)%sf)
1228#ifdef MFC_DEBUG
1229# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1230 block
1231# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1232 use iso_fortran_env, only: output_unit
1233# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1234
1235# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1236 print *, 'm_boundary_common.fpp:475: ', '@:DEALLOCATE(bc_buffers(1, 2)%sf)'
1237# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1238
1239# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1240 call flush (output_unit)
1241# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1242 end block
1243# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1244#endif
1245# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1246
1247# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1248#if defined(MFC_OpenACC)
1249# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1250!$acc exit data delete(bc_buffers(1, 2)%sf)
1251# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1252#elif defined(MFC_OpenMP)
1253# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1254!$omp target exit data map(release:bc_buffers(1, 2)%sf)
1255# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1256#endif
1257# 475 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1258 deallocate (bc_buffers(1, 2)%sf)
1259# 477 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1260 if (n > 0) then
1261#ifdef MFC_DEBUG
1262# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1263 block
1264# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1265 use iso_fortran_env, only: output_unit
1266# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1267
1268# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1269 print *, 'm_boundary_common.fpp:478: ', '@:DEALLOCATE(bc_buffers(2, 1)%sf)'
1270# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1271
1272# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1273 call flush (output_unit)
1274# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1275 end block
1276# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1277#endif
1278# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1279
1280# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1281#if defined(MFC_OpenACC)
1282# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1283!$acc exit data delete(bc_buffers(2, 1)%sf)
1284# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1285#elif defined(MFC_OpenMP)
1286# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1287!$omp target exit data map(release:bc_buffers(2, 1)%sf)
1288# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1289#endif
1290# 478 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1291 deallocate (bc_buffers(2, 1)%sf)
1292#ifdef MFC_DEBUG
1293# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1294 block
1295# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1296 use iso_fortran_env, only: output_unit
1297# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1298
1299# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1300 print *, 'm_boundary_common.fpp:479: ', '@:DEALLOCATE(bc_buffers(2, 2)%sf)'
1301# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1302
1303# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1304 call flush (output_unit)
1305# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1306 end block
1307# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1308#endif
1309# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1310
1311# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1312#if defined(MFC_OpenACC)
1313# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1314!$acc exit data delete(bc_buffers(2, 2)%sf)
1315# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1316#elif defined(MFC_OpenMP)
1317# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1318!$omp target exit data map(release:bc_buffers(2, 2)%sf)
1319# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1320#endif
1321# 479 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1322 deallocate (bc_buffers(2, 2)%sf)
1323# 481 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1324 if (p > 0) then
1325#ifdef MFC_DEBUG
1326# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1327 block
1328# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1329 use iso_fortran_env, only: output_unit
1330# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1331
1332# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1333 print *, 'm_boundary_common.fpp:482: ', '@:DEALLOCATE(bc_buffers(3, 1)%sf)'
1334# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1335
1336# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1337 call flush (output_unit)
1338# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1339 end block
1340# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1341#endif
1342# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1343
1344# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1345#if defined(MFC_OpenACC)
1346# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1347!$acc exit data delete(bc_buffers(3, 1)%sf)
1348# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1349#elif defined(MFC_OpenMP)
1350# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1351!$omp target exit data map(release:bc_buffers(3, 1)%sf)
1352# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1353#endif
1354# 482 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1355 deallocate (bc_buffers(3, 1)%sf)
1356#ifdef MFC_DEBUG
1357# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1358 block
1359# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1360 use iso_fortran_env, only: output_unit
1361# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1362
1363# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1364 print *, 'm_boundary_common.fpp:483: ', '@:DEALLOCATE(bc_buffers(3, 2)%sf)'
1365# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1366
1367# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1368 call flush (output_unit)
1369# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1370 end block
1371# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1372#endif
1373# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1374
1375# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1376#if defined(MFC_OpenACC)
1377# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1378!$acc exit data delete(bc_buffers(3, 2)%sf)
1379# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1380#elif defined(MFC_OpenMP)
1381# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1382!$omp target exit data map(release:bc_buffers(3, 2)%sf)
1383# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1384#endif
1385# 483 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1386 deallocate (bc_buffers(3, 2)%sf)
1387 end if
1388# 486 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1389 end if
1390# 488 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1391 end if
1392#ifdef MFC_DEBUG
1393# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1394 block
1395# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1396 use iso_fortran_env, only: output_unit
1397# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1398
1399# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1400 print *, 'm_boundary_common.fpp:489: ', '@:DEALLOCATE(bc_buffers)'
1401# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1402
1403# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1404 call flush (output_unit)
1405# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1406 end block
1407# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1408#endif
1409# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1410
1411# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1412#if defined(MFC_OpenACC)
1413# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1414!$acc exit data delete(bc_buffers)
1415# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1416#elif defined(MFC_OpenMP)
1417# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1418!$omp target exit data map(release:bc_buffers)
1419# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1420#endif
1421# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1422 deallocate (bc_buffers)
1423
1425
1426 !> Populate ghost cell buffers of the Lagrangian-bubble beta (void fraction) variables based on the boundary conditions.
1427 impure subroutine s_populate_beta_buffers(q_beta, kahan_comp, bc_type, nvar)
1428
1429 type(scalar_field), dimension(:), intent(inout) :: q_beta
1430 type(scalar_field), dimension(:), intent(inout) :: kahan_comp
1431 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
1432 integer, intent(in) :: nvar
1433
1434 call s_populate_beta_bc_direction(1, -1, bc%x, bc_type(1, 1), q_beta, kahan_comp, nvar)
1435 call s_populate_beta_bc_direction(1, 1, bc%x, bc_type(1, 2), q_beta, kahan_comp, nvar)
1436
1437 ! n > 0 always for bubbles_lagrange
1438# 506 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1439 call s_populate_beta_bc_direction(2, -1, bc%y, bc_type(2, 1), q_beta, kahan_comp, nvar)
1440 call s_populate_beta_bc_direction(2, 1, bc%y, bc_type(2, 2), q_beta, kahan_comp, nvar)
1441# 509 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1442
1443 if (p == 0) return
1444
1445# 513 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1446 call s_populate_beta_bc_direction(3, -1, bc%z, bc_type(3, 1), q_beta, kahan_comp, nvar)
1447 call s_populate_beta_bc_direction(3, 1, bc%z, bc_type(3, 2), q_beta, kahan_comp, nvar)
1448# 516 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1449
1450 end subroutine s_populate_beta_buffers
1451
1452 !> Populate beta variable buffers for one direction and location, by dispatching the per-cell beta BC routines over the boundary
1453 !! face and performing the paired MPI reduction for processor boundaries.
1454 impure subroutine s_populate_beta_bc_direction(bc_dir, bc_loc, bc_bounds, bc_type_edge, q_beta, kahan_comp, nvar)
1455
1456 integer, intent(in) :: bc_dir, bc_loc
1457 type(int_bounds_info), intent(in) :: bc_bounds
1458 type(integer_field), intent(in) :: bc_type_edge
1459 type(scalar_field), dimension(:), intent(inout) :: q_beta
1460 type(scalar_field), dimension(:), intent(inout) :: kahan_comp
1461 integer, intent(in) :: nvar
1462 integer :: bc_edge, k_beg, k_end, l_beg, l_end, k, l, bc_code
1463
1464 if (bc_loc == -1) then
1465 bc_edge = bc_bounds%beg
1466 else
1467 bc_edge = bc_bounds%end
1468 end if
1469
1470 if (bc_edge < 0) then
1471 if (bc_dir == 1) then
1472 k_beg = beta_bc_bounds(2)%beg; k_end = beta_bc_bounds(2)%end
1473 l_beg = beta_bc_bounds(3)%beg; l_end = beta_bc_bounds(3)%end
1474 else if (bc_dir == 2) then
1475 k_beg = beta_bc_bounds(1)%beg; k_end = beta_bc_bounds(1)%end
1476 l_beg = beta_bc_bounds(3)%beg; l_end = beta_bc_bounds(3)%end
1477 else
1478 k_beg = beta_bc_bounds(1)%beg; k_end = beta_bc_bounds(1)%end
1479 l_beg = beta_bc_bounds(2)%beg; l_end = beta_bc_bounds(2)%end
1480 end if
1481
1482
1483# 549 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1484
1485# 549 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1486#if defined(MFC_OpenACC)
1487# 549 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1488!$acc parallel loop collapse(2) gang vector default(present) private(l, k, bc_code)
1489# 549 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1490#elif defined(MFC_OpenMP)
1491# 549 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1492
1493# 549 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1494
1495# 549 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1496
1497# 549 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1498!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k, bc_code)
1499# 549 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1500#endif
1501 do l = l_beg, l_end
1502 do k = k_beg, k_end
1503 ! bc_type is not allocated over the beta ghost extents in x and y, so those directions dispatch on the
1504 ! domain-edge BC; in z it is allocated with buff_size (>= mapcells + 1) ghost layers and dispatches per cell.
1505 if (bc_dir == 3) then
1506 bc_code = int(bc_type_edge%sf(k, l, 0))
1507 else
1508 bc_code = bc_edge
1509 end if
1510
1511 select case (bc_code)
1512 case (bc_periodic)
1513 call s_beta_periodic(q_beta, kahan_comp, bc_dir, bc_loc, k, l, nvar)
1514 case (bc_reflective)
1515 call s_beta_reflective(q_beta, kahan_comp, bc_dir, bc_loc, k, l, nvar)
1516 end select
1517 end do
1518 end do
1519
1520# 568 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1521#if defined(MFC_OpenACC)
1522# 568 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1523!$acc end parallel loop
1524# 568 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1525#elif defined(MFC_OpenMP)
1526# 568 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1527
1528# 568 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1529!$omp end target teams loop
1530# 568 "/home/runner/work/MFC/MFC/src/common/m_boundary_common.fpp"
1531#endif
1532 end if
1533
1534 ! The beta reduction is a paired exchange (rightward accumulate at bc_loc = -1, leftward distribute at bc_loc = 1), so it
1535 ! must run at both locations whenever either edge of the direction is a processor boundary.
1536 if (bc_bounds%beg >= 0 .or. bc_bounds%end >= 0) then
1537 call s_mpi_reduce_beta_variables_buffers(q_beta, kahan_comp, bc_dir, bc_loc, nvar)
1538 end if
1539
1540 end subroutine s_populate_beta_bc_direction
1541
1542end module m_boundary_common
integer, intent(in) k
integer, intent(in) j
integer, intent(in) l
Noncharacteristic and processor boundary condition application for ghost cells and buffer regions.
subroutine, public s_populate_grid_variables_buffers(x_cb_in, x_cc_in, dx_in, x_offset, y_offset, z_offset, y_cb_in, y_cc_in, dy_in, z_cb_in, z_cc_in, dz_in, global_bounds)
Populate the buffers of the grid variables, which are constituted of the cell-boundary locations and ...
subroutine s_populate_grid_bc_direction(cell_boundaries, cell_centers, cell_widths, num_cells, bc_dir, bc_loc, bc_bounds, offset)
Populate cell-boundary, cell-center, and cell-width buffers for one coordinate direction.
impure subroutine s_populate_bc_direction(bc_dir, bc_loc, bc_bounds, bc_type_edge, q_prim_vf, pb_in, mv_in, q_t_sf)
Populate the variable buffers along one direction and location, via MPI exchange for processor bounda...
impure subroutine s_populate_capillary_bc_direction(bc_dir, bc_loc, bc_bounds, bc_type_edge, c_divs)
Populate ghost cell buffers for one capillary BC direction and location, via MPI exchange for process...
impure subroutine s_populate_beta_bc_direction(bc_dir, bc_loc, bc_bounds, bc_type_edge, q_beta, kahan_comp, nvar)
Populate beta variable buffers for one direction and location, by dispatching the per-cell beta BC ro...
impure subroutine s_populate_f_igr_bc_direction(bc_dir, bc_loc, bc_bounds, bc_type_edge, jac_sf)
Populate ghost cell buffers for one IGR Jacobian BC direction and location, via MPI exchange for proc...
impure subroutine, public s_populate_f_igr_buffers(bc_type, jac_sf)
Populate ghost cell buffers for the Jacobian scalar field used in the IGR elliptic solver.
subroutine, public s_finalize_boundary_common_module()
Deallocate boundary condition buffer arrays allocated during module initialization.
impure subroutine, public s_populate_variables_buffers(bc_type, q_prim_vf, pb_in, mv_in, q_t_sf)
Populate the buffers of the primitive variables based on the selected boundary conditions.
type(int_bounds_info), dimension(3) beta_bc_bounds
Lagrangian-bubble beta (void-fraction) buffer bounds (#1290).
impure subroutine, public s_populate_capillary_buffers(c_divs, bc_type, bc)
Populate ghost cell buffers for the color function and its divergence used in capillary surface tensi...
impure subroutine, public s_populate_beta_buffers(q_beta, kahan_comp, bc_type, nvar)
Populate ghost cell buffers of the Lagrangian-bubble beta (void fraction) variables based on the boun...
impure subroutine, public s_initialize_boundary_common_module(use_dirichlet_buffers)
Allocate and set up boundary condition buffer arrays for all coordinate directions.
Boundary condition restart I/O, capillary/IGR buffer population, and grid-variable buffers.
integer, dimension(1:3, 1:2) mpi_bc_type_type
integer, dimension(1:3, 1:2) mpi_bc_buffer_type
Per-cell noncharacteristic boundary condition primitives applied in the ghost cells.
type(scalar_field), dimension(:,:), allocatable bc_buffers
Compile-time constant parameters: default values, tolerances, and physical constants.
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Global parameters for the post-process: domain geometry, equation of state, and output database setti...
MPI communication layer: domain decomposition, halo exchange, reductions, and parallel I/O setup.
MPI gather and scatter operations for distributing post-process grid and flow-variable data.
Integer bounds for variables.