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# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
33! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
34! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
35# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
36# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
37# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
38
39# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45
46# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49
50# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57! New line at end of file is required for FYPP
58# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
59# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
60# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
61# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
62# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
64# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
66
67# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
70
71# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
72# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
73! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
74! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
75# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
76# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
77# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
78
79# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
80# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81
82# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83
84# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
85
86# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
87
88# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
89
90# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
91
92# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
93
94# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
95
96# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
97! New line at end of file is required for FYPP
98# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
99
100# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
102# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
104# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 95 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 100 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 105 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 110 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 115 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 120 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 125 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 130 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 135 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 165 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 219 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 233 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 258 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 269 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 271 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151# 282 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 332 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154
155# 342 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
156
157# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
158
159# 361 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
160
161# 378 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
162
163# 388 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
164
165# 395 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
166
167# 401 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
168
169# 407 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
170
171# 413 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
172
173# 419 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
174
175# 425 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
176! New line at end of file is required for FYPP
177# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
178# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
179# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
180# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
181# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
182# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
183# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
184# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
185
186# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
187# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
188# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
189
190# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
191# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
192! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
193! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
194# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
195# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
196# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
197
198# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
199# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
200
201# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
202
203# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
204
205# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
206
207# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
208
209# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
210
211# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
212
213# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
214
215# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
216! New line at end of file is required for FYPP
217# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
218
219# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236
237# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
238
239# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
240
241# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
242
243# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
244
245# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
246
247# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
248
249# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
250
251# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
252
253# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
254
255# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
256
257# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
258
259# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
260
261# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
262
263# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
264
265# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
266
267# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
268
269# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
270
271# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
272
273# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
274! New line at end of file is required for FYPP
275# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
276
277! GPU parallel region (scalar reductions, maxval/minval)
278# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! GPU parallel loop over threads (most common GPU macro)
281# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Required closing for GPU_PARALLEL_LOOP
284# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Mark routine for device compilation
287# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Declare device-resident data
290# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Inner loop within a GPU parallel region
293# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Scoped GPU data region
296# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! Host code with device pointers (for MPI with GPU buffers)
299# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301! Allocate device memory (unscoped)
302# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303
304! Free device memory
305# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
306
307! Atomic operation on device
308# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
309
310! End atomic capture block
311# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
312
313! Copy data between host and device
314# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
315
316! Synchronization barrier
317# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
318
319! Import GPU library module (openacc or omp_lib)
320# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
321
322! Emit code only for AMD compiler
323# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
324
325! Emit code for non-Cray compilers
326# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
327
328! Emit code only for Cray compiler
329# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
330
331! Emit code for non-NVIDIA compilers
332# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
333
334# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
335# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
336! New line at end of file is required for FYPP
337# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
338
339# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
340
341! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
342! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
343! example see misc/nvidia_uvm/bind.sh.
344# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
345
346! Allocate and create GPU device memory
347# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
348
349! Free GPU device memory and deallocate
350# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
351
352! Cray-specific GPU pointer setup for vector fields
353# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
354
355! Cray-specific GPU pointer setup for scalar fields
356# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
357
358! Cray-specific GPU pointer setup for acoustic source spatials
359# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
360
361# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
362
363# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
364! New line at end of file is required for FYPP
365# 8 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp" 2
366
368
371 use m_mpi_proxy
372 use m_constants
376
377 implicit none
378
379#ifdef MFC_MPI
380 integer, dimension(1:3,1:2) :: mpi_bc_type_type
381 integer, dimension(1:3,1:2) :: mpi_bc_buffer_type
382#endif
383
384contains
385
386 !> Create MPI derived datatypes for boundary condition type arrays and buffer arrays used in parallel I/O.
387 impure subroutine s_create_mpi_types(bc_type)
388
389 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
390
391#ifdef MFC_MPI
392 integer :: dir, loc
393 integer, dimension(3) :: sf_start_idx, sf_extents_loc
394 integer :: ierr
395
396 do dir = 1, num_dims
397 do loc = 1, 2
398 sf_start_idx = (/0, 0, 0/)
399 sf_extents_loc = shape(bc_type(dir, loc)%sf)
400
401 call mpi_type_create_subarray(num_dims, sf_extents_loc, sf_extents_loc, sf_start_idx, mpi_order_fortran, &
402 & mpi_integer, mpi_bc_type_type(dir, loc), ierr)
403 call mpi_type_commit(mpi_bc_type_type(dir, loc), ierr)
404 end do
405 end do
406
407 do dir = 1, num_dims
408 do loc = 1, 2
409 sf_start_idx = (/0, 0, 0/)
410 sf_extents_loc = shape(bc_buffers(dir, loc)%sf)
411
412 call mpi_type_create_subarray(num_dims, sf_extents_loc*mpi_io_type, sf_extents_loc*mpi_io_type, sf_start_idx, &
413 & mpi_order_fortran, mpi_io_p, mpi_bc_buffer_type(dir, loc), ierr)
414 call mpi_type_commit(mpi_bc_buffer_type(dir, loc), ierr)
415 end do
416 end do
417#endif
418
419 end subroutine s_create_mpi_types
420
421 !> Write boundary condition type and buffer data to serial (unformatted) restart files.
422 subroutine s_write_serial_boundary_condition_files(q_prim_vf, bc_type, step_dirpath, old_grid_in, q_T_sf)
423
424 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
425 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
426 logical, intent(in) :: old_grid_in
427 character(LEN=*), intent(in) :: step_dirpath
428 integer :: dir, loc
429 character(len=path_len) :: file_path
430 character(len=10) :: status
431 type(scalar_field), optional, intent(in) :: q_T_sf
432
433 if (old_grid_in) then
434 status = 'old'
435 else
436 status = 'new'
437 end if
438
439 call s_pack_boundary_condition_buffers(q_prim_vf, q_t_sf)
440
441 file_path = trim(step_dirpath) // '/bc_type.dat'
442 open (1, file=trim(file_path), form='unformatted', status=status)
443 do dir = 1, num_dims
444 do loc = 1, 2
445 write (1) bc_type(dir, loc)%sf
446 end do
447 end do
448 close (1)
449
450 file_path = trim(step_dirpath) // '/bc_buffers.dat'
451 open (1, file=trim(file_path), form='unformatted', status=status)
452 do dir = 1, num_dims
453 do loc = 1, 2
454 write (1) bc_buffers(dir, loc)%sf
455 end do
456 end do
457 close (1)
458
460
461 !> Write boundary condition type and buffer data to per-rank parallel files using MPI I/O.
462 subroutine s_write_parallel_boundary_condition_files(q_prim_vf, bc_type, q_T_sf)
463
464 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
465 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
466 integer :: dir, loc
467 character(len=path_len) :: file_loc, file_path
468 type(scalar_field), intent(in), optional :: q_T_sf
469
470#ifdef MFC_MPI
471 integer :: ierr
472 integer :: file_id
473 character(len=7) :: proc_rank_str
474 logical :: dir_check
475 integer :: nelements
476 integer :: unit
477
478 call s_pack_boundary_condition_buffers(q_prim_vf, q_t_sf)
479
480 file_loc = trim(case_dir) // '/restart_data/boundary_conditions'
481 if (proc_rank == 0) then
482 call my_inquire(file_loc, dir_check)
483 if (dir_check .neqv. .true.) then
484 call s_create_directory(trim(file_loc))
485 end if
486 ! The files below are per rank, so record the decomposition they were written for
487 open (newunit=unit, file=trim(file_loc) // '/decomposition.dat', status='replace')
488 write (unit, '(4(I0,1X))') num_procs, num_procs_x, num_procs_y, num_procs_z
489 close (unit)
490 end if
491
492 call s_create_mpi_types(bc_type)
493
494 call s_mpi_barrier()
495
497
498 write (proc_rank_str, '(I7.7)') proc_rank
499 file_path = trim(file_loc) // '/bc_' // trim(proc_rank_str) // '.dat'
500 call mpi_file_open(mpi_comm_self, trim(file_path), mpi_mode_create + mpi_mode_wronly, mpi_info_null, file_id, ierr)
501 call s_check_mpi_file_open(ierr, file_path)
502
503 ! Write bc_types
504 do dir = 1, num_dims
505 do loc = 1, 2
506#ifdef MFC_MIXED_PRECISION
507 nelements = sizeof(bc_type(dir, loc)%sf)
508 call mpi_file_write_all(file_id, bc_type(dir, loc)%sf, nelements, mpi_byte, mpi_status_ignore, ierr)
509#else
510 nelements = sizeof(bc_type(dir, loc)%sf)/4
511 call mpi_file_write_all(file_id, bc_type(dir, loc)%sf, nelements, mpi_integer, mpi_status_ignore, ierr)
512#endif
513 end do
514 end do
515
516 ! Write bc_buffers
517 do dir = 1, num_dims
518 do loc = 1, 2
519 nelements = sizeof(bc_buffers(dir, loc)%sf)*mpi_io_type/stp
520 call mpi_file_write_all(file_id, bc_buffers(dir, loc)%sf, nelements, mpi_io_p, mpi_status_ignore, ierr)
521 end do
522 end do
523
524 call mpi_file_close(file_id, ierr)
525#endif
526
528
529 !> Read boundary condition type and buffer data from serial (unformatted) restart files.
530 subroutine s_read_serial_boundary_condition_files(step_dirpath, bc_type)
531
532 character(LEN=*), intent(in) :: step_dirpath
533 type(integer_field), dimension(1:num_dims,1:2), intent(inout) :: bc_type
534 integer :: dir, loc
535 logical :: file_exist
536 character(len=path_len) :: file_path
537
538 ! Read bc_types
539
540 file_path = trim(step_dirpath) // '/bc_type.dat'
541 inquire (file=trim(file_path), exist=file_exist)
542 if (.not. file_exist) then
543 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
544 end if
545
546 open (1, file=trim(file_path), form='unformatted', status='unknown')
547 do dir = 1, num_dims
548 do loc = 1, 2
549 read (1) bc_type(dir, loc)%sf
550
551# 192 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
552#if defined(MFC_OpenACC)
553# 192 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
554!$acc update device(bc_type(dir, loc)%sf)
555# 192 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
556#elif defined(MFC_OpenMP)
557# 192 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
558!$omp target update to(bc_type(dir, loc)%sf)
559# 192 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
560#endif
561# 193 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
562 end do
563 end do
564 close (1)
565
566 ! Read bc_buffers
567 file_path = trim(step_dirpath) // '/bc_buffers.dat'
568 inquire (file=trim(file_path), exist=file_exist)
569 if (.not. file_exist) then
570 call s_mpi_abort(trim(file_path) // ' is missing. Exiting.')
571 end if
572
573 open (1, file=trim(file_path), form='unformatted', status='unknown')
574 do dir = 1, num_dims
575 do loc = 1, 2
576 read (1) bc_buffers(dir, loc)%sf
577
578# 208 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
579#if defined(MFC_OpenACC)
580# 208 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
581!$acc update device(bc_buffers(dir, loc)%sf)
582# 208 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
583#elif defined(MFC_OpenMP)
584# 208 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
585!$omp target update to(bc_buffers(dir, loc)%sf)
586# 208 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
587#endif
588# 209 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
589 end do
590 end do
591 close (1)
592
594
595 !> Read boundary condition type and buffer data from per-rank parallel files using MPI I/O.
597
598 type(integer_field), dimension(1:num_dims,1:2), intent(inout) :: bc_type
599 logical, intent(in), optional :: strict !< abort on a decomposition mismatch (default)
600 integer :: dir, loc
601 character(len=path_len) :: file_loc, file_path
602
603#ifdef MFC_MPI
604 integer :: ierr
605 integer :: file_id
606 character(len=7) :: proc_rank_str
607 logical :: dir_check
608 integer :: nelements
609 logical :: strict_loc
610
611 file_loc = trim(case_dir) // '/restart_data/boundary_conditions'
612
613 if (proc_rank == 0) then
614 call my_inquire(file_loc, dir_check)
615 if (dir_check .neqv. .true.) then
616 call s_mpi_abort(trim(file_loc) // ' is missing. Exiting.')
617 end if
618 strict_loc = .true.
619 if (present(strict)) strict_loc = strict
620 call s_check_bc_decomposition(file_loc, strict_loc)
621 end if
622
623 call s_create_mpi_types(bc_type)
624
625 call s_mpi_barrier()
626
628
629 write (proc_rank_str, '(I7.7)') proc_rank
630 file_path = trim(file_loc) // '/bc_' // trim(proc_rank_str) // '.dat'
631 call mpi_file_open(mpi_comm_self, trim(file_path), mpi_mode_rdonly, mpi_info_null, file_id, ierr)
632 call s_check_mpi_file_open(ierr, file_path)
633
634 ! Read bc_types
635 do dir = 1, num_dims
636 do loc = 1, 2
637#ifdef MFC_MIXED_PRECISION
638 nelements = sizeof(bc_type(dir, loc)%sf)
639 call mpi_file_read_all(file_id, bc_type(dir, loc)%sf, nelements, mpi_byte, mpi_status_ignore, ierr)
640#else
641 nelements = sizeof(bc_type(dir, loc)%sf)/4
642 call mpi_file_read_all(file_id, bc_type(dir, loc)%sf, nelements, mpi_integer, mpi_status_ignore, ierr)
643#endif
644
645# 264 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
646#if defined(MFC_OpenACC)
647# 264 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
648!$acc update device(bc_type(dir, loc)%sf)
649# 264 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
650#elif defined(MFC_OpenMP)
651# 264 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
652!$omp target update to(bc_type(dir, loc)%sf)
653# 264 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
654#endif
655# 265 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
656 end do
657 end do
658
659 ! Read bc_buffers
660 do dir = 1, num_dims
661 do loc = 1, 2
662 nelements = sizeof(bc_buffers(dir, loc)%sf)*mpi_io_type/stp
663 call mpi_file_read_all(file_id, bc_buffers(dir, loc)%sf, nelements, mpi_io_p, mpi_status_ignore, ierr)
664
665# 273 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
666#if defined(MFC_OpenACC)
667# 273 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
668!$acc update device(bc_buffers(dir, loc)%sf)
669# 273 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
670#elif defined(MFC_OpenMP)
671# 273 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
672!$omp target update to(bc_buffers(dir, loc)%sf)
673# 273 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
674#endif
675# 274 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
676 end do
677 end do
678
679 call mpi_file_close(file_id, ierr)
680#endif
681
683
684 !> Check that the per-rank boundary files in file_loc were written for this run's decomposition: abort if strict, else warn.
685 !! They are read by rank index, so on another decomposition each rank would silently read another rank's boundary slab. Files
686 !! written before decomposition.dat existed are not checked.
687 impure subroutine s_check_bc_decomposition(file_loc, strict)
688
689 character(len=*), intent(in) :: file_loc
690 logical, intent(in) :: strict
691 integer :: decomp(4)
692 integer :: unit, ios
693 logical :: file_exist
694 character(len=64) :: written, running
695
696 inquire (file=trim(file_loc) // '/decomposition.dat', exist=file_exist)
697 if (.not. file_exist) return
698
699 open (newunit=unit, file=trim(file_loc) // '/decomposition.dat', status='old', action='read', iostat=ios)
700 if (ios == 0) then
701 read (unit, *, iostat=ios) decomp
702 close (unit)
703 end if
704 if (ios /= 0) then
705 if (strict) then
706 call s_mpi_abort(trim(file_loc) // '/decomposition.dat is unreadable. Exiting.')
707 else
708 print '(A)', 'WARNING: ' // trim(file_loc) // '/decomposition.dat is unreadable; rank count not checked.'
709 end if
710 return
711 end if
712
713 if (any(decomp /= [num_procs, num_procs_x, num_procs_y, num_procs_z])) then
714 write (written, '(I0," ranks (",I0,"x",I0,"x",I0,")")') decomp
715 write (running, '(I0," ranks (",I0,"x",I0,"x",I0,")")') num_procs, num_procs_x, num_procs_y, num_procs_z
716 if (strict) then
717 call s_mpi_abort(trim(file_loc) // ' was written for ' // trim(written) // ' but this run uses ' // trim(running) &
718 & // '. These per-rank boundary files only work on the decomposition that ' &
719 & // 'wrote them: run on that rank count, or rerun pre_process on this one.')
720 else
721 print '(A)', &
722 & 'WARNING: ' // trim(file_loc) // ' was written for ' // trim(written) &
723 & // ' but this run uses ' // trim(running) &
724 & // '; boundary ghost values will be wrong. Use the pre_process rank count.'
725 end if
726 end if
727
728 end subroutine s_check_bc_decomposition
729
730 !> Pack primitive variable boundary slices into bc_buffers arrays for serialization.
731 subroutine s_pack_boundary_condition_buffers(q_prim_vf, q_T_sf)
732
733 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
734 integer :: i, j, k
735 type(scalar_field), intent(in), optional :: q_T_sf
736
737 do k = 0, p
738 do j = 0, n
739 do i = 1, sys_size
740 bc_buffers(1, 1)%sf(i, j, k) = q_prim_vf(i)%sf(0, j, k)
741 bc_buffers(1, 2)%sf(i, j, k) = q_prim_vf(i)%sf(m, j, k)
742 end do
743 if ((chemistry .or. heat_conduction) .and. present(q_t_sf)) then
744 bc_buffers(1, 1)%sf(sys_size + 1, j, k) = q_t_sf%sf(0, j, k)
745 bc_buffers(1, 2)%sf(sys_size + 1, j, k) = q_t_sf%sf(m, j, k)
746 end if
747 end do
748 end do
749
750# 349 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
751 if (n > 0) then
752 do k = 0, p
753 do j = 1, sys_size
754 do i = 0, m
755 bc_buffers(2, 1)%sf(i, j, k) = q_prim_vf(j)%sf(i, 0, k)
756 bc_buffers(2, 2)%sf(i, j, k) = q_prim_vf(j)%sf(i, n, k)
757 end do
758 end do
759 if ((chemistry .or. heat_conduction) .and. present(q_t_sf)) then
760 do i = 0, m
761 bc_buffers(2, 1)%sf(i, sys_size + 1, k) = q_t_sf%sf(i, 0, k)
762 bc_buffers(2, 2)%sf(i, sys_size + 1, k) = q_t_sf%sf(i, n, k)
763 end do
764 end if
765 end do
766
767# 366 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
768 if (p > 0) then
769 do k = 1, sys_size
770 do j = 0, n
771 do i = 0, m
772 bc_buffers(3, 1)%sf(i, j, k) = q_prim_vf(k)%sf(i, j, 0)
773 bc_buffers(3, 2)%sf(i, j, k) = q_prim_vf(k)%sf(i, j, p)
774 end do
775 end do
776 end do
777 if ((chemistry .or. heat_conduction) .and. present(q_t_sf)) then
778 do j = 0, n
779 do i = 0, m
780 bc_buffers(3, 1)%sf(i, j, sys_size + 1) = q_t_sf%sf(i, j, 0)
781 bc_buffers(3, 2)%sf(i, j, sys_size + 1) = q_t_sf%sf(i, j, p)
782 end do
783 end do
784 end if
785 end if
786# 385 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
787 end if
788# 387 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
789
791
792 !> Initialize the per-cell boundary condition type arrays with the global default BC values.
793 subroutine s_assign_default_bc_type(bc_type)
794
795 type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
796
797 bc_type(1, 1)%sf(:,:,:) = int(min(bc_x%beg, 0), kind=1)
798 bc_type(1, 2)%sf(:,:,:) = int(min(bc_x%end, 0), kind=1)
799
800# 397 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
801#if defined(MFC_OpenACC)
802# 397 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
803!$acc update device(bc_type(1, 1)%sf, bc_type(1, 2)%sf)
804# 397 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
805#elif defined(MFC_OpenMP)
806# 397 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
807!$omp target update to(bc_type(1, 1)%sf, bc_type(1, 2)%sf)
808# 397 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
809#endif
810# 398 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
811
812# 400 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
813 if (n > 0) then
814 bc_type(2, 1)%sf(:,:,:) = int(min(bc_y%beg, 0), kind=1)
815 bc_type(2, 2)%sf(:,:,:) = int(min(bc_y%end, 0), kind=1)
816
817# 403 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
818#if defined(MFC_OpenACC)
819# 403 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
820!$acc update device(bc_type(2, 1)%sf, bc_type(2, 2)%sf)
821# 403 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
822#elif defined(MFC_OpenMP)
823# 403 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
824!$omp target update to(bc_type(2, 1)%sf, bc_type(2, 2)%sf)
825# 403 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
826#endif
827# 404 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
828# 405 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
829 if (p > 0) then
830 bc_type(3, 1)%sf(:,:,:) = int(min(bc_z%beg, 0), kind=1)
831 bc_type(3, 2)%sf(:,:,:) = int(min(bc_z%end, 0), kind=1)
832
833# 408 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
834#if defined(MFC_OpenACC)
835# 408 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
836!$acc update device(bc_type(3, 1)%sf, bc_type(3, 2)%sf)
837# 408 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
838#elif defined(MFC_OpenMP)
839# 408 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
840!$omp target update to(bc_type(3, 1)%sf, bc_type(3, 2)%sf)
841# 408 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
842#endif
843# 409 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
844 end if
845# 411 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
846 end if
847# 413 "/home/runner/work/MFC/MFC/src/common/m_boundary_io.fpp"
848
849 end subroutine s_assign_default_bc_type
850
851end module m_boundary_io
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.
integer, dimension(1:3, 1:2) mpi_bc_buffer_type
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_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, strict)
Read boundary condition type and buffer data from per-rank parallel files using MPI I/O.
impure subroutine s_check_bc_decomposition(file_loc, strict)
Check that the per-rank boundary files in file_loc were written for this run's decomposition: abort i...
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)
Inquire on the existence of a directory or file.
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.
Rank-staggered file access delays to prevent I/O contention on parallel file systems.
impure subroutine, public s_delay_file_access(process_rank)
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.
Global parameters for the post-process: domain geometry, equation of state, and output database setti...
integer proc_rank
Rank of the local processor.
integer num_procs
Number of processors.
MPI gather and scatter operations for distributing post-process grid and flow-variable data.
Derived type annexing an integer scalar field (SF).
Derived type annexing a scalar field (SF).