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