MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_ibm.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2!>
3!! @file
4!! @brief Contains module m_ibm
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
7# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
8# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
9# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
10# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
11# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
12# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
13# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
14
15# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
16# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
17# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
18
19# 15 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
21# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22
23# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24
25# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26
27# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28
29# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30
31# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32
33# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
34
35# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
36
37# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38! New line at end of file is required for FYPP
39# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
40# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
41# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
42# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
46# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 15 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63
64# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67
68# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71! New line at end of file is required for FYPP
72# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
73
74# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
76# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
78# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 126 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 156 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 197 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 211 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 236 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 247 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 249 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125# 260 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 310 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 320 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 356 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 366 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 373 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 379 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 385 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 391 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 397 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 403 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150! New line at end of file is required for FYPP
151# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
152# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
153# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
154# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
156# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159
160# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 15 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171
172# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175
176# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179
180# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
181
182# 174 "/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.
311# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
312
313! Allocate and create GPU device memory
314# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
315
316! Free GPU device memory and deallocate
317# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
318
319! Cray-specific GPU pointer setup for vector fields
320# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
321
322! Cray-specific GPU pointer setup for scalar fields
323# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
324
325! Cray-specific GPU pointer setup for acoustic source spatials
326# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
327
328# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
329
330# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
331! New line at end of file is required for FYPP
332# 6 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp" 2
333
334!> @brief Ghost-node immersed boundary method: locates ghost/image points, computes interpolation coefficients, and corrects the
335!! flow state
336module m_ibm
337
338 use m_derived_types
339 use m_global_parameters
340 use m_mpi_proxy
341 use m_variables_conversion
342 use m_eos
343 use m_helper
344 use m_helper_basic
345 use m_constants
346 use m_compute_levelset
347 use m_ib_patches
348 use m_viscous
349 use m_model
350 use m_patch_geometries
351 use m_collisions
352 use m_thermochem, only: num_species, gas_constant, get_mixture_molecular_weight, get_mixture_energy_mass
353
354 implicit none
355
356 private :: s_compute_image_points, s_compute_interpolation_coeffs, s_interpolate_image_point, s_find_ghost_points, &
357 & s_find_num_ghost_points, s_compute_ghost_point_pressure, s_compute_ghost_point_velocity
358 ; public :: s_initialize_ibm_module, s_ibm_setup, s_ibm_correct_state, s_finalize_ibm_module
359
360 type(integer_field), public :: ib_markers
361
362# 34 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
363#if defined(MFC_OpenACC)
364# 34 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
365!$acc declare create(ib_markers)
366# 34 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
367#elif defined(MFC_OpenMP)
368# 34 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
369!$omp declare target (ib_markers)
370# 34 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
371#endif
372
373 type(ghost_point), dimension(:), allocatable :: ghost_points
374
375# 37 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
376#if defined(MFC_OpenACC)
377# 37 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
378!$acc declare create(ghost_points)
379# 37 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
380#elif defined(MFC_OpenMP)
381# 37 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
382!$omp declare target (ghost_points)
383# 37 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
384#endif
385
386 integer :: num_gps !< Number of ghost points
387#if defined(MFC_OpenACC)
388
389# 41 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
390#if defined(MFC_OpenACC)
391# 41 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
392!$acc declare create(gp_layers, num_gps)
393# 41 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
394#elif defined(MFC_OpenMP)
395# 41 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
396!$omp declare target (gp_layers, num_gps)
397# 41 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
398#endif
399#elif defined(MFC_OpenMP)
400
401# 43 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
402#if defined(MFC_OpenACC)
403# 43 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
404!$acc declare create(num_gps)
405# 43 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
406#elif defined(MFC_OpenMP)
407# 43 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
408!$omp declare target (num_gps)
409# 43 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
410#endif
411#endif
412 logical :: moving_immersed_boundary_flag
413
414 ! IB MPI buffers
415 integer, allocatable :: send_ids(:), recv_ids(:)
416 real(wp), allocatable :: send_ft(:,:), recv_ft(:,:)
417 real(wp), allocatable :: recv_forces_snap(:,:), recv_torques_snap(:,:)
418
419contains
420
421 !> Allocates memory for the variables in the IBM module
422 impure subroutine s_initialize_ibm_module()
423
424 if (p > 0) then
425#ifdef MFC_DEBUG
426# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
427 block
428# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
429 use iso_fortran_env, only: output_unit
430# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
431
432# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
433 print *, 'm_ibm.fpp:58: ', '@:ALLOCATE(ib_markers%sf(-buff_size:m+buff_size, -buff_size:n+buff_size, -buff_size:p+buff_size))'
434# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
435
436# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
437 call flush (output_unit)
438# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
439 end block
440# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
441#endif
442# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
443 allocate (ib_markers%sf(-buff_size:m+buff_size, -buff_size:n+buff_size, -buff_size:p+buff_size))
444# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
445
446# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
447
448# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
449#if defined(MFC_OpenACC)
450# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
451!$acc enter data create(ib_markers%sf)
452# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
453#elif defined(MFC_OpenMP)
454# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
455!$omp target enter data map(always,alloc:ib_markers%sf)
456# 58 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
457#endif
458 else
459#ifdef MFC_DEBUG
460# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
461 block
462# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
463 use iso_fortran_env, only: output_unit
464# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
465
466# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
467 print *, 'm_ibm.fpp:60: ', '@:ALLOCATE(ib_markers%sf(-buff_size:m+buff_size, -buff_size:n+buff_size, 0:0))'
468# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
469
470# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
471 call flush (output_unit)
472# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
473 end block
474# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
475#endif
476# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
477 allocate (ib_markers%sf(-buff_size:m+buff_size, -buff_size:n+buff_size, 0:0))
478# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
479
480# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
481
482# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
483#if defined(MFC_OpenACC)
484# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
485!$acc enter data create(ib_markers%sf)
486# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
487#elif defined(MFC_OpenMP)
488# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
489!$omp target enter data map(always,alloc:ib_markers%sf)
490# 60 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
491#endif
492 end if
493
494#ifdef _CRAYFTN
495# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
496 block
497# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
498#ifdef MFC_DEBUG
499# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
500 block
501# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
502 use iso_fortran_env, only: output_unit
503# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
504
505# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
506 print *, 'm_ibm.fpp:63: ', '@:ACC_SETUP_SFs(ib_markers)'
507# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
508
509# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
510 call flush (output_unit)
511# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
512 end block
513# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
514#endif
515# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
516
517# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
518
519# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
520#if defined(MFC_OpenACC)
521# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
522!$acc enter data copyin(ib_markers)
523# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
524#elif defined(MFC_OpenMP)
525# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
526!$omp target enter data map(to:ib_markers)
527# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
528#endif
529# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
530 if (associated(ib_markers%sf)) then
531# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
532
533# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
534#if defined(MFC_OpenACC)
535# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
536!$acc enter data copyin(ib_markers%sf)
537# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
538#elif defined(MFC_OpenMP)
539# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
540!$omp target enter data map(to:ib_markers%sf)
541# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
542#endif
543# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
544 end if
545# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
546 end block
547# 63 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
548#endif
549
550
551# 65 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
552#if defined(MFC_OpenACC)
553# 65 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
554!$acc enter data copyin(num_gps)
555# 65 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
556#elif defined(MFC_OpenMP)
557# 65 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
558!$omp target enter data map(to:num_gps)
559# 65 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
560#endif
561
562 if (collision_model > 0) call s_initialize_collisions_module()
563
564 end subroutine s_initialize_ibm_module
565
566 !> Initializes the values of various IBM variables, such as ghost points and image points.
567 impure subroutine s_ibm_setup()
568
569 integer :: i, j, k
570 real(wp) :: t_init !< initial time for prescribed kinematics
571 integer(kind=8) :: max_num_gps
572
573 call nvtxstartrange("SETUP-IBM-MODULE")
574
575 ! GPU routines require updated cell centers
576
577# 81 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
578#if defined(MFC_OpenACC)
579# 81 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
580!$acc update device(num_ibs, num_gbl_ibs, x_cc, y_cc, dx, dy, ib_bc_x%beg, ib_bc_x%end, ib_bc_y%beg, ib_bc_y%end)
581# 81 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
582#elif defined(MFC_OpenMP)
583# 81 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
584!$omp target update to(num_ibs, num_gbl_ibs, x_cc, y_cc, dx, dy, ib_bc_x%beg, ib_bc_x%end, ib_bc_y%beg, ib_bc_y%end)
585# 81 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
586#endif
587 if (p /= 0) then
588
589# 83 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
590#if defined(MFC_OpenACC)
591# 83 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
592!$acc update device(z_cc, dz, ib_bc_z%beg, ib_bc_z%end)
593# 83 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
594#elif defined(MFC_OpenMP)
595# 83 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
596!$omp target update to(z_cc, dz, ib_bc_z%beg, ib_bc_z%end)
597# 83 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
598#endif
599 end if
600
601# 85 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
602#if defined(MFC_OpenACC)
603# 85 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
604!$acc update device(patch_ib(1:num_ibs), glb_bounds)
605# 85 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
606#elif defined(MFC_OpenMP)
607# 85 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
608!$omp target update to(patch_ib(1:num_ibs), glb_bounds)
609# 85 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
610#endif
611
612 ! do all set up for moving immersed boundaries; prescribed kinematics are evaluated at the initial time so the
613 ! first stage already sees the correct body state, velocity and angular velocity
614 t_init = t_step_start*dt
615 if (cfl_dt) t_init = t_save*n_start
616
617# 91 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
618
619# 91 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
620#if defined(MFC_OpenACC)
621# 91 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
622!$acc parallel loop gang vector default(present) private(i) copyin(t_init)
623# 91 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
624#elif defined(MFC_OpenMP)
625# 91 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
626
627# 91 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
628
629# 91 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
630
631# 91 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
632!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i) map(to:t_init)
633# 91 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
634#endif
635 do i = 1, num_ibs
636 if (patch_ib(i)%moving_ibm /= 0) then
637 if (patch_ib(i)%kin_model > 0) call s_prescribed_kinematics(i, t_init)
638 call s_compute_moment_of_inertia(patch_ib(i), patch_ib(i)%angular_vel, patch_ib(i)%moment)
639 end if
640 call s_update_ib_rotation_matrix(i)
641 end do
642
643# 99 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
644#if defined(MFC_OpenACC)
645# 99 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
646!$acc end parallel loop
647# 99 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
648#elif defined(MFC_OpenMP)
649# 99 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
650
651# 99 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
652!$omp end target teams loop
653# 99 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
654#endif
655
656# 100 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
657#if defined(MFC_OpenACC)
658# 100 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
659!$acc update host(patch_ib(1:num_ibs))
660# 100 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
661#elif defined(MFC_OpenMP)
662# 100 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
663!$omp target update from(patch_ib(1:num_ibs))
664# 100 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
665#endif
666
667 ! allocate some arrays for MPI communication, if required by this simulation
668#ifdef MFC_MPI
669 if (num_procs > 1) then
670#ifdef MFC_DEBUG
671# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
672 block
673# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
674 use iso_fortran_env, only: output_unit
675# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
676
677# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
678 print *, 'm_ibm.fpp:105: ', '@:ALLOCATE(send_ids(size(patch_ib)), send_ft(6, size(patch_ib)))'
679# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
680
681# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
682 call flush (output_unit)
683# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
684 end block
685# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
686#endif
687# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
688 allocate (send_ids(size(patch_ib)), send_ft(6, size(patch_ib)))
689# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
690
691# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
692
693# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
694
695# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
696#if defined(MFC_OpenACC)
697# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
698!$acc enter data create(send_ids, send_ft)
699# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
700#elif defined(MFC_OpenMP)
701# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
702!$omp target enter data map(always,alloc:send_ids, send_ft)
703# 105 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
704#endif
705#ifdef MFC_DEBUG
706# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
707 block
708# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
709 use iso_fortran_env, only: output_unit
710# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
711
712# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
713 print *, 'm_ibm.fpp:106: ', '@:ALLOCATE(recv_forces_snap(size(patch_ib), 3), recv_torques_snap(size(patch_ib), 3), recv_ids(size(patch_ib)), recv_ft(6, size(patch_ib)))'
714# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
715
716# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
717 call flush (output_unit)
718# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
719 end block
720# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
721#endif
722# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
723 allocate (recv_forces_snap(size(patch_ib), 3), recv_torques_snap(size(patch_ib), 3), recv_ids(size(patch_ib)), recv_ft(6, size(patch_ib)))
724# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
725
726# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
727
728# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
729
730# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
731
732# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
733
734# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
735#if defined(MFC_OpenACC)
736# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
737!$acc enter data create(recv_forces_snap, recv_torques_snap, recv_ids, recv_ft)
738# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
739#elif defined(MFC_OpenMP)
740# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
741!$omp target enter data map(always,alloc:recv_forces_snap, recv_torques_snap, recv_ids, recv_ft)
742# 106 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
743#endif
744# 108 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
745 end if
746#endif
747
748 call s_update_ib_lookup()
749
750 ! recompute the new ib_patch locations
751 ib_markers%sf = 0._wp
752
753# 115 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
754#if defined(MFC_OpenACC)
755# 115 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
756!$acc update device(ib_markers%sf)
757# 115 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
758#elif defined(MFC_OpenMP)
759# 115 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
760!$omp target update to(ib_markers%sf)
761# 115 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
762#endif
763 call s_apply_ib_patches(ib_markers)
764
765# 117 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
766#if defined(MFC_OpenACC)
767# 117 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
768!$acc update host(ib_markers%sf)
769# 117 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
770#elif defined(MFC_OpenMP)
771# 117 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
772!$omp target update from(ib_markers%sf)
773# 117 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
774#endif
775 do i = 1, num_ibs
776 if (patch_ib(i)%moving_ibm /= 0) call s_compute_centroid_offset(i) ! offsets are computed after IB markers are generated
777
778# 120 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
779#if defined(MFC_OpenACC)
780# 120 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
781!$acc update device(patch_ib(i))
782# 120 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
783#elif defined(MFC_OpenMP)
784# 120 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
785!$omp target update to(patch_ib(i))
786# 120 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
787#endif
788 end do
789
790 ! find the number of ghost points and set them to be the maximum total across ranks
791 call s_find_num_ghost_points(num_gps)
792 if (moving_immersed_boundary_flag) then
793 call s_mpi_allreduce_integer_sum(int(num_gps, 8), max_num_gps)
794 max_num_gps = min(max_num_gps*2_8, int(m + 1, 8)*int(n + 1, 8)*int(p + 1, 8))
795 else
796 max_num_gps = int(num_gps, 8)
797 end if
798
799 ! set the size of the ghost point arrays to be the amount of points total, plus a factor of 2 buffer
800
801# 133 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
802#if defined(MFC_OpenACC)
803# 133 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
804!$acc update device(num_gps)
805# 133 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
806#elif defined(MFC_OpenMP)
807# 133 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
808!$omp target update to(num_gps)
809# 133 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
810#endif
811#ifdef MFC_DEBUG
812# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
813 block
814# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
815 use iso_fortran_env, only: output_unit
816# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
817
818# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
819 print *, 'm_ibm.fpp:134: ', '@:ALLOCATE(ghost_points(1:max_num_gps))'
820# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
821
822# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
823 call flush (output_unit)
824# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
825 end block
826# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
827#endif
828# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
829 allocate (ghost_points(1:max_num_gps))
830# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
831
832# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
833
834# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
835#if defined(MFC_OpenACC)
836# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
837!$acc enter data create(ghost_points)
838# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
839#elif defined(MFC_OpenMP)
840# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
841!$omp target enter data map(always,alloc:ghost_points)
842# 134 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
843#endif
844
845
846# 136 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
847#if defined(MFC_OpenACC)
848# 136 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
849!$acc enter data copyin(ghost_points)
850# 136 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
851#elif defined(MFC_OpenMP)
852# 136 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
853!$omp target enter data map(to:ghost_points)
854# 136 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
855#endif
856 ! Ghost-cell IBM, Tseng & Ferziger JCP (2003), Mittal & Iaccarino ARFM (2005)
857 call s_find_ghost_points(ghost_points)
858 call s_apply_levelset(ghost_points, num_gps)
859
860 call s_compute_image_points(ghost_points)
861 call s_compute_interpolation_coeffs(ghost_points)
862
863 call nvtxendrange
864
865 end subroutine s_ibm_setup
866
867 subroutine s_compute_ghost_point_pressure(gp, gp_patch_id, alpha_rho_IP, pres_IP, pres_GP)
868
869
870# 150 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
871#if MFC_OpenACC
872# 150 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
873!$acc routine seq
874# 150 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
875#elif MFC_OpenMP
876# 150 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
877
878# 150 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
879
880# 150 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
881!$omp declare target device_type(any)
882# 150 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
883#endif
884
885 type(ghost_point), intent(in) :: gp
886 integer, intent(in) :: gp_patch_id
887# 157 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
888 real(wp), dimension(num_fluids), intent(in) :: alpha_rho_ip
889# 159 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
890 real(wp), intent(in) :: pres_ip
891 real(wp), intent(out) :: pres_gp
892 integer :: q !< Iterator variable
893
894 pres_gp = 0._wp
895
896# 164 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
897#if defined(MFC_OpenACC)
898# 164 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
899!$acc loop seq
900# 164 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
901#elif defined(MFC_OpenMP)
902# 164 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
903
904# 164 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
905#endif
906 do q = 1, num_fluids
907 ! Pressure correction for moving IB: accounts for acceleration of IB surface
908 pres_gp = pres_gp + pres_ip/(1._wp - 2._wp*abs(gp%levelset*alpha_rho_ip(q)/pres_ip) &
909 & *dot_product(patch_ib(gp_patch_id)%force/patch_ib(gp_patch_id)%mass, gp%levelset_norm))
910 end do
911
912 end subroutine s_compute_ghost_point_pressure
913
914 subroutine s_compute_ghost_point_velocity(gp, gp_patch_id, radial_vector, vel_IP, pres_IP, vel_GP)
915
916
917# 175 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
918#if MFC_OpenACC
919# 175 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
920!$acc routine seq
921# 175 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
922#elif MFC_OpenMP
923# 175 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
924
925# 175 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
926
927# 175 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
928!$omp declare target device_type(any)
929# 175 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
930#endif
931
932 type(ghost_point), intent(in) :: gp
933 integer, intent(in) :: gp_patch_id
934 real(wp), dimension(3), intent(in) :: radial_vector, vel_ip
935 real(wp), intent(in) :: pres_ip
936 real(wp), dimension(3), intent(out) :: vel_gp
937 real(wp), dimension(3) :: norm, vel_norm_ip, rotation_velocity
938 real(wp) :: buf, v_blow_eff
939 integer :: q !< Iterator variable
940
941 ! Calculate velocity of ghost cell
942 if (gp%slip) then
943 norm(1:3) = gp%levelset_norm
944 buf = sqrt(sum(norm**2))
945 norm = norm/buf
946 vel_norm_ip = sum(vel_ip*norm)*norm
947 vel_gp = vel_ip - vel_norm_ip
948 if (patch_ib(gp_patch_id)%moving_ibm /= 0) then
949 ! compute the linear velocity of the ghost point due to rotation
950 call s_cross_product(patch_ib(gp_patch_id)%angular_vel, radial_vector, rotation_velocity)
951
952 ! add only the component of the IB's motion that is normal to the surface
953 vel_gp = vel_gp + sum((patch_ib(gp_patch_id)%vel + rotation_velocity)*norm)*norm
954 end if
955 else
956 if (patch_ib(gp_patch_id)%moving_ibm == 0) then
957 ! we know the object is not moving if moving_ibm is 0 (false)
958 vel_gp = 0._wp
959 else
960 ! convert the angular velocity from the inertial reference frame to the fluids frame, then convert to linear
961 ! velocity
962 call s_cross_product(patch_ib(gp_patch_id)%angular_vel, radial_vector, rotation_velocity)
963 do q = 1, 3
964 ! if mibm is 1 or 2, then the boundary may be moving
965 vel_gp(q) = patch_ib(gp_patch_id)%vel(q) ! add the linear velocity
966 vel_gp(q) = vel_gp(q) + rotation_velocity(q) ! add the rotational velocity
967 end do
968 end if
969 end if
970
971 ! Burning/injecting surface: superimpose wall-normal (outward) blowing on the
972 ! ghost velocity so the immersed surface transpires/injects gas into the flow.
973 if (patch_ib(gp_patch_id)%v_blow > 0._wp) then
974 v_blow_eff = patch_ib(gp_patch_id)%v_blow
975 ! Pressure-coupled burn rate (Vieille's law r_dot ~ p^n)
976 if (patch_ib(gp_patch_id)%burn_rate_pref > 0._wp) then
977 ! max(pres_IP, 0) guards the fractional power against a transient negative
978 v_blow_eff = v_blow_eff*(max(pres_ip, &
979 & 0._wp)/patch_ib(gp_patch_id)%burn_rate_pref)**patch_ib(gp_patch_id)%burn_rate_exp
980 end if
981 norm(1:3) = gp%levelset_norm
982 buf = sqrt(sum(norm**2))
983 if (buf > 0._wp) vel_gp = vel_gp + v_blow_eff*norm/buf
984 end if
985
986 end subroutine s_compute_ghost_point_velocity
987
988 !> Update the conservative variables at the ghost points
989 subroutine s_ibm_correct_state(q_cons_vf, q_prim_vf, pb_in, mv_in)
990
991 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf !< Primitive Variables
992 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf !< Primitive Variables
993 real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), optional, intent(inout) :: pb_in, mv_in
994 integer :: i, j, k, l, q, r !< Iterator variables
995 integer :: patch_id, patch_id_temp !< Patch ID of ghost point
996 real(wp) :: rho, gamma, pi_inf, dyn_pres !< Mixture variables
997 real(wp) :: vel_sum_g, e_ghost !< Ghost-point velocity magnitude and energy
998 real(wp), dimension(2) :: re_k
999 real(wp) :: g_k
1000 real(wp) :: qv_k
1001 real(wp) :: pres_ip, pres_gp
1002 real(wp), dimension(3) :: vel_ip
1003 real(wp) :: c_ip
1004
1005# 258 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1006 real(wp), dimension(num_fluids) :: gs
1007 real(wp), dimension(num_fluids) :: alpha_rho_ip, alpha_ip
1008 real(wp), dimension(nb) :: r_ip, v_ip, pb_ip, mv_ip
1009 real(wp), dimension(nb*nmom) :: nmom_ip
1010 real(wp), dimension(nb*nnode) :: presb_ip, massv_ip
1011 real(wp), dimension(num_species) :: ys_ip
1012# 265 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1013 real(wp) :: alpha_q, alpha_rho_q, e_q
1014 real(wp) :: t_ip, mw_ip, e_ip !< Image-point temperature, mixture MW, and mass-specific internal energy (chemistry)
1015 ! Primitive variables at the image point associated with a ghost point, interpolated from surrounding fluid cells.
1016
1017 real(wp), dimension(3) :: physical_loc !< Physical loc of GP
1018 real(wp), dimension(3) :: vel_g !< Velocity of GP
1019 real(wp), dimension(3) :: radial_vector !< vector from centroid to ghost point
1020 real(wp) :: nbub
1021 type(ghost_point) :: gp
1022
1023 ! set the Moving IBM interior conservative variables
1024
1025# 276 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1026
1027# 276 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1028#if defined(MFC_OpenACC)
1029# 276 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1030!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, patch_id, rho)
1031# 276 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1032#elif defined(MFC_OpenMP)
1033# 276 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1034
1035# 276 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1036
1037# 276 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1038
1039# 276 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1040!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1041# 276 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1042!$omp& private(i, j, k, patch_id, rho)
1043# 276 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1044#endif
1045 do l = 0, p
1046 do k = 0, n
1047 do j = 0, m
1048 patch_id = ib_markers%sf(j, k, l)
1049 if (patch_id /= 0) then
1050 call s_decode_patch_periodicity(patch_id, patch_id_temp)
1051 call s_get_neighborhood_idx(patch_id_temp, patch_id)
1052 if (patch_id > 0) then
1053 ! Placeholder low pressure inside the IB solid. Skip it with
1054 ! chemistry on: it would force an unphysical temperature
1055 ! (P=1 Pa at the ambient density -> T~0.01 K), which the
1056 ! Cantera temperature/transport evaluation (run grid-wide
1057 ! before the IB mask is applied) cannot handle -> NaN/hang.
1058 ! The interior is masked from the RHS regardless.
1059 if (.not. chemistry) q_prim_vf(eqn_idx%E)%sf(j, k, l) = 1._wp
1060 rho = 0._wp
1061 do i = 1, num_fluids
1062 rho = rho + q_prim_vf(eqn_idx%cont%beg + i - 1)%sf(j, k, l)
1063 end do
1064
1065 ! Sets the momentum
1066 do i = 1, num_dims
1067 q_cons_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l) = patch_ib(patch_id)%vel(i)*rho
1068 q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l) = patch_ib(patch_id)%vel(i)
1069 end do
1070 end if ! patch_id > 0
1071 end if
1072 end do
1073 end do
1074 end do
1075
1076# 307 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1077#if defined(MFC_OpenACC)
1078# 307 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1079!$acc end parallel loop
1080# 307 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1081#elif defined(MFC_OpenMP)
1082# 307 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1083
1084# 307 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1085!$omp end target teams loop
1086# 307 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1087#endif
1088
1089 if (num_gps > 0) then
1090
1091# 310 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1092
1093# 310 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1094#if defined(MFC_OpenACC)
1095# 310 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1096!$acc parallel loop gang vector default(present) private(i, physical_loc, dyn_pres, alpha_rho_IP, alpha_IP, pres_IP, pres_GP, vel_IP, vel_g, r_IP, v_IP, pb_IP, mv_IP, nmom_IP, presb_IP, massv_IP, rho, &
1097# 310 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1098!$acc& gamma, pi_inf, Re_K, G_K, Gs, gp, radial_vector, j, k, l, q, qv_K, c_IP, nbub, patch_id, Ys_IP, T_IP, mw_IP, e_IP, vel_sum_g, E_ghost, alpha_q, alpha_rho_q, e_q)
1099# 310 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1100#elif defined(MFC_OpenMP)
1101# 310 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1102
1103# 310 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1104
1105# 310 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1106
1107# 310 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1108!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, physical_loc, dyn_pres, &
1109# 310 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1110!$omp& alpha_rho_IP, alpha_IP, pres_IP, pres_GP, vel_IP, vel_g, r_IP, v_IP, pb_IP, mv_IP, nmom_IP, presb_IP, massv_IP, rho, gamma, pi_inf, Re_K, G_K, Gs, gp, radial_vector, j, k, l, q, qv_K, c_IP, &
1111# 310 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1112!$omp& nbub, patch_id, Ys_IP, T_IP, mw_IP, e_IP, vel_sum_g, E_ghost, alpha_q, alpha_rho_q, e_q)
1113# 310 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1114#endif
1115# 314 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1116 do i = 1, num_gps
1117 gp = ghost_points(i)
1118 j = gp%loc(1)
1119 k = gp%loc(2)
1120 l = gp%loc(3)
1121 patch_id = ghost_points(i)%ib_patch_id
1122
1123 ! Calculate physical location of GP
1124 physical_loc = [x_cc(j), y_cc(k), 0._wp]
1125 if (num_dims == 3) physical_loc(3) = z_cc(l)
1126
1127 ! Interpolate primitive variables at image point associated w/ GP
1128 if (bubbles_euler .and. .not. qbmm) then
1129 call s_interpolate_image_point(q_prim_vf, gp, alpha_rho_ip, alpha_ip, pres_ip, vel_ip, c_ip, r_ip, v_ip, &
1130 & pb_ip, mv_ip)
1131 else if (qbmm .and. polytropic) then
1132 call s_interpolate_image_point(q_prim_vf, gp, alpha_rho_ip, alpha_ip, pres_ip, vel_ip, c_ip, r_ip, v_ip, &
1133 & pb_ip, mv_ip, nmom_ip)
1134 else if (qbmm .and. .not. polytropic) then
1135 call s_interpolate_image_point(q_prim_vf, gp, alpha_rho_ip, alpha_ip, pres_ip, vel_ip, c_ip, r_ip, v_ip, &
1136 & pb_ip, mv_ip, nmom_ip, pb_in, mv_in, presb_ip, massv_ip)
1137 else if (chemistry) then
1138 call s_interpolate_image_point(q_prim_vf, gp, alpha_rho_ip, alpha_ip, pres_ip, vel_ip, c_ip, ys_ip=ys_ip)
1139 else
1140 call s_interpolate_image_point(q_prim_vf, gp, alpha_rho_ip, alpha_ip, pres_ip, vel_ip, c_ip)
1141 end if
1142
1143 ! Injecting (burning) surface: replace the mirrored ghost composition with pure
1144 ! injected fuel at the local pressure and the ambient (image-point) temperature.
1145 ! Setting a consistent injected density here (rather than reusing the heavy ambient
1146 ! rho) keeps the light fuel at a physical temperature and feeds the surface flame.
1147 if (chemistry .and. patch_ib(patch_id)%inj_species > 0) then
1148 call get_mixture_molecular_weight(ys_ip, mw_ip)
1149 t_ip = pres_ip*mw_ip/(alpha_rho_ip(1)*gas_constant)
1150 ys_ip = 0._wp
1151 ys_ip(patch_ib(patch_id)%inj_species) = 1._wp
1152 call get_mixture_molecular_weight(ys_ip, mw_ip)
1153 alpha_rho_ip(1) = pres_ip*mw_ip/(t_ip*gas_constant)
1154 end if
1155
1156 dyn_pres = 0._wp
1157
1158 ! Set q_prim_vf params at GP so that mixture vars calculated properly
1159
1160# 357 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1161#if defined(MFC_OpenACC)
1162# 357 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1163!$acc loop seq
1164# 357 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1165#elif defined(MFC_OpenMP)
1166# 357 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1167
1168# 357 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1169#endif
1170 do q = 1, num_fluids
1171 q_prim_vf(q)%sf(j, k, l) = alpha_rho_ip(q)
1172 q_prim_vf(eqn_idx%adv%beg + q - 1)%sf(j, k, l) = alpha_ip(q)
1173 end do
1174
1175 if (surface_tension) then
1176 q_prim_vf(eqn_idx%c)%sf(j, k, l) = c_ip
1177 end if
1178
1179 ! set the pressure
1180 if (patch_ib(patch_id)%moving_ibm <= 1) then
1181 q_prim_vf(eqn_idx%E)%sf(j, k, l) = pres_ip
1182 else
1183 call s_compute_ghost_point_pressure(gp, patch_id, alpha_rho_ip, pres_ip, pres_gp)
1184 q_prim_vf(eqn_idx%E)%sf(j, k, l) = pres_gp
1185 end if
1186
1187 ! If in simulation, use acc mixture subroutines
1188 if (hypoelasticity) then
1189 call s_convert_species_to_mixture_variables_kernel(rho, gamma, pi_inf, qv_k, alpha_ip, alpha_rho_ip, re_k, &
1190 & g_k, gs)
1191 else
1192 call s_convert_species_to_mixture_variables_kernel(rho, gamma, pi_inf, qv_k, alpha_ip, alpha_rho_ip, re_k)
1193 end if
1194
1195 ! get the vector that points from the centroid to the ghost
1196 radial_vector(1) = physical_loc(1) - (patch_ib(patch_id)%x_centroid + real(ghost_points(i)%x_periodicity, &
1197 & wp)*(glb_bounds(1)%end - glb_bounds(1)%beg))
1198 radial_vector(2) = physical_loc(2) - (patch_ib(patch_id)%y_centroid + real(ghost_points(i)%y_periodicity, &
1199 & wp)*(glb_bounds(2)%end - glb_bounds(2)%beg))
1200 radial_vector(3) = 0._wp
1201 if (num_dims == 3) radial_vector(3) = physical_loc(3) - (patch_ib(patch_id)%z_centroid &
1202 & + real(ghost_points(i)%z_periodicity, wp)*(glb_bounds(3)%end - glb_bounds(3)%beg))
1203
1204 ! Calculate velocity of ghost cell
1205 call s_compute_ghost_point_velocity(gp, patch_id, radial_vector, vel_ip, pres_ip, vel_g)
1206
1207 ! Set momentum
1208 vel_sum_g = 0._wp
1209
1210# 397 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1211#if defined(MFC_OpenACC)
1212# 397 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1213!$acc loop seq
1214# 397 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1215#elif defined(MFC_OpenMP)
1216# 397 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1217
1218# 397 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1219#endif
1220 do q = eqn_idx%mom%beg, eqn_idx%mom%end
1221 q_cons_vf(q)%sf(j, k, l) = rho*vel_g(q - eqn_idx%mom%beg + 1)
1222 vel_sum_g = vel_sum_g + vel_g(q - eqn_idx%mom%beg + 1)**2._wp
1223 end do
1224 dyn_pres = 5.e-1_wp*rho*vel_sum_g
1225
1226 ! Set continuity and adv vars
1227
1228# 405 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1229#if defined(MFC_OpenACC)
1230# 405 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1231!$acc loop seq
1232# 405 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1233#elif defined(MFC_OpenMP)
1234# 405 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1235
1236# 405 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1237#endif
1238 do q = 1, num_fluids
1239 q_cons_vf(q)%sf(j, k, l) = alpha_rho_ip(q)
1240 q_cons_vf(eqn_idx%adv%beg + q - 1)%sf(j, k, l) = alpha_ip(q)
1241 end do
1242
1243 ! Set color function
1244 if (surface_tension) q_cons_vf(eqn_idx%c)%sf(j, k, l) = c_ip
1245
1246 ! Set Energy
1247 if (chemistry) then
1248 ! Mirror the reacting-mixture state at the ghost point: interpolated species,
1249 ! plus a thermodynamically consistent conserved energy from the mixture EOS.
1250 ! (The gamma*pres_IP closure below is only valid for a calorically perfect gas
1251 ! and yields an out-of-range temperature when inverted against the Cantera model.)
1252 mw_ip = 0._wp
1253 call get_mixture_molecular_weight(ys_ip, mw_ip)
1254 t_ip = pres_ip*mw_ip/(rho*gas_constant)
1255 call get_mixture_energy_mass(t_ip, ys_ip, e_ip)
1256
1257# 424 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1258#if defined(MFC_OpenACC)
1259# 424 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1260!$acc loop seq
1261# 424 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1262#elif defined(MFC_OpenMP)
1263# 424 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1264
1265# 424 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1266#endif
1267 do q = 1, num_species
1268 q_cons_vf(eqn_idx%species%beg + q - 1)%sf(j, k, l) = rho*ys_ip(q)
1269 end do
1270 q_cons_vf(eqn_idx%E)%sf(j, k, l) = rho*e_ip + dyn_pres
1271 else
1272 call s_compute_energy(pres_ip, alpha_rho_ip, alpha_ip, vel_sum_g, e_ghost)
1273 q_cons_vf(eqn_idx%E)%sf(j, k, l) = e_ghost
1274 end if
1275 ! Set bubble vars
1276 if (bubbles_euler .and. .not. qbmm) then
1277 call s_comp_n_from_prim(alpha_ip(1), r_ip, nbub, weight)
1278
1279# 436 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1280#if defined(MFC_OpenACC)
1281# 436 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1282!$acc loop seq
1283# 436 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1284#elif defined(MFC_OpenMP)
1285# 436 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1286
1287# 436 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1288#endif
1289 do q = 1, nb
1290 q_cons_vf(eqn_idx%bub%beg + (q - 1)*2)%sf(j, k, l) = nbub*r_ip(q)
1291 q_cons_vf(eqn_idx%bub%beg + (q - 1)*2 + 1)%sf(j, k, l) = nbub*v_ip(q)
1292 if (.not. polytropic) then
1293 q_cons_vf(eqn_idx%bub%beg + (q - 1)*4)%sf(j, k, l) = nbub*r_ip(q)
1294 q_cons_vf(eqn_idx%bub%beg + (q - 1)*4 + 1)%sf(j, k, l) = nbub*v_ip(q)
1295 q_cons_vf(eqn_idx%bub%beg + (q - 1)*4 + 2)%sf(j, k, l) = nbub*pb_ip(q)
1296 q_cons_vf(eqn_idx%bub%beg + (q - 1)*4 + 3)%sf(j, k, l) = nbub*mv_ip(q)
1297 end if
1298 end do
1299 end if
1300
1301 if (qbmm) then
1302 nbub = nmom_ip(1)
1303
1304# 451 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1305#if defined(MFC_OpenACC)
1306# 451 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1307!$acc loop seq
1308# 451 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1309#elif defined(MFC_OpenMP)
1310# 451 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1311
1312# 451 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1313#endif
1314 do q = 1, nb*nmom
1315 q_cons_vf(eqn_idx%bub%beg + q - 1)%sf(j, k, l) = nbub*nmom_ip(q)
1316 end do
1317
1318
1319# 456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1320#if defined(MFC_OpenACC)
1321# 456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1322!$acc loop seq
1323# 456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1324#elif defined(MFC_OpenMP)
1325# 456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1326
1327# 456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1328#endif
1329 do q = 1, nb
1330 q_cons_vf(eqn_idx%bub%beg + (q - 1)*nmom)%sf(j, k, l) = nbub
1331 end do
1332
1333 if (.not. polytropic) then
1334
1335# 462 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1336#if defined(MFC_OpenACC)
1337# 462 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1338!$acc loop seq
1339# 462 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1340#elif defined(MFC_OpenMP)
1341# 462 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1342
1343# 462 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1344#endif
1345 do q = 1, nb
1346
1347# 464 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1348#if defined(MFC_OpenACC)
1349# 464 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1350!$acc loop seq
1351# 464 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1352#elif defined(MFC_OpenMP)
1353# 464 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1354
1355# 464 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1356#endif
1357 do r = 1, nnode
1358 pb_in(j, k, l, r, q) = presb_ip((q - 1)*nnode + r)
1359 mv_in(j, k, l, r, q) = massv_ip((q - 1)*nnode + r)
1360 end do
1361 end do
1362 end if
1363 end if
1364
1365 if (model_eqns == model_eqns_6eq) then
1366
1367# 474 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1368#if defined(MFC_OpenACC)
1369# 474 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1370!$acc loop seq
1371# 474 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1372#elif defined(MFC_OpenMP)
1373# 474 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1374
1375# 474 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1376#endif
1377 do q = eqn_idx%int_en%beg, eqn_idx%int_en%end
1378 alpha_q = alpha_ip(q - eqn_idx%int_en%beg + 1)
1379 alpha_rho_q = alpha_rho_ip(q - eqn_idx%int_en%beg + 1)
1380 call s_phase_internal_energy(pres_ip, alpha_q, alpha_rho_q, q - eqn_idx%int_en%beg + 1, e_q)
1381 q_cons_vf(q)%sf(j, k, l) = e_q
1382 end do
1383 end if
1384 end do
1385
1386# 483 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1387#if defined(MFC_OpenACC)
1388# 483 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1389!$acc end parallel loop
1390# 483 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1391#elif defined(MFC_OpenMP)
1392# 483 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1393
1394# 483 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1395!$omp end target teams loop
1396# 483 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1397#endif
1398 end if
1399
1400 end subroutine s_ibm_correct_state
1401
1402 !> Compute the image points for each ghost point
1403 impure subroutine s_compute_image_points(ghost_points_in)
1404
1405 type(ghost_point), dimension(num_gps), intent(inout) :: ghost_points_in
1406 real(wp) :: dist
1407 real(wp), dimension(3) :: norm
1408 real(wp), dimension(3) :: physical_loc
1409 real(wp) :: temp_loc
1410 real(wp), pointer, dimension(:) :: s_cc => null()
1411 integer :: bound
1412 type(ghost_point) :: gp
1413 integer :: q, dim !< Iterator variables
1414 integer :: i, j, k, l !< Location indexes
1415 integer :: patch_id !< IB Patch ID
1416 integer :: dir
1417 integer :: index
1418 logical :: bounds_error
1419
1420 bounds_error = .false.
1421
1422
1423# 508 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1424
1425# 508 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1426#if defined(MFC_OpenACC)
1427# 508 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1428!$acc parallel loop gang vector default(present) private(q, gp, i, j, k, physical_loc, patch_id, dist, norm, dim, bound, dir, index, temp_loc, s_cc) copy(bounds_error)
1429# 508 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1430#elif defined(MFC_OpenMP)
1431# 508 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1432
1433# 508 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1434
1435# 508 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1436
1437# 508 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1438!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1439# 508 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1440!$omp& private(q, gp, i, j, k, physical_loc, patch_id, dist, norm, dim, bound, dir, index, temp_loc, s_cc) map(tofrom:bounds_error)
1441# 508 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1442#endif
1443# 510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1444 do q = 1, num_gps
1445 gp = ghost_points_in(q)
1446 i = gp%loc(1)
1447 j = gp%loc(2)
1448 k = gp%loc(3)
1449
1450 ! Calculate physical location of ghost point
1451 if (p > 0) then
1452 physical_loc = [x_cc(i), y_cc(j), z_cc(k)]
1453 else
1454 physical_loc = [x_cc(i), y_cc(j), 0._wp]
1455 end if
1456
1457 ! Calculate and store the precise location of the image point
1458 patch_id = gp%ib_patch_id
1459 dist = abs(real(gp%levelset, kind=wp))
1460 norm(:) = gp%levelset_norm
1461 ghost_points_in(q)%ip_loc(:) = physical_loc(:) + 2*dist*norm(:)
1462
1463 ! Find the closest grid point to the image point
1464 do dim = 1, num_dims
1465 ! s_cc points to the dim array we need
1466 if (dim == 1) then
1467 s_cc => x_cc
1468 bound = m + buff_size - 1
1469 else if (dim == 2) then
1470 s_cc => y_cc
1471 bound = n + buff_size - 1
1472 else
1473 s_cc => z_cc
1474 bound = p + buff_size - 1
1475 end if
1476
1477 if (f_approx_equal(norm(dim), 0._wp)) then
1478 ! if the ghost point is almost equal to a cell location, we set it equal and continue
1479 ghost_points_in(q)%ip_grid(dim) = ghost_points_in(q)%loc(dim)
1480 else
1481 if (norm(dim) > 0) then
1482 dir = 1
1483 else
1484 dir = -1
1485 end if
1486
1487 index = ghost_points_in(q)%loc(dim)
1488 temp_loc = ghost_points_in(q)%ip_loc(dim)
1489 do while ((temp_loc < s_cc(index) .or. temp_loc > s_cc(index + 1)) .and. (.not. bounds_error))
1490 index = index + dir
1491 if (index < -buff_size .or. index > bound) then
1492#if !defined(MFC_OpenACC) && !defined(MFC_OpenMP)
1493 print *, "A required image point is not located in this computational domain."
1494 print *, "Ghost Point is located at :"
1495 if (p == 0) then
1496 print *, [x_cc(i), y_cc(j)]
1497 else
1498 print *, [x_cc(i), y_cc(j), z_cc(k)]
1499 end if
1500 print *, "We are searching in dimension ", dim, " for image point at ", ghost_points_in(q)%ip_loc(:)
1501 print *, "Domain size: "
1502 print *, "x: ", x_cc(-buff_size), " to: ", x_cc(m + buff_size - 1)
1503 print *, "y: ", y_cc(-buff_size), " to: ", y_cc(n + buff_size - 1)
1504 if (p /= 0) print *, "z: ", z_cc(-buff_size), " to: ", z_cc(p + buff_size - 1)
1505 print *, "Image point is located approximately ", &
1506 & (ghost_points_in(q)%loc(dim) - ghost_points_in(q) %ip_loc(dim))/(s_cc(1) - s_cc(0)), &
1507 & " grid cells away"
1508 print *, "Levelset ", dist, " and Norm: ", norm(:)
1509 print *, &
1510 & "A short term fix may include increasing buff_size further in m_helper_basic (currently set to a minimum of 10)"
1511#endif
1512 bounds_error = .true.
1513 end if
1514 end do
1515
1516 ghost_points_in(q)%ip_grid(dim) = index
1517 if (ghost_points_in(q)%DB(dim) == -1) then
1518 ghost_points_in(q)%ip_grid(dim) = ghost_points_in(q)%loc(dim) + 1
1519 else if (ghost_points_in(q)%DB(dim) == 1) then
1520 ghost_points_in(q)%ip_grid(dim) = ghost_points_in(q)%loc(dim) - 1
1521 end if
1522 end if
1523 end do
1524 end do
1525
1526# 591 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1527#if defined(MFC_OpenACC)
1528# 591 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1529!$acc end parallel loop
1530# 591 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1531#elif defined(MFC_OpenMP)
1532# 591 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1533
1534# 591 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1535!$omp end target teams loop
1536# 591 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1537#endif
1538
1539 if (bounds_error) then
1540# 593 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1541 call s_prohibit_abort("bounds_error", "Ghost Point and Image Point on Different Processors. Exiting")
1542# 593 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1543 end if
1544
1545 end subroutine s_compute_image_points
1546
1547 !> Count the number of ghost points for memory allocation
1548 subroutine s_find_num_ghost_points(num_gps_out)
1549
1550 integer, intent(out) :: num_gps_out
1551 integer :: i, j, k, ii, jj, kk, gp_layers_z !< Iterator variables
1552 integer :: num_gps_local !< local copies of the gp count to support GPU compute
1553 logical :: is_gp
1554
1555 num_gps_local = 0
1556 gp_layers_z = gp_layers
1557 if (p == 0) gp_layers_z = 0
1558
1559
1560# 609 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1561
1562# 609 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1563#if defined(MFC_OpenACC)
1564# 609 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1565!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, ii, jj, kk, is_gp) firstprivate(gp_layers, gp_layers_z) copy(num_gps_local)
1566# 609 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1567#elif defined(MFC_OpenMP)
1568# 609 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1569
1570# 609 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1571
1572# 609 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1573
1574# 609 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1575!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1576# 609 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1577!$omp& private(i, j, k, ii, jj, kk, is_gp) firstprivate(gp_layers, gp_layers_z) map(tofrom:num_gps_local)
1578# 609 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1579#endif
1580# 611 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1581 do i = 0, m
1582 do j = 0, n
1583 do k = 0, p
1584 if (ib_markers%sf(i, j, k) /= 0) then
1585 is_gp = .false.
1586 marker_search: do ii = i - gp_layers, i + gp_layers
1587 do jj = j - gp_layers, j + gp_layers
1588 do kk = k - gp_layers_z, k + gp_layers_z
1589 if (ib_markers%sf(ii, jj, kk) == 0) then
1590 ! if any neighbors are not in the IB, it is a ghost point
1591 is_gp = .true.
1592 exit marker_search
1593 end if
1594 end do
1595 end do
1596 end do marker_search
1597
1598 if (is_gp) then
1599
1600# 629 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1601#if defined(MFC_OpenACC)
1602# 629 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1603!$acc atomic update
1604# 629 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1605#elif defined(MFC_OpenMP)
1606# 629 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1607!$omp atomic update
1608# 629 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1609#endif
1610 num_gps_local = num_gps_local + 1
1611 end if
1612 end if
1613 end do
1614 end do
1615 end do
1616
1617# 636 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1618#if defined(MFC_OpenACC)
1619# 636 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1620!$acc end parallel loop
1621# 636 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1622#elif defined(MFC_OpenMP)
1623# 636 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1624
1625# 636 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1626!$omp end target teams loop
1627# 636 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1628#endif
1629
1630 num_gps_out = num_gps_local
1631
1632 end subroutine s_find_num_ghost_points
1633
1634 !> Locate all ghost points in the domain
1635 subroutine s_find_ghost_points(ghost_points_in)
1636
1637 type(ghost_point), dimension(num_gps), intent(inout) :: ghost_points_in
1638 integer :: i, j, k, ii, jj, kk, gp_layers_z !< Iterator variables
1639 integer :: xp, yp, zp !< periodicities
1640 integer :: count, count_i, local_idx
1641 integer :: patch_id, encoded_patch_id, neighborhood_patch_id
1642 logical :: is_gp
1643
1644 count = 0
1645 count_i = 0
1646 gp_layers_z = gp_layers
1647 if (p == 0) gp_layers_z = 0
1648
1649
1650# 657 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1651
1652# 657 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1653#if defined(MFC_OpenACC)
1654# 657 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1655!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, ii, jj, kk, is_gp, local_idx, patch_id, encoded_patch_id, neighborhood_patch_id, xp, yp, zp) &
1656# 657 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1657!$acc& firstprivate(gp_layers, gp_layers_z) copyin(count, count_i, glb_bounds)
1658# 657 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1659#elif defined(MFC_OpenMP)
1660# 657 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1661
1662# 657 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1663
1664# 657 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1665
1666# 657 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1667!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1668# 657 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1669!$omp& private(i, j, k, ii, jj, kk, is_gp, local_idx, patch_id, encoded_patch_id, neighborhood_patch_id, xp, yp, zp) firstprivate(gp_layers, gp_layers_z) map(to:count, count_i, glb_bounds)
1670# 657 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1671#endif
1672# 659 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1673 do i = 0, m
1674 do j = 0, n
1675 do k = 0, p
1676 if (ib_markers%sf(i, j, k) /= 0) then
1677 is_gp = .false.
1678 marker_search: do ii = i - gp_layers, i + gp_layers
1679 do jj = j - gp_layers, j + gp_layers
1680 do kk = k - gp_layers_z, k + gp_layers_z
1681 if (ib_markers%sf(ii, jj, kk) == 0) then
1682 ! if any neighbors are not in the IB, it is a ghost point
1683 is_gp = .true.
1684 exit marker_search
1685 end if
1686 end do
1687 end do
1688 end do marker_search
1689
1690 if (is_gp) then
1691
1692# 677 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1693#if defined(MFC_OpenACC)
1694# 677 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1695!$acc atomic capture
1696# 677 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1697#elif defined(MFC_OpenMP)
1698# 677 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1699!$omp atomic capture
1700# 677 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1701#endif
1702 count = count + 1
1703 local_idx = count
1704#if defined(MFC_OpenACC)
1705# 680 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1706!$acc end atomic
1707# 680 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1708#elif defined(MFC_OpenMP)
1709# 680 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1710!$omp end atomic
1711# 680 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1712#endif
1713
1714 ghost_points_in(local_idx)%loc = [i, j, k]
1715 encoded_patch_id = ib_markers%sf(i, j, k)
1716 call s_decode_patch_periodicity(encoded_patch_id, patch_id, xp, yp, zp)
1717 call s_get_neighborhood_idx(patch_id, neighborhood_patch_id)
1718 ghost_points_in(local_idx)%ib_patch_id = neighborhood_patch_id
1719 ghost_points_in(local_idx)%x_periodicity = xp
1720 ghost_points_in(local_idx)%y_periodicity = yp
1721 ghost_points_in(local_idx)%z_periodicity = zp
1722 ghost_points_in(local_idx)%slip = patch_ib(neighborhood_patch_id)%slip
1723
1724 if ((x_cc(i) - dx(i)) < glb_bounds(1)%beg) then
1725 ghost_points_in(local_idx)%DB(1) = -1
1726 else if ((x_cc(i) + dx(i)) > glb_bounds(1)%end) then
1727 ghost_points_in(local_idx)%DB(1) = 1
1728 else
1729 ghost_points_in(local_idx)%DB(1) = 0
1730 end if
1731
1732 if ((y_cc(j) - dy(j)) < glb_bounds(2)%beg) then
1733 ghost_points_in(local_idx)%DB(2) = -1
1734 else if ((y_cc(j) + dy(j)) > glb_bounds(2)%end) then
1735 ghost_points_in(local_idx)%DB(2) = 1
1736 else
1737 ghost_points_in(local_idx)%DB(2) = 0
1738 end if
1739
1740 if (p /= 0) then
1741 if ((z_cc(k) - dz(k)) < glb_bounds(3)%beg) then
1742 ghost_points_in(local_idx)%DB(3) = -1
1743 else if ((z_cc(k) + dz(k)) > glb_bounds(3)%end) then
1744 ghost_points_in(local_idx)%DB(3) = 1
1745 else
1746 ghost_points_in(local_idx)%DB(3) = 0
1747 end if
1748 end if
1749 end if
1750 end if
1751 end do
1752 end do
1753 end do
1754
1755# 722 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1756#if defined(MFC_OpenACC)
1757# 722 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1758!$acc end parallel loop
1759# 722 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1760#elif defined(MFC_OpenMP)
1761# 722 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1762
1763# 722 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1764!$omp end target teams loop
1765# 722 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1766#endif
1767
1768 end subroutine s_find_ghost_points
1769
1770 !> Compute the interpolation coefficients for image points
1771 subroutine s_compute_interpolation_coeffs(ghost_points_in)
1772
1773 type(ghost_point), dimension(num_gps), intent(inout) :: ghost_points_in
1774 real(wp), dimension(2, 2, 2) :: dist
1775 real(wp), dimension(2, 2, 2) :: alpha
1776 real(wp), dimension(2, 2, 2) :: interp_coeffs
1777 real(wp) :: buf
1778 real(wp), dimension(2, 2, 2) :: eta
1779 type(ghost_point) :: gp
1780 integer :: q, i, j, k, ii, jj, kk !< Grid indexes and iterators
1781 integer :: patch_id
1782 logical :: is_cell_center
1783
1784
1785# 740 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1786
1787# 740 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1788#if defined(MFC_OpenACC)
1789# 740 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1790!$acc parallel loop gang vector default(present) private(q, i, j, k, ii, jj, kk, dist, buf, gp, interp_coeffs, eta, alpha, patch_id, is_cell_center)
1791# 740 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1792#elif defined(MFC_OpenMP)
1793# 740 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1794
1795# 740 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1796
1797# 740 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1798
1799# 740 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1800!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1801# 740 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1802!$omp& private(q, i, j, k, ii, jj, kk, dist, buf, gp, interp_coeffs, eta, alpha, patch_id, is_cell_center)
1803# 740 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1804#endif
1805 do q = 1, num_gps
1806 gp = ghost_points_in(q)
1807 ! Get the interpolation points
1808 i = gp%ip_grid(1)
1809 j = gp%ip_grid(2)
1810 if (p /= 0) then
1811 k = gp%ip_grid(3)
1812 else
1813 k = 0
1814 end if
1815
1816 ! get the distance to a cell in each direction
1817 dist = 0._wp
1818 buf = 1._wp
1819 do ii = 0, 1
1820 do jj = 0, 1
1821 if (p == 0) then
1822 dist(1 + ii, 1 + jj, 1) = sqrt((x_cc(i + ii) - gp%ip_loc(1))**2 + (y_cc(j + jj) - gp%ip_loc(2))**2)
1823 else
1824 do kk = 0, 1
1825 dist(1 + ii, 1 + jj, &
1826 & 1 + kk) = sqrt((x_cc(i + ii) - gp%ip_loc(1))**2 + (y_cc(j + jj) - gp%ip_loc(2))**2 + (z_cc(k &
1827 & + kk) - gp%ip_loc(3))**2)
1828 end do
1829 end if
1830 end do
1831 end do
1832
1833 ! check if we are arbitrarily close to a cell center
1834 interp_coeffs = 0._wp
1835 is_cell_center = .false.
1836 check_is_cell_center: do ii = 0, 1
1837 do jj = 0, 1
1838 if (dist(ii + 1, jj + 1, 1) <= 1.e-16_wp) then
1839 interp_coeffs(ii + 1, jj + 1, 1) = 1._wp
1840 is_cell_center = .true.
1841 exit check_is_cell_center
1842 else
1843 if (p /= 0) then
1844 if (dist(ii + 1, jj + 1, 2) <= 1.e-16_wp) then
1845 interp_coeffs(ii + 1, jj + 1, 2) = 1._wp
1846 is_cell_center = .true.
1847 exit check_is_cell_center
1848 end if
1849 end if
1850 end if
1851 end do
1852 end do check_is_cell_center
1853
1854 if (.not. is_cell_center) then
1855 ! if we are not arbitrarily close, interpolate
1856 alpha = 1._wp
1857 patch_id = gp%ib_patch_id
1858 if (ib_markers%sf(i, j, k) /= 0) alpha(1, 1, 1) = 0._wp
1859 if (ib_markers%sf(i + 1, j, k) /= 0) alpha(2, 1, 1) = 0._wp
1860 if (ib_markers%sf(i, j + 1, k) /= 0) alpha(1, 2, 1) = 0._wp
1861 if (ib_markers%sf(i + 1, j + 1, k) /= 0) alpha(2, 2, 1) = 0._wp
1862
1863 if (p == 0) then
1864 eta(:,:,1) = 1._wp/dist(:,:,1)**2
1865 buf = sum(alpha(:,:,1)*eta(:,:,1))
1866 if (buf > 0._wp) then
1867 interp_coeffs(:,:,1) = alpha(:,:,1)*eta(:,:,1)/buf
1868 else
1869 buf = sum(eta(:,:,1))
1870 interp_coeffs(:,:,1) = eta(:,:,1)/buf
1871 end if
1872 else
1873 if (ib_markers%sf(i, j, k + 1) /= 0) alpha(1, 1, 2) = 0._wp
1874 if (ib_markers%sf(i + 1, j, k + 1) /= 0) alpha(2, 1, 2) = 0._wp
1875 if (ib_markers%sf(i, j + 1, k + 1) /= 0) alpha(1, 2, 2) = 0._wp
1876 if (ib_markers%sf(i + 1, j + 1, k + 1) /= 0) alpha(2, 2, 2) = 0._wp
1877 eta = 1._wp/dist**2
1878 buf = sum(alpha*eta)
1879
1880 if (buf > 0._wp) then
1881 interp_coeffs = alpha*eta/buf
1882 else
1883 buf = sum(eta)
1884 interp_coeffs = eta/buf
1885 end if
1886 end if
1887 end if
1888
1889 ghost_points_in(q)%interp_coeffs = interp_coeffs
1890 end do
1891
1892# 827 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1893#if defined(MFC_OpenACC)
1894# 827 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1895!$acc end parallel loop
1896# 827 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1897#elif defined(MFC_OpenMP)
1898# 827 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1899
1900# 827 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1901!$omp end target teams loop
1902# 827 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1903#endif
1904
1905 end subroutine s_compute_interpolation_coeffs
1906
1907 !> Interpolate primitive variables to a ghost point's image point using bilinear or trilinear interpolation
1908 subroutine s_interpolate_image_point(q_prim_vf, gp, alpha_rho_IP, alpha_IP, pres_IP, vel_IP, c_IP, r_IP, v_IP, pb_IP, mv_IP, &
1909 & nmom_IP, pb_in, mv_in, presb_IP, massv_IP, Ys_IP)
1910
1911# 834 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1912#if MFC_OpenACC
1913# 834 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1914!$acc routine seq
1915# 834 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1916#elif MFC_OpenMP
1917# 834 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1918
1919# 834 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1920
1921# 834 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1922!$omp declare target device_type(any)
1923# 834 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1924#endif
1925
1926 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf !< Primitive Variables
1927 real(stp), optional, dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(in) :: pb_in, mv_in
1928 type(ghost_point), intent(in) :: gp
1929 real(wp), intent(inout) :: pres_ip
1930 real(wp), dimension(3), intent(inout) :: vel_ip
1931 real(wp), intent(inout) :: c_ip
1932# 845 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1933 real(wp), dimension(num_fluids), intent(inout) :: alpha_ip, alpha_rho_ip
1934# 847 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1935 real(wp), optional, dimension(:), intent(inout) :: r_ip, v_ip, pb_ip, mv_ip
1936 real(wp), optional, dimension(:), intent(inout) :: nmom_ip
1937 real(wp), optional, dimension(:), intent(inout) :: presb_ip, massv_ip
1938 real(wp), optional, dimension(:), intent(inout) :: ys_ip !< Interpolated species mass fractions (chemistry)
1939 integer :: i, j, k, l, q !< Iterator variables
1940 integer :: i1, i2, j1, j2, k1, k2 !< Iterator variables
1941 real(wp) :: coeff
1942
1943 i1 = gp%ip_grid(1); i2 = i1 + 1
1944 j1 = gp%ip_grid(2); j2 = j1 + 1
1945 k1 = gp%ip_grid(3); k2 = k1 + 1
1946
1947 if (p == 0) then
1948 k1 = 0
1949 k2 = 0
1950 end if
1951
1952 alpha_rho_ip = 0._wp
1953 alpha_ip = 0._wp
1954 pres_ip = 0._wp
1955 vel_ip = 0._wp
1956
1957 if (chemistry) ys_ip = 0._wp
1958
1959 if (surface_tension) c_ip = 0._wp
1960
1961 if (bubbles_euler) then
1962 r_ip = 0._wp
1963 v_ip = 0._wp
1964 if (.not. polytropic) then
1965 mv_ip = 0._wp
1966 pb_ip = 0._wp
1967 end if
1968 end if
1969
1970 if (qbmm) then
1971 nmom_ip = 0._wp
1972 if (.not. polytropic) then
1973 presb_ip = 0._wp
1974 massv_ip = 0._wp
1975 end if
1976 end if
1977
1978
1979# 890 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1980#if defined(MFC_OpenACC)
1981# 890 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1982!$acc loop seq
1983# 890 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1984#elif defined(MFC_OpenMP)
1985# 890 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1986
1987# 890 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1988#endif
1989 do i = i1, i2
1990
1991# 892 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1992#if defined(MFC_OpenACC)
1993# 892 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1994!$acc loop seq
1995# 892 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1996#elif defined(MFC_OpenMP)
1997# 892 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1998
1999# 892 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2000#endif
2001 do j = j1, j2
2002
2003# 894 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2004#if defined(MFC_OpenACC)
2005# 894 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2006!$acc loop seq
2007# 894 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2008#elif defined(MFC_OpenMP)
2009# 894 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2010
2011# 894 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2012#endif
2013 do k = k1, k2
2014 coeff = gp%interp_coeffs(i - i1 + 1, j - j1 + 1, k - k1 + 1)
2015
2016 pres_ip = pres_ip + coeff*q_prim_vf(eqn_idx%E)%sf(i, j, k)
2017
2018
2019# 900 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2020#if defined(MFC_OpenACC)
2021# 900 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2022!$acc loop seq
2023# 900 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2024#elif defined(MFC_OpenMP)
2025# 900 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2026
2027# 900 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2028#endif
2029 do q = eqn_idx%mom%beg, eqn_idx%mom%end
2030 vel_ip(q + 1 - eqn_idx%mom%beg) = vel_ip(q + 1 - eqn_idx%mom%beg) + coeff*q_prim_vf(q)%sf(i, j, k)
2031 end do
2032
2033
2034# 905 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2035#if defined(MFC_OpenACC)
2036# 905 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2037!$acc loop seq
2038# 905 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2039#elif defined(MFC_OpenMP)
2040# 905 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2041
2042# 905 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2043#endif
2044 do l = eqn_idx%cont%beg, eqn_idx%cont%end
2045 alpha_rho_ip(l) = alpha_rho_ip(l) + coeff*q_prim_vf(l)%sf(i, j, k)
2046 alpha_ip(l) = alpha_ip(l) + coeff*q_prim_vf(eqn_idx%adv%beg + l - 1)%sf(i, j, k)
2047 end do
2048
2049 if (surface_tension) then
2050 c_ip = c_ip + coeff*q_prim_vf(eqn_idx%c)%sf(i, j, k)
2051 end if
2052
2053 if (chemistry) then
2054
2055# 916 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2056#if defined(MFC_OpenACC)
2057# 916 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2058!$acc loop seq
2059# 916 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2060#elif defined(MFC_OpenMP)
2061# 916 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2062
2063# 916 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2064#endif
2065 do q = 1, num_species
2066 ys_ip(q) = ys_ip(q) + coeff*q_prim_vf(eqn_idx%species%beg + q - 1)%sf(i, j, k)
2067 end do
2068 end if
2069
2070 if (bubbles_euler .and. .not. qbmm) then
2071
2072# 923 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2073#if defined(MFC_OpenACC)
2074# 923 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2075!$acc loop seq
2076# 923 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2077#elif defined(MFC_OpenMP)
2078# 923 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2079
2080# 923 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2081#endif
2082 do l = 1, nb
2083 if (polytropic) then
2084 r_ip(l) = r_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg + (l - 1)*2)%sf(i, j, k)
2085 v_ip(l) = v_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg + 1 + (l - 1)*2)%sf(i, j, k)
2086 else
2087 r_ip(l) = r_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg + (l - 1)*4)%sf(i, j, k)
2088 v_ip(l) = v_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg + 1 + (l - 1)*4)%sf(i, j, k)
2089 pb_ip(l) = pb_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg + 2 + (l - 1)*4)%sf(i, j, k)
2090 mv_ip(l) = mv_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg + 3 + (l - 1)*4)%sf(i, j, k)
2091 end if
2092 end do
2093 end if
2094
2095 if (qbmm) then
2096 do l = 1, nb*nmom
2097 nmom_ip(l) = nmom_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg - 1 + l)%sf(i, j, k)
2098 end do
2099 if (.not. polytropic) then
2100 do q = 1, nb
2101 do l = 1, nnode
2102 presb_ip((q - 1)*nnode + l) = presb_ip((q - 1)*nnode + l) + coeff*real(pb_in(i, j, k, l, q), &
2103 & kind=wp)
2104 massv_ip((q - 1)*nnode + l) = massv_ip((q - 1)*nnode + l) + coeff*real(mv_in(i, j, k, l, q), &
2105 & kind=wp)
2106 end do
2107 end do
2108 end if
2109 end if
2110 end do
2111 end do
2112 end do
2113
2114 end subroutine s_interpolate_image_point
2115
2116 !> Resets the current indexes of immersed boundaries and replaces them after updating
2117 !> the position of each moving immersed boundary
2118 impure subroutine s_update_mib(num_ibs)
2119
2120 integer, intent(in) :: num_ibs
2121 integer :: i, j, k, z_gp_layers
2122
2123 call nvtxstartrange("UPDATE-MIBM")
2124
2125 ! Clears the existing immersed boundary indices
2126 z_gp_layers = 0; if (p /= 0) z_gp_layers = gp_layers + 1
2127
2128# 969 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2129
2130# 969 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2131#if defined(MFC_OpenACC)
2132# 969 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2133!$acc parallel loop gang vector default(present) private(i, j, k)
2134# 969 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2135#elif defined(MFC_OpenMP)
2136# 969 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2137
2138# 969 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2139
2140# 969 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2141
2142# 969 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2143!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k)
2144# 969 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2145#endif
2146 do i = -gp_layers - 1, m + gp_layers + 1; do j = -gp_layers - 1, n + gp_layers + 1; do k = -z_gp_layers, p + z_gp_layers
2147 ib_markers%sf(i, j, k) = 0._wp
2148 end do; end do; end do
2149
2150# 973 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2151#if defined(MFC_OpenACC)
2152# 973 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2153!$acc end parallel loop
2154# 973 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2155#elif defined(MFC_OpenMP)
2156# 973 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2157
2158# 973 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2159!$omp end target teams loop
2160# 973 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2161#endif
2162
2163 ! recalulcate the rotation matrix based upon the new angles
2164
2165# 976 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2166
2167# 976 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2168#if defined(MFC_OpenACC)
2169# 976 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2170!$acc parallel loop gang vector default(present) private(i)
2171# 976 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2172#elif defined(MFC_OpenMP)
2173# 976 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2174
2175# 976 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2176
2177# 976 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2178
2179# 976 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2180!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i)
2181# 976 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2182#endif
2183 do i = 1, num_ibs
2184 if (patch_ib(i)%moving_ibm /= 0) then
2185 call s_update_ib_rotation_matrix(i)
2186 end if
2187 end do
2188
2189# 982 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2190#if defined(MFC_OpenACC)
2191# 982 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2192!$acc end parallel loop
2193# 982 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2194#elif defined(MFC_OpenMP)
2195# 982 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2196
2197# 982 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2198!$omp end target teams loop
2199# 982 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2200#endif
2201
2202 ! recompute the new ib_patch locations and broadcast them.
2203 call nvtxstartrange("APPLY-IB-PATCHES")
2204 call s_apply_ib_patches(ib_markers)
2205 call nvtxendrange
2206
2207 call nvtxstartrange("COMPUTE-GHOST-POINTS")
2208 ! recalculate the ghost point locations and coefficients
2209 call s_find_num_ghost_points(num_gps)
2210 ! num_gps is a declare-target module variable and bounds every device loop over the ghost points; it is
2211 ! copied to the device once in s_ibm_setup, so without this refresh the kernels keep the setup-time count
2212 ! as a moving body's count changes: stale list entries beyond the current count are written as wall
2213 ! states into cells that are now fluid, new ghost cells are left uncorrected, and which entries those are
2214 ! depends on the atomic fill order -- nondeterministic results run to run (#1886).
2215
2216# 997 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2217#if defined(MFC_OpenACC)
2218# 997 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2219!$acc update device(num_gps)
2220# 997 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2221#elif defined(MFC_OpenMP)
2222# 997 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2223!$omp target update to(num_gps)
2224# 997 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2225#endif
2226 call s_find_ghost_points(ghost_points)
2227 call nvtxendrange
2228
2229 call nvtxstartrange("COMPUTE-IMAGE-POINTS")
2230 call s_apply_levelset(ghost_points, num_gps)
2231 call s_compute_image_points(ghost_points)
2232 call s_compute_interpolation_coeffs(ghost_points)
2233 call nvtxendrange
2234
2235 call nvtxendrange
2236
2237 end subroutine s_update_mib
2238
2239 !> log(cosh(x)) without overflow for large |x|
2240 pure function f_log_cosh(x) result(y)
2241
2242
2243# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2244#if MFC_OpenACC
2245# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2246!$acc routine seq
2247# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2248#elif MFC_OpenMP
2249# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2250
2251# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2252
2253# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2254!$omp declare target device_type(any)
2255# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2256#endif
2257 real(wp), intent(in) :: x
2258 real(wp) :: y
2259 y = abs(x) + log(0.5_wp*(1._wp + exp(-2._wp*abs(x))))
2260
2261 end function f_log_cosh
2262
2263 !> Prescribed kinematics for patch i at time t: hinged flapping (kin_model = 1) or the Eldredge pitch ramp (kin_model = 2).
2264 !! Flapping rolls phi about the lab x axis through the hinge and pitches theta about the body spanwise (y) axis through it; the
2265 !! ramp holds phi at zero and drives theta alone. Both compose as R = Rx(phi) Ry(theta) (MFC's angle convention) and set the
2266 !! angles, centroid, velocity and lab-frame angular velocity; nothing is integrated, so restarts are exact.
2267 subroutine s_prescribed_kinematics(i, t)
2268
2269
2270# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2271#if MFC_OpenACC
2272# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2273!$acc routine seq
2274# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2275#elif MFC_OpenMP
2276# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2277
2278# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2279
2280# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2281!$omp declare target device_type(any)
2282# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2283#endif
2284
2285 integer, intent(in) :: i
2286 real(wp), intent(in) :: t
2287 real(wp) :: tau, amp, damp, omega, phi, theta, phid, thetad, arg_phi, arg_th, t_p, a_s
2288 real(wp), dimension(3) :: r, c, w, v
2289
2290 tau = t - patch_ib(i)%kin_t0
2291 omega = 2._wp*pi*patch_ib(i)%kin_freq
2292 amp = 0._wp
2293 damp = 0._wp
2294 if (tau >= 0._wp) then
2295 amp = 1._wp
2296 if (patch_ib(i)%kin_ramp > 0._wp .and. tau < patch_ib(i)%kin_ramp) then
2297 amp = 0.5_wp*(1._wp - cos(pi*tau/patch_ib(i)%kin_ramp))
2298 damp = 0.5_wp*pi/patch_ib(i)%kin_ramp*sin(pi*tau/patch_ib(i)%kin_ramp)
2299 end if
2300 end if
2301 arg_phi = omega*tau
2302 arg_th = omega*tau + patch_ib(i)%kin_phase
2303
2304 if (patch_ib(i)%kin_model == 2) then
2305 ! Eldredge smoothed linear pitch ramp and hold (AIAA canonical pitch-up): with a = kin_smooth, nominal rate
2306 ! Omega = kin_pitch_rate and pitch time t_p = theta0/Omega, G = log[cosh(a tau)/cosh(a (tau - t_p))] rises from
2307 ! -a t_p to +a t_p, so theta = mean + theta0/2 [1 + G/(a t_p)] and theta' = Omega/2 [tanh(a tau) - tanh(a (tau - t_p))]
2308 phi = 0._wp
2309 phid = 0._wp
2310 t_p = patch_ib(i)%kin_theta0/patch_ib(i)%kin_pitch_rate
2311 a_s = patch_ib(i)%kin_smooth
2312 theta = patch_ib(i)%kin_theta_mean + 0.5_wp*patch_ib(i)%kin_theta0*(1._wp + (f_log_cosh(a_s*tau) &
2313 & - f_log_cosh(a_s*(tau - t_p)))/(a_s*t_p))
2314 thetad = 0.5_wp*patch_ib(i)%kin_pitch_rate*(tanh(a_s*tau) - tanh(a_s*(tau - t_p)))
2315 else
2316 phi = amp*patch_ib(i)%kin_phi0*sin(arg_phi)
2317 phid = damp*patch_ib(i)%kin_phi0*sin(arg_phi) + amp*patch_ib(i)%kin_phi0*omega*cos(arg_phi)
2318 theta = patch_ib(i)%kin_theta_mean + amp*patch_ib(i)%kin_theta0*sin(arg_th)
2319 thetad = damp*patch_ib(i)%kin_theta0*sin(arg_th) + amp*patch_ib(i)%kin_theta0*omega*cos(arg_th)
2320 end if
2321
2322 ! centroid relative to the hinge: Rx(phi) Ry(theta) offset
2323 r = patch_ib(i)%kin_offset
2324 c(1) = cos(theta)*r(1) + sin(theta)*r(3)
2325 c(2) = r(2)
2326 c(3) = -sin(theta)*r(1) + cos(theta)*r(3)
2327 v(1) = c(1)
2328 v(2) = cos(phi)*c(2) - sin(phi)*c(3)
2329 v(3) = sin(phi)*c(2) + cos(phi)*c(3)
2330 c = v
2331
2332 ! lab-frame angular velocity: phi' e_x + theta' Rx(phi) e_y
2333 w(1) = phid
2334 w(2) = thetad*cos(phi)
2335 w(3) = thetad*sin(phi)
2336 call s_cross_product(w, c, v)
2337
2338 patch_ib(i)%angles(1) = phi
2339 patch_ib(i)%angles(2) = theta
2340 patch_ib(i)%angles(3) = 0._wp
2341 patch_ib(i)%x_centroid = patch_ib(i)%kin_hinge(1) + c(1)
2342 patch_ib(i)%y_centroid = patch_ib(i)%kin_hinge(2) + c(2)
2343 patch_ib(i)%z_centroid = patch_ib(i)%kin_hinge(3) + c(3)
2344 patch_ib(i)%vel = v
2345 patch_ib(i)%angular_vel = w
2346
2347 end subroutine s_prescribed_kinematics
2348
2349 !> Compute pressure and viscous forces and torques on immersed bodies via volume integration
2350 subroutine s_compute_ib_forces(q_prim_vf, fluid_pp)
2351
2352 type(scalar_field), dimension(1:sys_size), intent(in) :: q_prim_vf
2353 type(physical_parameters), dimension(1:num_fluids), intent(in) :: fluid_pp
2354 integer :: i, j, k, l, encoded_ib_idx, xp, yp, zp, ib_idx, ib_idx_temp, fluid_idx
2355 real(wp), dimension(num_ibs, 3) :: forces, torques
2356 ! viscous stress tensor with temp vectors to hold divergence calculations
2357 real(wp), dimension(1:3,1:3) :: viscous_stress
2358 real(wp), dimension(1:3) :: local_force_contribution, radial_vector, local_torque_contribution
2359 real(wp) :: cell_volume, dynamic_viscosity
2360
2361# 1108 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2362 real(wp), dimension(num_fluids) :: dynamic_viscosities
2363# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2364
2365 call nvtxstartrange("COMPUTE-IB-FORCES")
2366
2367 forces = 0._wp
2368 torques = 0._wp
2369
2370 if (viscous) then
2371 do fluid_idx = 1, num_fluids
2372 if (fluid_pp(fluid_idx)%Re(1) > 0._wp) then
2373 dynamic_viscosities(fluid_idx) = 1._wp/fluid_pp(fluid_idx)%Re(1)
2374 else
2375 dynamic_viscosities(fluid_idx) = 0._wp
2376 end if
2377 end do
2378 end if
2379
2380
2381# 1126 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2382
2383# 1126 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2384#if defined(MFC_OpenACC)
2385# 1126 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2386!$acc parallel loop collapse(3) gang vector default(present) &
2387# 1126 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2388!$acc& private(i, j, k, l, xp, yp, zp, ib_idx, ib_idx_temp, encoded_ib_idx, fluid_idx, radial_vector, local_force_contribution, cell_volume, local_torque_contribution, dynamic_viscosity, viscous_stress) &
2389# 1126 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2390!$acc& copy(forces, torques) copyin(dynamic_viscosities)
2391# 1126 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2392#elif defined(MFC_OpenMP)
2393# 1126 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2394
2395# 1126 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2396
2397# 1126 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2398
2399# 1126 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2400!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
2401# 1126 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2402!$omp& private(i, j, k, l, xp, yp, zp, ib_idx, ib_idx_temp, encoded_ib_idx, fluid_idx, radial_vector, local_force_contribution, cell_volume, local_torque_contribution, dynamic_viscosity, viscous_stress) &
2403# 1126 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2404!$omp& map(tofrom:forces, torques) map(to:dynamic_viscosities)
2405# 1126 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2406#endif
2407# 1129 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2408 do i = 0, m
2409 do j = 0, n
2410 do k = 0, p
2411 encoded_ib_idx = ib_markers%sf(i, j, k)
2412 if (encoded_ib_idx /= 0) then
2413 call s_decode_patch_periodicity(encoded_ib_idx, ib_idx_temp, xp, yp, zp)
2414 call s_get_neighborhood_idx(ib_idx_temp, ib_idx) ! global patch ID -> local index
2415 if (ib_idx > 0) then
2416 ! get the vector pointing to the grid cell from the IB centroid
2417 radial_vector(1) = x_cc(i) - (patch_ib(ib_idx)%x_centroid + real(xp, &
2418 & wp)*(glb_bounds(1)%end - glb_bounds(1)%beg))
2419 radial_vector(2) = y_cc(j) - (patch_ib(ib_idx)%y_centroid + real(yp, &
2420 & wp)*(glb_bounds(2)%end - glb_bounds(2)%beg))
2421 radial_vector(3) = 0._wp
2422 if (num_dims == 3) radial_vector(3) = z_cc(k) - (patch_ib(ib_idx)%z_centroid + real(zp, &
2423 & wp)*(glb_bounds(3)%end - glb_bounds(3)%beg))
2424
2425 local_force_contribution(:) = 0._wp
2426
2427 ! compute the pressure force component, which is the negative pressure gradient
2428 do l = -fd_number, fd_number
2429 local_force_contribution(1) = local_force_contribution(1) - (fd_coeff_x(l, &
2430 & i)*q_prim_vf(eqn_idx%E)%sf(i + l, j, k))
2431 local_force_contribution(2) = local_force_contribution(2) - (fd_coeff_y(l, &
2432 & j)*q_prim_vf(eqn_idx%E)%sf(i, j + l, k))
2433 if (num_dims == 3) then
2434 local_force_contribution(3) = local_force_contribution(3) - (fd_coeff_z(l, &
2435 & k)*q_prim_vf(eqn_idx%E)%sf(i, j, k + l))
2436 end if
2437 end do
2438
2439 ! get the viscous stress and add its contribution if that is considered
2440 if (viscous) then
2441 ! compute the volume-weighted local dynamic viscosity
2442 dynamic_viscosity = 0._wp
2443 do fluid_idx = 1, num_fluids
2444 ! local dynamic viscosity is the dynamic viscosity of the fluid times alpha of the fluid
2445 dynamic_viscosity = dynamic_viscosity + (q_prim_vf(fluid_idx + eqn_idx%adv%beg - 1)%sf(i, j, &
2446 & k)*dynamic_viscosities(fluid_idx))
2447 end do
2448
2449 do l = -fd_number, fd_number
2450 call s_compute_viscous_stress_tensor(viscous_stress, q_prim_vf, dynamic_viscosity, i + l, j, k)
2451 local_force_contribution(1:3) = local_force_contribution(1:3) + fd_coeff_x(l, &
2452 & i)*viscous_stress(1,1:3)
2453
2454 call s_compute_viscous_stress_tensor(viscous_stress, q_prim_vf, dynamic_viscosity, i, j + l, k)
2455 local_force_contribution(1:3) = local_force_contribution(1:3) + fd_coeff_y(l, &
2456 & j)*viscous_stress(2,1:3)
2457
2458 if (num_dims == 3) then
2459 call s_compute_viscous_stress_tensor(viscous_stress, q_prim_vf, dynamic_viscosity, i, j, &
2460 & k + l)
2461 local_force_contribution(1:3) = local_force_contribution(1:3) + fd_coeff_z(l, &
2462 & k)*viscous_stress(3,1:3)
2463 end if
2464 end do
2465 end if
2466
2467 call s_cross_product(radial_vector, local_force_contribution, local_torque_contribution)
2468
2469 ! Update the force and torque values atomically to prevent race conditions
2470 cell_volume = dx(i)*dy(j)
2471 if (num_dims == 3) cell_volume = cell_volume*dz(k)
2472 do l = 1, num_dims
2473
2474# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2475#if defined(MFC_OpenACC)
2476# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2477!$acc atomic update
2478# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2479#elif defined(MFC_OpenMP)
2480# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2481!$omp atomic update
2482# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2483#endif
2484 forces(ib_idx, l) = forces(ib_idx, l) + (local_force_contribution(l)*cell_volume)
2485
2486# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2487#if defined(MFC_OpenACC)
2488# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2489!$acc atomic update
2490# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2491#elif defined(MFC_OpenMP)
2492# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2493!$omp atomic update
2494# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2495#endif
2496 torques(ib_idx, l) = torques(ib_idx, l) + local_torque_contribution(l)*cell_volume
2497 end do
2498 end if ! ib_idx > 0
2499 end if
2500 end do
2501 end do
2502 end do
2503
2504# 1204 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2505#if defined(MFC_OpenACC)
2506# 1204 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2507!$acc end parallel loop
2508# 1204 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2509#elif defined(MFC_OpenMP)
2510# 1204 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2511
2512# 1204 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2513!$omp end target teams loop
2514# 1204 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2515#endif
2516
2517 call s_apply_collision_forces(ghost_points, num_gps, ib_markers, forces, torques)
2518
2519 ! reduce the forces across local neighborhood ranks
2520 call s_communicate_ib_forces(forces, torques)
2521
2522 ! consider body forces after reducing to avoid double counting
2523 do i = 1, num_ibs
2524 if (bf_x) then
2525 forces(i, 1) = forces(i, 1) + accel_bf(1)*patch_ib(i)%mass
2526 end if
2527 if (bf_y) then
2528 forces(i, 2) = forces(i, 2) + accel_bf(2)*patch_ib(i)%mass
2529 end if
2530 if (bf_z) then
2531 forces(i, 3) = forces(i, 3) + accel_bf(3)*patch_ib(i)%mass
2532 end if
2533 end do
2534
2535 ! apply the summed forces
2536
2537# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2538
2539# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2540#if defined(MFC_OpenACC)
2541# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2542!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
2543# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2544#elif defined(MFC_OpenMP)
2545# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2546
2547# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2548
2549# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2550
2551# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2552!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i) map(to:forces, torques)
2553# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2554#endif
2555 do i = 1, num_ibs
2556 patch_ib(i)%force(:) = forces(i,:)
2557 patch_ib(i)%torque(:) = torques(i,:)
2558 end do
2559
2560# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2561#if defined(MFC_OpenACC)
2562# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2563!$acc end parallel loop
2564# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2565#elif defined(MFC_OpenMP)
2566# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2567
2568# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2569!$omp end target teams loop
2570# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2571#endif
2572
2573 call nvtxendrange
2574
2575 end subroutine s_compute_ib_forces
2576
2577 !> Computes the center of mass for IB patch types where we are unable to determine their center of mass analytically.
2578 !> These patches include things like NACA airfoils and STL models
2579 subroutine s_compute_centroid_offset(ib_marker)
2580
2581 integer, intent(in) :: ib_marker
2582 integer :: i, j, k, num_cells_local, decoded_gbl_id
2583 integer(kind=8) :: num_cells
2584 real(wp), dimension(1:3) :: center_of_mass, center_of_mass_local
2585
2586 ! Offset only needs to be computes for specific geometries
2587
2588 if (patch_ib(ib_marker)%geometry == 4 .or. patch_ib(ib_marker)%geometry == 5 .or. patch_ib(ib_marker)%geometry == 11 &
2589 & .or. patch_ib(ib_marker)%geometry == 12) then
2590 center_of_mass_local = [0._wp, 0._wp, 0._wp]
2591 num_cells_local = 0
2592
2593 ! get the summed mass distribution and number of cells to divide by
2594 do i = 0, m
2595 do j = 0, n
2596 do k = 0, p
2597 if (ib_markers%sf(i, j, k) /= 0) then
2598 call s_decode_patch_periodicity(ib_markers%sf(i, j, k), decoded_gbl_id)
2599 if (decoded_gbl_id == patch_ib(ib_marker)%gbl_patch_id) then
2600 num_cells_local = num_cells_local + 1
2601 center_of_mass_local = center_of_mass_local + [x_cc(i), y_cc(j), 0._wp]
2602 if (num_dims == 3) center_of_mass_local(3) = center_of_mass_local(3) + z_cc(k)
2603 end if
2604 end if
2605 end do
2606 end do
2607 end do
2608
2609 ! reduce the mass contribution over all MPI ranks and compute COM
2610 call s_mpi_allreduce_integer_sum(int(num_cells_local, 8), num_cells)
2611 if (num_cells /= 0) then
2612 call s_mpi_allreduce_sum(center_of_mass_local(1), center_of_mass(1))
2613 call s_mpi_allreduce_sum(center_of_mass_local(2), center_of_mass(2))
2614 call s_mpi_allreduce_sum(center_of_mass_local(3), center_of_mass(3))
2615 center_of_mass = center_of_mass/real(num_cells, wp)
2616 else
2617 patch_ib(ib_marker)%centroid_offset = [0._wp, 0._wp, 0._wp]
2618 return
2619 end if
2620
2621 ! assign the centroid offset as a vector pointing from the true COM to the "centroid" in the input file and replace the
2622 ! current centroid
2623 patch_ib(ib_marker)%centroid_offset = [patch_ib(ib_marker)%x_centroid, patch_ib(ib_marker)%y_centroid, &
2624 & patch_ib(ib_marker)%z_centroid] - center_of_mass
2625 patch_ib(ib_marker)%x_centroid = center_of_mass(1)
2626 patch_ib(ib_marker)%y_centroid = center_of_mass(2)
2627 patch_ib(ib_marker)%z_centroid = center_of_mass(3)
2628
2629 ! rotate the centroid offset back into the local coords of the IB
2630 patch_ib(ib_marker)%centroid_offset = matmul(patch_ib(ib_marker)%rotation_matrix_inverse, &
2631 & patch_ib(ib_marker)%centroid_offset)
2632 else
2633 patch_ib(ib_marker)%centroid_offset(:) = [0._wp, 0._wp, 0._wp]
2634 end if
2635
2636 end subroutine s_compute_centroid_offset
2637
2638 !> Computes the moment of inertia for an immersed boundary
2639 subroutine s_compute_moment_of_inertia(patch, axis, moment)
2640
2641
2642# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2643#if MFC_OpenACC
2644# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2645!$acc routine seq
2646# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2647#elif MFC_OpenMP
2648# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2649
2650# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2651
2652# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2653!$omp declare target device_type(any)
2654# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2655#endif
2656
2657 type(ib_patch_parameters), intent(in) :: patch
2658 real(wp), dimension(3), intent(in) :: axis
2659 real(wp), intent(out) :: moment
2660 real(wp) :: distance_to_axis, cell_volume
2661 real(wp), dimension(3) :: position, closest_point_along_axis, vector_to_axis, normal_axis
2662 integer :: i, j, k, count, ib_marker
2663
2664 ! if the IB is in 2D or a 3D sphere, we can compute this exactly
2665 if (patch%geometry == 2) then ! circle
2666 moment = 0.5_wp*patch%mass*(patch%radius)**2
2667 else if (patch%geometry == 3) then ! rectangle
2668 moment = patch%mass*(patch%length_x**2 + patch %length_y**2)/6._wp
2669 else if (patch%geometry == 6) then ! ellipse
2670 moment = 0.0625_wp*patch%mass*(patch%length_x**2 + patch %length_y**2)
2671 else if (patch%geometry == 8) then ! sphere
2672 moment = 0.4*patch%mass*(patch%radius)**2
2673 else ! we do not have an analytic moment of inertia calculation and need to approximate it directly via a sum
2674 count = 0
2675 cell_volume = (x_cc(1) - x_cc(0))*(y_cc(1) - y_cc(0))
2676 ! computed without grid stretching. Update in the loop to perform with stretching
2677 if (p /= 0) then
2678 cell_volume = cell_volume*(z_cc(1) - z_cc(0))
2679 end if
2680
2681 ib_marker = patch%gbl_patch_id
2682
2683 if (p == 0) then
2684 normal_axis = [0, 0, 1]
2685 else if (sqrt(sum(axis**2)) < sgm_eps) then
2686 ! if the object is not actually rotating at this time, return a dummy value and exit
2687 moment = 1._wp
2688 return
2689 else
2690 normal_axis = axis/sqrt(sum(axis**2))
2691 end if
2692
2693 moment = 0._wp
2694
2695 do i = 0, m
2696 do j = 0, n
2697 do k = 0, p
2698 if (ib_markers%sf(i, j, k) == ib_marker) then
2699 count = count + 1 ! increment the count of total cells in the boundary
2700
2701 ! get the position in local coordinates so that the axis passes through 0, 0, 0
2702 if (num_dims < 3) then
2703 position = [x_cc(i), y_cc(j), 0._wp] - [patch%x_centroid, patch%y_centroid, 0._wp]
2704 else
2705 position = [x_cc(i), y_cc(j), z_cc(k)] - [patch%x_centroid, patch%y_centroid, patch%z_centroid]
2706 end if
2707
2708 ! project the position along the axis to find the closest distance to the rotation axis
2709 closest_point_along_axis = normal_axis*dot_product(normal_axis, position)
2710 vector_to_axis = position - closest_point_along_axis
2711 distance_to_axis = dot_product(vector_to_axis, vector_to_axis) ! saves the distance to the axis squared
2712
2713 ! compute the position component of the moment
2714 moment = moment + distance_to_axis
2715 end if
2716 end do
2717 end do
2718 end do
2719
2720 ! write the final moment assuming the points are all uniform density
2721 moment = moment*patch%mass/(count*cell_volume)
2722 end if
2723
2724 end subroutine s_compute_moment_of_inertia
2725
2726 !> Wrap immersed boundary positions across periodic domain boundaries
2727 subroutine s_wrap_periodic_ibs()
2728
2729 integer :: patch_id
2730
2731
2732# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2733
2734# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2735#if defined(MFC_OpenACC)
2736# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2737!$acc parallel loop gang vector default(present) private(patch_id)
2738# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2739#elif defined(MFC_OpenMP)
2740# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2741
2742# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2743
2744# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2745
2746# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2747!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(patch_id)
2748# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2749#endif
2750 do patch_id = 1, num_ibs
2751 ! check domain wraps in x, y,
2752# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2753 if (num_dims >= 1) then
2754 ! check for periodicity
2755 if (ib_bc_x%beg == bc_periodic) then
2756 ! check if the boundary has left the domain, and then correct
2757 if (patch_ib(patch_id)%x_centroid < glb_bounds(1)%beg) then
2758 ! if the boundary exited "left", wrap it back around to the "right"
2759 patch_ib(patch_id)%x_centroid = patch_ib(patch_id)%x_centroid + (glb_bounds(1)%end &
2760 & - glb_bounds(1)%beg)
2761 else if (patch_ib(patch_id)%x_centroid > glb_bounds(1)%end) then
2762 ! if the boundary exited "right", wrap it back around to the "left"
2763 patch_ib(patch_id)%x_centroid = patch_ib(patch_id)%x_centroid - (glb_bounds(1)%end &
2764 & - glb_bounds(1)%beg)
2765 end if
2766 end if
2767 end if
2768# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2769 if (num_dims >= 2) then
2770 ! check for periodicity
2771 if (ib_bc_y%beg == bc_periodic) then
2772 ! check if the boundary has left the domain, and then correct
2773 if (patch_ib(patch_id)%y_centroid < glb_bounds(2)%beg) then
2774 ! if the boundary exited "left", wrap it back around to the "right"
2775 patch_ib(patch_id)%y_centroid = patch_ib(patch_id)%y_centroid + (glb_bounds(2)%end &
2776 & - glb_bounds(2)%beg)
2777 else if (patch_ib(patch_id)%y_centroid > glb_bounds(2)%end) then
2778 ! if the boundary exited "right", wrap it back around to the "left"
2779 patch_ib(patch_id)%y_centroid = patch_ib(patch_id)%y_centroid - (glb_bounds(2)%end &
2780 & - glb_bounds(2)%beg)
2781 end if
2782 end if
2783 end if
2784# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2785 if (num_dims >= 3) then
2786 ! check for periodicity
2787 if (ib_bc_z%beg == bc_periodic) then
2788 ! check if the boundary has left the domain, and then correct
2789 if (patch_ib(patch_id)%z_centroid < glb_bounds(3)%beg) then
2790 ! if the boundary exited "left", wrap it back around to the "right"
2791 patch_ib(patch_id)%z_centroid = patch_ib(patch_id)%z_centroid + (glb_bounds(3)%end &
2792 & - glb_bounds(3)%beg)
2793 else if (patch_ib(patch_id)%z_centroid > glb_bounds(3)%end) then
2794 ! if the boundary exited "right", wrap it back around to the "left"
2795 patch_ib(patch_id)%z_centroid = patch_ib(patch_id)%z_centroid - (glb_bounds(3)%end &
2796 & - glb_bounds(3)%beg)
2797 end if
2798 end if
2799 end if
2800# 1396 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2801 end do
2802
2803# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2804#if defined(MFC_OpenACC)
2805# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2806!$acc end parallel loop
2807# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2808#elif defined(MFC_OpenMP)
2809# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2810
2811# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2812!$omp end target teams loop
2813# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2814#endif
2815
2816 end subroutine s_wrap_periodic_ibs
2817
2818 !> @brief Swaps ownership of IBs and passes ownership of IBs to neighbor processors
2819 !> Reduces forces and torques across the local neighborhood without a global allreduce. Accumulation phase: 2 passes per
2820 !! dimension receiving from the low-index (-X) neighbor. Pass 1: add received values; save what was received as recv_snap. Pass
2821 !! 2: send current (post-pass-1) values; add received; subtract recv_snap to remove double-counting of the direct contribution
2822 !! already added in pass 1. Back-propagation phase: 2 passes per dimension receiving from the high-index (+X) neighbor, each
2823 !! overwriting local forces with the neighbor's accumulated total.
2824 subroutine s_communicate_ib_forces(forces, torques)
2825
2826 real(wp), dimension(num_ibs, 3), intent(inout) :: forces, torques
2827
2828#ifdef MFC_MPI
2829 integer :: i, j, k, pack_pos, unpack_pos, buf_size, ierr
2830 integer :: send_neighbor, recv_neighbor, recv_count, tag
2831 character(len=1), allocatable :: ib_force_send_buf(:), ib_force_recv_buf(:)
2832
2833 if (num_procs == 1) return
2834
2835 buf_size = storage_size(0)/8 + (storage_size(0)/8 + 6*storage_size(0._wp)/8)*size(patch_ib)
2836 allocate (ib_force_send_buf(buf_size), ib_force_recv_buf(buf_size))
2837
2838 ! Accumulation phase: propagate contributions toward the high-index corner.
2839# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2840 if (num_dims >= 1) then
2841 send_neighbor = merge(bc_x%end, mpi_proc_null, bc_x%end >= 0)
2842 recv_neighbor = merge(bc_x%beg, mpi_proc_null, bc_x%beg >= 0)
2843
2844 recv_forces_snap = 0._wp
2845 recv_torques_snap = 0._wp
2846
2847# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2848#if defined(MFC_OpenACC)
2849# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2850!$acc update device(recv_forces_snap, recv_torques_snap)
2851# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2852#elif defined(MFC_OpenMP)
2853# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2854!$omp target update to(recv_forces_snap, recv_torques_snap)
2855# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2856#endif
2857 tag = 300
2858
2859 do k = 1, min(2*ib_neighborhood_radius, num_procs_x - 1)
2860 ! send forces to +x neighbor; receive from -x neighbor. Add received values then
2861 pack_pos = 0
2862
2863# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2864
2865# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2866#if defined(MFC_OpenACC)
2867# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2868!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
2869# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2870#elif defined(MFC_OpenMP)
2871# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2872
2873# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2874
2875# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2876
2877# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2878!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i) map(to:forces, torques)
2879# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2880#endif
2881 do i = 1, num_ibs
2882 send_ids(i) = patch_ib(i)%gbl_patch_id
2883 send_ft(1:3,i) = forces(i,:)
2884 send_ft(4:6,i) = torques(i,:)
2885 end do
2886
2887# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2888#if defined(MFC_OpenACC)
2889# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2890!$acc end parallel loop
2891# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2892#elif defined(MFC_OpenMP)
2893# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2894
2895# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2896!$omp end target teams loop
2897# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2898#endif
2899
2900# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2901#if defined(MFC_OpenACC)
2902# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2903!$acc update host(send_ids, send_ft)
2904# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2905#elif defined(MFC_OpenMP)
2906# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2907!$omp target update from(send_ids, send_ft)
2908# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2909#endif
2910 call mpi_pack(num_ibs, 1, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2911 call mpi_pack(send_ids, num_ibs, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2912 call mpi_pack(send_ft, 6*num_ibs, mpi_p, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2913 call mpi_sendrecv(ib_force_send_buf, pack_pos, mpi_packed, send_neighbor, tag, ib_force_recv_buf, buf_size, &
2914 & mpi_packed, recv_neighbor, tag, mpi_comm_world, mpi_status_ignore, ierr)
2915
2916 if (recv_neighbor /= mpi_proc_null) then
2917 unpack_pos = 0
2918 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
2919 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ids, recv_count, mpi_integer, &
2920 & mpi_comm_world, ierr)
2921 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ft, 6*recv_count, mpi_p, mpi_comm_world, ierr)
2922
2923# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2924#if defined(MFC_OpenACC)
2925# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2926!$acc update device(recv_ids(1:recv_count), recv_ft(:, 1:recv_count))
2927# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2928#elif defined(MFC_OpenMP)
2929# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2930!$omp target update to(recv_ids(1:recv_count), recv_ft(:, 1:recv_count))
2931# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2932#endif
2933
2934# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2935
2936# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2937#if defined(MFC_OpenACC)
2938# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2939!$acc parallel loop gang vector default(present) private(i, j) copy(forces, torques)
2940# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2941#elif defined(MFC_OpenMP)
2942# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2943
2944# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2945
2946# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2947
2948# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2949!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j) &
2950# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2951!$omp& map(tofrom:forces, torques)
2952# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2953#endif
2954 do i = 1, recv_count
2955 call s_get_neighborhood_idx(recv_ids(i), j)
2956 if (j > 0) then
2957 ! add forces and subtract recv_snap prevent double-counting
2958 forces(j,:) = forces(j,:) + recv_ft(1:3,i) - recv_forces_snap(j,:)
2959 torques(j,:) = torques(j,:) + recv_ft(4:6,i) - recv_torques_snap(j,:)
2960 recv_forces_snap(j,:) = recv_ft(1:3,i)
2961 recv_torques_snap(j,:) = recv_ft(4:6,i)
2962 end if
2963 end do
2964
2965# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2966#if defined(MFC_OpenACC)
2967# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2968!$acc end parallel loop
2969# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2970#elif defined(MFC_OpenMP)
2971# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2972
2973# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2974!$omp end target teams loop
2975# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2976#endif
2977 end if
2978 tag = tag + 2
2979 end do
2980 end if
2981# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2982 if (num_dims >= 2) then
2983 send_neighbor = merge(bc_y%end, mpi_proc_null, bc_y%end >= 0)
2984 recv_neighbor = merge(bc_y%beg, mpi_proc_null, bc_y%beg >= 0)
2985
2986 recv_forces_snap = 0._wp
2987 recv_torques_snap = 0._wp
2988
2989# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2990#if defined(MFC_OpenACC)
2991# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2992!$acc update device(recv_forces_snap, recv_torques_snap)
2993# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2994#elif defined(MFC_OpenMP)
2995# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2996!$omp target update to(recv_forces_snap, recv_torques_snap)
2997# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2998#endif
2999 tag = 300
3000
3001 do k = 1, min(2*ib_neighborhood_radius, num_procs_y - 1)
3002 ! send forces to +y neighbor; receive from -y neighbor. Add received values then
3003 pack_pos = 0
3004
3005# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3006
3007# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3008#if defined(MFC_OpenACC)
3009# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3010!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
3011# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3012#elif defined(MFC_OpenMP)
3013# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3014
3015# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3016
3017# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3018
3019# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3020!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i) map(to:forces, torques)
3021# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3022#endif
3023 do i = 1, num_ibs
3024 send_ids(i) = patch_ib(i)%gbl_patch_id
3025 send_ft(1:3,i) = forces(i,:)
3026 send_ft(4:6,i) = torques(i,:)
3027 end do
3028
3029# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3030#if defined(MFC_OpenACC)
3031# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3032!$acc end parallel loop
3033# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3034#elif defined(MFC_OpenMP)
3035# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3036
3037# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3038!$omp end target teams loop
3039# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3040#endif
3041
3042# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3043#if defined(MFC_OpenACC)
3044# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3045!$acc update host(send_ids, send_ft)
3046# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3047#elif defined(MFC_OpenMP)
3048# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3049!$omp target update from(send_ids, send_ft)
3050# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3051#endif
3052 call mpi_pack(num_ibs, 1, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3053 call mpi_pack(send_ids, num_ibs, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3054 call mpi_pack(send_ft, 6*num_ibs, mpi_p, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3055 call mpi_sendrecv(ib_force_send_buf, pack_pos, mpi_packed, send_neighbor, tag, ib_force_recv_buf, buf_size, &
3056 & mpi_packed, recv_neighbor, tag, mpi_comm_world, mpi_status_ignore, ierr)
3057
3058 if (recv_neighbor /= mpi_proc_null) then
3059 unpack_pos = 0
3060 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
3061 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ids, recv_count, mpi_integer, &
3062 & mpi_comm_world, ierr)
3063 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ft, 6*recv_count, mpi_p, mpi_comm_world, ierr)
3064
3065# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3066#if defined(MFC_OpenACC)
3067# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3068!$acc update device(recv_ids(1:recv_count), recv_ft(:, 1:recv_count))
3069# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3070#elif defined(MFC_OpenMP)
3071# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3072!$omp target update to(recv_ids(1:recv_count), recv_ft(:, 1:recv_count))
3073# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3074#endif
3075
3076# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3077
3078# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3079#if defined(MFC_OpenACC)
3080# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3081!$acc parallel loop gang vector default(present) private(i, j) copy(forces, torques)
3082# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3083#elif defined(MFC_OpenMP)
3084# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3085
3086# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3087
3088# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3089
3090# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3091!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j) &
3092# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3093!$omp& map(tofrom:forces, torques)
3094# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3095#endif
3096 do i = 1, recv_count
3097 call s_get_neighborhood_idx(recv_ids(i), j)
3098 if (j > 0) then
3099 ! add forces and subtract recv_snap prevent double-counting
3100 forces(j,:) = forces(j,:) + recv_ft(1:3,i) - recv_forces_snap(j,:)
3101 torques(j,:) = torques(j,:) + recv_ft(4:6,i) - recv_torques_snap(j,:)
3102 recv_forces_snap(j,:) = recv_ft(1:3,i)
3103 recv_torques_snap(j,:) = recv_ft(4:6,i)
3104 end if
3105 end do
3106
3107# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3108#if defined(MFC_OpenACC)
3109# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3110!$acc end parallel loop
3111# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3112#elif defined(MFC_OpenMP)
3113# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3114
3115# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3116!$omp end target teams loop
3117# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3118#endif
3119 end if
3120 tag = tag + 2
3121 end do
3122 end if
3123# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3124 if (num_dims >= 3) then
3125 send_neighbor = merge(bc_z%end, mpi_proc_null, bc_z%end >= 0)
3126 recv_neighbor = merge(bc_z%beg, mpi_proc_null, bc_z%beg >= 0)
3127
3128 recv_forces_snap = 0._wp
3129 recv_torques_snap = 0._wp
3130
3131# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3132#if defined(MFC_OpenACC)
3133# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3134!$acc update device(recv_forces_snap, recv_torques_snap)
3135# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3136#elif defined(MFC_OpenMP)
3137# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3138!$omp target update to(recv_forces_snap, recv_torques_snap)
3139# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3140#endif
3141 tag = 300
3142
3143 do k = 1, min(2*ib_neighborhood_radius, num_procs_z - 1)
3144 ! send forces to +z neighbor; receive from -z neighbor. Add received values then
3145 pack_pos = 0
3146
3147# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3148
3149# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3150#if defined(MFC_OpenACC)
3151# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3152!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
3153# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3154#elif defined(MFC_OpenMP)
3155# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3156
3157# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3158
3159# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3160
3161# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3162!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i) map(to:forces, torques)
3163# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3164#endif
3165 do i = 1, num_ibs
3166 send_ids(i) = patch_ib(i)%gbl_patch_id
3167 send_ft(1:3,i) = forces(i,:)
3168 send_ft(4:6,i) = torques(i,:)
3169 end do
3170
3171# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3172#if defined(MFC_OpenACC)
3173# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3174!$acc end parallel loop
3175# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3176#elif defined(MFC_OpenMP)
3177# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3178
3179# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3180!$omp end target teams loop
3181# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3182#endif
3183
3184# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3185#if defined(MFC_OpenACC)
3186# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3187!$acc update host(send_ids, send_ft)
3188# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3189#elif defined(MFC_OpenMP)
3190# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3191!$omp target update from(send_ids, send_ft)
3192# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3193#endif
3194 call mpi_pack(num_ibs, 1, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3195 call mpi_pack(send_ids, num_ibs, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3196 call mpi_pack(send_ft, 6*num_ibs, mpi_p, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3197 call mpi_sendrecv(ib_force_send_buf, pack_pos, mpi_packed, send_neighbor, tag, ib_force_recv_buf, buf_size, &
3198 & mpi_packed, recv_neighbor, tag, mpi_comm_world, mpi_status_ignore, ierr)
3199
3200 if (recv_neighbor /= mpi_proc_null) then
3201 unpack_pos = 0
3202 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
3203 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ids, recv_count, mpi_integer, &
3204 & mpi_comm_world, ierr)
3205 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ft, 6*recv_count, mpi_p, mpi_comm_world, ierr)
3206
3207# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3208#if defined(MFC_OpenACC)
3209# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3210!$acc update device(recv_ids(1:recv_count), recv_ft(:, 1:recv_count))
3211# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3212#elif defined(MFC_OpenMP)
3213# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3214!$omp target update to(recv_ids(1:recv_count), recv_ft(:, 1:recv_count))
3215# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3216#endif
3217
3218# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3219
3220# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3221#if defined(MFC_OpenACC)
3222# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3223!$acc parallel loop gang vector default(present) private(i, j) copy(forces, torques)
3224# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3225#elif defined(MFC_OpenMP)
3226# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3227
3228# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3229
3230# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3231
3232# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3233!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j) &
3234# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3235!$omp& map(tofrom:forces, torques)
3236# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3237#endif
3238 do i = 1, recv_count
3239 call s_get_neighborhood_idx(recv_ids(i), j)
3240 if (j > 0) then
3241 ! add forces and subtract recv_snap prevent double-counting
3242 forces(j,:) = forces(j,:) + recv_ft(1:3,i) - recv_forces_snap(j,:)
3243 torques(j,:) = torques(j,:) + recv_ft(4:6,i) - recv_torques_snap(j,:)
3244 recv_forces_snap(j,:) = recv_ft(1:3,i)
3245 recv_torques_snap(j,:) = recv_ft(4:6,i)
3246 end if
3247 end do
3248
3249# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3250#if defined(MFC_OpenACC)
3251# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3252!$acc end parallel loop
3253# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3254#elif defined(MFC_OpenMP)
3255# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3256
3257# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3258!$omp end target teams loop
3259# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3260#endif
3261 end if
3262 tag = tag + 2
3263 end do
3264 end if
3265# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3266
3267 ! Send final sums back to neighbors in -X direction
3268# 1476 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3269 if (num_dims >= 1) then
3270 send_neighbor = merge(bc_x%beg, mpi_proc_null, bc_x%beg >= 0)
3271 recv_neighbor = merge(bc_x%end, mpi_proc_null, bc_x%end >= 0)
3272
3273 do k = 1, min(2*ib_neighborhood_radius, num_procs_x - 1)
3274 pack_pos = 0
3275
3276# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3277
3278# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3279#if defined(MFC_OpenACC)
3280# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3281!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
3282# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3283#elif defined(MFC_OpenMP)
3284# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3285
3286# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3287
3288# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3289
3290# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3291!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i) map(to:forces, torques)
3292# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3293#endif
3294 do i = 1, num_ibs
3295 send_ids(i) = patch_ib(i)%gbl_patch_id
3296 send_ft(1:3,i) = forces(i,:)
3297 send_ft(4:6,i) = torques(i,:)
3298 end do
3299
3300# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3301#if defined(MFC_OpenACC)
3302# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3303!$acc end parallel loop
3304# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3305#elif defined(MFC_OpenMP)
3306# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3307
3308# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3309!$omp end target teams loop
3310# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3311#endif
3312
3313# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3314#if defined(MFC_OpenACC)
3315# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3316!$acc update host(send_ids, send_ft)
3317# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3318#elif defined(MFC_OpenMP)
3319# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3320!$omp target update from(send_ids, send_ft)
3321# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3322#endif
3323 call mpi_pack(num_ibs, 1, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3324 call mpi_pack(send_ids, num_ibs, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3325 call mpi_pack(send_ft, 6*num_ibs, mpi_p, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3326 call mpi_sendrecv(ib_force_send_buf, pack_pos, mpi_packed, send_neighbor, tag, ib_force_recv_buf, buf_size, &
3327 & mpi_packed, recv_neighbor, tag, mpi_comm_world, mpi_status_ignore, ierr)
3328 if (recv_neighbor /= mpi_proc_null) then
3329 unpack_pos = 0
3330 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
3331 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ids, recv_count, mpi_integer, &
3332 & mpi_comm_world, ierr)
3333 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ft, 6*recv_count, mpi_p, mpi_comm_world, ierr)
3334
3335# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3336#if defined(MFC_OpenACC)
3337# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3338!$acc update device(recv_ids(1:recv_count), recv_ft(:, 1:recv_count))
3339# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3340#elif defined(MFC_OpenMP)
3341# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3342!$omp target update to(recv_ids(1:recv_count), recv_ft(:, 1:recv_count))
3343# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3344#endif
3345
3346# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3347
3348# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3349#if defined(MFC_OpenACC)
3350# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3351!$acc parallel loop gang vector default(present) private(i, j) copy(forces, torques)
3352# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3353#elif defined(MFC_OpenMP)
3354# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3355
3356# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3357
3358# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3359
3360# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3361!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j) &
3362# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3363!$omp& map(tofrom:forces, torques)
3364# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3365#endif
3366 do i = 1, recv_count
3367 call s_get_neighborhood_idx(recv_ids(i), j)
3368 if (j > 0) then
3369 forces(j,:) = recv_ft(1:3,i)
3370 torques(j,:) = recv_ft(4:6,i)
3371 end if
3372 end do
3373
3374# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3375#if defined(MFC_OpenACC)
3376# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3377!$acc end parallel loop
3378# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3379#elif defined(MFC_OpenMP)
3380# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3381
3382# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3383!$omp end target teams loop
3384# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3385#endif
3386 end if
3387 tag = tag + 2
3388 end do
3389 end if
3390# 1476 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3391 if (num_dims >= 2) then
3392 send_neighbor = merge(bc_y%beg, mpi_proc_null, bc_y%beg >= 0)
3393 recv_neighbor = merge(bc_y%end, mpi_proc_null, bc_y%end >= 0)
3394
3395 do k = 1, min(2*ib_neighborhood_radius, num_procs_y - 1)
3396 pack_pos = 0
3397
3398# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3399
3400# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3401#if defined(MFC_OpenACC)
3402# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3403!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
3404# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3405#elif defined(MFC_OpenMP)
3406# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3407
3408# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3409
3410# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3411
3412# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3413!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i) map(to:forces, torques)
3414# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3415#endif
3416 do i = 1, num_ibs
3417 send_ids(i) = patch_ib(i)%gbl_patch_id
3418 send_ft(1:3,i) = forces(i,:)
3419 send_ft(4:6,i) = torques(i,:)
3420 end do
3421
3422# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3423#if defined(MFC_OpenACC)
3424# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3425!$acc end parallel loop
3426# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3427#elif defined(MFC_OpenMP)
3428# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3429
3430# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3431!$omp end target teams loop
3432# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3433#endif
3434
3435# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3436#if defined(MFC_OpenACC)
3437# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3438!$acc update host(send_ids, send_ft)
3439# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3440#elif defined(MFC_OpenMP)
3441# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3442!$omp target update from(send_ids, send_ft)
3443# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3444#endif
3445 call mpi_pack(num_ibs, 1, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3446 call mpi_pack(send_ids, num_ibs, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3447 call mpi_pack(send_ft, 6*num_ibs, mpi_p, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3448 call mpi_sendrecv(ib_force_send_buf, pack_pos, mpi_packed, send_neighbor, tag, ib_force_recv_buf, buf_size, &
3449 & mpi_packed, recv_neighbor, tag, mpi_comm_world, mpi_status_ignore, ierr)
3450 if (recv_neighbor /= mpi_proc_null) then
3451 unpack_pos = 0
3452 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
3453 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ids, recv_count, mpi_integer, &
3454 & mpi_comm_world, ierr)
3455 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ft, 6*recv_count, mpi_p, mpi_comm_world, ierr)
3456
3457# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3458#if defined(MFC_OpenACC)
3459# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3460!$acc update device(recv_ids(1:recv_count), recv_ft(:, 1:recv_count))
3461# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3462#elif defined(MFC_OpenMP)
3463# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3464!$omp target update to(recv_ids(1:recv_count), recv_ft(:, 1:recv_count))
3465# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3466#endif
3467
3468# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3469
3470# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3471#if defined(MFC_OpenACC)
3472# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3473!$acc parallel loop gang vector default(present) private(i, j) copy(forces, torques)
3474# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3475#elif defined(MFC_OpenMP)
3476# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3477
3478# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3479
3480# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3481
3482# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3483!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j) &
3484# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3485!$omp& map(tofrom:forces, torques)
3486# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3487#endif
3488 do i = 1, recv_count
3489 call s_get_neighborhood_idx(recv_ids(i), j)
3490 if (j > 0) then
3491 forces(j,:) = recv_ft(1:3,i)
3492 torques(j,:) = recv_ft(4:6,i)
3493 end if
3494 end do
3495
3496# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3497#if defined(MFC_OpenACC)
3498# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3499!$acc end parallel loop
3500# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3501#elif defined(MFC_OpenMP)
3502# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3503
3504# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3505!$omp end target teams loop
3506# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3507#endif
3508 end if
3509 tag = tag + 2
3510 end do
3511 end if
3512# 1476 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3513 if (num_dims >= 3) then
3514 send_neighbor = merge(bc_z%beg, mpi_proc_null, bc_z%beg >= 0)
3515 recv_neighbor = merge(bc_z%end, mpi_proc_null, bc_z%end >= 0)
3516
3517 do k = 1, min(2*ib_neighborhood_radius, num_procs_z - 1)
3518 pack_pos = 0
3519
3520# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3521
3522# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3523#if defined(MFC_OpenACC)
3524# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3525!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
3526# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3527#elif defined(MFC_OpenMP)
3528# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3529
3530# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3531
3532# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3533
3534# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3535!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i) map(to:forces, torques)
3536# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3537#endif
3538 do i = 1, num_ibs
3539 send_ids(i) = patch_ib(i)%gbl_patch_id
3540 send_ft(1:3,i) = forces(i,:)
3541 send_ft(4:6,i) = torques(i,:)
3542 end do
3543
3544# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3545#if defined(MFC_OpenACC)
3546# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3547!$acc end parallel loop
3548# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3549#elif defined(MFC_OpenMP)
3550# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3551
3552# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3553!$omp end target teams loop
3554# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3555#endif
3556
3557# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3558#if defined(MFC_OpenACC)
3559# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3560!$acc update host(send_ids, send_ft)
3561# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3562#elif defined(MFC_OpenMP)
3563# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3564!$omp target update from(send_ids, send_ft)
3565# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3566#endif
3567 call mpi_pack(num_ibs, 1, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3568 call mpi_pack(send_ids, num_ibs, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3569 call mpi_pack(send_ft, 6*num_ibs, mpi_p, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3570 call mpi_sendrecv(ib_force_send_buf, pack_pos, mpi_packed, send_neighbor, tag, ib_force_recv_buf, buf_size, &
3571 & mpi_packed, recv_neighbor, tag, mpi_comm_world, mpi_status_ignore, ierr)
3572 if (recv_neighbor /= mpi_proc_null) then
3573 unpack_pos = 0
3574 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
3575 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ids, recv_count, mpi_integer, &
3576 & mpi_comm_world, ierr)
3577 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ft, 6*recv_count, mpi_p, mpi_comm_world, ierr)
3578
3579# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3580#if defined(MFC_OpenACC)
3581# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3582!$acc update device(recv_ids(1:recv_count), recv_ft(:, 1:recv_count))
3583# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3584#elif defined(MFC_OpenMP)
3585# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3586!$omp target update to(recv_ids(1:recv_count), recv_ft(:, 1:recv_count))
3587# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3588#endif
3589
3590# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3591
3592# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3593#if defined(MFC_OpenACC)
3594# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3595!$acc parallel loop gang vector default(present) private(i, j) copy(forces, torques)
3596# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3597#elif defined(MFC_OpenMP)
3598# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3599
3600# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3601
3602# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3603
3604# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3605!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j) &
3606# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3607!$omp& map(tofrom:forces, torques)
3608# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3609#endif
3610 do i = 1, recv_count
3611 call s_get_neighborhood_idx(recv_ids(i), j)
3612 if (j > 0) then
3613 forces(j,:) = recv_ft(1:3,i)
3614 torques(j,:) = recv_ft(4:6,i)
3615 end if
3616 end do
3617
3618# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3619#if defined(MFC_OpenACC)
3620# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3621!$acc end parallel loop
3622# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3623#elif defined(MFC_OpenMP)
3624# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3625
3626# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3627!$omp end target teams loop
3628# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3629#endif
3630 end if
3631 tag = tag + 2
3632 end do
3633 end if
3634# 1516 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3635#endif
3636
3637 end subroutine s_communicate_ib_forces
3638
3639 subroutine s_handoff_ib_ownership()
3640
3641 integer :: i, j, k, output_idx, local_output_idx
3642 integer :: old_num_local_ibs
3643 integer :: new_count, recv_count
3644 integer :: pack_pos, unpack_pos, buf_size, patch_bytes
3645 integer :: send_neighbor, recv_neighbor, ierr
3646 integer :: dx, dy, dz, tag, nbr_idx, nreqs
3647 real(wp), dimension(3) :: centroid
3648 logical :: is_new
3649 type(ib_patch_parameters) :: tmp_patch
3650 integer, dimension(num_local_ibs_max) :: local_ib_idx_old
3651 ! 26 neighbors max in 3D (8 in 2D); each gets its own recv buffer
3652 integer, parameter :: max_nbrs = 26
3653 character(len=1), allocatable :: send_buf(:), recv_bufs(:,:)
3654 integer, dimension(2*max_nbrs) :: requests
3655 integer, dimension(max_nbrs) :: recv_neighbor_list
3656
3657#ifdef MFC_MPI
3658 if (num_procs > 1) then
3659 ! save a copy of the local IB's global indices to cross-reference for later.
3660 local_ib_idx_old = 0
3661 old_num_local_ibs = num_local_ibs
3662 do i = 1, num_local_ibs
3663 local_ib_idx_old(i) = patch_ib(local_ib_patch_ids(i))%gbl_patch_id
3664 end do
3665
3666 ! Sync GPU-updated fields (angles, angular_vel, centroids) to host before
3667 ! compaction and MPI packing, which read from host memory.
3668
3669# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3670#if defined(MFC_OpenACC)
3671# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3672!$acc update host(patch_ib)
3673# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3674#elif defined(MFC_OpenMP)
3675# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3676!$omp target update from(patch_ib)
3677# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3678#endif
3679
3680 ! delete any particles that no longer need to be tracked and coalesce the array
3681 output_idx = 0
3682 local_output_idx = 0
3683 do i = 1, num_ibs
3684 centroid = [patch_ib(i)%x_centroid, patch_ib(i)%y_centroid, 0._wp]
3685 if (num_dims == 3) centroid(3) = patch_ib(i)%z_centroid
3686
3687 ! delete if not in neighborhood
3688 if (f_neighborhood_ranks_own_location(centroid)) then
3689 output_idx = output_idx + 1
3690 if (i /= output_idx) then
3691 patch_ib(output_idx) = patch_ib(i)
3692 end if
3693
3694 ! check if in local domain
3695 if (f_local_rank_owns_location(centroid, glb_bounds)) then
3696 local_output_idx = local_output_idx + 1
3697 local_ib_patch_ids(local_output_idx) = output_idx
3698 end if
3699 end if
3700 end do
3701 num_ibs = output_idx
3702 num_local_ibs = local_output_idx
3703
3704# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3705#if defined(MFC_OpenACC)
3706# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3707!$acc update device(patch_ib)
3708# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3709#elif defined(MFC_OpenMP)
3710# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3711!$omp target update to(patch_ib)
3712# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3713#endif
3714 call s_update_ib_lookup()
3715
3716 ! Broadcast newly-owned patches to all neighborhood neighbors
3717 patch_bytes = storage_size(tmp_patch)/8
3718 buf_size = storage_size(0)/8 + patch_bytes*num_local_ibs_max
3719 allocate (send_buf(buf_size), recv_bufs(buf_size, max_nbrs))
3720
3721 ! Write placeholder count at position 0
3722 pack_pos = 0
3723 call mpi_pack(0, 1, mpi_integer, send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3724
3725 ! pack new patches and count them
3726 new_count = 0
3727 do i = 1, num_local_ibs
3728 k = local_ib_patch_ids(i)
3729 is_new = .true.
3730 do j = 1, old_num_local_ibs
3731 if (patch_ib(k)%gbl_patch_id == local_ib_idx_old(j)) then
3732 is_new = .false.
3733 exit
3734 end if
3735 end do
3736 if (is_new) then
3737 call mpi_pack(patch_ib(k), patch_bytes, mpi_byte, send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3738 new_count = new_count + 1
3739 end if
3740 end do
3741
3742 ! Overwrite the placeholder with the real count
3743 pack_pos = 0
3744 call mpi_pack(new_count, 1, mpi_integer, send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3745 pack_pos = storage_size(0)/8 + new_count*patch_bytes
3746
3747 ! Post all receives first, then sends
3748 nreqs = 0
3749 nbr_idx = 0
3750 do dz = merge(-1, 0, num_dims == 3), merge(1, 0, num_dims == 3)
3751 do dy = -1, 1
3752 do dx = -1, 1
3753 if (dx == 0 .and. dy == 0 .and. dz == 0) cycle
3754 nbr_idx = nbr_idx + 1
3755 tag = 200 + (dx + 1)*9 + (dy + 1)*3 + (dz + 1)
3756 recv_neighbor = ib_neighbor_ranks(-dx, -dy, -dz)
3757 recv_neighbor_list(nbr_idx) = mpi_proc_null
3758 if (recv_neighbor < 0) cycle
3759 recv_neighbor_list(nbr_idx) = recv_neighbor
3760 nreqs = nreqs + 1
3761 call mpi_irecv(recv_bufs(:,nbr_idx), buf_size, mpi_packed, recv_neighbor, tag, mpi_comm_world, &
3762 & requests(nreqs), ierr)
3763 end do
3764 end do
3765 end do
3766
3767 do dz = merge(-1, 0, num_dims == 3), merge(1, 0, num_dims == 3)
3768 do dy = -1, 1
3769 do dx = -1, 1
3770 if (dx == 0 .and. dy == 0 .and. dz == 0) cycle
3771 tag = 200 + (dx + 1)*9 + (dy + 1)*3 + (dz + 1)
3772 send_neighbor = ib_neighbor_ranks(dx, dy, dz)
3773 if (send_neighbor < 0) cycle
3774 nreqs = nreqs + 1
3775 call mpi_isend(send_buf, pack_pos, mpi_packed, send_neighbor, tag, mpi_comm_world, requests(nreqs), ierr)
3776 end do
3777 end do
3778 end do
3779
3780 call mpi_waitall(nreqs, requests, mpi_statuses_ignore, ierr)
3781
3782 ! Unpack all received buffers
3783 do nbr_idx = 1, merge(26, 8, num_dims == 3)
3784 if (recv_neighbor_list(nbr_idx) == mpi_proc_null) cycle
3785 unpack_pos = 0
3786 call mpi_unpack(recv_bufs(:,nbr_idx), buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
3787 do i = 1, recv_count
3788 call mpi_unpack(recv_bufs(:,nbr_idx), buf_size, unpack_pos, tmp_patch, patch_bytes, mpi_byte, mpi_comm_world, &
3789 & ierr)
3790 call s_get_neighborhood_idx(tmp_patch%gbl_patch_id, j)
3791 if (j < 0) then
3792 num_ibs = num_ibs + 1
3793 if (.not. (num_ibs <= size(patch_ib))) then
3794# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3795 call s_mpi_abort("m_ibm.fpp:1654: " // "Assertion failed: num_ibs <= size(patch_ib). " &
3796# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3797 & // 'patch_ib overflow in neighborhood handoff')
3798# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3799 end if
3800 patch_ib(num_ibs) = tmp_patch
3801 end if
3802 end do
3803 end do
3804
3805 deallocate (send_buf, recv_bufs)
3806
3807# 1661 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3808#if defined(MFC_OpenACC)
3809# 1661 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3810!$acc update device(patch_ib)
3811# 1661 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3812#elif defined(MFC_OpenMP)
3813# 1661 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3814!$omp target update to(patch_ib)
3815# 1661 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3816#endif
3817 call s_update_ib_lookup()
3818 end if
3819#endif
3820
3821 end subroutine s_handoff_ib_ownership
3822
3823 subroutine s_get_neighborhood_idx(gbl_idx, neighborhood_idx)
3824
3825
3826# 1670 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3827#if MFC_OpenACC
3828# 1670 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3829!$acc routine seq
3830# 1670 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3831#elif MFC_OpenMP
3832# 1670 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3833
3834# 1670 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3835
3836# 1670 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3837!$omp declare target device_type(any)
3838# 1670 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3839#endif
3840
3841 integer, intent(in) :: gbl_idx
3842 integer, intent(out) :: neighborhood_idx
3843 integer :: i
3844
3845 neighborhood_idx = ib_gbl_idx_lookup(gbl_idx)
3846
3847 end subroutine s_get_neighborhood_idx
3848
3849 subroutine s_update_ib_lookup()
3850
3851 integer :: i
3852
3853 ib_gbl_idx_lookup = -1
3854
3855# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3856#if defined(MFC_OpenACC)
3857# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3858!$acc update device(ib_gbl_idx_lookup)
3859# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3860#elif defined(MFC_OpenMP)
3861# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3862!$omp target update to(ib_gbl_idx_lookup)
3863# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3864#endif
3865
3866
3867# 1687 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3868
3869# 1687 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3870#if defined(MFC_OpenACC)
3871# 1687 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3872!$acc parallel loop gang vector default(present) private(i)
3873# 1687 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3874#elif defined(MFC_OpenMP)
3875# 1687 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3876
3877# 1687 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3878
3879# 1687 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3880
3881# 1687 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3882!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i)
3883# 1687 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3884#endif
3885 do i = 1, num_ibs
3886 ib_gbl_idx_lookup(patch_ib(i)%gbl_patch_id) = i
3887 end do
3888
3889# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3890#if defined(MFC_OpenACC)
3891# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3892!$acc end parallel loop
3893# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3894#elif defined(MFC_OpenMP)
3895# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3896
3897# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3898!$omp end target teams loop
3899# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3900#endif
3901
3902
3903# 1693 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3904#if defined(MFC_OpenACC)
3905# 1693 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3906!$acc update host(ib_gbl_idx_lookup)
3907# 1693 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3908#elif defined(MFC_OpenMP)
3909# 1693 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3910!$omp target update from(ib_gbl_idx_lookup)
3911# 1693 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3912#endif
3913
3914 end subroutine s_update_ib_lookup
3915
3916 !> Finalize the IBM module
3917 impure subroutine s_finalize_ibm_module()
3918
3919 integer :: i
3920
3921#ifdef MFC_DEBUG
3922# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3923 block
3924# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3925 use iso_fortran_env, only: output_unit
3926# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3927
3928# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3929 print *, 'm_ibm.fpp:1702: ', '@:DEALLOCATE(ib_markers%sf)'
3930# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3931
3932# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3933 call flush (output_unit)
3934# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3935 end block
3936# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3937#endif
3938# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3939
3940# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3941#if defined(MFC_OpenACC)
3942# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3943!$acc exit data delete(ib_markers%sf)
3944# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3945#elif defined(MFC_OpenMP)
3946# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3947!$omp target exit data map(release:ib_markers%sf)
3948# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3949#endif
3950# 1702 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3951 deallocate (ib_markers%sf)
3952#ifdef MFC_DEBUG
3953# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3954 block
3955# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3956 use iso_fortran_env, only: output_unit
3957# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3958
3959# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3960 print *, 'm_ibm.fpp:1703: ', '@:DEALLOCATE(ib_gbl_idx_lookup)'
3961# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3962
3963# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3964 call flush (output_unit)
3965# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3966 end block
3967# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3968#endif
3969# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3970
3971# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3972#if defined(MFC_OpenACC)
3973# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3974!$acc exit data delete(ib_gbl_idx_lookup)
3975# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3976#elif defined(MFC_OpenMP)
3977# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3978!$omp target exit data map(release:ib_gbl_idx_lookup)
3979# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3980#endif
3981# 1703 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3982 deallocate (ib_gbl_idx_lookup)
3983 do i = 1, num_ib_airfoils_max
3984 if (allocated(ib_airfoil_grids(i)%upper)) then
3985#ifdef MFC_DEBUG
3986# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3987 block
3988# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3989 use iso_fortran_env, only: output_unit
3990# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3991
3992# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3993 print *, 'm_ibm.fpp:1706: ', '@:DEALLOCATE(ib_airfoil_grids(i)%upper)'
3994# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3995
3996# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3997 call flush (output_unit)
3998# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3999 end block
4000# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4001#endif
4002# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4003
4004# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4005#if defined(MFC_OpenACC)
4006# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4007!$acc exit data delete(ib_airfoil_grids(i)%upper)
4008# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4009#elif defined(MFC_OpenMP)
4010# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4011!$omp target exit data map(release:ib_airfoil_grids(i)%upper)
4012# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4013#endif
4014# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4015 deallocate (ib_airfoil_grids(i)%upper)
4016#ifdef MFC_DEBUG
4017# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4018 block
4019# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4020 use iso_fortran_env, only: output_unit
4021# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4022
4023# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4024 print *, 'm_ibm.fpp:1707: ', '@:DEALLOCATE(ib_airfoil_grids(i)%lower)'
4025# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4026
4027# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4028 call flush (output_unit)
4029# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4030 end block
4031# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4032#endif
4033# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4034
4035# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4036#if defined(MFC_OpenACC)
4037# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4038!$acc exit data delete(ib_airfoil_grids(i)%lower)
4039# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4040#elif defined(MFC_OpenMP)
4041# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4042!$omp target exit data map(release:ib_airfoil_grids(i)%lower)
4043# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4044#endif
4045# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4046 deallocate (ib_airfoil_grids(i)%lower)
4047 end if
4048 end do
4049 if (allocated(models)) then
4050#ifdef MFC_DEBUG
4051# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4052 block
4053# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4054 use iso_fortran_env, only: output_unit
4055# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4056
4057# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4058 print *, 'm_ibm.fpp:1711: ', '@:DEALLOCATE(models)'
4059# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4060
4061# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4062 call flush (output_unit)
4063# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4064 end block
4065# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4066#endif
4067# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4068
4069# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4070#if defined(MFC_OpenACC)
4071# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4072!$acc exit data delete(models)
4073# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4074#elif defined(MFC_OpenMP)
4075# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4076!$omp target exit data map(release:models)
4077# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4078#endif
4079# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4080 deallocate (models)
4081 end if
4082 if (allocated(ghost_points)) then
4083#ifdef MFC_DEBUG
4084# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4085 block
4086# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4087 use iso_fortran_env, only: output_unit
4088# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4089
4090# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4091 print *, 'm_ibm.fpp:1714: ', '@:DEALLOCATE(ghost_points)'
4092# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4093
4094# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4095 call flush (output_unit)
4096# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4097 end block
4098# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4099#endif
4100# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4101
4102# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4103#if defined(MFC_OpenACC)
4104# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4105!$acc exit data delete(ghost_points)
4106# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4107#elif defined(MFC_OpenMP)
4108# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4109!$omp target exit data map(release:ghost_points)
4110# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4111#endif
4112# 1714 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4113 deallocate (ghost_points)
4114 end if
4115 if (collision_model > 0) call s_finalize_collisions_module()
4116#ifdef MFC_MPI
4117 if (num_procs > 1) then
4118#ifdef MFC_DEBUG
4119# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4120 block
4121# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4122 use iso_fortran_env, only: output_unit
4123# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4124
4125# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4126 print *, 'm_ibm.fpp:1719: ', '@:DEALLOCATE(send_ids, send_ft)'
4127# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4128
4129# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4130 call flush (output_unit)
4131# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4132 end block
4133# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4134#endif
4135# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4136
4137# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4138#if defined(MFC_OpenACC)
4139# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4140!$acc exit data delete(send_ids, send_ft)
4141# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4142#elif defined(MFC_OpenMP)
4143# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4144!$omp target exit data map(release:send_ids, send_ft)
4145# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4146#endif
4147# 1719 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4148 deallocate (send_ids, send_ft)
4149#ifdef MFC_DEBUG
4150# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4151 block
4152# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4153 use iso_fortran_env, only: output_unit
4154# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4155
4156# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4157 print *, 'm_ibm.fpp:1720: ', '@:DEALLOCATE(recv_forces_snap, recv_torques_snap, recv_ids, recv_ft)'
4158# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4159
4160# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4161 call flush (output_unit)
4162# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4163 end block
4164# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4165#endif
4166# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4167
4168# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4169#if defined(MFC_OpenACC)
4170# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4171!$acc exit data delete(recv_forces_snap, recv_torques_snap, recv_ids, recv_ft)
4172# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4173#elif defined(MFC_OpenMP)
4174# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4175!$omp target exit data map(release:recv_forces_snap, recv_torques_snap, recv_ids, recv_ft)
4176# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4177#endif
4178# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
4179 deallocate (recv_forces_snap, recv_torques_snap, recv_ids, recv_ft)
4180 end if
4181#endif
4182
4183 end subroutine s_finalize_ibm_module
4184
4185end module m_ibm
q_cons_vf
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
Definition m_phase_change.fpp.f90:1006
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1008
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1008
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1008
m_collisions
Ghost-node immersed boundary method: locates ghost/image points, computes interpolation coefficients,...
Definition m_collisions.fpp.f90:336
m_compute_levelset
Computes signed-distance level-set fields and surface normals for immersed-boundary patch geometries.
Definition m_compute_levelset.fpp.f90:335
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:335
m_eos
Equations of state in Gamma/Pi form, rho e = Gamma(rho) p + Pi(rho).
Definition m_eos.fpp.f90:381
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:346
m_global_parameters::buff_size
integer buff_size
Number of ghost cells for boundary condition storage.
Definition m_global_parameters.fpp.f90:805
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:335
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:346
m_ib_patches
Allocate memory and read initial condition data for IC extrusion.
Definition m_ib_patches.fpp.f90:405
m_ibm
Ghost-node immersed boundary method: locates ghost/image points, computes interpolation coefficients,...
Definition m_ibm.fpp.f90:336
m_ibm::s_update_mib
impure subroutine s_update_mib(num_ibs)
Resets the current indexes of immersed boundaries and replaces them after updating the position of ea...
Definition m_ibm.fpp.f90:2119
m_ibm::send_ft
real(wp), dimension(:,:), allocatable send_ft
Definition m_ibm.fpp.f90:416
m_ibm::s_interpolate_image_point
subroutine, private s_interpolate_image_point(q_prim_vf, gp, alpha_rho_ip, alpha_ip, pres_ip, vel_ip, c_ip, r_ip, v_ip, pb_ip, mv_ip, nmom_ip, pb_in, mv_in, presb_ip, massv_ip, ys_ip)
Interpolate primitive variables to a ghost point's image point using bilinear or trilinear interpolat...
Definition m_ibm.fpp.f90:1910
m_ibm::s_compute_ib_forces
subroutine s_compute_ib_forces(q_prim_vf, fluid_pp)
Compute pressure and viscous forces and torques on immersed bodies via volume integration.
Definition m_ibm.fpp.f90:2351
m_ibm::s_ibm_setup
impure subroutine, public s_ibm_setup()
Initializes the values of various IBM variables, such as ghost points and image points.
Definition m_ibm.fpp.f90:568
m_ibm::s_update_ib_lookup
subroutine s_update_ib_lookup()
Definition m_ibm.fpp.f90:3850
m_ibm::s_communicate_ib_forces
subroutine s_communicate_ib_forces(forces, torques)
Swaps ownership of IBs and passes ownership of IBs to neighbor processors Reduces forces and torques ...
Definition m_ibm.fpp.f90:2825
m_ibm::s_compute_interpolation_coeffs
subroutine, private s_compute_interpolation_coeffs(ghost_points_in)
Compute the interpolation coefficients for image points.
Definition m_ibm.fpp.f90:1772
m_ibm::s_handoff_ib_ownership
subroutine s_handoff_ib_ownership()
Definition m_ibm.fpp.f90:3640
m_ibm::s_finalize_ibm_module
impure subroutine, public s_finalize_ibm_module()
Finalize the IBM module.
Definition m_ibm.fpp.f90:3918
m_ibm::ghost_points
type(ghost_point), dimension(:), allocatable ghost_points
Definition m_ibm.fpp.f90:373
m_ibm::num_gps
integer num_gps
Number of ghost points.
Definition m_ibm.fpp.f90:386
m_ibm::recv_forces_snap
real(wp), dimension(:,:), allocatable recv_forces_snap
Definition m_ibm.fpp.f90:417
m_ibm::s_compute_moment_of_inertia
subroutine s_compute_moment_of_inertia(patch, axis, moment)
Computes the moment of inertia for an immersed boundary.
Definition m_ibm.fpp.f90:2640
m_ibm::moving_immersed_boundary_flag
logical moving_immersed_boundary_flag
Definition m_ibm.fpp.f90:412
m_ibm::s_compute_ghost_point_velocity
subroutine, private s_compute_ghost_point_velocity(gp, gp_patch_id, radial_vector, vel_ip, pres_ip, vel_gp)
Definition m_ibm.fpp.f90:915
m_ibm::s_find_ghost_points
subroutine, private s_find_ghost_points(ghost_points_in)
Locate all ghost points in the domain.
Definition m_ibm.fpp.f90:1636
m_ibm::s_get_neighborhood_idx
subroutine s_get_neighborhood_idx(gbl_idx, neighborhood_idx)
Definition m_ibm.fpp.f90:3824
m_ibm::f_log_cosh
pure real(wp) function f_log_cosh(x)
log(cosh(x)) without overflow for large |x|
Definition m_ibm.fpp.f90:2241
m_ibm::recv_ft
real(wp), dimension(:,:), allocatable recv_ft
Definition m_ibm.fpp.f90:416
m_ibm::s_compute_centroid_offset
subroutine s_compute_centroid_offset(ib_marker)
Computes the center of mass for IB patch types where we are unable to determine their center of mass ...
Definition m_ibm.fpp.f90:2580
m_ibm::s_prescribed_kinematics
subroutine s_prescribed_kinematics(i, t)
Prescribed kinematics for patch i at time t: hinged flapping (kin_model = 1) or the Eldredge pitch ra...
Definition m_ibm.fpp.f90:2268
m_ibm::ib_markers
type(integer_field), public ib_markers
Definition m_ibm.fpp.f90:360
m_ibm::recv_ids
integer, dimension(:), allocatable recv_ids
Definition m_ibm.fpp.f90:415
m_ibm::s_initialize_ibm_module
impure subroutine, public s_initialize_ibm_module()
Allocates memory for the variables in the IBM module.
Definition m_ibm.fpp.f90:423
m_ibm::s_wrap_periodic_ibs
subroutine s_wrap_periodic_ibs()
Wrap immersed boundary positions across periodic domain boundaries.
Definition m_ibm.fpp.f90:2728
m_ibm::s_ibm_correct_state
subroutine, public s_ibm_correct_state(q_cons_vf, q_prim_vf, pb_in, mv_in)
Update the conservative variables at the ghost points.
Definition m_ibm.fpp.f90:990
m_ibm::send_ids
integer, dimension(:), allocatable send_ids
Definition m_ibm.fpp.f90:415
m_ibm::s_compute_image_points
impure subroutine, private s_compute_image_points(ghost_points_in)
Compute the image points for each ghost point.
Definition m_ibm.fpp.f90:1404
m_ibm::s_find_num_ghost_points
subroutine, private s_find_num_ghost_points(num_gps_out)
Count the number of ghost points for memory allocation.
Definition m_ibm.fpp.f90:1549
m_ibm::s_compute_ghost_point_pressure
subroutine, private s_compute_ghost_point_pressure(gp, gp_patch_id, alpha_rho_ip, pres_ip, pres_gp)
Definition m_ibm.fpp.f90:868
m_ibm::recv_torques_snap
real(wp), dimension(:,:), allocatable recv_torques_snap
Definition m_ibm.fpp.f90:417
m_model
Binary STL file reader and processor for immersed boundary geometry.
Definition m_model.fpp.f90:336
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:346
m_patch_geometries
Contains helper functions specific to various patch gemoetries for determining if a grid cell lies in...
Definition m_patch_geometries.fpp.f90:336
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:346
m_viscous
Computes viscous stress tensors and diffusive flux contributions for the Navier–Stokes equations.
Definition m_viscous.fpp.f90:347
m_derived_types::ghost_point
Ghost Point for Immersed Boundaries.
Definition m_derived_types.fpp.f90:845
m_derived_types::integer_field
Derived type annexing an integer scalar field (SF).
Definition m_derived_types.fpp.f90:359