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