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