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