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