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