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