MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_boundary_primitives.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
2!>
3!! @file
4!! @brief Contains module m_boundary_primitives
5
6!> @brief Per-cell noncharacteristic boundary condition primitives applied in the ghost cells
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# 8 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
14
15! For moving immersed boundaries in simulation
16# 12 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
17# 7 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.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
45# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
46! New line at end of file is required for FYPP
47# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
48# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
49# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
50# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63
64# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67
68# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73
74# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
75! New line at end of file is required for FYPP
76# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
77
78# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
80# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
82# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154! New line at end of file is required for FYPP
155# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
156# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
157# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
158# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171
172# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175
176# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179
180# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
181
182# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
183! New line at end of file is required for FYPP
184# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
185
186# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233
234# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
235
236# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
237
238# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
239
240# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
241! New line at end of file is required for FYPP
242# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
243
244! GPU parallel region (scalar reductions, maxval/minval)
245# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247! GPU parallel loop over threads (most common GPU macro)
248# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250! Required closing for GPU_PARALLEL_LOOP
251# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253! Mark routine for device compilation
254# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256! Declare device-resident data
257# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259! Inner loop within a GPU parallel region
260# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262! Scoped GPU data region
263# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265! Host code with device pointers (for MPI with GPU buffers)
266# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! Allocate device memory (unscoped)
269# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Free device memory
272# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Atomic operation on device
275# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! End atomic capture block
278# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Copy data between host and device
281# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Synchronization barrier
284# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Import GPU library module (openacc or omp_lib)
287# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Emit code only for AMD compiler
290# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Emit code for non-Cray compilers
293# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Emit code only for Cray compiler
296# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! Emit code for non-NVIDIA compilers
299# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
302# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303! New line at end of file is required for FYPP
304# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
305
306# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
307
308! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
309! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
310! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
311# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
312
313! Allocate and create GPU device memory
314# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
315
316! Free GPU device memory and deallocate
317# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
318
319! Cray-specific GPU pointer setup for vector fields
320# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
321
322! Cray-specific GPU pointer setup for scalar fields
323# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
324
325! Cray-specific GPU pointer setup for acoustic source spatials
326# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
327
328# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
329
330# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
331! New line at end of file is required for FYPP
332# 8 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp" 2
333
334module m_boundary_primitives
335
336 use m_derived_types
337 use m_global_parameters
338 use m_constants
339
340 implicit none
341
342 type(scalar_field), dimension(:,:), allocatable :: bc_buffers
343
344# 18 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
345#if defined(MFC_OpenACC)
346# 18 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
347!$acc declare create(bc_buffers)
348# 18 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
349#elif defined(MFC_OpenMP)
350# 18 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
351!$omp declare target (bc_buffers)
352# 18 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
353#endif
354
355contains
356
357 !> Fill ghost cells by copying the nearest boundary cell value along the specified direction.
358 subroutine s_ghost_cell_extrapolation(q_prim_vf, bc_dir, bc_loc, k, l, q_T_sf)
359
360
361# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
362#ifdef _CRAYFTN
363# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
364#if MFC_OpenACC
365# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
366!$acc routine seq
367# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
368#elif MFC_OpenMP
369# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
370
371# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
372
373# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
374!$omp declare target device_type(any)
375# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
376#else
377# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
378!DIR$ INLINEALWAYS s_ghost_cell_extrapolation
379# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
380#endif
381# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
382#elif MFC_OpenACC
383# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
384!$acc routine seq
385# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
386#elif MFC_OpenMP
387# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
388
389# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
390
391# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
392!$omp declare target device_type(any)
393# 25 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
394#endif
395 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
396 integer, intent(in) :: bc_dir, bc_loc
397 integer, intent(in) :: k, l
398 integer :: j, i
399 type(scalar_field), optional, intent(inout) :: q_T_sf
400
401 if (bc_dir == 1) then !< x-direction
402 if (bc_loc == -1) then ! bc_x%beg
403 do i = 1, sys_size
404 do j = 1, buff_size
405 q_prim_vf(i)%sf(-j, k, l) = q_prim_vf(i)%sf(0, k, l)
406 end do
407 end do
408 if (chemistry .and. present(q_t_sf)) then
409 do j = 1, buff_size
410 q_t_sf%sf(-j, k, l) = q_t_sf%sf(0, k, l)
411 end do
412 end if
413 else !< bc_x%end
414 do i = 1, sys_size
415 do j = 1, buff_size
416 q_prim_vf(i)%sf(m + j, k, l) = q_prim_vf(i)%sf(m, k, l)
417 end do
418 end do
419 if (chemistry .and. present(q_t_sf)) then
420 do j = 1, buff_size
421 q_t_sf%sf(m + j, k, l) = q_t_sf%sf(m, k, l)
422 end do
423 end if
424 end if
425 else if (bc_dir == 2) then !< y-direction
426 if (bc_loc == -1) then !< bc_y%beg
427 do i = 1, sys_size
428 do j = 1, buff_size
429 q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, 0, l)
430 end do
431 end do
432
433 if (chemistry .and. present(q_t_sf)) then
434 do j = 1, buff_size
435 q_t_sf%sf(k, -j, l) = q_t_sf%sf(k, 0, l)
436 end do
437 end if
438 else !< bc_y%end
439 do i = 1, sys_size
440 do j = 1, buff_size
441 q_prim_vf(i)%sf(k, n + j, l) = q_prim_vf(i)%sf(k, n, l)
442 end do
443 end do
444 if (chemistry .and. present(q_t_sf)) then
445 do j = 1, buff_size
446 q_t_sf%sf(k, n + j, l) = q_t_sf%sf(k, n, l)
447 end do
448 end if
449 end if
450 else if (bc_dir == 3) then !< z-direction
451 if (bc_loc == -1) then !< bc_z%beg
452 do i = 1, sys_size
453 do j = 1, buff_size
454 q_prim_vf(i)%sf(k, l, -j) = q_prim_vf(i)%sf(k, l, 0)
455 end do
456 end do
457 if (chemistry .and. present(q_t_sf)) then
458 do j = 1, buff_size
459 q_t_sf%sf(k, l, -j) = q_t_sf%sf(k, l, 0)
460 end do
461 end if
462 else !< bc_z%end
463 do i = 1, sys_size
464 do j = 1, buff_size
465 q_prim_vf(i)%sf(k, l, p + j) = q_prim_vf(i)%sf(k, l, p)
466 end do
467 end do
468 if (chemistry .and. present(q_t_sf)) then
469 do j = 1, buff_size
470 q_t_sf%sf(k, l, p + j) = q_t_sf%sf(k, l, p)
471 end do
472 end if
473 end if
474 end if
475
476 end subroutine s_ghost_cell_extrapolation
477
478 !> Apply reflective (symmetry) boundary conditions by mirroring primitive variables and flipping the normal velocity component.
479 subroutine s_symmetry(q_prim_vf, bc_dir, bc_loc, k, l, pb_in, mv_in, q_T_sf)
480
481
482# 112 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
483#if MFC_OpenACC
484# 112 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
485!$acc routine seq
486# 112 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
487#elif MFC_OpenMP
488# 112 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
489
490# 112 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
491
492# 112 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
493!$omp declare target device_type(any)
494# 112 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
495#endif
496 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
497 real(stp), optional, dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_in, mv_in
498 integer, intent(in) :: bc_dir, bc_loc
499 integer, intent(in) :: k, l
500 integer :: j, q, i
501 type(scalar_field), optional, intent(inout) :: q_T_sf
502
503 if (bc_dir == 1) then !< x-direction
504 if (bc_loc == -1) then !< bc_x%beg
505 do j = 1, buff_size
506 do i = 1, eqn_idx%cont%end
507 q_prim_vf(i)%sf(-j, k, l) = q_prim_vf(i)%sf(j - 1, k, l)
508 end do
509
510 q_prim_vf(eqn_idx%mom%beg)%sf(-j, k, l) = -q_prim_vf(eqn_idx%mom%beg)%sf(j - 1, k, l)
511
512 do i = eqn_idx%mom%beg + 1, sys_size
513 q_prim_vf(i)%sf(-j, k, l) = q_prim_vf(i)%sf(j - 1, k, l)
514 end do
515
516 if (chemistry .and. present(q_t_sf)) then
517 q_t_sf%sf(-j, k, l) = q_t_sf%sf(j - 1, k, l)
518 end if
519
520 if (elasticity) then
521 do i = 1, shear_bc_flip_num
522 q_prim_vf(shear_bc_flip_indices(1, i))%sf(-j, k, l) = -q_prim_vf(shear_bc_flip_indices(1, &
523 & i))%sf(j - 1, k, l)
524 end do
525 end if
526
527 if (hyperelasticity) then
528 q_prim_vf(eqn_idx%xi%beg)%sf(-j, k, l) = -q_prim_vf(eqn_idx%xi%beg)%sf(j - 1, k, l)
529 end if
530 end do
531
532 if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then
533 do i = 1, nb
534 do q = 1, nnode
535 do j = 1, buff_size
536 pb_in(-j, k, l, q, i) = pb_in(j - 1, k, l, q, i)
537 mv_in(-j, k, l, q, i) = mv_in(j - 1, k, l, q, i)
538 end do
539 end do
540 end do
541 end if
542 else !< bc_x%end
543 do j = 1, buff_size
544 do i = 1, eqn_idx%cont%end
545 q_prim_vf(i)%sf(m + j, k, l) = q_prim_vf(i)%sf(m - (j - 1), k, l)
546 end do
547
548 q_prim_vf(eqn_idx%mom%beg)%sf(m + j, k, l) = -q_prim_vf(eqn_idx%mom%beg)%sf(m - (j - 1), k, l)
549
550 do i = eqn_idx%mom%beg + 1, sys_size
551 q_prim_vf(i)%sf(m + j, k, l) = q_prim_vf(i)%sf(m - (j - 1), k, l)
552 end do
553
554 if (chemistry .and. present(q_t_sf)) then
555 q_t_sf%sf(m + j, k, l) = q_t_sf%sf(m - (j - 1), k, l)
556 end if
557
558 if (elasticity) then
559 do i = 1, shear_bc_flip_num
560 q_prim_vf(shear_bc_flip_indices(1, i))%sf(m + j, k, l) = -q_prim_vf(shear_bc_flip_indices(1, &
561 & i))%sf(m - (j - 1), k, l)
562 end do
563 end if
564
565 if (hyperelasticity) then
566 q_prim_vf(eqn_idx%xi%beg)%sf(m + j, k, l) = -q_prim_vf(eqn_idx%xi%beg)%sf(m - (j - 1), k, l)
567 end if
568 end do
569 if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then
570 do i = 1, nb
571 do q = 1, nnode
572 do j = 1, buff_size
573 pb_in(m + j, k, l, q, i) = pb_in(m - (j - 1), k, l, q, i)
574 mv_in(m + j, k, l, q, i) = mv_in(m - (j - 1), k, l, q, i)
575 end do
576 end do
577 end do
578 end if
579 end if
580 else if (bc_dir == 2) then !< y-direction
581 if (bc_loc == -1) then !< bc_y%beg
582 do j = 1, buff_size
583 do i = 1, eqn_idx%mom%beg
584 q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, j - 1, l)
585 end do
586
587 q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, -j, l) = -q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, j - 1, l)
588
589 do i = eqn_idx%mom%beg + 2, sys_size
590 q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, j - 1, l)
591 end do
592
593 if (chemistry .and. present(q_t_sf)) then
594 q_t_sf%sf(k, -j, l) = q_t_sf%sf(k, j - 1, l)
595 end if
596
597 if (elasticity) then
598 do i = 1, shear_bc_flip_num
599 q_prim_vf(shear_bc_flip_indices(2, i))%sf(k, -j, l) = -q_prim_vf(shear_bc_flip_indices(2, i))%sf(k, &
600 & j - 1, l)
601 end do
602 end if
603
604 if (hyperelasticity) then
605 q_prim_vf(eqn_idx%xi%beg + 1)%sf(k, -j, l) = -q_prim_vf(eqn_idx%xi%beg + 1)%sf(k, j - 1, l)
606 end if
607 end do
608
609 if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then
610 do i = 1, nb
611 do q = 1, nnode
612 do j = 1, buff_size
613 pb_in(k, -j, l, q, i) = pb_in(k, j - 1, l, q, i)
614 mv_in(k, -j, l, q, i) = mv_in(k, j - 1, l, q, i)
615 end do
616 end do
617 end do
618 end if
619 else !< bc_y%end
620 do j = 1, buff_size
621 do i = 1, eqn_idx%mom%beg
622 q_prim_vf(i)%sf(k, n + j, l) = q_prim_vf(i)%sf(k, n - (j - 1), l)
623 end do
624
625 q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, n + j, l) = -q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, n - (j - 1), l)
626
627 do i = eqn_idx%mom%beg + 2, sys_size
628 q_prim_vf(i)%sf(k, n + j, l) = q_prim_vf(i)%sf(k, n - (j - 1), l)
629 end do
630
631 if (chemistry .and. present(q_t_sf)) then
632 q_t_sf%sf(k, n + j, l) = q_t_sf%sf(k, n - (j - 1), l)
633 end if
634
635 if (elasticity) then
636 do i = 1, shear_bc_flip_num
637 q_prim_vf(shear_bc_flip_indices(2, i))%sf(k, n + j, l) = -q_prim_vf(shear_bc_flip_indices(2, &
638 & i))%sf(k, n - (j - 1), l)
639 end do
640 end if
641
642 if (hyperelasticity) then
643 q_prim_vf(eqn_idx%xi%beg + 1)%sf(k, n + j, l) = -q_prim_vf(eqn_idx%xi%beg + 1)%sf(k, n - (j - 1), l)
644 end if
645 end do
646
647 if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then
648 do i = 1, nb
649 do q = 1, nnode
650 do j = 1, buff_size
651 pb_in(k, n + j, l, q, i) = pb_in(k, n - (j - 1), l, q, i)
652 mv_in(k, n + j, l, q, i) = mv_in(k, n - (j - 1), l, q, i)
653 end do
654 end do
655 end do
656 end if
657 end if
658 else if (bc_dir == 3) then !< z-direction
659 if (bc_loc == -1) then !< bc_z%beg
660 do j = 1, buff_size
661 do i = 1, eqn_idx%mom%beg + 1
662 q_prim_vf(i)%sf(k, l, -j) = q_prim_vf(i)%sf(k, l, j - 1)
663 end do
664
665 q_prim_vf(eqn_idx%mom%end)%sf(k, l, -j) = -q_prim_vf(eqn_idx%mom%end)%sf(k, l, j - 1)
666
667 do i = eqn_idx%E, sys_size
668 q_prim_vf(i)%sf(k, l, -j) = q_prim_vf(i)%sf(k, l, j - 1)
669 end do
670
671 if (chemistry .and. present(q_t_sf)) then
672 q_t_sf%sf(k, l, -j) = q_t_sf%sf(k, l, j - 1)
673 end if
674
675 if (elasticity) then
676 do i = 1, shear_bc_flip_num
677 q_prim_vf(shear_bc_flip_indices(3, i))%sf(k, l, -j) = -q_prim_vf(shear_bc_flip_indices(3, i))%sf(k, &
678 & l, j - 1)
679 end do
680 end if
681
682 if (hyperelasticity) then
683 q_prim_vf(eqn_idx%xi%end)%sf(k, l, -j) = -q_prim_vf(eqn_idx%xi%end)%sf(k, l, j - 1)
684 end if
685 end do
686
687 if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then
688 do i = 1, nb
689 do q = 1, nnode
690 do j = 1, buff_size
691 pb_in(k, l, -j, q, i) = pb_in(k, l, j - 1, q, i)
692 mv_in(k, l, -j, q, i) = mv_in(k, l, j - 1, q, i)
693 end do
694 end do
695 end do
696 end if
697 else !< bc_z%end
698 do j = 1, buff_size
699 do i = 1, eqn_idx%mom%beg + 1
700 q_prim_vf(i)%sf(k, l, p + j) = q_prim_vf(i)%sf(k, l, p - (j - 1))
701 end do
702
703 q_prim_vf(eqn_idx%mom%end)%sf(k, l, p + j) = -q_prim_vf(eqn_idx%mom%end)%sf(k, l, p - (j - 1))
704
705 do i = eqn_idx%E, sys_size
706 q_prim_vf(i)%sf(k, l, p + j) = q_prim_vf(i)%sf(k, l, p - (j - 1))
707 end do
708
709 if (chemistry .and. present(q_t_sf)) then
710 q_t_sf%sf(k, l, p + j) = q_t_sf%sf(k, l, p - (j - 1))
711 end if
712
713 if (elasticity) then
714 do i = 1, shear_bc_flip_num
715 q_prim_vf(shear_bc_flip_indices(3, i))%sf(k, l, p + j) = -q_prim_vf(shear_bc_flip_indices(3, &
716 & i))%sf(k, l, p - (j - 1))
717 end do
718 end if
719
720 if (hyperelasticity) then
721 q_prim_vf(eqn_idx%xi%end)%sf(k, l, p + j) = -q_prim_vf(eqn_idx%xi%end)%sf(k, l, p - (j - 1))
722 end if
723 end do
724
725 if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then
726 do i = 1, nb
727 do q = 1, nnode
728 do j = 1, buff_size
729 pb_in(k, l, p + j, q, i) = pb_in(k, l, p - (j - 1), q, i)
730 mv_in(k, l, p + j, q, i) = mv_in(k, l, p - (j - 1), q, i)
731 end do
732 end do
733 end do
734 end if
735 end if
736 end if
737
738 end subroutine s_symmetry
739
740 !> Apply periodic boundary conditions by copying values from the opposite domain boundary.
741 subroutine s_periodic(q_prim_vf, bc_dir, bc_loc, k, l, pb_in, mv_in, q_T_sf)
742
743
744# 360 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
745#if MFC_OpenACC
746# 360 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
747!$acc routine seq
748# 360 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
749#elif MFC_OpenMP
750# 360 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
751
752# 360 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
753
754# 360 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
755!$omp declare target device_type(any)
756# 360 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
757#endif
758 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
759 real(stp), optional, dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_in, mv_in
760 integer, intent(in) :: bc_dir, bc_loc
761 integer, intent(in) :: k, l
762 integer :: j, q, i
763 type(scalar_field), optional, intent(inout) :: q_T_sf
764
765 if (bc_dir == 1) then !< x-direction
766 if (bc_loc == -1) then !< bc_x%beg
767 do i = 1, sys_size
768 do j = 1, buff_size
769 q_prim_vf(i)%sf(-j, k, l) = q_prim_vf(i)%sf(m - (j - 1), k, l)
770 end do
771 end do
772
773 if (chemistry .and. present(q_t_sf)) then
774 do j = 1, buff_size
775 q_t_sf%sf(-j, k, l) = q_t_sf%sf(m - (j - 1), k, l)
776 end do
777 end if
778
779 if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then
780 do i = 1, nb
781 do q = 1, nnode
782 do j = 1, buff_size
783 pb_in(-j, k, l, q, i) = pb_in(m - (j - 1), k, l, q, i)
784 mv_in(-j, k, l, q, i) = mv_in(m - (j - 1), k, l, q, i)
785 end do
786 end do
787 end do
788 end if
789 else !< bc_x%end
790 do i = 1, sys_size
791 do j = 1, buff_size
792 q_prim_vf(i)%sf(m + j, k, l) = q_prim_vf(i)%sf(j - 1, k, l)
793 end do
794 end do
795
796 if (chemistry .and. present(q_t_sf)) then
797 do j = 1, buff_size
798 q_t_sf%sf(m + j, k, l) = q_t_sf%sf(j - 1, k, l)
799 end do
800 end if
801
802 if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then
803 do i = 1, nb
804 do q = 1, nnode
805 do j = 1, buff_size
806 pb_in(m + j, k, l, q, i) = pb_in(j - 1, k, l, q, i)
807 mv_in(m + j, k, l, q, i) = mv_in(j - 1, k, l, q, i)
808 end do
809 end do
810 end do
811 end if
812 end if
813 else if (bc_dir == 2) then !< y-direction
814 if (bc_loc == -1) then !< bc_y%beg
815 do i = 1, sys_size
816 do j = 1, buff_size
817 q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, n - (j - 1), l)
818 end do
819 end do
820
821 if (chemistry .and. present(q_t_sf)) then
822 do j = 1, buff_size
823 q_t_sf%sf(k, -j, l) = q_t_sf%sf(k, n - (j - 1), l)
824 end do
825 end if
826
827 if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then
828 do i = 1, nb
829 do q = 1, nnode
830 do j = 1, buff_size
831 pb_in(k, -j, l, q, i) = pb_in(k, n - (j - 1), l, q, i)
832 mv_in(k, -j, l, q, i) = mv_in(k, n - (j - 1), l, q, i)
833 end do
834 end do
835 end do
836 end if
837 else !< bc_y%end
838 do i = 1, sys_size
839 do j = 1, buff_size
840 q_prim_vf(i)%sf(k, n + j, l) = q_prim_vf(i)%sf(k, j - 1, l)
841 end do
842 end do
843
844 if (chemistry .and. present(q_t_sf)) then
845 do j = 1, buff_size
846 q_t_sf%sf(k, n + j, l) = q_t_sf%sf(k, j - 1, l)
847 end do
848 end if
849
850 if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then
851 do i = 1, nb
852 do q = 1, nnode
853 do j = 1, buff_size
854 pb_in(k, n + j, l, q, i) = pb_in(k, (j - 1), l, q, i)
855 mv_in(k, n + j, l, q, i) = mv_in(k, (j - 1), l, q, i)
856 end do
857 end do
858 end do
859 end if
860 end if
861 else if (bc_dir == 3) then !< z-direction
862 if (bc_loc == -1) then !< bc_z%beg
863 do i = 1, sys_size
864 do j = 1, buff_size
865 q_prim_vf(i)%sf(k, l, -j) = q_prim_vf(i)%sf(k, l, p - (j - 1))
866 end do
867 end do
868
869 if (chemistry .and. present(q_t_sf)) then
870 do j = 1, buff_size
871 q_t_sf%sf(k, l, -j) = q_t_sf%sf(k, l, p - (j - 1))
872 end do
873 end if
874
875 if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then
876 do i = 1, nb
877 do q = 1, nnode
878 do j = 1, buff_size
879 pb_in(k, l, -j, q, i) = pb_in(k, l, p - (j - 1), q, i)
880 mv_in(k, l, -j, q, i) = mv_in(k, l, p - (j - 1), q, i)
881 end do
882 end do
883 end do
884 end if
885 else !< bc_z%end
886 do i = 1, sys_size
887 do j = 1, buff_size
888 q_prim_vf(i)%sf(k, l, p + j) = q_prim_vf(i)%sf(k, l, j - 1)
889 end do
890 end do
891
892 if (chemistry .and. present(q_t_sf)) then
893 do j = 1, buff_size
894 q_t_sf%sf(k, l, p + j) = q_t_sf%sf(k, l, j - 1)
895 end do
896 end if
897
898 if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then
899 do i = 1, nb
900 do q = 1, nnode
901 do j = 1, buff_size
902 pb_in(k, l, p + j, q, i) = pb_in(k, l, j - 1, q, i)
903 mv_in(k, l, p + j, q, i) = mv_in(k, l, j - 1, q, i)
904 end do
905 end do
906 end do
907 end if
908 end if
909 end if
910
911 end subroutine s_periodic
912
913 !> Apply axis boundary conditions for cylindrical coordinates by reflecting values across the axis with azimuthal phase shift.
914 subroutine s_axis(q_prim_vf, pb_in, mv_in, k, l)
915
916
917# 519 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
918#if MFC_OpenACC
919# 519 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
920!$acc routine seq
921# 519 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
922#elif MFC_OpenMP
923# 519 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
924
925# 519 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
926
927# 519 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
928!$omp declare target device_type(any)
929# 519 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
930#endif
931 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
932 real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), optional, intent(inout) :: pb_in, mv_in
933 integer, intent(in) :: k, l
934 integer :: j, q, i
935
936 do j = 1, buff_size
937 if (z_cc(l) < pi) then
938 do i = 1, eqn_idx%mom%beg
939 q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, j - 1, l + ((p + 1)/2))
940 end do
941
942 q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, -j, l) = -q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, j - 1, l + ((p + 1)/2))
943
944 q_prim_vf(eqn_idx%mom%end)%sf(k, -j, l) = -q_prim_vf(eqn_idx%mom%end)%sf(k, j - 1, l + ((p + 1)/2))
945
946 do i = eqn_idx%E, sys_size
947 q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, j - 1, l + ((p + 1)/2))
948 end do
949 else
950 do i = 1, eqn_idx%mom%beg
951 q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, j - 1, l - ((p + 1)/2))
952 end do
953
954 q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, -j, l) = -q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, j - 1, l - ((p + 1)/2))
955
956 q_prim_vf(eqn_idx%mom%end)%sf(k, -j, l) = -q_prim_vf(eqn_idx%mom%end)%sf(k, j - 1, l - ((p + 1)/2))
957
958 do i = eqn_idx%E, sys_size
959 q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, j - 1, l - ((p + 1)/2))
960 end do
961 end if
962 end do
963
964 if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then
965 do i = 1, nb
966 do q = 1, nnode
967 do j = 1, buff_size
968 if (z_cc(l) < pi) then
969 pb_in(k, -j, l, q, i) = pb_in(k, j - 1, l + ((p + 1)/2), q, i)
970 mv_in(k, -j, l, q, i) = mv_in(k, j - 1, l + ((p + 1)/2), q, i)
971 else
972 pb_in(k, -j, l, q, i) = pb_in(k, j - 1, l - ((p + 1)/2), q, i)
973 mv_in(k, -j, l, q, i) = mv_in(k, j - 1, l - ((p + 1)/2), q, i)
974 end if
975 end do
976 end do
977 end do
978 end if
979
980 end subroutine s_axis
981
982 !> Apply slip wall boundary conditions by extrapolating scalars and reflecting the wall-normal velocity component.
983 subroutine s_slip_wall(q_prim_vf, bc_dir, bc_loc, k, l, q_T_sf)
984
985
986# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
987#ifdef _CRAYFTN
988# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
989#if MFC_OpenACC
990# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
991!$acc routine seq
992# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
993#elif MFC_OpenMP
994# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
995
996# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
997
998# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
999!$omp declare target device_type(any)
1000# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1001#else
1002# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1003!DIR$ INLINEALWAYS s_slip_wall
1004# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1005#endif
1006# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1007#elif MFC_OpenACC
1008# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1009!$acc routine seq
1010# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1011#elif MFC_OpenMP
1012# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1013
1014# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1015
1016# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1017!$omp declare target device_type(any)
1018# 574 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1019#endif
1020 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
1021 integer, intent(in) :: bc_dir, bc_loc
1022 integer, intent(in) :: k, l
1023 integer :: j, i
1024 type(scalar_field), optional, intent(inout) :: q_T_sf
1025
1026 if (bc_dir == 1) then !< x-direction
1027 if (bc_loc == -1) then !< bc_x%beg
1028 do i = 1, sys_size
1029 do j = 1, buff_size
1030 if (i == eqn_idx%mom%beg) then
1031 q_prim_vf(i)%sf(-j, k, l) = -q_prim_vf(i)%sf(j - 1, k, l) + 2._wp*bc_x%vb1
1032 else
1033 q_prim_vf(i)%sf(-j, k, l) = q_prim_vf(i)%sf(0, k, l)
1034 end if
1035 end do
1036 end do
1037
1038 if (chemistry .and. present(q_t_sf)) then
1039 if (bc_x%isothermal_in) then
1040 do j = 1, buff_size
1041 q_t_sf%sf(-j, k, l) = 2._wp*bc_x%Twall_in - q_t_sf%sf(j - 1, k, l)
1042 end do
1043 else
1044 do j = 1, buff_size
1045 q_t_sf%sf(-j, k, l) = q_t_sf%sf(0, k, l)
1046 end do
1047 end if
1048 end if
1049 else !< bc_x%end
1050 do i = 1, sys_size
1051 do j = 1, buff_size
1052 if (i == eqn_idx%mom%beg) then
1053 q_prim_vf(i)%sf(m + j, k, l) = -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2._wp*bc_x%ve1
1054 else
1055 q_prim_vf(i)%sf(m + j, k, l) = q_prim_vf(i)%sf(m, k, l)
1056 end if
1057 end do
1058 end do
1059
1060 if (chemistry .and. present(q_t_sf)) then
1061 if (bc_x%isothermal_out) then
1062 do j = 1, buff_size
1063 q_t_sf%sf(m + j, k, l) = 2._wp*bc_x%Twall_out - q_t_sf%sf(m - (j - 1), k, l)
1064 end do
1065 else
1066 do j = 1, buff_size
1067 q_t_sf%sf(m + j, k, l) = q_t_sf%sf(m, k, l)
1068 end do
1069 end if
1070 end if
1071 end if
1072 else if (bc_dir == 2) then !< y-direction
1073 if (bc_loc == -1) then !< bc_y%beg
1074 do i = 1, sys_size
1075 do j = 1, buff_size
1076 if (i == eqn_idx%mom%beg + 1) then
1077 q_prim_vf(i)%sf(k, -j, l) = -q_prim_vf(i)%sf(k, j - 1, l) + 2._wp*bc_y%vb2
1078 else
1079 q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, 0, l)
1080 end if
1081 end do
1082 end do
1083
1084 if (chemistry .and. present(q_t_sf)) then
1085 if (bc_y%isothermal_in) then
1086 do j = 1, buff_size
1087 q_t_sf%sf(k, -j, l) = 2._wp*bc_y%Twall_in - q_t_sf%sf(k, j - 1, l)
1088 end do
1089 else
1090 do j = 1, buff_size
1091 q_t_sf%sf(k, -j, l) = q_t_sf%sf(k, 0, l)
1092 end do
1093 end if
1094 end if
1095 else !< bc_y%end
1096 do i = 1, sys_size
1097 do j = 1, buff_size
1098 if (i == eqn_idx%mom%beg + 1) then
1099 q_prim_vf(i)%sf(k, n + j, l) = -q_prim_vf(i)%sf(k, n - (j - 1), l) + 2._wp*bc_y%ve2
1100 else
1101 q_prim_vf(i)%sf(k, n + j, l) = q_prim_vf(i)%sf(k, n, l)
1102 end if
1103 end do
1104 end do
1105
1106 if (chemistry .and. present(q_t_sf)) then
1107 if (bc_y%isothermal_out) then
1108 do j = 1, buff_size
1109 q_t_sf%sf(k, n + j, l) = 2._wp*bc_y%Twall_out - q_t_sf%sf(k, n - (j - 1), l)
1110 end do
1111 else
1112 do j = 1, buff_size
1113 q_t_sf%sf(k, n + j, l) = q_t_sf%sf(k, n, l)
1114 end do
1115 end if
1116 end if
1117 end if
1118 else if (bc_dir == 3) then !< z-direction
1119 if (bc_loc == -1) then !< bc_z%beg
1120 do i = 1, sys_size
1121 do j = 1, buff_size
1122 if (i == eqn_idx%mom%end) then
1123 q_prim_vf(i)%sf(k, l, -j) = -q_prim_vf(i)%sf(k, l, j - 1) + 2._wp*bc_z%vb3
1124 else
1125 q_prim_vf(i)%sf(k, l, -j) = q_prim_vf(i)%sf(k, l, 0)
1126 end if
1127 end do
1128 end do
1129
1130 if (chemistry .and. present(q_t_sf)) then
1131 if (bc_z%isothermal_in) then
1132 do j = 1, buff_size
1133 q_t_sf%sf(k, l, -j) = 2._wp*bc_z%Twall_in - q_t_sf%sf(k, l, j - 1)
1134 end do
1135 else
1136 do j = 1, buff_size
1137 q_t_sf%sf(k, l, -j) = q_t_sf%sf(k, l, 0)
1138 end do
1139 end if
1140 end if
1141 else !< bc_z%end
1142 do i = 1, sys_size
1143 do j = 1, buff_size
1144 if (i == eqn_idx%mom%end) then
1145 q_prim_vf(i)%sf(k, l, p + j) = -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2._wp*bc_z%ve3
1146 else
1147 q_prim_vf(i)%sf(k, l, p + j) = q_prim_vf(i)%sf(k, l, p)
1148 end if
1149 end do
1150 end do
1151
1152 if (chemistry .and. present(q_t_sf)) then
1153 if (bc_z%isothermal_out) then
1154 do j = 1, buff_size
1155 q_t_sf%sf(k, l, p + j) = 2._wp*bc_z%Twall_out - q_t_sf%sf(k, l, p - (j - 1))
1156 end do
1157 else
1158 do j = 1, buff_size
1159 q_t_sf%sf(k, l, p + j) = q_t_sf%sf(k, l, p)
1160 end do
1161 end if
1162 end if
1163 end if
1164 end if
1165
1166 end subroutine s_slip_wall
1167
1168 !> Apply no-slip wall boundary conditions by reflecting and negating all velocity components at the wall.
1169 subroutine s_no_slip_wall(q_prim_vf, bc_dir, bc_loc, k, l, q_T_sf)
1170
1171
1172# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1173#ifdef _CRAYFTN
1174# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1175#if MFC_OpenACC
1176# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1177!$acc routine seq
1178# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1179#elif MFC_OpenMP
1180# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1181
1182# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1183
1184# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1185!$omp declare target device_type(any)
1186# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1187#else
1188# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1189!DIR$ INLINEALWAYS s_no_slip_wall
1190# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1191#endif
1192# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1193#elif MFC_OpenACC
1194# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1195!$acc routine seq
1196# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1197#elif MFC_OpenMP
1198# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1199
1200# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1201
1202# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1203!$omp declare target device_type(any)
1204# 726 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1205#endif
1206
1207 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
1208 integer, intent(in) :: bc_dir, bc_loc
1209 integer, intent(in) :: k, l
1210 integer :: j, i
1211 type(scalar_field), optional, intent(inout) :: q_T_sf
1212
1213 if (bc_dir == 1) then !< x-direction
1214 if (bc_loc == -1) then !< bc_x%beg
1215 do i = 1, sys_size
1216 do j = 1, buff_size
1217 if (i == eqn_idx%mom%beg) then
1218 q_prim_vf(i)%sf(-j, k, l) = -q_prim_vf(i)%sf(j - 1, k, l) + 2._wp*bc_x%vb1
1219 else if (i == eqn_idx%mom%beg + 1 .and. num_dims > 1) then
1220 q_prim_vf(i)%sf(-j, k, l) = -q_prim_vf(i)%sf(j - 1, k, l) + 2._wp*bc_x%vb2
1221 else if (i == eqn_idx%mom%beg + 2 .and. num_dims > 2) then
1222 q_prim_vf(i)%sf(-j, k, l) = -q_prim_vf(i)%sf(j - 1, k, l) + 2._wp*bc_x%vb3
1223 else
1224 q_prim_vf(i)%sf(-j, k, l) = q_prim_vf(i)%sf(0, k, l)
1225 end if
1226 end do
1227 end do
1228
1229 if (chemistry .and. present(q_t_sf)) then
1230 if (bc_x%isothermal_in) then
1231 do j = 1, buff_size
1232 q_t_sf%sf(-j, k, l) = 2._wp*bc_x%Twall_in - q_t_sf%sf(j - 1, k, l)
1233 end do
1234 else
1235 do j = 1, buff_size
1236 q_t_sf%sf(-j, k, l) = q_t_sf%sf(0, k, l)
1237 end do
1238 end if
1239 end if
1240 else !< bc_x%end
1241 do i = 1, sys_size
1242 do j = 1, buff_size
1243 if (i == eqn_idx%mom%beg) then
1244 q_prim_vf(i)%sf(m + j, k, l) = -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2._wp*bc_x%ve1
1245 else if (i == eqn_idx%mom%beg + 1 .and. num_dims > 1) then
1246 q_prim_vf(i)%sf(m + j, k, l) = -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2._wp*bc_x%ve2
1247 else if (i == eqn_idx%mom%beg + 2 .and. num_dims > 2) then
1248 q_prim_vf(i)%sf(m + j, k, l) = -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2._wp*bc_x%ve3
1249 else
1250 q_prim_vf(i)%sf(m + j, k, l) = q_prim_vf(i)%sf(m, k, l)
1251 end if
1252 end do
1253 end do
1254
1255 if (chemistry .and. present(q_t_sf)) then
1256 if (bc_x%isothermal_out) then
1257 do j = 1, buff_size
1258 q_t_sf%sf(m + j, k, l) = 2._wp*bc_x%Twall_out - q_t_sf%sf(m - (j - 1), k, l)
1259 end do
1260 else
1261 do j = 1, buff_size
1262 q_t_sf%sf(m + j, k, l) = q_t_sf%sf(m, k, l)
1263 end do
1264 end if
1265 end if
1266 end if
1267 else if (bc_dir == 2) then !< y-direction
1268 if (bc_loc == -1) then !< bc_y%beg
1269 do i = 1, sys_size
1270 do j = 1, buff_size
1271 if (i == eqn_idx%mom%beg) then
1272 q_prim_vf(i)%sf(k, -j, l) = -q_prim_vf(i)%sf(k, j - 1, l) + 2._wp*bc_y%vb1
1273 else if (i == eqn_idx%mom%beg + 1 .and. num_dims > 1) then
1274 q_prim_vf(i)%sf(k, -j, l) = -q_prim_vf(i)%sf(k, j - 1, l) + 2._wp*bc_y%vb2
1275 else if (i == eqn_idx%mom%beg + 2 .and. num_dims > 2) then
1276 q_prim_vf(i)%sf(k, -j, l) = -q_prim_vf(i)%sf(k, j - 1, l) + 2._wp*bc_y%vb3
1277 else
1278 q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, 0, l)
1279 end if
1280 end do
1281 end do
1282 if (chemistry .and. present(q_t_sf)) then
1283 if (bc_y%isothermal_in) then
1284 do j = 1, buff_size
1285 q_t_sf%sf(k, -j, l) = 2._wp*bc_y%Twall_in - q_t_sf%sf(k, j - 1, l)
1286 end do
1287 else
1288 do j = 1, buff_size
1289 q_t_sf%sf(k, -j, l) = q_t_sf%sf(k, 0, l)
1290 end do
1291 end if
1292 end if
1293 else !< bc_y%end
1294 do i = 1, sys_size
1295 do j = 1, buff_size
1296 if (i == eqn_idx%mom%beg) then
1297 q_prim_vf(i)%sf(k, n + j, l) = -q_prim_vf(i)%sf(k, n - (j - 1), l) + 2._wp*bc_y%ve1
1298 else if (i == eqn_idx%mom%beg + 1 .and. num_dims > 1) then
1299 q_prim_vf(i)%sf(k, n + j, l) = -q_prim_vf(i)%sf(k, n - (j - 1), l) + 2._wp*bc_y%ve2
1300 else if (i == eqn_idx%mom%beg + 2 .and. num_dims > 2) then
1301 q_prim_vf(i)%sf(k, n + j, l) = -q_prim_vf(i)%sf(k, n - (j - 1), l) + 2._wp*bc_y%ve3
1302 else
1303 q_prim_vf(i)%sf(k, n + j, l) = q_prim_vf(i)%sf(k, n, l)
1304 end if
1305 end do
1306 end do
1307 if (chemistry .and. present(q_t_sf)) then
1308 if (bc_y%isothermal_out) then
1309 do j = 1, buff_size
1310 q_t_sf%sf(k, n + j, l) = 2._wp*bc_y%Twall_out - q_t_sf%sf(k, n - (j - 1), l)
1311 end do
1312 else
1313 do j = 1, buff_size
1314 q_t_sf%sf(k, n + j, l) = q_t_sf%sf(k, n, l)
1315 end do
1316 end if
1317 end if
1318 end if
1319 else if (bc_dir == 3) then !< z-direction
1320 if (bc_loc == -1) then !< bc_z%beg
1321 do i = 1, sys_size
1322 do j = 1, buff_size
1323 if (i == eqn_idx%mom%beg) then
1324 q_prim_vf(i)%sf(k, l, -j) = -q_prim_vf(i)%sf(k, l, j - 1) + 2._wp*bc_z%vb1
1325 else if (i == eqn_idx%mom%beg + 1 .and. num_dims > 1) then
1326 q_prim_vf(i)%sf(k, l, -j) = -q_prim_vf(i)%sf(k, l, j - 1) + 2._wp*bc_z%vb2
1327 else if (i == eqn_idx%mom%beg + 2 .and. num_dims > 2) then
1328 q_prim_vf(i)%sf(k, l, -j) = -q_prim_vf(i)%sf(k, l, j - 1) + 2._wp*bc_z%vb3
1329 else
1330 q_prim_vf(i)%sf(k, l, -j) = q_prim_vf(i)%sf(k, l, 0)
1331 end if
1332 end do
1333 end do
1334 if (chemistry .and. present(q_t_sf)) then
1335 if (bc_z%isothermal_in) then
1336 do j = 1, buff_size
1337 q_t_sf%sf(k, l, -j) = 2._wp*bc_z%Twall_in - q_t_sf%sf(k, l, j - 1)
1338 end do
1339 else
1340 do j = 1, buff_size
1341 q_t_sf%sf(k, l, -j) = q_t_sf%sf(k, l, 0)
1342 end do
1343 end if
1344 end if
1345 else !< bc_z%end
1346 do i = 1, sys_size
1347 do j = 1, buff_size
1348 if (i == eqn_idx%mom%beg) then
1349 q_prim_vf(i)%sf(k, l, p + j) = -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2._wp*bc_z%ve1
1350 else if (i == eqn_idx%mom%beg + 1 .and. num_dims > 1) then
1351 q_prim_vf(i)%sf(k, l, p + j) = -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2._wp*bc_z%ve2
1352 else if (i == eqn_idx%mom%beg + 2 .and. num_dims > 2) then
1353 q_prim_vf(i)%sf(k, l, p + j) = -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2._wp*bc_z%ve3
1354 else
1355 q_prim_vf(i)%sf(k, l, p + j) = q_prim_vf(i)%sf(k, l, p)
1356 end if
1357 end do
1358 end do
1359 if (chemistry .and. present(q_t_sf)) then
1360 if (bc_z%isothermal_out) then
1361 do j = 1, buff_size
1362 q_t_sf%sf(k, l, p + j) = 2._wp*bc_z%Twall_out - q_t_sf%sf(k, l, p - (j - 1))
1363 end do
1364 else
1365 do j = 1, buff_size
1366 q_t_sf%sf(k, l, p + j) = q_t_sf%sf(k, l, p)
1367 end do
1368 end if
1369 end if
1370 end if
1371 end if
1372
1373 end subroutine s_no_slip_wall
1374
1375 !> Apply Dirichlet boundary conditions by prescribing ghost cell values from stored boundary buffers.
1376 subroutine s_dirichlet(q_prim_vf, bc_dir, bc_loc, k, l, q_T_sf)
1377
1378
1379# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1380#ifdef _CRAYFTN
1381# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1382#if MFC_OpenACC
1383# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1384!$acc routine seq
1385# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1386#elif MFC_OpenMP
1387# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1388
1389# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1390
1391# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1392!$omp declare target device_type(any)
1393# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1394#else
1395# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1396!DIR$ INLINEALWAYS s_dirichlet
1397# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1398#endif
1399# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1400#elif MFC_OpenACC
1401# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1402!$acc routine seq
1403# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1404#elif MFC_OpenMP
1405# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1406
1407# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1408
1409# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1410!$omp declare target device_type(any)
1411# 899 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1412#endif
1413 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
1414 integer, intent(in) :: bc_dir, bc_loc
1415 integer, intent(in) :: k, l
1416 integer :: j, i
1417 type(scalar_field), optional, intent(inout) :: q_T_sf
1418
1419#ifdef MFC_SIMULATION
1420 if (bc_dir == 1) then !< x-direction
1421 if (bc_loc == -1) then ! bc_x%beg
1422 do i = 1, sys_size
1423 do j = 1, buff_size
1424 q_prim_vf(i)%sf(-j, k, l) = bc_buffers(1, 1)%sf(i, k, l)
1425 end do
1426 end do
1427 if (chemistry .and. present(q_t_sf)) then
1428 do j = 1, buff_size
1429 q_t_sf%sf(-j, k, l) = bc_buffers(1, 1)%sf(sys_size + 1, k, l)
1430 end do
1431 end if
1432 else !< bc_x%end
1433 do i = 1, sys_size
1434 do j = 1, buff_size
1435 q_prim_vf(i)%sf(m + j, k, l) = bc_buffers(1, 2)%sf(i, k, l)
1436 end do
1437 end do
1438 if (chemistry .and. present(q_t_sf)) then
1439 do j = 1, buff_size
1440 q_t_sf%sf(m + j, k, l) = bc_buffers(1, 2)%sf(sys_size + 1, k, l)
1441 end do
1442 end if
1443 end if
1444 else if (bc_dir == 2) then !< y-direction
1445# 933 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1446 if (bc_loc == -1) then !< bc_y%beg
1447 do i = 1, sys_size
1448 do j = 1, buff_size
1449 q_prim_vf(i)%sf(k, -j, l) = bc_buffers(2, 1)%sf(k, i, l)
1450 end do
1451 end do
1452 if (chemistry .and. present(q_t_sf)) then
1453 do j = 1, buff_size
1454 q_t_sf%sf(k, -j, l) = bc_buffers(2, 1)%sf(k, sys_size + 1, l)
1455 end do
1456 end if
1457 else !< bc_y%end
1458 do i = 1, sys_size
1459 do j = 1, buff_size
1460 q_prim_vf(i)%sf(k, n + j, l) = bc_buffers(2, 2)%sf(k, i, l)
1461 end do
1462 end do
1463 if (chemistry .and. present(q_t_sf)) then
1464 do j = 1, buff_size
1465 q_t_sf%sf(k, n + j, l) = bc_buffers(2, 2)%sf(k, sys_size + 1, l)
1466 end do
1467 end if
1468 end if
1469# 957 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1470 else if (bc_dir == 3) then !< z-direction
1471# 959 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1472 if (bc_loc == -1) then !< bc_z%beg
1473 do i = 1, sys_size
1474 do j = 1, buff_size
1475 q_prim_vf(i)%sf(k, l, -j) = bc_buffers(3, 1)%sf(k, l, i)
1476 end do
1477 end do
1478 if (chemistry .and. present(q_t_sf)) then
1479 do j = 1, buff_size
1480 q_t_sf%sf(k, l, -j) = bc_buffers(3, 1)%sf(k, l, sys_size + 1)
1481 end do
1482 end if
1483 else !< bc_z%end
1484 do i = 1, sys_size
1485 do j = 1, buff_size
1486 q_prim_vf(i)%sf(k, l, p + j) = bc_buffers(3, 2)%sf(k, l, i)
1487 end do
1488 end do
1489 if (chemistry .and. present(q_t_sf)) then
1490 do j = 1, buff_size
1491 q_t_sf%sf(k, l, p + j) = bc_buffers(3, 2)%sf(k, l, sys_size + 1)
1492 end do
1493 end if
1494 end if
1495# 983 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1496 end if
1497#else
1498 call s_ghost_cell_extrapolation(q_prim_vf, bc_dir, bc_loc, k, l, q_t_sf)
1499#endif
1500
1501 end subroutine s_dirichlet
1502
1503 !> Extrapolate QBMM bubble pressure and mass-vapor variables into ghost cells by copying boundary values.
1504 subroutine s_qbmm_extrapolation(bc_dir, bc_loc, k, l, pb_in, mv_in)
1505
1506
1507# 993 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1508#if MFC_OpenACC
1509# 993 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1510!$acc routine seq
1511# 993 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1512#elif MFC_OpenMP
1513# 993 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1514
1515# 993 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1516
1517# 993 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1518!$omp declare target device_type(any)
1519# 993 "/home/runner/work/MFC/MFC/src/common/m_boundary_primitives.fpp"
1520#endif
1521 real(stp), optional, dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_in, mv_in
1522 integer, intent(in) :: bc_dir, bc_loc
1523 integer, intent(in) :: k, l
1524 integer :: j, q, i
1525
1526 if (bc_dir == 1) then !< x-direction
1527 if (bc_loc == -1) then ! bc_x%beg
1528 do i = 1, nb
1529 do q = 1, nnode
1530 do j = 1, buff_size
1531 pb_in(-j, k, l, q, i) = pb_in(0, k, l, q, i)
1532 mv_in(-j, k, l, q, i) = mv_in(0, k, l, q, i)
1533 end do
1534 end do
1535 end do
1536 else !< bc_x%end
1537 do i = 1, nb
1538 do q = 1, nnode
1539 do j = 1, buff_size
1540 pb_in(m + j, k, l, q, i) = pb_in(m, k, l, q, i)
1541 mv_in(m + j, k, l, q, i) = mv_in(m, k, l, q, i)
1542 end do
1543 end do
1544 end do
1545 end if
1546 else if (bc_dir == 2) then !< y-direction
1547 if (bc_loc == -1) then !< bc_y%beg
1548 do i = 1, nb
1549 do q = 1, nnode
1550 do j = 1, buff_size
1551 pb_in(k, -j, l, q, i) = pb_in(k, 0, l, q, i)
1552 mv_in(k, -j, l, q, i) = mv_in(k, 0, l, q, i)
1553 end do
1554 end do
1555 end do
1556 else !< bc_y%end
1557 do i = 1, nb
1558 do q = 1, nnode
1559 do j = 1, buff_size
1560 pb_in(k, n + j, l, q, i) = pb_in(k, n, l, q, i)
1561 mv_in(k, n + j, l, q, i) = mv_in(k, n, l, q, i)
1562 end do
1563 end do
1564 end do
1565 end if
1566 else if (bc_dir == 3) then !< z-direction
1567 if (bc_loc == -1) then !< bc_z%beg
1568 do i = 1, nb
1569 do q = 1, nnode
1570 do j = 1, buff_size
1571 pb_in(k, l, -j, q, i) = pb_in(k, l, 0, q, i)
1572 mv_in(k, l, -j, q, i) = mv_in(k, l, 0, q, i)
1573 end do
1574 end do
1575 end do
1576 else !< bc_z%end
1577 do i = 1, nb
1578 do q = 1, nnode
1579 do j = 1, buff_size
1580 pb_in(k, l, p + j, q, i) = pb_in(k, l, p, q, i)
1581 mv_in(k, l, p + j, q, i) = mv_in(k, l, p, q, i)
1582 end do
1583 end do
1584 end do
1585 end if
1586 end if
1587
1588 end subroutine s_qbmm_extrapolation
1589
1590end module m_boundary_primitives
m_boundary_primitives
Per-cell noncharacteristic boundary condition primitives applied in the ghost cells.
Definition m_boundary_primitives.fpp.f90:334
m_boundary_primitives::s_slip_wall
subroutine s_slip_wall(q_prim_vf, bc_dir, bc_loc, k, l, q_t_sf)
Apply slip wall boundary conditions by extrapolating scalars and reflecting the wall-normal velocity ...
Definition m_boundary_primitives.fpp.f90:984
m_boundary_primitives::bc_buffers
type(scalar_field), dimension(:,:), allocatable bc_buffers
Definition m_boundary_primitives.fpp.f90:342
m_boundary_primitives::s_no_slip_wall
subroutine s_no_slip_wall(q_prim_vf, bc_dir, bc_loc, k, l, q_t_sf)
Apply no-slip wall boundary conditions by reflecting and negating all velocity components at the wall...
Definition m_boundary_primitives.fpp.f90:1170
m_boundary_primitives::s_axis
subroutine s_axis(q_prim_vf, pb_in, mv_in, k, l)
Apply axis boundary conditions for cylindrical coordinates by reflecting values across the axis with ...
Definition m_boundary_primitives.fpp.f90:915
m_boundary_primitives::s_qbmm_extrapolation
subroutine s_qbmm_extrapolation(bc_dir, bc_loc, k, l, pb_in, mv_in)
Extrapolate QBMM bubble pressure and mass-vapor variables into ghost cells by copying boundary values...
Definition m_boundary_primitives.fpp.f90:1505
m_boundary_primitives::s_periodic
subroutine s_periodic(q_prim_vf, bc_dir, bc_loc, k, l, pb_in, mv_in, q_t_sf)
Apply periodic boundary conditions by copying values from the opposite domain boundary.
Definition m_boundary_primitives.fpp.f90:742
m_boundary_primitives::s_ghost_cell_extrapolation
subroutine s_ghost_cell_extrapolation(q_prim_vf, bc_dir, bc_loc, k, l, q_t_sf)
Fill ghost cells by copying the nearest boundary cell value along the specified direction.
Definition m_boundary_primitives.fpp.f90:359
m_boundary_primitives::s_symmetry
subroutine s_symmetry(q_prim_vf, bc_dir, bc_loc, k, l, pb_in, mv_in, q_t_sf)
Apply reflective (symmetry) boundary conditions by mirroring primitive variables and flipping the nor...
Definition m_boundary_primitives.fpp.f90:480
m_boundary_primitives::s_dirichlet
subroutine s_dirichlet(q_prim_vf, bc_dir, bc_loc, k, l, q_t_sf)
Apply Dirichlet boundary conditions by prescribing ghost cell values from stored boundary buffers.
Definition m_boundary_primitives.fpp.f90:1377
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::nnode
integer, parameter nnode
Number of QBMM nodes.
Definition m_constants.fpp.f90:40
m_constants::pi
real(wp), parameter pi
Pi.
Definition m_constants.fpp.f90:16
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:323
m_global_parameters
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
Definition m_global_parameters.fpp.f90:19
m_global_parameters::bc_z
type(int_bounds_info) bc_z
Boundary conditions in the x-, y- and z-coordinate directions.
Definition m_global_parameters.fpp.f90:63
m_global_parameters::buff_size
integer buff_size
Number of ghost cells for boundary condition storage.
Definition m_global_parameters.fpp.f90:103
m_global_parameters::bc_y
type(int_bounds_info) bc_y
Definition m_global_parameters.fpp.f90:63
m_global_parameters::bc_x
type(int_bounds_info) bc_x
Definition m_global_parameters.fpp.f90:63
m_global_parameters::z_cc
real(wp), dimension(:), allocatable z_cc
Definition m_global_parameters.fpp.f90:47
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:337