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