MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_boundary_io.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
2!>
3!! @file
4!! @brief Contains module m_boundary_io
5
6!> @brief Boundary condition restart I/O, capillary/IGR buffer population, and grid-variable buffers
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_io.fpp" 2
18# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
19# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
20# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
21# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
23# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
25# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26
27# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30
31# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32
33# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
34
35# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
36
37# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38
39# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40
41# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42
43# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44! New line at end of file is required for FYPP
45# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
46# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
47# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
48# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63
64# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67
68# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71! New line at end of file is required for FYPP
72# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
73
74# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
76# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
78# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150! New line at end of file is required for FYPP
151# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
152# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
153# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
154# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
156# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159
160# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165
166# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171
172# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175
176# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177! New line at end of file is required for FYPP
178# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
179
180# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
181
182# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233
234# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
235! New line at end of file is required for FYPP
236# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
237
238! GPU parallel region (scalar reductions, maxval/minval)
239# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
240
241! GPU parallel loop over threads (most common GPU macro)
242# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
243
244! Required closing for GPU_PARALLEL_LOOP
245# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247! Mark routine for device compilation
248# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250! Declare device-resident data
251# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253! Inner loop within a GPU parallel region
254# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256! Scoped GPU data region
257# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259! Host code with device pointers (for MPI with GPU buffers)
260# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262! Allocate device memory (unscoped)
263# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265! Free device memory
266# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! Atomic operation on device
269# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! End atomic capture block
272# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Copy data between host and device
275# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Synchronization barrier
278# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Import GPU library module (openacc or omp_lib)
281# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Emit code only for AMD compiler
284# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Emit code for non-Cray compilers
287# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Emit code only for Cray compiler
290# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Emit code for non-NVIDIA compilers
293# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
296# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297! New line at end of file is required for FYPP
298# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
299
300# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
301
302! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
303! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
304! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
305# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
306
307! Allocate and create GPU device memory
308# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
309
310! Free GPU device memory and deallocate
311# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
312
313! Cray-specific GPU pointer setup for vector fields
314# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
315
316! Cray-specific GPU pointer setup for scalar fields
317# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
318
319! Cray-specific GPU pointer setup for acoustic source spatials
320# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
321
322# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
323
324# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
325! New line at end of file is required for FYPP
326# 8 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp" 2
327
329
332 use m_mpi_proxy
333 use m_constants
337
338 implicit none
339
340#ifdef MFC_MPI
341 integer, dimension(1:3,1:2) :: mpi_bc_type_type
342 integer, dimension(1:3,1:2) :: mpi_bc_buffer_type
343#endif
344
345contains
346
347 !> Populate ghost cell buffers for the color function and its divergence used in capillary surface tension.
348 impure subroutine s_populate_capillary_buffers(c_divs, bc_type, bc)
349
350 type(scalar_field), dimension(num_dims + 1), intent(inout) :: c_divs
351 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
352 type(bc_xyz_info), intent(in) :: bc
353 integer :: k, l
354
355 !> x-direction
356
357 if (bc%x%beg >= 0) then
358 call s_mpi_sendrecv_variables_buffers(c_divs, 1, -1, num_dims + 1)
359 else
360
361# 41 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
362
363# 41 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
364#if defined(MFC_OpenACC)
365# 41 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
366!$acc parallel loop collapse(2) gang vector default(present) private(l, k)
367# 41 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
368#elif defined(MFC_OpenMP)
369# 41 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
370
371# 41 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
372
373# 41 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
374
375# 41 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
376!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k)
377# 41 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
378#endif
379 do l = 0, p
380 do k = 0, n
381 select case (bc_type(1, 1)%sf(0, k, l))
382 case (bc_periodic)
383 call s_color_function_periodic(c_divs, 1, -1, k, l)
384 case (bc_reflective)
385 call s_color_function_reflective(c_divs, 1, -1, k, l)
386 case default
387 call s_color_function_ghost_cell_extrapolation(c_divs, 1, -1, k, l)
388 end select
389 end do
390 end do
391
392# 54 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
393#if defined(MFC_OpenACC)
394# 54 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
395!$acc end parallel loop
396# 54 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
397#elif defined(MFC_OpenMP)
398# 54 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
399
400# 54 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
401!$omp end target teams loop
402# 54 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
403#endif
404 end if
405
406 if (bc%x%end >= 0) then
407 call s_mpi_sendrecv_variables_buffers(c_divs, 1, 1, num_dims + 1)
408 else
409
410# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
411
412# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
413#if defined(MFC_OpenACC)
414# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
415!$acc parallel loop collapse(2) gang vector default(present) private(l, k)
416# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
417#elif defined(MFC_OpenMP)
418# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
419
420# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
421
422# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
423
424# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
425!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k)
426# 60 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
427#endif
428 do l = 0, p
429 do k = 0, n
430 select case (bc_type(1, 2)%sf(0, k, l))
431 case (bc_periodic)
432 call s_color_function_periodic(c_divs, 1, 1, k, l)
433 case (bc_reflective)
434 call s_color_function_reflective(c_divs, 1, 1, k, l)
435 case default
437 end select
438 end do
439 end do
440
441# 73 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
442#if defined(MFC_OpenACC)
443# 73 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
444!$acc end parallel loop
445# 73 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
446#elif defined(MFC_OpenMP)
447# 73 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
448
449# 73 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
450!$omp end target teams loop
451# 73 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
452#endif
453 end if
454
455 if (n == 0) return
456
457# 79 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
458 !> y-direction
459 if (bc%y%beg >= 0) then
460 call s_mpi_sendrecv_variables_buffers(c_divs, 2, -1, num_dims + 1)
461 else
462
463# 83 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
464
465# 83 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
466#if defined(MFC_OpenACC)
467# 83 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
468!$acc parallel loop collapse(2) gang vector default(present) private(l, k)
469# 83 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
470#elif defined(MFC_OpenMP)
471# 83 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
472
473# 83 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
474
475# 83 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
476
477# 83 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
478!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k)
479# 83 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
480#endif
481 do l = 0, p
482 do k = -buff_size, m + buff_size
483 select case (bc_type(2, 1)%sf(k, 0, l))
484 case (bc_periodic)
485 call s_color_function_periodic(c_divs, 2, -1, k, l)
486 case (bc_reflective)
487 call s_color_function_reflective(c_divs, 2, -1, k, l)
488 case default
489 call s_color_function_ghost_cell_extrapolation(c_divs, 2, -1, k, l)
490 end select
491 end do
492 end do
493
494# 96 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
495#if defined(MFC_OpenACC)
496# 96 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
497!$acc end parallel loop
498# 96 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
499#elif defined(MFC_OpenMP)
500# 96 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
501
502# 96 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
503!$omp end target teams loop
504# 96 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
505#endif
506 end if
507
508 if (bc%y%end >= 0) then
509 call s_mpi_sendrecv_variables_buffers(c_divs, 2, 1, num_dims + 1)
510 else
511
512# 102 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
513
514# 102 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
515#if defined(MFC_OpenACC)
516# 102 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
517!$acc parallel loop collapse(2) gang vector default(present) private(l, k)
518# 102 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
519#elif defined(MFC_OpenMP)
520# 102 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
521
522# 102 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
523
524# 102 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
525
526# 102 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
527!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k)
528# 102 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
529#endif
530 do l = 0, p
531 do k = -buff_size, m + buff_size
532 select case (bc_type(2, 2)%sf(k, 0, l))
533 case (bc_periodic)
534 call s_color_function_periodic(c_divs, 2, 1, k, l)
535 case (bc_reflective)
536 call s_color_function_reflective(c_divs, 2, 1, k, l)
537 case default
539 end select
540 end do
541 end do
542
543# 115 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
544#if defined(MFC_OpenACC)
545# 115 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
546!$acc end parallel loop
547# 115 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
548#elif defined(MFC_OpenMP)
549# 115 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
550
551# 115 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
552!$omp end target teams loop
553# 115 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
554#endif
555 end if
556# 118 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
557
558 if (p == 0) return
559
560# 122 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
561 !> z-direction
562 if (bc%z%beg >= 0) then
563 call s_mpi_sendrecv_variables_buffers(c_divs, 3, -1, num_dims + 1)
564 else
565
566# 126 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
567
568# 126 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
569#if defined(MFC_OpenACC)
570# 126 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
571!$acc parallel loop collapse(2) gang vector default(present) private(l, k)
572# 126 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
573#elif defined(MFC_OpenMP)
574# 126 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
575
576# 126 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
577
578# 126 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
579
580# 126 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
581!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k)
582# 126 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
583#endif
584 do l = -buff_size, n + buff_size
585 do k = -buff_size, m + buff_size
586 select case (bc_type(3, 1)%sf(k, l, 0))
587 case (bc_periodic)
588 call s_color_function_periodic(c_divs, 3, -1, k, l)
589 case (bc_reflective)
590 call s_color_function_reflective(c_divs, 3, -1, k, l)
591 case default
592 call s_color_function_ghost_cell_extrapolation(c_divs, 3, -1, k, l)
593 end select
594 end do
595 end do
596
597# 139 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
598#if defined(MFC_OpenACC)
599# 139 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
600!$acc end parallel loop
601# 139 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
602#elif defined(MFC_OpenMP)
603# 139 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
604
605# 139 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
606!$omp end target teams loop
607# 139 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
608#endif
609 end if
610
611 if (bc%z%end >= 0) then
612 call s_mpi_sendrecv_variables_buffers(c_divs, 3, 1, num_dims + 1)
613 else
614
615# 145 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
616
617# 145 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
618#if defined(MFC_OpenACC)
619# 145 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
620!$acc parallel loop collapse(2) gang vector default(present) private(l, k)
621# 145 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
622#elif defined(MFC_OpenMP)
623# 145 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
624
625# 145 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
626
627# 145 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
628
629# 145 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
630!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k)
631# 145 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
632#endif
633 do l = -buff_size, n + buff_size
634 do k = -buff_size, m + buff_size
635 select case (bc_type(3, 2)%sf(k, l, 0))
636 case (bc_periodic)
637 call s_color_function_periodic(c_divs, 3, 1, k, l)
638 case (bc_reflective)
639 call s_color_function_reflective(c_divs, 3, 1, k, l)
640 case default
642 end select
643 end do
644 end do
645
646# 158 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
647#if defined(MFC_OpenACC)
648# 158 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
649!$acc end parallel loop
650# 158 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
651#elif defined(MFC_OpenMP)
652# 158 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
653
654# 158 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
655!$omp end target teams loop
656# 158 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
657#endif
658 end if
659# 161 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
660
661 end subroutine s_populate_capillary_buffers
662
663 !> Apply periodic boundary conditions to the color function and its divergence fields.
664 subroutine s_color_function_periodic(c_divs, bc_dir, bc_loc, k, l)
665
666
667# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
668#ifdef _CRAYFTN
669# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
670#if MFC_OpenACC
671# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
672!$acc routine seq
673# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
674#elif MFC_OpenMP
675# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
676
677# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
678
679# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
680!$omp declare target device_type(any)
681# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
682#else
683# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
684!DIR$ INLINEALWAYS s_color_function_periodic
685# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
686#endif
687# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
688#elif MFC_OpenACC
689# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
690!$acc routine seq
691# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
692#elif MFC_OpenMP
693# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
694
695# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
696
697# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
698!$omp declare target device_type(any)
699# 167 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
700#endif
701 type(scalar_field), dimension(num_dims + 1), intent(inout) :: c_divs
702 integer, intent(in) :: bc_dir, bc_loc
703 integer, intent(in) :: k, l
704 integer :: j, i
705
706 if (bc_dir == 1) then !< x-direction
707 if (bc_loc == -1) then ! bc_x%beg
708 do i = 1, num_dims + 1
709 do j = 1, buff_size
710 c_divs(i)%sf(-j, k, l) = c_divs(i)%sf(m - (j - 1), k, l)
711 end do
712 end do
713 else !< bc_x%end
714 do i = 1, num_dims + 1
715 do j = 1, buff_size
716 c_divs(i)%sf(m + j, k, l) = c_divs(i)%sf(j - 1, k, l)
717 end do
718 end do
719 end if
720 else if (bc_dir == 2) then !< y-direction
721 if (bc_loc == -1) then !< bc_y%beg
722 do i = 1, num_dims + 1
723 do j = 1, buff_size
724 c_divs(i)%sf(k, -j, l) = c_divs(i)%sf(k, n - (j - 1), l)
725 end do
726 end do
727 else !< bc_y%end
728 do i = 1, num_dims + 1
729 do j = 1, buff_size
730 c_divs(i)%sf(k, n + j, l) = c_divs(i)%sf(k, j - 1, l)
731 end do
732 end do
733 end if
734 else if (bc_dir == 3) then !< z-direction
735 if (bc_loc == -1) then !< bc_z%beg
736 do i = 1, num_dims + 1
737 do j = 1, buff_size
738 c_divs(i)%sf(k, l, -j) = c_divs(i)%sf(k, l, p - (j - 1))
739 end do
740 end do
741 else !< bc_z%end
742 do i = 1, num_dims + 1
743 do j = 1, buff_size
744 c_divs(i)%sf(k, l, p + j) = c_divs(i)%sf(k, l, j - 1)
745 end do
746 end do
747 end if
748 end if
749
750 end subroutine s_color_function_periodic
751
752 !> Apply reflective boundary conditions to the color function and its divergence fields.
753 subroutine s_color_function_reflective(c_divs, bc_dir, bc_loc, k, l)
754
755
756# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
757#ifdef _CRAYFTN
758# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
759#if MFC_OpenACC
760# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
761!$acc routine seq
762# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
763#elif MFC_OpenMP
764# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
765
766# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
767
768# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
769!$omp declare target device_type(any)
770# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
771#else
772# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
773!DIR$ INLINEALWAYS s_color_function_reflective
774# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
775#endif
776# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
777#elif MFC_OpenACC
778# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
779!$acc routine seq
780# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
781#elif MFC_OpenMP
782# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
783
784# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
785
786# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
787!$omp declare target device_type(any)
788# 222 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
789#endif
790 type(scalar_field), dimension(num_dims + 1), intent(inout) :: c_divs
791 integer, intent(in) :: bc_dir, bc_loc
792 integer, intent(in) :: k, l
793 integer :: j, i
794
795 if (bc_dir == 1) then !< x-direction
796 if (bc_loc == -1) then ! bc_x%beg
797 do i = 1, num_dims + 1
798 do j = 1, buff_size
799 if (i == bc_dir) then
800 c_divs(i)%sf(-j, k, l) = -c_divs(i)%sf(j - 1, k, l)
801 else
802 c_divs(i)%sf(-j, k, l) = c_divs(i)%sf(j - 1, k, l)
803 end if
804 end do
805 end do
806 else !< bc_x%end
807 do i = 1, num_dims + 1
808 do j = 1, buff_size
809 if (i == bc_dir) then
810 c_divs(i)%sf(m + j, k, l) = -c_divs(i)%sf(m - (j - 1), k, l)
811 else
812 c_divs(i)%sf(m + j, k, l) = c_divs(i)%sf(m - (j - 1), k, l)
813 end if
814 end do
815 end do
816 end if
817 else if (bc_dir == 2) then !< y-direction
818 if (bc_loc == -1) then !< bc_y%beg
819 do i = 1, num_dims + 1
820 do j = 1, buff_size
821 if (i == bc_dir) then
822 c_divs(i)%sf(k, -j, l) = -c_divs(i)%sf(k, j - 1, l)
823 else
824 c_divs(i)%sf(k, -j, l) = c_divs(i)%sf(k, j - 1, l)
825 end if
826 end do
827 end do
828 else !< bc_y%end
829 do i = 1, num_dims + 1
830 do j = 1, buff_size
831 if (i == bc_dir) then
832 c_divs(i)%sf(k, n + j, l) = -c_divs(i)%sf(k, n - (j - 1), l)
833 else
834 c_divs(i)%sf(k, n + j, l) = c_divs(i)%sf(k, n - (j - 1), l)
835 end if
836 end do
837 end do
838 end if
839 else if (bc_dir == 3) then !< z-direction
840 if (bc_loc == -1) then !< bc_z%beg
841 do i = 1, num_dims + 1
842 do j = 1, buff_size
843 if (i == bc_dir) then
844 c_divs(i)%sf(k, l, -j) = -c_divs(i)%sf(k, l, j - 1)
845 else
846 c_divs(i)%sf(k, l, -j) = c_divs(i)%sf(k, l, j - 1)
847 end if
848 end do
849 end do
850 else !< bc_z%end
851 do i = 1, num_dims + 1
852 do j = 1, buff_size
853 if (i == bc_dir) then
854 c_divs(i)%sf(k, l, p + j) = -c_divs(i)%sf(k, l, p - (j - 1))
855 else
856 c_divs(i)%sf(k, l, p + j) = c_divs(i)%sf(k, l, p - (j - 1))
857 end if
858 end do
859 end do
860 end if
861 end if
862
863 end subroutine s_color_function_reflective
864
865 !> Extrapolate the color function and its divergence into ghost cells by copying boundary values.
866 subroutine s_color_function_ghost_cell_extrapolation(c_divs, bc_dir, bc_loc, k, l)
867
868
869# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
870#ifdef _CRAYFTN
871# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
872#if MFC_OpenACC
873# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
874!$acc routine seq
875# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
876#elif MFC_OpenMP
877# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
878
879# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
880
881# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
882!$omp declare target device_type(any)
883# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
884#else
885# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
886!DIR$ INLINEALWAYS s_color_function_ghost_cell_extrapolation
887# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
888#endif
889# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
890#elif MFC_OpenACC
891# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
892!$acc routine seq
893# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
894#elif MFC_OpenMP
895# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
896
897# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
898
899# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
900!$omp declare target device_type(any)
901# 301 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
902#endif
903 type(scalar_field), dimension(num_dims + 1), intent(inout) :: c_divs
904 integer, intent(in) :: bc_dir, bc_loc
905 integer, intent(in) :: k, l
906 integer :: j, i
907
908 if (bc_dir == 1) then !< x-direction
909 if (bc_loc == -1) then ! bc_x%beg
910 do i = 1, num_dims + 1
911 do j = 1, buff_size
912 c_divs(i)%sf(-j, k, l) = c_divs(i)%sf(0, k, l)
913 end do
914 end do
915 else !< bc_x%end
916 do i = 1, num_dims + 1
917 do j = 1, buff_size
918 c_divs(i)%sf(m + j, k, l) = c_divs(i)%sf(m, k, l)
919 end do
920 end do
921 end if
922 else if (bc_dir == 2) then !< y-direction
923 if (bc_loc == -1) then !< bc_y%beg
924 do i = 1, num_dims + 1
925 do j = 1, buff_size
926 c_divs(i)%sf(k, -j, l) = c_divs(i)%sf(k, 0, l)
927 end do
928 end do
929 else !< bc_y%end
930 do i = 1, num_dims + 1
931 do j = 1, buff_size
932 c_divs(i)%sf(k, n + j, l) = c_divs(i)%sf(k, n, l)
933 end do
934 end do
935 end if
936 else if (bc_dir == 3) then !< z-direction
937 if (bc_loc == -1) then !< bc_z%beg
938 do i = 1, num_dims + 1
939 do j = 1, buff_size
940 c_divs(i)%sf(k, l, -j) = c_divs(i)%sf(k, l, 0)
941 end do
942 end do
943 else !< bc_z%end
944 do i = 1, num_dims + 1
945 do j = 1, buff_size
946 c_divs(i)%sf(k, l, p + j) = c_divs(i)%sf(k, l, p)
947 end do
948 end do
949 end if
950 end if
951
953
954 !> Populate ghost cell buffers for the Jacobian scalar field used in the IGR elliptic solver.
955 impure subroutine s_populate_f_igr_buffers(bc_type, jac_sf)
956
957 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
958 type(scalar_field), dimension(1:), intent(inout) :: jac_sf
959 integer :: j, k, l
960
961 if (bc_x%beg >= 0) then
962 call s_mpi_sendrecv_variables_buffers(jac_sf, 1, -1, 1)
963 else
964
965# 363 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
966
967# 363 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
968#if defined(MFC_OpenACC)
969# 363 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
970!$acc parallel loop collapse(2) gang vector default(present) private(l, k)
971# 363 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
972#elif defined(MFC_OpenMP)
973# 363 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
974
975# 363 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
976
977# 363 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
978
979# 363 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
980!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k)
981# 363 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
982#endif
983 do l = 0, p
984 do k = 0, n
985 select case (bc_type(1, 1)%sf(0, k, l))
986 case (bc_periodic)
987 do j = 1, buff_size
988 jac_sf(1)%sf(-j, k, l) = jac_sf(1)%sf(m - j + 1, k, l)
989 end do
990 case (bc_reflective)
991 do j = 1, buff_size
992 jac_sf(1)%sf(-j, k, l) = jac_sf(1)%sf(j - 1, k, l)
993 end do
994 case default
995 do j = 1, buff_size
996 jac_sf(1)%sf(-j, k, l) = jac_sf(1)%sf(0, k, l)
997 end do
998 end select
999 end do
1000 end do
1001
1002# 382 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1003#if defined(MFC_OpenACC)
1004# 382 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1005!$acc end parallel loop
1006# 382 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1007#elif defined(MFC_OpenMP)
1008# 382 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1009
1010# 382 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1011!$omp end target teams loop
1012# 382 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1013#endif
1014 end if
1015
1016 if (bc_x%end >= 0) then
1017 call s_mpi_sendrecv_variables_buffers(jac_sf, 1, 1, 1)
1018 else
1019
1020# 388 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1021
1022# 388 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1023#if defined(MFC_OpenACC)
1024# 388 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1025!$acc parallel loop collapse(2) gang vector default(present) private(l, k)
1026# 388 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1027#elif defined(MFC_OpenMP)
1028# 388 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1029
1030# 388 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1031
1032# 388 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1033
1034# 388 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1035!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k)
1036# 388 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1037#endif
1038 do l = 0, p
1039 do k = 0, n
1040 select case (bc_type(1, 2)%sf(0, k, l))
1041 case (bc_periodic)
1042 do j = 1, buff_size
1043 jac_sf(1)%sf(m + j, k, l) = jac_sf(1)%sf(j - 1, k, l)
1044 end do
1045 case (bc_reflective)
1046 do j = 1, buff_size
1047 jac_sf(1)%sf(m + j, k, l) = jac_sf(1)%sf(m - (j - 1), k, l)
1048 end do
1049 case default
1050 do j = 1, buff_size
1051 jac_sf(1)%sf(m + j, k, l) = jac_sf(1)%sf(m, k, l)
1052 end do
1053 end select
1054 end do
1055 end do
1056
1057# 407 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1058#if defined(MFC_OpenACC)
1059# 407 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1060!$acc end parallel loop
1061# 407 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1062#elif defined(MFC_OpenMP)
1063# 407 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1064
1065# 407 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1066!$omp end target teams loop
1067# 407 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1068#endif
1069 end if
1070
1071# 411 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1072 if (n == 0) then
1073 return
1074 else if (bc_y%beg >= 0) then
1075 call s_mpi_sendrecv_variables_buffers(jac_sf, 2, -1, 1)
1076 else
1077
1078# 416 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1079
1080# 416 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1081#if defined(MFC_OpenACC)
1082# 416 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1083!$acc parallel loop collapse(2) gang vector default(present) private(l, k)
1084# 416 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1085#elif defined(MFC_OpenMP)
1086# 416 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1087
1088# 416 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1089
1090# 416 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1091
1092# 416 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1093!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k)
1094# 416 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1095#endif
1096 do l = 0, p
1097 do k = idwbuff(1)%beg, idwbuff(1)%end
1098 select case (bc_type(2, 1)%sf(k, 0, l))
1099 case (bc_periodic)
1100 do j = 1, buff_size
1101 jac_sf(1)%sf(k, -j, l) = jac_sf(1)%sf(k, n - j + 1, l)
1102 end do
1103 case (bc_reflective)
1104 do j = 1, buff_size
1105 jac_sf(1)%sf(k, -j, l) = jac_sf(1)%sf(k, j - 1, l)
1106 end do
1107 case default
1108 do j = 1, buff_size
1109 jac_sf(1)%sf(k, -j, l) = jac_sf(1)%sf(k, 0, l)
1110 end do
1111 end select
1112 end do
1113 end do
1114
1115# 435 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1116#if defined(MFC_OpenACC)
1117# 435 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1118!$acc end parallel loop
1119# 435 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1120#elif defined(MFC_OpenMP)
1121# 435 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1122
1123# 435 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1124!$omp end target teams loop
1125# 435 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1126#endif
1127 end if
1128
1129 if (bc_y%end >= 0) then
1130 call s_mpi_sendrecv_variables_buffers(jac_sf, 2, 1, 1)
1131 else
1132
1133# 441 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1134
1135# 441 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1136#if defined(MFC_OpenACC)
1137# 441 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1138!$acc parallel loop collapse(2) gang vector default(present) private(l, k)
1139# 441 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1140#elif defined(MFC_OpenMP)
1141# 441 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1142
1143# 441 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1144
1145# 441 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1146
1147# 441 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1148!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k)
1149# 441 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1150#endif
1151 do l = 0, p
1152 do k = idwbuff(1)%beg, idwbuff(1)%end
1153 select case (bc_type(2, 2)%sf(k, 0, l))
1154 case (bc_periodic)
1155 do j = 1, buff_size
1156 jac_sf(1)%sf(k, n + j, l) = jac_sf(1)%sf(k, j - 1, l)
1157 end do
1158 case (bc_reflective)
1159 do j = 1, buff_size
1160 jac_sf(1)%sf(k, n + j, l) = jac_sf(1)%sf(k, n - (j - 1), l)
1161 end do
1162 case default
1163 do j = 1, buff_size
1164 jac_sf(1)%sf(k, n + j, l) = jac_sf(1)%sf(k, n, l)
1165 end do
1166 end select
1167 end do
1168 end do
1169
1170# 460 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1171#if defined(MFC_OpenACC)
1172# 460 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1173!$acc end parallel loop
1174# 460 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1175#elif defined(MFC_OpenMP)
1176# 460 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1177
1178# 460 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1179!$omp end target teams loop
1180# 460 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1181#endif
1182 end if
1183# 463 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1184
1185# 465 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1186 if (p == 0) then
1187 return
1188 else if (bc_z%beg >= 0) then
1189 call s_mpi_sendrecv_variables_buffers(jac_sf, 3, -1, 1)
1190 else
1191
1192# 470 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1193
1194# 470 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1195#if defined(MFC_OpenACC)
1196# 470 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1197!$acc parallel loop collapse(2) gang vector default(present) private(l, k)
1198# 470 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1199#elif defined(MFC_OpenMP)
1200# 470 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1201
1202# 470 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1203
1204# 470 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1205
1206# 470 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1207!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k)
1208# 470 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1209#endif
1210 do l = idwbuff(2)%beg, idwbuff(2)%end
1211 do k = idwbuff(1)%beg, idwbuff(1)%end
1212 select case (bc_type(3, 1)%sf(k, l, 0))
1213 case (bc_periodic)
1214 do j = 1, buff_size
1215 jac_sf(1)%sf(k, l, -j) = jac_sf(1)%sf(k, l, p - j + 1)
1216 end do
1217 case (bc_reflective)
1218 do j = 1, buff_size
1219 jac_sf(1)%sf(k, l, -j) = jac_sf(1)%sf(k, l, j - 1)
1220 end do
1221 case default
1222 do j = 1, buff_size
1223 jac_sf(1)%sf(k, l, -j) = jac_sf(1)%sf(k, l, 0)
1224 end do
1225 end select
1226 end do
1227 end do
1228
1229# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1230#if defined(MFC_OpenACC)
1231# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1232!$acc end parallel loop
1233# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1234#elif defined(MFC_OpenMP)
1235# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1236
1237# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1238!$omp end target teams loop
1239# 489 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1240#endif
1241 end if
1242
1243 if (bc_z%end >= 0) then
1244 call s_mpi_sendrecv_variables_buffers(jac_sf, 3, 1, 1)
1245 else
1246
1247# 495 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1248
1249# 495 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1250#if defined(MFC_OpenACC)
1251# 495 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1252!$acc parallel loop collapse(2) gang vector default(present) private(l, k)
1253# 495 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1254#elif defined(MFC_OpenMP)
1255# 495 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1256
1257# 495 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1258
1259# 495 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1260
1261# 495 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1262!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, k)
1263# 495 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1264#endif
1265 do l = idwbuff(2)%beg, idwbuff(2)%end
1266 do k = idwbuff(1)%beg, idwbuff(1)%end
1267 select case (bc_type(3, 2)%sf(k, l, 0))
1268 case (bc_periodic)
1269 do j = 1, buff_size
1270 jac_sf(1)%sf(k, l, p + j) = jac_sf(1)%sf(k, l, j - 1)
1271 end do
1272 case (bc_reflective)
1273 do j = 1, buff_size
1274 jac_sf(1)%sf(k, l, p + j) = jac_sf(1)%sf(k, l, p - (j - 1))
1275 end do
1276 case default
1277 do j = 1, buff_size
1278 jac_sf(1)%sf(k, l, p + j) = jac_sf(1)%sf(k, l, p)
1279 end do
1280 end select
1281 end do
1282 end do
1283
1284# 514 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1285#if defined(MFC_OpenACC)
1286# 514 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1287!$acc end parallel loop
1288# 514 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1289#elif defined(MFC_OpenMP)
1290# 514 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1291
1292# 514 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1293!$omp end target teams loop
1294# 514 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1295#endif
1296 end if
1297# 517 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1298
1299 end subroutine s_populate_f_igr_buffers
1300
1301 !> Create MPI derived datatypes for boundary condition type arrays and buffer arrays used in parallel I/O.
1302 impure subroutine s_create_mpi_types(bc_type)
1303
1304 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
1305
1306#ifdef MFC_MPI
1307 integer :: dir, loc
1308 integer, dimension(3) :: sf_start_idx, sf_extents_loc
1309 integer :: ierr
1310
1311 do dir = 1, num_dims
1312 do loc = 1, 2
1313 sf_start_idx = (/0, 0, 0/)
1314 sf_extents_loc = shape(bc_type(dir, loc)%sf)
1315
1316 call mpi_type_create_subarray(num_dims, sf_extents_loc, sf_extents_loc, sf_start_idx, mpi_order_fortran, &
1317 & mpi_integer, mpi_bc_type_type(dir, loc), ierr)
1318 call mpi_type_commit(mpi_bc_type_type(dir, loc), ierr)
1319 end do
1320 end do
1321
1322 do dir = 1, num_dims
1323 do loc = 1, 2
1324 sf_start_idx = (/0, 0, 0/)
1325 sf_extents_loc = shape(bc_buffers(dir, loc)%sf)
1326
1327 call mpi_type_create_subarray(num_dims, sf_extents_loc*mpi_io_type, sf_extents_loc*mpi_io_type, sf_start_idx, &
1328 & mpi_order_fortran, mpi_io_p, mpi_bc_buffer_type(dir, loc), ierr)
1329 call mpi_type_commit(mpi_bc_buffer_type(dir, loc), ierr)
1330 end do
1331 end do
1332#endif
1333
1334 end subroutine s_create_mpi_types
1335
1336 !> Write boundary condition type and buffer data to serial (unformatted) restart files.
1337 subroutine s_write_serial_boundary_condition_files(q_prim_vf, bc_type, step_dirpath, old_grid_in, q_T_sf)
1338
1339 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1340 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
1341 logical, intent(in) :: old_grid_in
1342 character(LEN=*), intent(in) :: step_dirpath
1343 integer :: dir, loc
1344 character(len=path_len) :: file_path
1345 character(len=10) :: status
1346 type(scalar_field), optional, intent(in) :: q_T_sf
1347
1348 if (old_grid_in) then
1349 status = 'old'
1350 else
1351 status = 'new'
1352 end if
1353
1354 call s_pack_boundary_condition_buffers(q_prim_vf, q_t_sf)
1355
1356 file_path = trim(step_dirpath) // '/bc_type.dat'
1357 open (1, file=trim(file_path), form='unformatted', status=status)
1358 do dir = 1, num_dims
1359 do loc = 1, 2
1360 write (1) bc_type(dir, loc)%sf
1361 end do
1362 end do
1363 close (1)
1364
1365 file_path = trim(step_dirpath) // '/bc_buffers.dat'
1366 open (1, file=trim(file_path), form='unformatted', status=status)
1367 do dir = 1, num_dims
1368 do loc = 1, 2
1369 write (1) bc_buffers(dir, loc)%sf
1370 end do
1371 end do
1372 close (1)
1373
1375
1376 !> Write boundary condition type and buffer data to per-rank parallel files using MPI I/O.
1377 subroutine s_write_parallel_boundary_condition_files(q_prim_vf, bc_type, q_T_sf)
1378
1379 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1380 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
1381 integer :: dir, loc
1382 character(len=path_len) :: file_loc, file_path
1383 type(scalar_field), intent(in), optional :: q_T_sf
1384
1385#ifdef MFC_MPI
1386 integer :: ierr
1387 integer :: file_id
1388 character(len=7) :: proc_rank_str
1389 logical :: dir_check
1390 integer :: nelements
1391
1392 call s_pack_boundary_condition_buffers(q_prim_vf, q_t_sf)
1393
1394 file_loc = trim(case_dir) // '/restart_data/boundary_conditions'
1395 if (proc_rank == 0) then
1396 call my_inquire(file_loc, dir_check)
1397 if (dir_check .neqv. .true.) then
1398 call s_create_directory(trim(file_loc))
1399 end if
1400 end if
1401
1402 call s_create_mpi_types(bc_type)
1403
1404 call s_mpi_barrier()
1405
1407
1408 write (proc_rank_str, '(I7.7)') proc_rank
1409 file_path = trim(file_loc) // '/bc_' // trim(proc_rank_str) // '.dat'
1410 call mpi_file_open(mpi_comm_self, trim(file_path), mpi_mode_create + mpi_mode_wronly, mpi_info_null, file_id, ierr)
1411
1412 ! Write bc_types
1413 do dir = 1, num_dims
1414 do loc = 1, 2
1415#ifdef MFC_MIXED_PRECISION
1416 nelements = sizeof(bc_type(dir, loc)%sf)
1417 call mpi_file_write_all(file_id, bc_type(dir, loc)%sf, nelements, mpi_byte, mpi_status_ignore, ierr)
1418#else
1419 nelements = sizeof(bc_type(dir, loc)%sf)/4
1420 call mpi_file_write_all(file_id, bc_type(dir, loc)%sf, nelements, mpi_integer, mpi_status_ignore, ierr)
1421#endif
1422 end do
1423 end do
1424
1425 ! Write bc_buffers
1426 do dir = 1, num_dims
1427 do loc = 1, 2
1428 nelements = sizeof(bc_buffers(dir, loc)%sf)*mpi_io_type/stp
1429 call mpi_file_write_all(file_id, bc_buffers(dir, loc)%sf, nelements, mpi_io_p, mpi_status_ignore, ierr)
1430 end do
1431 end do
1432
1433 call mpi_file_close(file_id, ierr)
1434#endif
1435
1437
1438 !> Read boundary condition type and buffer data from serial (unformatted) restart files.
1439 subroutine s_read_serial_boundary_condition_files(step_dirpath, bc_type)
1440
1441 character(LEN=*), intent(in) :: step_dirpath
1442 type(integer_field), dimension(1:num_dims,1:2), intent(inout) :: bc_type
1443 integer :: dir, loc
1444 logical :: file_exist
1445 character(len=path_len) :: file_path
1446
1447 ! Read bc_types
1448
1449 file_path = trim(step_dirpath) // '/bc_type.dat'
1450 inquire (file=trim(file_path), exist=file_exist)
1451 if (.not. file_exist) then
1452 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
1453 end if
1454
1455 open (1, file=trim(file_path), form='unformatted', status='unknown')
1456 do dir = 1, num_dims
1457 do loc = 1, 2
1458 read (1) bc_type(dir, loc)%sf
1459
1460# 678 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1461#if defined(MFC_OpenACC)
1462# 678 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1463!$acc update device(bc_type(dir, loc)%sf)
1464# 678 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1465#elif defined(MFC_OpenMP)
1466# 678 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1467!$omp target update to(bc_type(dir, loc)%sf)
1468# 678 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1469#endif
1470 end do
1471 end do
1472 close (1)
1473
1474 ! Read bc_buffers
1475 file_path = trim(step_dirpath) // '/bc_buffers.dat'
1476 inquire (file=trim(file_path), exist=file_exist)
1477 if (.not. file_exist) then
1478 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
1479 end if
1480
1481 open (1, file=trim(file_path), form='unformatted', status='unknown')
1482 do dir = 1, num_dims
1483 do loc = 1, 2
1484 read (1) bc_buffers(dir, loc)%sf
1485
1486# 694 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1487#if defined(MFC_OpenACC)
1488# 694 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1489!$acc update device(bc_buffers(dir, loc)%sf)
1490# 694 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1491#elif defined(MFC_OpenMP)
1492# 694 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1493!$omp target update to(bc_buffers(dir, loc)%sf)
1494# 694 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1495#endif
1496 end do
1497 end do
1498 close (1)
1499
1501
1502 !> Read boundary condition type and buffer data from per-rank parallel files using MPI I/O.
1504
1505 type(integer_field), dimension(1:num_dims,1:2), intent(inout) :: bc_type
1506 integer :: dir, loc
1507 character(len=path_len) :: file_loc, file_path
1508
1509#ifdef MFC_MPI
1510 integer :: ierr
1511 integer :: file_id
1512 character(len=7) :: proc_rank_str
1513 logical :: dir_check
1514 integer :: nelements
1515
1516 file_loc = trim(case_dir) // '/restart_data/boundary_conditions'
1517
1518 if (proc_rank == 0) then
1519 call my_inquire(file_loc, dir_check)
1520 if (dir_check .neqv. .true.) then
1521 call s_mpi_abort(trim(file_loc) // ' is missing. Exiting.')
1522 end if
1523 end if
1524
1525 call s_create_mpi_types(bc_type)
1526
1527 call s_mpi_barrier()
1528
1530
1531 write (proc_rank_str, '(I7.7)') proc_rank
1532 file_path = trim(file_loc) // '/bc_' // trim(proc_rank_str) // '.dat'
1533 call mpi_file_open(mpi_comm_self, trim(file_path), mpi_mode_rdonly, mpi_info_null, file_id, ierr)
1534
1535 ! Read bc_types
1536 do dir = 1, num_dims
1537 do loc = 1, 2
1538#ifdef MFC_MIXED_PRECISION
1539 nelements = sizeof(bc_type(dir, loc)%sf)
1540 call mpi_file_read_all(file_id, bc_type(dir, loc)%sf, nelements, mpi_byte, mpi_status_ignore, ierr)
1541#else
1542 nelements = sizeof(bc_type(dir, loc)%sf)/4
1543 call mpi_file_read_all(file_id, bc_type(dir, loc)%sf, nelements, mpi_integer, mpi_status_ignore, ierr)
1544#endif
1545
1546# 744 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1547#if defined(MFC_OpenACC)
1548# 744 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1549!$acc update device(bc_type(dir, loc)%sf)
1550# 744 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1551#elif defined(MFC_OpenMP)
1552# 744 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1553!$omp target update to(bc_type(dir, loc)%sf)
1554# 744 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1555#endif
1556 end do
1557 end do
1558
1559 ! Read bc_buffers
1560 do dir = 1, num_dims
1561 do loc = 1, 2
1562 nelements = sizeof(bc_buffers(dir, loc)%sf)*mpi_io_type/stp
1563 call mpi_file_read_all(file_id, bc_buffers(dir, loc)%sf, nelements, mpi_io_p, mpi_status_ignore, ierr)
1564
1565# 753 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1566#if defined(MFC_OpenACC)
1567# 753 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1568!$acc update device(bc_buffers(dir, loc)%sf)
1569# 753 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1570#elif defined(MFC_OpenMP)
1571# 753 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1572!$omp target update to(bc_buffers(dir, loc)%sf)
1573# 753 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1574#endif
1575 end do
1576 end do
1577
1578 call mpi_file_close(file_id, ierr)
1579#endif
1580
1582
1583 !> Pack primitive variable boundary slices into bc_buffers arrays for serialization.
1584 subroutine s_pack_boundary_condition_buffers(q_prim_vf, q_T_sf)
1585
1586 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1587 integer :: i, j, k
1588 type(scalar_field), intent(in), optional :: q_T_sf
1589
1590 do k = 0, p
1591 do j = 0, n
1592 do i = 1, sys_size
1593 bc_buffers(1, 1)%sf(i, j, k) = q_prim_vf(i)%sf(0, j, k)
1594 bc_buffers(1, 2)%sf(i, j, k) = q_prim_vf(i)%sf(m, j, k)
1595 end do
1596 if (chemistry .and. present(q_t_sf)) then
1597 bc_buffers(1, 1)%sf(sys_size + 1, j, k) = q_t_sf%sf(0, j, k)
1598 bc_buffers(1, 2)%sf(sys_size + 1, j, k) = q_t_sf%sf(m, j, k)
1599 end if
1600 end do
1601 end do
1602
1603# 783 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1604 if (n > 0) then
1605 do k = 0, p
1606 do j = 1, sys_size
1607 do i = 0, m
1608 bc_buffers(2, 1)%sf(i, j, k) = q_prim_vf(j)%sf(i, 0, k)
1609 bc_buffers(2, 2)%sf(i, j, k) = q_prim_vf(j)%sf(i, n, k)
1610 end do
1611 end do
1612 if (chemistry .and. present(q_t_sf)) then
1613 do i = 0, m
1614 bc_buffers(2, 1)%sf(i, sys_size + 1, k) = q_t_sf%sf(i, 0, k)
1615 bc_buffers(2, 2)%sf(i, sys_size + 1, k) = q_t_sf%sf(i, n, k)
1616 end do
1617 end if
1618 end do
1619
1620# 800 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1621 if (p > 0) then
1622 do k = 1, sys_size
1623 do j = 0, n
1624 do i = 0, m
1625 bc_buffers(3, 1)%sf(i, j, k) = q_prim_vf(k)%sf(i, j, 0)
1626 bc_buffers(3, 2)%sf(i, j, k) = q_prim_vf(k)%sf(i, j, p)
1627 end do
1628 end do
1629 end do
1630 if (chemistry .and. present(q_t_sf)) then
1631 do j = 0, n
1632 do i = 0, m
1633 bc_buffers(3, 1)%sf(i, j, sys_size + 1) = q_t_sf%sf(i, j, 0)
1634 bc_buffers(3, 2)%sf(i, j, sys_size + 1) = q_t_sf%sf(i, j, p)
1635 end do
1636 end do
1637 end if
1638 end if
1639# 819 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1640 end if
1641# 821 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1642
1644
1645 !> Initialize the per-cell boundary condition type arrays with the global default BC values.
1646 subroutine s_assign_default_bc_type(bc_type)
1647
1648 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
1649
1650 bc_type(1, 1)%sf(:,:,:) = int(min(bc_x%beg, 0), kind=1)
1651 bc_type(1, 2)%sf(:,:,:) = int(min(bc_x%end, 0), kind=1)
1652
1653# 831 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1654#if defined(MFC_OpenACC)
1655# 831 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1656!$acc update device(bc_type(1, 1)%sf, bc_type(1, 2)%sf)
1657# 831 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1658#elif defined(MFC_OpenMP)
1659# 831 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1660!$omp target update to(bc_type(1, 1)%sf, bc_type(1, 2)%sf)
1661# 831 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1662#endif
1663
1664# 834 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1665 if (n > 0) then
1666 bc_type(2, 1)%sf(:,:,:) = int(min(bc_y%beg, 0), kind=1)
1667 bc_type(2, 2)%sf(:,:,:) = int(min(bc_y%end, 0), kind=1)
1668
1669# 837 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1670#if defined(MFC_OpenACC)
1671# 837 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1672!$acc update device(bc_type(2, 1)%sf, bc_type(2, 2)%sf)
1673# 837 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1674#elif defined(MFC_OpenMP)
1675# 837 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1676!$omp target update to(bc_type(2, 1)%sf, bc_type(2, 2)%sf)
1677# 837 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1678#endif
1679# 839 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1680 if (p > 0) then
1681 bc_type(3, 1)%sf(:,:,:) = int(min(bc_z%beg, 0), kind=1)
1682 bc_type(3, 2)%sf(:,:,:) = int(min(bc_z%end, 0), kind=1)
1683
1684# 842 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1685#if defined(MFC_OpenACC)
1686# 842 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1687!$acc update device(bc_type(3, 1)%sf, bc_type(3, 2)%sf)
1688# 842 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1689#elif defined(MFC_OpenMP)
1690# 842 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1691!$omp target update to(bc_type(3, 1)%sf, bc_type(3, 2)%sf)
1692# 842 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1693#endif
1694 end if
1695# 845 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1696 end if
1697# 847 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
1698
1699 end subroutine s_assign_default_bc_type
1700
1701 !> Populate the buffers of the grid variables, which are constituted of the cell-boundary locations and cell-width
1702 !! distributions, based on the boundary conditions.
1704
1705 integer :: i
1706
1707#ifdef MFC_SIMULATION
1708 ! Required for compatibility between codes
1709 type(int_bounds_info) :: offset_x, offset_y, offset_z
1710
1711 offset_x%beg = buff_size; offset_x%end = buff_size
1712 offset_y%beg = buff_size; offset_y%end = buff_size
1713 offset_z%beg = buff_size; offset_z%end = buff_size
1714#endif
1715
1716#ifndef MFC_PRE_PROCESS
1717 ! Population of Buffers in x-direction
1718
1719 ! Populating cell-width distribution buffer at bc_x%beg
1720 if (bc_x%beg >= 0) then
1721 call s_mpi_sendrecv_grid_variables_buffers(1, -1)
1722 else if (bc_x%beg <= bc_ghost_extrap) then
1723 do i = 1, buff_size
1724 dx(-i) = dx(0)
1725 end do
1726 else if (bc_x%beg == bc_reflective) then
1727 do i = 1, buff_size
1728 dx(-i) = dx(i - 1)
1729 end do
1730 else if (bc_x%beg == bc_periodic) then
1731 do i = 1, buff_size
1732 dx(-i) = dx(m - (i - 1))
1733 end do
1734 end if
1735
1736 ! Computing the cell-boundary and center locations buffer at bc_x%beg
1737 do i = 1, offset_x%beg
1738 x_cb(-1 - i) = x_cb(-i) - dx(-i)
1739 end do
1740
1741 do i = 1, buff_size
1742 x_cc(-i) = x_cc(1 - i) - (dx(1 - i) + dx(-i))/2._wp
1743 end do
1744
1745 ! Populating the cell-width distribution buffer at bc_x%end
1746 if (bc_x%end >= 0) then
1747 call s_mpi_sendrecv_grid_variables_buffers(1, 1)
1748 else if (bc_x%end <= bc_ghost_extrap) then
1749 do i = 1, buff_size
1750 dx(m + i) = dx(m)
1751 end do
1752 else if (bc_x%end == bc_reflective) then
1753 do i = 1, buff_size
1754 dx(m + i) = dx(m - (i - 1))
1755 end do
1756 else if (bc_x%end == bc_periodic) then
1757 do i = 1, buff_size
1758 dx(m + i) = dx(i - 1)
1759 end do
1760 end if
1761
1762 ! Populating the cell-boundary and center locations buffer at bc_x%end
1763 do i = 1, offset_x%end
1764 x_cb(m + i) = x_cb(m + (i - 1)) + dx(m + i)
1765 end do
1766
1767 do i = 1, buff_size
1768 x_cc(m + i) = x_cc(m + (i - 1)) + (dx(m + (i - 1)) + dx(m + i))/2._wp
1769 end do
1770
1771 ! Population of Buffers in y-direction
1772
1773 ! Populating cell-width distribution buffer at bc_y%beg
1774 if (n == 0) then
1775 return
1776 else if (bc_y%beg >= 0) then
1777 call s_mpi_sendrecv_grid_variables_buffers(2, -1)
1778 else if (bc_y%beg <= bc_ghost_extrap .and. bc_y%beg /= bc_axis) then
1779 do i = 1, buff_size
1780 dy(-i) = dy(0)
1781 end do
1782 else if (bc_y%beg == bc_reflective .or. bc_y%beg == bc_axis) then
1783 do i = 1, buff_size
1784 dy(-i) = dy(i - 1)
1785 end do
1786 else if (bc_y%beg == bc_periodic) then
1787 do i = 1, buff_size
1788 dy(-i) = dy(n - (i - 1))
1789 end do
1790 end if
1791
1792 ! Computing the cell-boundary and center locations buffer at bc_y%beg
1793 do i = 1, offset_y%beg
1794 y_cb(-1 - i) = y_cb(-i) - dy(-i)
1795 end do
1796
1797 do i = 1, buff_size
1798 y_cc(-i) = y_cc(1 - i) - (dy(1 - i) + dy(-i))/2._wp
1799 end do
1800
1801 ! Populating the cell-width distribution buffer at bc_y%end
1802 if (bc_y%end >= 0) then
1803 call s_mpi_sendrecv_grid_variables_buffers(2, 1)
1804 else if (bc_y%end <= bc_ghost_extrap) then
1805 do i = 1, buff_size
1806 dy(n + i) = dy(n)
1807 end do
1808 else if (bc_y%end == bc_reflective) then
1809 do i = 1, buff_size
1810 dy(n + i) = dy(n - (i - 1))
1811 end do
1812 else if (bc_y%end == bc_periodic) then
1813 do i = 1, buff_size
1814 dy(n + i) = dy(i - 1)
1815 end do
1816 end if
1817
1818 ! Populating the cell-boundary and center locations buffer at bc_y%end
1819 do i = 1, offset_y%end
1820 y_cb(n + i) = y_cb(n + (i - 1)) + dy(n + i)
1821 end do
1822
1823 do i = 1, buff_size
1824 y_cc(n + i) = y_cc(n + (i - 1)) + (dy(n + (i - 1)) + dy(n + i))/2._wp
1825 end do
1826
1827 ! Population of Buffers in z-direction
1828
1829 ! Populating cell-width distribution buffer at bc_z%beg
1830 if (p == 0) then
1831 return
1832 else if (bc_z%beg >= 0) then
1833 call s_mpi_sendrecv_grid_variables_buffers(3, -1)
1834 else if (bc_z%beg <= bc_ghost_extrap) then
1835 do i = 1, buff_size
1836 dz(-i) = dz(0)
1837 end do
1838 else if (bc_z%beg == bc_reflective) then
1839 do i = 1, buff_size
1840 dz(-i) = dz(i - 1)
1841 end do
1842 else if (bc_z%beg == bc_periodic) then
1843 do i = 1, buff_size
1844 dz(-i) = dz(p - (i - 1))
1845 end do
1846 end if
1847
1848 ! Computing the cell-boundary and center locations buffer at bc_z%beg
1849 do i = 1, offset_z%beg
1850 z_cb(-1 - i) = z_cb(-i) - dz(-i)
1851 end do
1852
1853 do i = 1, buff_size
1854 z_cc(-i) = z_cc(1 - i) - (dz(1 - i) + dz(-i))/2._wp
1855 end do
1856
1857 ! Populating the cell-width distribution buffer at bc_z%end
1858 if (bc_z%end >= 0) then
1859 call s_mpi_sendrecv_grid_variables_buffers(3, 1)
1860 else if (bc_z%end <= bc_ghost_extrap) then
1861 do i = 1, buff_size
1862 dz(p + i) = dz(p)
1863 end do
1864 else if (bc_z%end == bc_reflective) then
1865 do i = 1, buff_size
1866 dz(p + i) = dz(p - (i - 1))
1867 end do
1868 else if (bc_z%end == bc_periodic) then
1869 do i = 1, buff_size
1870 dz(p + i) = dz(i - 1)
1871 end do
1872 end if
1873
1874 ! Populating the cell-boundary and center locations buffer at bc_z%end
1875 do i = 1, offset_z%end
1876 z_cb(p + i) = z_cb(p + (i - 1)) + dz(p + i)
1877 end do
1878
1879 do i = 1, buff_size
1880 z_cc(p + i) = z_cc(p + (i - 1)) + (dz(p + (i - 1)) + dz(p + i))/2._wp
1881 end do
1882#endif
1883
1885
1886end module m_boundary_io
integer, intent(in) k
integer, intent(in) j
integer, intent(in) l
Boundary condition restart I/O, capillary/IGR buffer population, and grid-variable buffers.
integer, dimension(1:3, 1:2) mpi_bc_type_type
subroutine s_write_parallel_boundary_condition_files(q_prim_vf, bc_type, q_t_sf)
Write boundary condition type and buffer data to per-rank parallel files using MPI I/O.
subroutine s_populate_grid_variables_buffers
Populate the buffers of the grid variables, which are constituted of the cell-boundary locations and ...
subroutine s_color_function_periodic(c_divs, bc_dir, bc_loc, k, l)
Apply periodic boundary conditions to the color function and its divergence fields.
integer, dimension(1:3, 1:2) mpi_bc_buffer_type
impure subroutine s_populate_capillary_buffers(c_divs, bc_type, bc)
Populate ghost cell buffers for the color function and its divergence used in capillary surface tensi...
subroutine s_assign_default_bc_type(bc_type)
Initialize the per-cell boundary condition type arrays with the global default BC values.
subroutine s_read_serial_boundary_condition_files(step_dirpath, bc_type)
Read boundary condition type and buffer data from serial (unformatted) restart files.
impure subroutine s_create_mpi_types(bc_type)
Create MPI derived datatypes for boundary condition type arrays and buffer arrays used in parallel I/...
subroutine s_color_function_reflective(c_divs, bc_dir, bc_loc, k, l)
Apply reflective boundary conditions to the color function and its divergence fields.
subroutine s_pack_boundary_condition_buffers(q_prim_vf, q_t_sf)
Pack primitive variable boundary slices into bc_buffers arrays for serialization.
subroutine s_read_parallel_boundary_condition_files(bc_type)
Read boundary condition type and buffer data from per-rank parallel files using MPI I/O.
impure subroutine s_populate_f_igr_buffers(bc_type, jac_sf)
Populate ghost cell buffers for the Jacobian scalar field used in the IGR elliptic solver.
subroutine s_color_function_ghost_cell_extrapolation(c_divs, bc_dir, bc_loc, k, l)
Extrapolate the color function and its divergence into ghost cells by copying boundary values.
subroutine s_write_serial_boundary_condition_files(q_prim_vf, bc_type, step_dirpath, old_grid_in, q_t_sf)
Write boundary condition type and buffer data to serial (unformatted) restart files.
Per-cell noncharacteristic boundary condition primitives applied in the ghost cells.
type(scalar_field), dimension(:,:), allocatable bc_buffers
Platform-specific file and directory operations: create, delete, inquire, getcwd, and basename.
impure subroutine my_inquire(fileloc, dircheck)
Inquires on the existence of a directory.
impure subroutine s_create_directory(dir_name)
Create a directory and all its parents if it does not exist.
Compile-time constant parameters: default values, tolerances, and physical constants.
integer, parameter bc_ghost_extrap
integer, parameter bc_axis
integer, parameter bc_reflective
integer, parameter bc_periodic
Rank-staggered file access delays to prevent I/O contention on parallel file systems.
impure subroutine, public delayfileaccess(processrank)
Introduce a rank-dependent busy-wait delay to stagger parallel file access and reduce I/O contention.
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
real(wp) dz
Minimum cell-widths in the x-, y- and z-coordinate directions.
type(int_bounds_info) bc_z
Boundary conditions in the x-, y- and z-coordinate directions.
real(wp), dimension(:), allocatable y_cc
integer proc_rank
Rank of the local processor Number of cells in the x-, y- and z-coordinate directions.
real(wp), dimension(:), allocatable y_cb
type(int_bounds_info), dimension(1:3) idwbuff
integer buff_size
Number of ghost cells for boundary condition storage.
real(wp), dimension(:), allocatable z_cb
type(int_bounds_info) bc_y
real(wp), dimension(:), allocatable x_cc
Locations of cell-centers (cc) in x-, y- and z-directions, respectively.
type(int_bounds_info) bc_x
real(wp), dimension(:), allocatable x_cb
Locations of cell-boundaries (cb) in x-, y- and z-directions, respectively.
real(wp), dimension(:), allocatable z_cc
Broadcasts user inputs and decomposes the domain across MPI ranks for pre-processing.
Groups the x, y, z boundary condition begin/end codes for passing as a single argument.
Integer bounds for variables.
Derived type annexing an integer scalar field (SF).
Derived type annexing a scalar field (SF).