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. NVIDIA unified memory page placement hint
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, x_domain, y_domain, 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, x_domain, y_domain, 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, z_domain, 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, z_domain, 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))
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))
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)*(x_domain%end - x_domain%beg))
1019 radial_vector(2) = physical_loc(2) - (patch_ib(patch_id)%y_centroid + real(ghost_points(i)%y_periodicity, &
1020 & wp)*(y_domain%end - y_domain%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)*(z_domain%end - z_domain%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: ", [x_cc(-buff_size), y_cc(-buff_size), z_cc(-buff_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, x_domain, y_domain, z_domain)
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) &
1495# 568 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1496!$omp& map(to:count, count_i, x_domain, y_domain, z_domain)
1497# 568 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1498#endif
1499# 571 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1500 do i = 0, m
1501 do j = 0, n
1502 do k = 0, p
1503 if (ib_markers%sf(i, j, k) /= 0) then
1504 is_gp = .false.
1505 marker_search: do ii = i - gp_layers, i + gp_layers
1506 do jj = j - gp_layers, j + gp_layers
1507 do kk = k - gp_layers_z, k + gp_layers_z
1508 if (ib_markers%sf(ii, jj, kk) == 0) then
1509 ! if any neighbors are not in the IB, it is a ghost point
1510 is_gp = .true.
1511 exit marker_search
1512 end if
1513 end do
1514 end do
1515 end do marker_search
1516
1517 if (is_gp) then
1518
1519# 589 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1520#if defined(MFC_OpenACC)
1521# 589 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1522!$acc atomic capture
1523# 589 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1524#elif defined(MFC_OpenMP)
1525# 589 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1526!$omp atomic capture
1527# 589 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1528#endif
1529 count = count + 1
1530 local_idx = count
1531#if defined(MFC_OpenACC)
1532# 592 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1533!$acc end atomic
1534# 592 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1535#elif defined(MFC_OpenMP)
1536# 592 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1537!$omp end atomic
1538# 592 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1539#endif
1540
1541 ghost_points_in(local_idx)%loc = [i, j, k]
1542 encoded_patch_id = ib_markers%sf(i, j, k)
1543 call s_decode_patch_periodicity(encoded_patch_id, patch_id, xp, yp, zp)
1544 call s_get_neighborhood_idx(patch_id, neighborhood_patch_id)
1545 ghost_points_in(local_idx)%ib_patch_id = neighborhood_patch_id
1546 ghost_points_in(local_idx)%x_periodicity = xp
1547 ghost_points_in(local_idx)%y_periodicity = yp
1548 ghost_points_in(local_idx)%z_periodicity = zp
1549 ghost_points_in(local_idx)%slip = patch_ib(neighborhood_patch_id)%slip
1550
1551 if ((x_cc(i) - dx(i)) < x_domain%beg) then
1552 ghost_points_in(local_idx)%DB(1) = -1
1553 else if ((x_cc(i) + dx(i)) > x_domain%end) then
1554 ghost_points_in(local_idx)%DB(1) = 1
1555 else
1556 ghost_points_in(local_idx)%DB(1) = 0
1557 end if
1558
1559 if ((y_cc(j) - dy(j)) < y_domain%beg) then
1560 ghost_points_in(local_idx)%DB(2) = -1
1561 else if ((y_cc(j) + dy(j)) > y_domain%end) then
1562 ghost_points_in(local_idx)%DB(2) = 1
1563 else
1564 ghost_points_in(local_idx)%DB(2) = 0
1565 end if
1566
1567 if (p /= 0) then
1568 if ((z_cc(k) - dz(k)) < z_domain%beg) then
1569 ghost_points_in(local_idx)%DB(3) = -1
1570 else if ((z_cc(k) + dz(k)) > z_domain%end) then
1571 ghost_points_in(local_idx)%DB(3) = 1
1572 else
1573 ghost_points_in(local_idx)%DB(3) = 0
1574 end if
1575 end if
1576 end if
1577 end if
1578 end do
1579 end do
1580 end do
1581
1582# 634 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1583#if defined(MFC_OpenACC)
1584# 634 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1585!$acc end parallel loop
1586# 634 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1587#elif defined(MFC_OpenMP)
1588# 634 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1589
1590# 634 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1591!$omp end target teams loop
1592# 634 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1593#endif
1594
1595 end subroutine s_find_ghost_points
1596
1597 !> Compute the interpolation coefficients for image points
1598 subroutine s_compute_interpolation_coeffs(ghost_points_in)
1599
1600 type(ghost_point), dimension(num_gps), intent(inout) :: ghost_points_in
1601 real(wp), dimension(2, 2, 2) :: dist
1602 real(wp), dimension(2, 2, 2) :: alpha
1603 real(wp), dimension(2, 2, 2) :: interp_coeffs
1604 real(wp) :: buf
1605 real(wp), dimension(2, 2, 2) :: eta
1606 type(ghost_point) :: gp
1607 integer :: q, i, j, k, ii, jj, kk !< Grid indexes and iterators
1608 integer :: patch_id
1609 logical :: is_cell_center
1610
1611
1612# 652 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1613
1614# 652 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1615#if defined(MFC_OpenACC)
1616# 652 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1617!$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)
1618# 652 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1619#elif defined(MFC_OpenMP)
1620# 652 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1621
1622# 652 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1623
1624# 652 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1625
1626# 652 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1627!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1628# 652 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1629!$omp& private(q, i, j, k, ii, jj, kk, dist, buf, gp, interp_coeffs, eta, alpha, patch_id, is_cell_center)
1630# 652 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1631#endif
1632 do q = 1, num_gps
1633 gp = ghost_points_in(q)
1634 ! Get the interpolation points
1635 i = gp%ip_grid(1)
1636 j = gp%ip_grid(2)
1637 if (p /= 0) then
1638 k = gp%ip_grid(3)
1639 else
1640 k = 0
1641 end if
1642
1643 ! get the distance to a cell in each direction
1644 dist = 0._wp
1645 buf = 1._wp
1646 do ii = 0, 1
1647 do jj = 0, 1
1648 if (p == 0) then
1649 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)
1650 else
1651 do kk = 0, 1
1652 dist(1 + ii, 1 + jj, &
1653 & 1 + kk) = sqrt((x_cc(i + ii) - gp%ip_loc(1))**2 + (y_cc(j + jj) - gp%ip_loc(2))**2 + (z_cc(k &
1654 & + kk) - gp%ip_loc(3))**2)
1655 end do
1656 end if
1657 end do
1658 end do
1659
1660 ! check if we are arbitrarily close to a cell center
1661 interp_coeffs = 0._wp
1662 is_cell_center = .false.
1663 check_is_cell_center: do ii = 0, 1
1664 do jj = 0, 1
1665 if (dist(ii + 1, jj + 1, 1) <= 1.e-16_wp) then
1666 interp_coeffs(ii + 1, jj + 1, 1) = 1._wp
1667 is_cell_center = .true.
1668 exit check_is_cell_center
1669 else
1670 if (p /= 0) then
1671 if (dist(ii + 1, jj + 1, 2) <= 1.e-16_wp) then
1672 interp_coeffs(ii + 1, jj + 1, 2) = 1._wp
1673 is_cell_center = .true.
1674 exit check_is_cell_center
1675 end if
1676 end if
1677 end if
1678 end do
1679 end do check_is_cell_center
1680
1681 if (.not. is_cell_center) then
1682 ! if we are not arbitrarily close, interpolate
1683 alpha = 1._wp
1684 patch_id = gp%ib_patch_id
1685 if (ib_markers%sf(i, j, k) /= 0) alpha(1, 1, 1) = 0._wp
1686 if (ib_markers%sf(i + 1, j, k) /= 0) alpha(2, 1, 1) = 0._wp
1687 if (ib_markers%sf(i, j + 1, k) /= 0) alpha(1, 2, 1) = 0._wp
1688 if (ib_markers%sf(i + 1, j + 1, k) /= 0) alpha(2, 2, 1) = 0._wp
1689
1690 if (p == 0) then
1691 eta(:,:,1) = 1._wp/dist(:,:,1)**2
1692 buf = sum(alpha(:,:,1)*eta(:,:,1))
1693 if (buf > 0._wp) then
1694 interp_coeffs(:,:,1) = alpha(:,:,1)*eta(:,:,1)/buf
1695 else
1696 buf = sum(eta(:,:,1))
1697 interp_coeffs(:,:,1) = eta(:,:,1)/buf
1698 end if
1699 else
1700 if (ib_markers%sf(i, j, k + 1) /= 0) alpha(1, 1, 2) = 0._wp
1701 if (ib_markers%sf(i + 1, j, k + 1) /= 0) alpha(2, 1, 2) = 0._wp
1702 if (ib_markers%sf(i, j + 1, k + 1) /= 0) alpha(1, 2, 2) = 0._wp
1703 if (ib_markers%sf(i + 1, j + 1, k + 1) /= 0) alpha(2, 2, 2) = 0._wp
1704 eta = 1._wp/dist**2
1705 buf = sum(alpha*eta)
1706
1707 if (buf > 0._wp) then
1708 interp_coeffs = alpha*eta/buf
1709 else
1710 buf = sum(eta)
1711 interp_coeffs = eta/buf
1712 end if
1713 end if
1714 end if
1715
1716 ghost_points_in(q)%interp_coeffs = interp_coeffs
1717 end do
1718
1719# 739 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1720#if defined(MFC_OpenACC)
1721# 739 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1722!$acc end parallel loop
1723# 739 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1724#elif defined(MFC_OpenMP)
1725# 739 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1726
1727# 739 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1728!$omp end target teams loop
1729# 739 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1730#endif
1731
1732 end subroutine s_compute_interpolation_coeffs
1733
1734 !> Interpolate primitive variables to a ghost point's image point using bilinear or trilinear interpolation
1735 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, &
1736 & nmom_IP, pb_in, mv_in, presb_IP, massv_IP)
1737
1738
1739# 747 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1740#if MFC_OpenACC
1741# 747 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1742!$acc routine seq
1743# 747 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1744#elif MFC_OpenMP
1745# 747 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1746
1747# 747 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1748
1749# 747 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1750!$omp declare target device_type(any)
1751# 747 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1752#endif
1753
1754 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf !< Primitive Variables
1755 real(stp), optional, dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(in) :: pb_in, mv_in
1756 type(ghost_point), intent(in) :: gp
1757 real(wp), intent(inout) :: pres_ip
1758 real(wp), dimension(3), intent(inout) :: vel_ip
1759 real(wp), intent(inout) :: c_ip
1760# 758 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1761 real(wp), dimension(num_fluids), intent(inout) :: alpha_ip, alpha_rho_ip
1762# 760 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1763 real(wp), optional, dimension(:), intent(inout) :: r_ip, v_ip, pb_ip, mv_ip
1764 real(wp), optional, dimension(:), intent(inout) :: nmom_ip
1765 real(wp), optional, dimension(:), intent(inout) :: presb_ip, massv_ip
1766 integer :: i, j, k, l, q !< Iterator variables
1767 integer :: i1, i2, j1, j2, k1, k2 !< Iterator variables
1768 real(wp) :: coeff
1769
1770 i1 = gp%ip_grid(1); i2 = i1 + 1
1771 j1 = gp%ip_grid(2); j2 = j1 + 1
1772 k1 = gp%ip_grid(3); k2 = k1 + 1
1773
1774 if (p == 0) then
1775 k1 = 0
1776 k2 = 0
1777 end if
1778
1779 alpha_rho_ip = 0._wp
1780 alpha_ip = 0._wp
1781 pres_ip = 0._wp
1782 vel_ip = 0._wp
1783
1784 if (surface_tension) c_ip = 0._wp
1785
1786 if (bubbles_euler) then
1787 r_ip = 0._wp
1788 v_ip = 0._wp
1789 if (.not. polytropic) then
1790 mv_ip = 0._wp
1791 pb_ip = 0._wp
1792 end if
1793 end if
1794
1795 if (qbmm) then
1796 nmom_ip = 0._wp
1797 if (.not. polytropic) then
1798 presb_ip = 0._wp
1799 massv_ip = 0._wp
1800 end if
1801 end if
1802
1803
1804# 800 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1805#if defined(MFC_OpenACC)
1806# 800 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1807!$acc loop seq
1808# 800 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1809#elif defined(MFC_OpenMP)
1810# 800 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1811
1812# 800 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1813#endif
1814 do i = i1, i2
1815
1816# 802 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1817#if defined(MFC_OpenACC)
1818# 802 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1819!$acc loop seq
1820# 802 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1821#elif defined(MFC_OpenMP)
1822# 802 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1823
1824# 802 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1825#endif
1826 do j = j1, j2
1827
1828# 804 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1829#if defined(MFC_OpenACC)
1830# 804 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1831!$acc loop seq
1832# 804 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1833#elif defined(MFC_OpenMP)
1834# 804 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1835
1836# 804 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1837#endif
1838 do k = k1, k2
1839 coeff = gp%interp_coeffs(i - i1 + 1, j - j1 + 1, k - k1 + 1)
1840
1841 pres_ip = pres_ip + coeff*q_prim_vf(eqn_idx%E)%sf(i, j, k)
1842
1843
1844# 810 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1845#if defined(MFC_OpenACC)
1846# 810 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1847!$acc loop seq
1848# 810 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1849#elif defined(MFC_OpenMP)
1850# 810 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1851
1852# 810 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1853#endif
1854 do q = eqn_idx%mom%beg, eqn_idx%mom%end
1855 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)
1856 end do
1857
1858
1859# 815 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1860#if defined(MFC_OpenACC)
1861# 815 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1862!$acc loop seq
1863# 815 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1864#elif defined(MFC_OpenMP)
1865# 815 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1866
1867# 815 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1868#endif
1869 do l = eqn_idx%cont%beg, eqn_idx%cont%end
1870 alpha_rho_ip(l) = alpha_rho_ip(l) + coeff*q_prim_vf(l)%sf(i, j, k)
1871 alpha_ip(l) = alpha_ip(l) + coeff*q_prim_vf(eqn_idx%adv%beg + l - 1)%sf(i, j, k)
1872 end do
1873
1874 if (surface_tension) then
1875 c_ip = c_ip + coeff*q_prim_vf(eqn_idx%c)%sf(i, j, k)
1876 end if
1877
1878 if (bubbles_euler .and. .not. qbmm) then
1879
1880# 826 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1881#if defined(MFC_OpenACC)
1882# 826 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1883!$acc loop seq
1884# 826 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1885#elif defined(MFC_OpenMP)
1886# 826 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1887
1888# 826 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1889#endif
1890 do l = 1, nb
1891 if (polytropic) then
1892 r_ip(l) = r_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg + (l - 1)*2)%sf(i, j, k)
1893 v_ip(l) = v_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg + 1 + (l - 1)*2)%sf(i, j, k)
1894 else
1895 r_ip(l) = r_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg + (l - 1)*4)%sf(i, j, k)
1896 v_ip(l) = v_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg + 1 + (l - 1)*4)%sf(i, j, k)
1897 pb_ip(l) = pb_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg + 2 + (l - 1)*4)%sf(i, j, k)
1898 mv_ip(l) = mv_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg + 3 + (l - 1)*4)%sf(i, j, k)
1899 end if
1900 end do
1901 end if
1902
1903 if (qbmm) then
1904 do l = 1, nb*nmom
1905 nmom_ip(l) = nmom_ip(l) + coeff*q_prim_vf(eqn_idx%bub%beg - 1 + l)%sf(i, j, k)
1906 end do
1907 if (.not. polytropic) then
1908 do q = 1, nb
1909 do l = 1, nnode
1910 presb_ip((q - 1)*nnode + l) = presb_ip((q - 1)*nnode + l) + coeff*real(pb_in(i, j, k, l, q), &
1911 & kind=wp)
1912 massv_ip((q - 1)*nnode + l) = massv_ip((q - 1)*nnode + l) + coeff*real(mv_in(i, j, k, l, q), &
1913 & kind=wp)
1914 end do
1915 end do
1916 end if
1917 end if
1918 end do
1919 end do
1920 end do
1921
1922 end subroutine s_interpolate_image_point
1923
1924 !> Resets the current indexes of immersed boundaries and replaces them after updating
1925 !> the position of each moving immersed boundary
1926 impure subroutine s_update_mib(num_ibs)
1927
1928 integer, intent(in) :: num_ibs
1929 integer :: i, j, k, z_gp_layers
1930
1931 call nvtxstartrange("UPDATE-MIBM")
1932
1933 ! Clears the existing immersed boundary indices
1934 z_gp_layers = 0; if (p /= 0) z_gp_layers = gp_layers + 1
1935
1936# 872 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1937
1938# 872 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1939#if defined(MFC_OpenACC)
1940# 872 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1941!$acc parallel loop gang vector default(present) private(i, j, k)
1942# 872 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1943#elif defined(MFC_OpenMP)
1944# 872 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1945
1946# 872 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1947
1948# 872 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1949
1950# 872 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1951!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k)
1952# 872 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1953#endif
1954 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
1955 ib_markers%sf(i, j, k) = 0._wp
1956 end do; end do; end do
1957
1958# 876 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1959#if defined(MFC_OpenACC)
1960# 876 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1961!$acc end parallel loop
1962# 876 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1963#elif defined(MFC_OpenMP)
1964# 876 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1965
1966# 876 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1967!$omp end target teams loop
1968# 876 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1969#endif
1970
1971 ! recalulcate the rotation matrix based upon the new angles
1972
1973# 879 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1974
1975# 879 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1976#if defined(MFC_OpenACC)
1977# 879 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1978!$acc parallel loop gang vector default(present) private(i)
1979# 879 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1980#elif defined(MFC_OpenMP)
1981# 879 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1982
1983# 879 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1984
1985# 879 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1986
1987# 879 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1988!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i)
1989# 879 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1990#endif
1991 do i = 1, num_ibs
1992 if (patch_ib(i)%moving_ibm /= 0) then
1993 call s_update_ib_rotation_matrix(i)
1994 end if
1995 end do
1996
1997# 885 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
1998#if defined(MFC_OpenACC)
1999# 885 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2000!$acc end parallel loop
2001# 885 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2002#elif defined(MFC_OpenMP)
2003# 885 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2004
2005# 885 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2006!$omp end target teams loop
2007# 885 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2008#endif
2009
2010 ! recompute the new ib_patch locations and broadcast them.
2011 call nvtxstartrange("APPLY-IB-PATCHES")
2012 call s_apply_ib_patches(ib_markers)
2013 call nvtxendrange
2014
2015 call nvtxstartrange("COMPUTE-GHOST-POINTS")
2016 ! recalculate the ghost point locations and coefficients
2017 call s_find_num_ghost_points(num_gps)
2018 call s_find_ghost_points(ghost_points)
2019 call nvtxendrange
2020
2021 call nvtxstartrange("COMPUTE-IMAGE-POINTS")
2022 call s_apply_levelset(ghost_points, num_gps)
2023 call s_compute_image_points(ghost_points)
2024 call s_compute_interpolation_coeffs(ghost_points)
2025 call nvtxendrange
2026
2027 call nvtxendrange
2028
2029 end subroutine s_update_mib
2030
2031 !> Compute pressure and viscous forces and torques on immersed bodies via volume integration
2032 subroutine s_compute_ib_forces(q_prim_vf, fluid_pp)
2033
2034 type(scalar_field), dimension(1:sys_size), intent(in) :: q_prim_vf
2035 type(physical_parameters), dimension(1:num_fluids), intent(in) :: fluid_pp
2036 integer :: i, j, k, l, encoded_ib_idx, xp, yp, zp, ib_idx, ib_idx_temp, fluid_idx
2037 real(wp), dimension(num_ibs, 3) :: forces, torques
2038 ! viscous stress tensor with temp vectors to hold divergence calculations
2039 real(wp), dimension(1:3,1:3) :: viscous_stress
2040 real(wp), dimension(1:3) :: local_force_contribution, radial_vector, local_torque_contribution
2041 real(wp) :: cell_volume, dynamic_viscosity
2042
2043# 923 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2044 real(wp), dimension(num_fluids) :: dynamic_viscosities
2045# 925 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2046
2047 call nvtxstartrange("COMPUTE-IB-FORCES")
2048
2049 forces = 0._wp
2050 torques = 0._wp
2051
2052 if (viscous) then
2053 do fluid_idx = 1, num_fluids
2054 if (fluid_pp(fluid_idx)%Re(1) > 0._wp) then
2055 dynamic_viscosities(fluid_idx) = 1._wp/fluid_pp(fluid_idx)%Re(1)
2056 else
2057 dynamic_viscosities(fluid_idx) = 0._wp
2058 end if
2059 end do
2060 end if
2061
2062
2063# 941 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2064
2065# 941 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2066#if defined(MFC_OpenACC)
2067# 941 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2068!$acc parallel loop collapse(3) gang vector default(present) &
2069# 941 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2070!$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) &
2071# 941 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2072!$acc& copy(forces, torques) copyin(dynamic_viscosities)
2073# 941 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2074#elif defined(MFC_OpenMP)
2075# 941 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2076
2077# 941 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2078
2079# 941 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2080
2081# 941 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2082!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
2083# 941 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2084!$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) &
2085# 941 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2086!$omp& map(tofrom:forces, torques) map(to:dynamic_viscosities)
2087# 941 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2088#endif
2089# 944 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2090 do i = 0, m
2091 do j = 0, n
2092 do k = 0, p
2093 encoded_ib_idx = ib_markers%sf(i, j, k)
2094 if (encoded_ib_idx /= 0) then
2095 call s_decode_patch_periodicity(encoded_ib_idx, ib_idx_temp, xp, yp, zp)
2096 call s_get_neighborhood_idx(ib_idx_temp, ib_idx) ! global patch ID -> local index
2097 if (ib_idx > 0) then
2098 ! get the vector pointing to the grid cell from the IB centroid
2099 radial_vector(1) = x_cc(i) - (patch_ib(ib_idx)%x_centroid + real(xp, wp)*(x_domain%end - x_domain%beg))
2100 radial_vector(2) = y_cc(j) - (patch_ib(ib_idx)%y_centroid + real(yp, wp)*(y_domain%end - y_domain%beg))
2101 radial_vector(3) = 0._wp
2102 if (num_dims == 3) radial_vector(3) = z_cc(k) - (patch_ib(ib_idx)%z_centroid + real(zp, &
2103 & wp)*(z_domain%end - z_domain%beg))
2104
2105 local_force_contribution(:) = 0._wp
2106
2107 ! compute the pressure force component, which is the negative pressure gradient
2108 do l = -fd_number, fd_number
2109 local_force_contribution(1) = local_force_contribution(1) - (fd_coeff_x(l, &
2110 & i)*q_prim_vf(eqn_idx%E)%sf(i + l, j, k))
2111 local_force_contribution(2) = local_force_contribution(2) - (fd_coeff_y(l, &
2112 & j)*q_prim_vf(eqn_idx%E)%sf(i, j + l, k))
2113 if (num_dims == 3) then
2114 local_force_contribution(3) = local_force_contribution(3) - (fd_coeff_z(l, &
2115 & k)*q_prim_vf(eqn_idx%E)%sf(i, j, k + l))
2116 end if
2117 end do
2118
2119 ! get the viscous stress and add its contribution if that is considered
2120 if (viscous) then
2121 ! compute the volume-weighted local dynamic viscosity
2122 dynamic_viscosity = 0._wp
2123 do fluid_idx = 1, num_fluids
2124 ! local dynamic viscosity is the dynamic viscosity of the fluid times alpha of the fluid
2125 dynamic_viscosity = dynamic_viscosity + (q_prim_vf(fluid_idx + eqn_idx%adv%beg - 1)%sf(i, j, &
2126 & k)*dynamic_viscosities(fluid_idx))
2127 end do
2128
2129 do l = -fd_number, fd_number
2130 call s_compute_viscous_stress_tensor(viscous_stress, q_prim_vf, dynamic_viscosity, i + l, j, k)
2131 local_force_contribution(1:3) = local_force_contribution(1:3) + fd_coeff_x(l, &
2132 & i)*viscous_stress(1,1:3)
2133
2134 call s_compute_viscous_stress_tensor(viscous_stress, q_prim_vf, dynamic_viscosity, i, j + l, k)
2135 local_force_contribution(1:3) = local_force_contribution(1:3) + fd_coeff_y(l, &
2136 & j)*viscous_stress(2,1:3)
2137
2138 if (num_dims == 3) then
2139 call s_compute_viscous_stress_tensor(viscous_stress, q_prim_vf, dynamic_viscosity, i, j, &
2140 & k + l)
2141 local_force_contribution(1:3) = local_force_contribution(1:3) + fd_coeff_z(l, &
2142 & k)*viscous_stress(3,1:3)
2143 end if
2144 end do
2145 end if
2146
2147 call s_cross_product(radial_vector, local_force_contribution, local_torque_contribution)
2148
2149 ! Update the force and torque values atomically to prevent race conditions
2150 cell_volume = dx(i)*dy(j)
2151 if (num_dims == 3) cell_volume = cell_volume*dz(k)
2152 do l = 1, num_dims
2153
2154# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2155#if defined(MFC_OpenACC)
2156# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2157!$acc atomic update
2158# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2159#elif defined(MFC_OpenMP)
2160# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2161!$omp atomic update
2162# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2163#endif
2164 forces(ib_idx, l) = forces(ib_idx, l) + (local_force_contribution(l)*cell_volume)
2165
2166# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2167#if defined(MFC_OpenACC)
2168# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2169!$acc atomic update
2170# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2171#elif defined(MFC_OpenMP)
2172# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2173!$omp atomic update
2174# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2175#endif
2176 torques(ib_idx, l) = torques(ib_idx, l) + local_torque_contribution(l)*cell_volume
2177 end do
2178 end if ! ib_idx > 0
2179 end if
2180 end do
2181 end do
2182 end do
2183
2184# 1017 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2185#if defined(MFC_OpenACC)
2186# 1017 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2187!$acc end parallel loop
2188# 1017 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2189#elif defined(MFC_OpenMP)
2190# 1017 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2191
2192# 1017 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2193!$omp end target teams loop
2194# 1017 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2195#endif
2196
2197 call s_apply_collision_forces(ghost_points, num_gps, ib_markers, forces, torques)
2198
2199 ! reduce the forces across local neighborhood ranks
2200 call s_communicate_ib_forces(forces, torques)
2201
2202 ! consider body forces after reducing to avoid double counting
2203 do i = 1, num_ibs
2204 if (bf_x) then
2205 forces(i, 1) = forces(i, 1) + accel_bf(1)*patch_ib(i)%mass
2206 end if
2207 if (bf_y) then
2208 forces(i, 2) = forces(i, 2) + accel_bf(2)*patch_ib(i)%mass
2209 end if
2210 if (bf_z) then
2211 forces(i, 3) = forces(i, 3) + accel_bf(3)*patch_ib(i)%mass
2212 end if
2213 end do
2214
2215 ! apply the summed forces
2216
2217# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2218
2219# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2220#if defined(MFC_OpenACC)
2221# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2222!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
2223# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2224#elif defined(MFC_OpenMP)
2225# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2226
2227# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2228
2229# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2230
2231# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2232!$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)
2233# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2234#endif
2235 do i = 1, num_ibs
2236 patch_ib(i)%force(:) = forces(i,:)
2237 patch_ib(i)%torque(:) = torques(i,:)
2238 end do
2239
2240# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2241#if defined(MFC_OpenACC)
2242# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2243!$acc end parallel loop
2244# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2245#elif defined(MFC_OpenMP)
2246# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2247
2248# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2249!$omp end target teams loop
2250# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2251#endif
2252
2253 call nvtxendrange
2254
2255 end subroutine s_compute_ib_forces
2256
2257 !> Computes the center of mass for IB patch types where we are unable to determine their center of mass analytically.
2258 !> These patches include things like NACA airfoils and STL models
2259 subroutine s_compute_centroid_offset(ib_marker)
2260
2261 integer, intent(in) :: ib_marker
2262 integer :: i, j, k, num_cells_local, decoded_gbl_id
2263 integer(kind=8) :: num_cells
2264 real(wp), dimension(1:3) :: center_of_mass, center_of_mass_local
2265
2266 ! Offset only needs to be computes for specific geometries
2267
2268 if (patch_ib(ib_marker)%geometry == 4 .or. patch_ib(ib_marker)%geometry == 5 .or. patch_ib(ib_marker)%geometry == 11 &
2269 & .or. patch_ib(ib_marker)%geometry == 12) then
2270 center_of_mass_local = [0._wp, 0._wp, 0._wp]
2271 num_cells_local = 0
2272
2273 ! get the summed mass distribution and number of cells to divide by
2274 do i = 0, m
2275 do j = 0, n
2276 do k = 0, p
2277 if (ib_markers%sf(i, j, k) /= 0) then
2278 call s_decode_patch_periodicity(ib_markers%sf(i, j, k), decoded_gbl_id)
2279 if (decoded_gbl_id == patch_ib(ib_marker)%gbl_patch_id) then
2280 num_cells_local = num_cells_local + 1
2281 center_of_mass_local = center_of_mass_local + [x_cc(i), y_cc(j), 0._wp]
2282 if (num_dims == 3) center_of_mass_local(3) = center_of_mass_local(3) + z_cc(k)
2283 end if
2284 end if
2285 end do
2286 end do
2287 end do
2288
2289 ! reduce the mass contribution over all MPI ranks and compute COM
2290 call s_mpi_allreduce_integer_sum(int(num_cells_local, 8), num_cells)
2291 if (num_cells /= 0) then
2292 call s_mpi_allreduce_sum(center_of_mass_local(1), center_of_mass(1))
2293 call s_mpi_allreduce_sum(center_of_mass_local(2), center_of_mass(2))
2294 call s_mpi_allreduce_sum(center_of_mass_local(3), center_of_mass(3))
2295 center_of_mass = center_of_mass/real(num_cells, wp)
2296 else
2297 patch_ib(ib_marker)%centroid_offset = [0._wp, 0._wp, 0._wp]
2298 return
2299 end if
2300
2301 ! assign the centroid offset as a vector pointing from the true COM to the "centroid" in the input file and replace the
2302 ! current centroid
2303 patch_ib(ib_marker)%centroid_offset = [patch_ib(ib_marker)%x_centroid, patch_ib(ib_marker)%y_centroid, &
2304 & patch_ib(ib_marker)%z_centroid] - center_of_mass
2305 patch_ib(ib_marker)%x_centroid = center_of_mass(1)
2306 patch_ib(ib_marker)%y_centroid = center_of_mass(2)
2307 patch_ib(ib_marker)%z_centroid = center_of_mass(3)
2308
2309 ! rotate the centroid offset back into the local coords of the IB
2310 patch_ib(ib_marker)%centroid_offset = matmul(patch_ib(ib_marker)%rotation_matrix_inverse, &
2311 & patch_ib(ib_marker)%centroid_offset)
2312 else
2313 patch_ib(ib_marker)%centroid_offset(:) = [0._wp, 0._wp, 0._wp]
2314 end if
2315
2316 end subroutine s_compute_centroid_offset
2317
2318 !> Computes the moment of inertia for an immersed boundary
2319 subroutine s_compute_moment_of_inertia(patch, axis, moment)
2320
2321
2322# 1113 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2323#if MFC_OpenACC
2324# 1113 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2325!$acc routine seq
2326# 1113 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2327#elif MFC_OpenMP
2328# 1113 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2329
2330# 1113 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2331
2332# 1113 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2333!$omp declare target device_type(any)
2334# 1113 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2335#endif
2336
2337 type(ib_patch_parameters), intent(in) :: patch
2338 real(wp), dimension(3), intent(in) :: axis
2339 real(wp), intent(out) :: moment
2340 real(wp) :: distance_to_axis, cell_volume
2341 real(wp), dimension(3) :: position, closest_point_along_axis, vector_to_axis, normal_axis
2342 integer :: i, j, k, count, ib_marker
2343
2344 ! if the IB is in 2D or a 3D sphere, we can compute this exactly
2345 if (patch%geometry == 2) then ! circle
2346 moment = 0.5_wp*patch%mass*(patch%radius)**2
2347 else if (patch%geometry == 3) then ! rectangle
2348 moment = patch%mass*(patch%length_x**2 + patch %length_y**2)/6._wp
2349 else if (patch%geometry == 6) then ! ellipse
2350 moment = 0.0625_wp*patch%mass*(patch%length_x**2 + patch %length_y**2)
2351 else if (patch%geometry == 8) then ! sphere
2352 moment = 0.4*patch%mass*(patch%radius)**2
2353 else ! we do not have an analytic moment of inertia calculation and need to approximate it directly via a sum
2354 count = 0
2355 cell_volume = (x_cc(1) - x_cc(0))*(y_cc(1) - y_cc(0))
2356 ! computed without grid stretching. Update in the loop to perform with stretching
2357 if (p /= 0) then
2358 cell_volume = cell_volume*(z_cc(1) - z_cc(0))
2359 end if
2360
2361 ib_marker = patch%gbl_patch_id
2362
2363 if (p == 0) then
2364 normal_axis = [0, 0, 1]
2365 else if (sqrt(sum(axis**2)) < sgm_eps) then
2366 ! if the object is not actually rotating at this time, return a dummy value and exit
2367 moment = 1._wp
2368 return
2369 else
2370 normal_axis = axis/sqrt(sum(axis**2))
2371 end if
2372
2373 moment = 0._wp
2374
2375 do i = 0, m
2376 do j = 0, n
2377 do k = 0, p
2378 if (ib_markers%sf(i, j, k) == ib_marker) then
2379 count = count + 1 ! increment the count of total cells in the boundary
2380
2381 ! get the position in local coordinates so that the axis passes through 0, 0, 0
2382 if (num_dims < 3) then
2383 position = [x_cc(i), y_cc(j), 0._wp] - [patch%x_centroid, patch%y_centroid, 0._wp]
2384 else
2385 position = [x_cc(i), y_cc(j), z_cc(k)] - [patch%x_centroid, patch%y_centroid, patch%z_centroid]
2386 end if
2387
2388 ! project the position along the axis to find the closest distance to the rotation axis
2389 closest_point_along_axis = normal_axis*dot_product(normal_axis, position)
2390 vector_to_axis = position - closest_point_along_axis
2391 distance_to_axis = dot_product(vector_to_axis, vector_to_axis) ! saves the distance to the axis squared
2392
2393 ! compute the position component of the moment
2394 moment = moment + distance_to_axis
2395 end if
2396 end do
2397 end do
2398 end do
2399
2400 ! write the final moment assuming the points are all uniform density
2401 moment = moment*patch%mass/(count*cell_volume)
2402 end if
2403
2404 end subroutine s_compute_moment_of_inertia
2405
2406 !> Wrap immersed boundary positions across periodic domain boundaries
2407 subroutine s_wrap_periodic_ibs()
2408
2409 integer :: patch_id
2410
2411
2412# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2413
2414# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2415#if defined(MFC_OpenACC)
2416# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2417!$acc parallel loop gang vector default(present) private(patch_id)
2418# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2419#elif defined(MFC_OpenMP)
2420# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2421
2422# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2423
2424# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2425
2426# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2427!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(patch_id)
2428# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2429#endif
2430 do patch_id = 1, num_ibs
2431 ! check domain wraps in x, y,
2432# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2433 if (num_dims >= 1) then
2434 ! check for periodicity
2435 if (ib_bc_x%beg == bc_periodic) then
2436 ! check if the boundary has left the domain, and then correct
2437 if (patch_ib(patch_id)%x_centroid < x_domain%beg) then
2438 ! if the boundary exited "left", wrap it back around to the "right"
2439 patch_ib(patch_id)%x_centroid = patch_ib(patch_id)%x_centroid + (x_domain%end &
2440 & - x_domain%beg)
2441 else if (patch_ib(patch_id)%x_centroid > x_domain%end) then
2442 ! if the boundary exited "right", wrap it back around to the "left"
2443 patch_ib(patch_id)%x_centroid = patch_ib(patch_id)%x_centroid - (x_domain%end &
2444 & - x_domain%beg)
2445 end if
2446 end if
2447 end if
2448# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2449 if (num_dims >= 2) then
2450 ! check for periodicity
2451 if (ib_bc_y%beg == bc_periodic) then
2452 ! check if the boundary has left the domain, and then correct
2453 if (patch_ib(patch_id)%y_centroid < y_domain%beg) then
2454 ! if the boundary exited "left", wrap it back around to the "right"
2455 patch_ib(patch_id)%y_centroid = patch_ib(patch_id)%y_centroid + (y_domain%end &
2456 & - y_domain%beg)
2457 else if (patch_ib(patch_id)%y_centroid > y_domain%end) then
2458 ! if the boundary exited "right", wrap it back around to the "left"
2459 patch_ib(patch_id)%y_centroid = patch_ib(patch_id)%y_centroid - (y_domain%end &
2460 & - y_domain%beg)
2461 end if
2462 end if
2463 end if
2464# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2465 if (num_dims >= 3) then
2466 ! check for periodicity
2467 if (ib_bc_z%beg == bc_periodic) then
2468 ! check if the boundary has left the domain, and then correct
2469 if (patch_ib(patch_id)%z_centroid < z_domain%beg) then
2470 ! if the boundary exited "left", wrap it back around to the "right"
2471 patch_ib(patch_id)%z_centroid = patch_ib(patch_id)%z_centroid + (z_domain%end &
2472 & - z_domain%beg)
2473 else if (patch_ib(patch_id)%z_centroid > z_domain%end) then
2474 ! if the boundary exited "right", wrap it back around to the "left"
2475 patch_ib(patch_id)%z_centroid = patch_ib(patch_id)%z_centroid - (z_domain%end &
2476 & - z_domain%beg)
2477 end if
2478 end if
2479 end if
2480# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2481 end do
2482
2483# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2484#if defined(MFC_OpenACC)
2485# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2486!$acc end parallel loop
2487# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2488#elif defined(MFC_OpenMP)
2489# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2490
2491# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2492!$omp end target teams loop
2493# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2494#endif
2495
2496 end subroutine s_wrap_periodic_ibs
2497
2498 !> @brief Swaps ownership of IBs and passes ownership of IBs to neighbor processors
2499 !> Reduces forces and torques across the local neighborhood without a global allreduce. Accumulation phase: 2 passes per
2500 !! dimension receiving from the low-index (-X) neighbor. Pass 1: add received values; save what was received as recv_snap. Pass
2501 !! 2: send current (post-pass-1) values; add received; subtract recv_snap to remove double-counting of the direct contribution
2502 !! already added in pass 1. Back-propagation phase: 2 passes per dimension receiving from the high-index (+X) neighbor, each
2503 !! overwriting local forces with the neighbor's accumulated total.
2504 subroutine s_communicate_ib_forces(forces, torques)
2505
2506 real(wp), dimension(num_ibs, 3), intent(inout) :: forces, torques
2507
2508#ifdef MFC_MPI
2509 integer :: i, j, k, pack_pos, unpack_pos, buf_size, ierr
2510 integer :: send_neighbor, recv_neighbor, recv_count, tag
2511 character(len=1), allocatable :: ib_force_send_buf(:), ib_force_recv_buf(:)
2512
2513 if (num_procs == 1) return
2514
2515 buf_size = storage_size(0)/8 + (storage_size(0)/8 + 6*storage_size(0._wp)/8)*size(patch_ib)
2516 allocate (ib_force_send_buf(buf_size), ib_force_recv_buf(buf_size))
2517
2518 ! Accumulation phase: propagate contributions toward the high-index corner.
2519# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2520 if (num_dims >= 1) then
2521 send_neighbor = merge(bc_x%end, mpi_proc_null, bc_x%end >= 0)
2522 recv_neighbor = merge(bc_x%beg, mpi_proc_null, bc_x%beg >= 0)
2523
2524 recv_forces_snap = 0._wp
2525 recv_torques_snap = 0._wp
2526 tag = 300
2527
2528 do k = 1, min(2*ib_neighborhood_radius, num_procs_x - 1)
2529 ! send forces to +x neighbor; receive from -x neighbor. Add received values then
2530 pack_pos = 0
2531
2532# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2533
2534# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2535#if defined(MFC_OpenACC)
2536# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2537!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
2538# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2539#elif defined(MFC_OpenMP)
2540# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2541
2542# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2543
2544# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2545
2546# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2547!$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)
2548# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2549#endif
2550 do i = 1, num_ibs
2551 send_ids(i) = patch_ib(i)%gbl_patch_id
2552 send_ft(1:3,i) = forces(i,:)
2553 send_ft(4:6,i) = torques(i,:)
2554 end do
2555
2556# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2557#if defined(MFC_OpenACC)
2558# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2559!$acc end parallel loop
2560# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2561#elif defined(MFC_OpenMP)
2562# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2563
2564# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2565!$omp end target teams loop
2566# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2567#endif
2568
2569# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2570#if defined(MFC_OpenACC)
2571# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2572!$acc update host(send_ids, send_ft)
2573# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2574#elif defined(MFC_OpenMP)
2575# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2576!$omp target update from(send_ids, send_ft)
2577# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2578#endif
2579 call mpi_pack(num_ibs, 1, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2580 call mpi_pack(send_ids, num_ibs, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2581 call mpi_pack(send_ft, 6*num_ibs, mpi_p, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2582 call mpi_sendrecv(ib_force_send_buf, pack_pos, mpi_packed, send_neighbor, tag, ib_force_recv_buf, buf_size, &
2583 & mpi_packed, recv_neighbor, tag, mpi_comm_world, mpi_status_ignore, ierr)
2584
2585 if (recv_neighbor /= mpi_proc_null) then
2586 unpack_pos = 0
2587 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
2588 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ids, recv_count, mpi_integer, &
2589 & mpi_comm_world, ierr)
2590 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ft, 6*recv_count, mpi_p, mpi_comm_world, ierr)
2591
2592# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2593
2594# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2595#if defined(MFC_OpenACC)
2596# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2597!$acc parallel loop gang vector default(present) private(i, j) copy(forces, torques, recv_forces_snap, recv_torques_snap) copyin(recv_ft, recv_ids)
2598# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2599#elif defined(MFC_OpenMP)
2600# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2601
2602# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2603
2604# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2605
2606# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2607!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j) &
2608# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2609!$omp& map(tofrom:forces, torques, recv_forces_snap, recv_torques_snap) map(to:recv_ft, recv_ids)
2610# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2611#endif
2612# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2613 do i = 1, recv_count
2614 call s_get_neighborhood_idx(recv_ids(i), j)
2615 if (j > 0) then
2616 ! add forces and subtract recv_snap prevent double-counting
2617 forces(j,:) = forces(j,:) + recv_ft(1:3,i) - recv_forces_snap(j,:)
2618 torques(j,:) = torques(j,:) + recv_ft(4:6,i) - recv_torques_snap(j,:)
2619 recv_forces_snap(j,:) = recv_ft(1:3,i)
2620 recv_torques_snap(j,:) = recv_ft(4:6,i)
2621 end if
2622 end do
2623
2624# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2625#if defined(MFC_OpenACC)
2626# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2627!$acc end parallel loop
2628# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2629#elif defined(MFC_OpenMP)
2630# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2631
2632# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2633!$omp end target teams loop
2634# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2635#endif
2636 end if
2637 tag = tag + 2
2638 end do
2639 end if
2640# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2641 if (num_dims >= 2) then
2642 send_neighbor = merge(bc_y%end, mpi_proc_null, bc_y%end >= 0)
2643 recv_neighbor = merge(bc_y%beg, mpi_proc_null, bc_y%beg >= 0)
2644
2645 recv_forces_snap = 0._wp
2646 recv_torques_snap = 0._wp
2647 tag = 300
2648
2649 do k = 1, min(2*ib_neighborhood_radius, num_procs_y - 1)
2650 ! send forces to +y neighbor; receive from -y neighbor. Add received values then
2651 pack_pos = 0
2652
2653# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2654
2655# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2656#if defined(MFC_OpenACC)
2657# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2658!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
2659# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2660#elif defined(MFC_OpenMP)
2661# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2662
2663# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2664
2665# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2666
2667# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2668!$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)
2669# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2670#endif
2671 do i = 1, num_ibs
2672 send_ids(i) = patch_ib(i)%gbl_patch_id
2673 send_ft(1:3,i) = forces(i,:)
2674 send_ft(4:6,i) = torques(i,:)
2675 end do
2676
2677# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2678#if defined(MFC_OpenACC)
2679# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2680!$acc end parallel loop
2681# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2682#elif defined(MFC_OpenMP)
2683# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2684
2685# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2686!$omp end target teams loop
2687# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2688#endif
2689
2690# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2691#if defined(MFC_OpenACC)
2692# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2693!$acc update host(send_ids, send_ft)
2694# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2695#elif defined(MFC_OpenMP)
2696# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2697!$omp target update from(send_ids, send_ft)
2698# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2699#endif
2700 call mpi_pack(num_ibs, 1, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2701 call mpi_pack(send_ids, num_ibs, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2702 call mpi_pack(send_ft, 6*num_ibs, mpi_p, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2703 call mpi_sendrecv(ib_force_send_buf, pack_pos, mpi_packed, send_neighbor, tag, ib_force_recv_buf, buf_size, &
2704 & mpi_packed, recv_neighbor, tag, mpi_comm_world, mpi_status_ignore, ierr)
2705
2706 if (recv_neighbor /= mpi_proc_null) then
2707 unpack_pos = 0
2708 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
2709 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ids, recv_count, mpi_integer, &
2710 & mpi_comm_world, ierr)
2711 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ft, 6*recv_count, mpi_p, mpi_comm_world, ierr)
2712
2713# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2714
2715# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2716#if defined(MFC_OpenACC)
2717# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2718!$acc parallel loop gang vector default(present) private(i, j) copy(forces, torques, recv_forces_snap, recv_torques_snap) copyin(recv_ft, recv_ids)
2719# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2720#elif defined(MFC_OpenMP)
2721# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2722
2723# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2724
2725# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2726
2727# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2728!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j) &
2729# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2730!$omp& map(tofrom:forces, torques, recv_forces_snap, recv_torques_snap) map(to:recv_ft, recv_ids)
2731# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2732#endif
2733# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2734 do i = 1, recv_count
2735 call s_get_neighborhood_idx(recv_ids(i), j)
2736 if (j > 0) then
2737 ! add forces and subtract recv_snap prevent double-counting
2738 forces(j,:) = forces(j,:) + recv_ft(1:3,i) - recv_forces_snap(j,:)
2739 torques(j,:) = torques(j,:) + recv_ft(4:6,i) - recv_torques_snap(j,:)
2740 recv_forces_snap(j,:) = recv_ft(1:3,i)
2741 recv_torques_snap(j,:) = recv_ft(4:6,i)
2742 end if
2743 end do
2744
2745# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2746#if defined(MFC_OpenACC)
2747# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2748!$acc end parallel loop
2749# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2750#elif defined(MFC_OpenMP)
2751# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2752
2753# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2754!$omp end target teams loop
2755# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2756#endif
2757 end if
2758 tag = tag + 2
2759 end do
2760 end if
2761# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2762 if (num_dims >= 3) then
2763 send_neighbor = merge(bc_z%end, mpi_proc_null, bc_z%end >= 0)
2764 recv_neighbor = merge(bc_z%beg, mpi_proc_null, bc_z%beg >= 0)
2765
2766 recv_forces_snap = 0._wp
2767 recv_torques_snap = 0._wp
2768 tag = 300
2769
2770 do k = 1, min(2*ib_neighborhood_radius, num_procs_z - 1)
2771 ! send forces to +z neighbor; receive from -z neighbor. Add received values then
2772 pack_pos = 0
2773
2774# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2775
2776# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2777#if defined(MFC_OpenACC)
2778# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2779!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
2780# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2781#elif defined(MFC_OpenMP)
2782# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2783
2784# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2785
2786# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2787
2788# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2789!$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)
2790# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2791#endif
2792 do i = 1, num_ibs
2793 send_ids(i) = patch_ib(i)%gbl_patch_id
2794 send_ft(1:3,i) = forces(i,:)
2795 send_ft(4:6,i) = torques(i,:)
2796 end do
2797
2798# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2799#if defined(MFC_OpenACC)
2800# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2801!$acc end parallel loop
2802# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2803#elif defined(MFC_OpenMP)
2804# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2805
2806# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2807!$omp end target teams loop
2808# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2809#endif
2810
2811# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2812#if defined(MFC_OpenACC)
2813# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2814!$acc update host(send_ids, send_ft)
2815# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2816#elif defined(MFC_OpenMP)
2817# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2818!$omp target update from(send_ids, send_ft)
2819# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2820#endif
2821 call mpi_pack(num_ibs, 1, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2822 call mpi_pack(send_ids, num_ibs, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2823 call mpi_pack(send_ft, 6*num_ibs, mpi_p, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2824 call mpi_sendrecv(ib_force_send_buf, pack_pos, mpi_packed, send_neighbor, tag, ib_force_recv_buf, buf_size, &
2825 & mpi_packed, recv_neighbor, tag, mpi_comm_world, mpi_status_ignore, ierr)
2826
2827 if (recv_neighbor /= mpi_proc_null) then
2828 unpack_pos = 0
2829 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
2830 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ids, recv_count, mpi_integer, &
2831 & mpi_comm_world, ierr)
2832 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ft, 6*recv_count, mpi_p, mpi_comm_world, ierr)
2833
2834# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2835
2836# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2837#if defined(MFC_OpenACC)
2838# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2839!$acc parallel loop gang vector default(present) private(i, j) copy(forces, torques, recv_forces_snap, recv_torques_snap) copyin(recv_ft, recv_ids)
2840# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2841#elif defined(MFC_OpenMP)
2842# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2843
2844# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2845
2846# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2847
2848# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2849!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j) &
2850# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2851!$omp& map(tofrom:forces, torques, recv_forces_snap, recv_torques_snap) map(to:recv_ft, recv_ids)
2852# 1267 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2853#endif
2854# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2855 do i = 1, recv_count
2856 call s_get_neighborhood_idx(recv_ids(i), j)
2857 if (j > 0) then
2858 ! add forces and subtract recv_snap prevent double-counting
2859 forces(j,:) = forces(j,:) + recv_ft(1:3,i) - recv_forces_snap(j,:)
2860 torques(j,:) = torques(j,:) + recv_ft(4:6,i) - recv_torques_snap(j,:)
2861 recv_forces_snap(j,:) = recv_ft(1:3,i)
2862 recv_torques_snap(j,:) = recv_ft(4:6,i)
2863 end if
2864 end do
2865
2866# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2867#if defined(MFC_OpenACC)
2868# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2869!$acc end parallel loop
2870# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2871#elif defined(MFC_OpenMP)
2872# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2873
2874# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2875!$omp end target teams loop
2876# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2877#endif
2878 end if
2879 tag = tag + 2
2880 end do
2881 end if
2882# 1285 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2883
2884 ! Send final sums back to neighbors in -X direction
2885# 1288 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2886 if (num_dims >= 1) then
2887 send_neighbor = merge(bc_x%beg, mpi_proc_null, bc_x%beg >= 0)
2888 recv_neighbor = merge(bc_x%end, mpi_proc_null, bc_x%end >= 0)
2889
2890 do k = 1, min(2*ib_neighborhood_radius, num_procs_x - 1)
2891 pack_pos = 0
2892
2893# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2894
2895# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2896#if defined(MFC_OpenACC)
2897# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2898!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
2899# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2900#elif defined(MFC_OpenMP)
2901# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2902
2903# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2904
2905# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2906
2907# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2908!$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)
2909# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2910#endif
2911 do i = 1, num_ibs
2912 send_ids(i) = patch_ib(i)%gbl_patch_id
2913 send_ft(1:3,i) = forces(i,:)
2914 send_ft(4:6,i) = torques(i,:)
2915 end do
2916
2917# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2918#if defined(MFC_OpenACC)
2919# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2920!$acc end parallel loop
2921# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2922#elif defined(MFC_OpenMP)
2923# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2924
2925# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2926!$omp end target teams loop
2927# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2928#endif
2929
2930# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2931#if defined(MFC_OpenACC)
2932# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2933!$acc update host(send_ids, send_ft)
2934# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2935#elif defined(MFC_OpenMP)
2936# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2937!$omp target update from(send_ids, send_ft)
2938# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2939#endif
2940 call mpi_pack(num_ibs, 1, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2941 call mpi_pack(send_ids, num_ibs, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2942 call mpi_pack(send_ft, 6*num_ibs, mpi_p, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
2943 call mpi_sendrecv(ib_force_send_buf, pack_pos, mpi_packed, send_neighbor, tag, ib_force_recv_buf, buf_size, &
2944 & mpi_packed, recv_neighbor, tag, mpi_comm_world, mpi_status_ignore, ierr)
2945 if (recv_neighbor /= mpi_proc_null) then
2946 unpack_pos = 0
2947 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
2948 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ids, recv_count, mpi_integer, &
2949 & mpi_comm_world, ierr)
2950 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ft, 6*recv_count, mpi_p, mpi_comm_world, ierr)
2951
2952# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2953
2954# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2955#if defined(MFC_OpenACC)
2956# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2957!$acc parallel loop gang vector default(present) private(i, j) copy(forces, torques) copyin(recv_ft, recv_ids)
2958# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2959#elif defined(MFC_OpenMP)
2960# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2961
2962# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2963
2964# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2965
2966# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2967!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j) &
2968# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2969!$omp& map(tofrom:forces, torques) map(to:recv_ft, recv_ids)
2970# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2971#endif
2972 do i = 1, recv_count
2973 call s_get_neighborhood_idx(recv_ids(i), j)
2974 if (j > 0) then
2975 forces(j,:) = recv_ft(1:3,i)
2976 torques(j,:) = recv_ft(4:6,i)
2977 end if
2978 end do
2979
2980# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2981#if defined(MFC_OpenACC)
2982# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2983!$acc end parallel loop
2984# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2985#elif defined(MFC_OpenMP)
2986# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2987
2988# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2989!$omp end target teams loop
2990# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2991#endif
2992 end if
2993 tag = tag + 2
2994 end do
2995 end if
2996# 1288 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
2997 if (num_dims >= 2) then
2998 send_neighbor = merge(bc_y%beg, mpi_proc_null, bc_y%beg >= 0)
2999 recv_neighbor = merge(bc_y%end, mpi_proc_null, bc_y%end >= 0)
3000
3001 do k = 1, min(2*ib_neighborhood_radius, num_procs_y - 1)
3002 pack_pos = 0
3003
3004# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3005
3006# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3007#if defined(MFC_OpenACC)
3008# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3009!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
3010# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3011#elif defined(MFC_OpenMP)
3012# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3013
3014# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3015
3016# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3017
3018# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3019!$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)
3020# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3021#endif
3022 do i = 1, num_ibs
3023 send_ids(i) = patch_ib(i)%gbl_patch_id
3024 send_ft(1:3,i) = forces(i,:)
3025 send_ft(4:6,i) = torques(i,:)
3026 end do
3027
3028# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3029#if defined(MFC_OpenACC)
3030# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3031!$acc end parallel loop
3032# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3033#elif defined(MFC_OpenMP)
3034# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3035
3036# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3037!$omp end target teams loop
3038# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3039#endif
3040
3041# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3042#if defined(MFC_OpenACC)
3043# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3044!$acc update host(send_ids, send_ft)
3045# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3046#elif defined(MFC_OpenMP)
3047# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3048!$omp target update from(send_ids, send_ft)
3049# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3050#endif
3051 call mpi_pack(num_ibs, 1, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3052 call mpi_pack(send_ids, num_ibs, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3053 call mpi_pack(send_ft, 6*num_ibs, mpi_p, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3054 call mpi_sendrecv(ib_force_send_buf, pack_pos, mpi_packed, send_neighbor, tag, ib_force_recv_buf, buf_size, &
3055 & mpi_packed, recv_neighbor, tag, mpi_comm_world, mpi_status_ignore, ierr)
3056 if (recv_neighbor /= mpi_proc_null) then
3057 unpack_pos = 0
3058 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
3059 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ids, recv_count, mpi_integer, &
3060 & mpi_comm_world, ierr)
3061 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ft, 6*recv_count, mpi_p, mpi_comm_world, ierr)
3062
3063# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3064
3065# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3066#if defined(MFC_OpenACC)
3067# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3068!$acc parallel loop gang vector default(present) private(i, j) copy(forces, torques) copyin(recv_ft, recv_ids)
3069# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3070#elif defined(MFC_OpenMP)
3071# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3072
3073# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3074
3075# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3076
3077# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3078!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j) &
3079# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3080!$omp& map(tofrom:forces, torques) map(to:recv_ft, recv_ids)
3081# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3082#endif
3083 do i = 1, recv_count
3084 call s_get_neighborhood_idx(recv_ids(i), j)
3085 if (j > 0) then
3086 forces(j,:) = recv_ft(1:3,i)
3087 torques(j,:) = recv_ft(4:6,i)
3088 end if
3089 end do
3090
3091# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3092#if defined(MFC_OpenACC)
3093# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3094!$acc end parallel loop
3095# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3096#elif defined(MFC_OpenMP)
3097# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3098
3099# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3100!$omp end target teams loop
3101# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3102#endif
3103 end if
3104 tag = tag + 2
3105 end do
3106 end if
3107# 1288 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3108 if (num_dims >= 3) then
3109 send_neighbor = merge(bc_z%beg, mpi_proc_null, bc_z%beg >= 0)
3110 recv_neighbor = merge(bc_z%end, mpi_proc_null, bc_z%end >= 0)
3111
3112 do k = 1, min(2*ib_neighborhood_radius, num_procs_z - 1)
3113 pack_pos = 0
3114
3115# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3116
3117# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3118#if defined(MFC_OpenACC)
3119# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3120!$acc parallel loop gang vector default(present) private(i) copyin(forces, torques)
3121# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3122#elif defined(MFC_OpenMP)
3123# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3124
3125# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3126
3127# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3128
3129# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3130!$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)
3131# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3132#endif
3133 do i = 1, num_ibs
3134 send_ids(i) = patch_ib(i)%gbl_patch_id
3135 send_ft(1:3,i) = forces(i,:)
3136 send_ft(4:6,i) = torques(i,:)
3137 end do
3138
3139# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3140#if defined(MFC_OpenACC)
3141# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3142!$acc end parallel loop
3143# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3144#elif defined(MFC_OpenMP)
3145# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3146
3147# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3148!$omp end target teams loop
3149# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3150#endif
3151
3152# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3153#if defined(MFC_OpenACC)
3154# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3155!$acc update host(send_ids, send_ft)
3156# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3157#elif defined(MFC_OpenMP)
3158# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3159!$omp target update from(send_ids, send_ft)
3160# 1301 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3161#endif
3162 call mpi_pack(num_ibs, 1, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3163 call mpi_pack(send_ids, num_ibs, mpi_integer, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3164 call mpi_pack(send_ft, 6*num_ibs, mpi_p, ib_force_send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3165 call mpi_sendrecv(ib_force_send_buf, pack_pos, mpi_packed, send_neighbor, tag, ib_force_recv_buf, buf_size, &
3166 & mpi_packed, recv_neighbor, tag, mpi_comm_world, mpi_status_ignore, ierr)
3167 if (recv_neighbor /= mpi_proc_null) then
3168 unpack_pos = 0
3169 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
3170 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ids, recv_count, mpi_integer, &
3171 & mpi_comm_world, ierr)
3172 call mpi_unpack(ib_force_recv_buf, buf_size, unpack_pos, recv_ft, 6*recv_count, mpi_p, mpi_comm_world, ierr)
3173
3174# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3175
3176# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3177#if defined(MFC_OpenACC)
3178# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3179!$acc parallel loop gang vector default(present) private(i, j) copy(forces, torques) copyin(recv_ft, recv_ids)
3180# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3181#elif defined(MFC_OpenMP)
3182# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3183
3184# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3185
3186# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3187
3188# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3189!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j) &
3190# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3191!$omp& map(tofrom:forces, torques) map(to:recv_ft, recv_ids)
3192# 1313 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3193#endif
3194 do i = 1, recv_count
3195 call s_get_neighborhood_idx(recv_ids(i), j)
3196 if (j > 0) then
3197 forces(j,:) = recv_ft(1:3,i)
3198 torques(j,:) = recv_ft(4:6,i)
3199 end if
3200 end do
3201
3202# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3203#if defined(MFC_OpenACC)
3204# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3205!$acc end parallel loop
3206# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3207#elif defined(MFC_OpenMP)
3208# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3209
3210# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3211!$omp end target teams loop
3212# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3213#endif
3214 end if
3215 tag = tag + 2
3216 end do
3217 end if
3218# 1327 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3219#endif
3220
3221 end subroutine s_communicate_ib_forces
3222
3223 subroutine s_handoff_ib_ownership()
3224
3225 integer :: i, j, k, output_idx, local_output_idx
3226 integer :: old_num_local_ibs
3227 integer :: new_count, recv_count
3228 integer :: pack_pos, unpack_pos, buf_size, patch_bytes
3229 integer :: send_neighbor, recv_neighbor, ierr
3230 integer :: dx, dy, dz, tag, nbr_idx, nreqs
3231 real(wp), dimension(3) :: centroid
3232 logical :: is_new
3233 type(ib_patch_parameters) :: tmp_patch
3234 integer, dimension(num_local_ibs_max) :: local_ib_idx_old
3235 ! 26 neighbors max in 3D (8 in 2D); each gets its own recv buffer
3236 integer, parameter :: max_nbrs = 26
3237 character(len=1), allocatable :: send_buf(:), recv_bufs(:,:)
3238 integer, dimension(2*max_nbrs) :: requests
3239 integer, dimension(max_nbrs) :: recv_neighbor_list
3240
3241#ifdef MFC_MPI
3242 if (num_procs > 1) then
3243 ! save a copy of the local IB's global indices to cross-reference for later.
3244 local_ib_idx_old = 0
3245 old_num_local_ibs = num_local_ibs
3246 do i = 1, num_local_ibs
3247 local_ib_idx_old(i) = patch_ib(local_ib_patch_ids(i))%gbl_patch_id
3248 end do
3249
3250 ! delete any particles that no longer need to be tracked and coalesce the array
3251 output_idx = 0
3252 local_output_idx = 0
3253 do i = 1, num_ibs
3254 centroid = [patch_ib(i)%x_centroid, patch_ib(i)%y_centroid, 0._wp]
3255 if (num_dims == 3) centroid(3) = patch_ib(i)%z_centroid
3256
3257 ! delete if not in neighborhood
3258 if (f_neighborhood_ranks_own_location(centroid)) then
3259 output_idx = output_idx + 1
3260 if (i /= output_idx) then
3261 patch_ib(output_idx) = patch_ib(i)
3262 end if
3263
3264 ! check if in local domain
3265 if (f_local_rank_owns_location(centroid)) then
3266 local_output_idx = local_output_idx + 1
3267 local_ib_patch_ids(local_output_idx) = output_idx
3268 end if
3269 end if
3270 end do
3271 num_ibs = output_idx
3272 num_local_ibs = local_output_idx
3273
3274# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3275#if defined(MFC_OpenACC)
3276# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3277!$acc update device(patch_ib)
3278# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3279#elif defined(MFC_OpenMP)
3280# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3281!$omp target update to(patch_ib)
3282# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3283#endif
3284 call s_update_ib_lookup()
3285
3286 ! Broadcast newly-owned patches to all neighborhood neighbors
3287 patch_bytes = storage_size(tmp_patch)/8
3288 buf_size = storage_size(0)/8 + patch_bytes*num_local_ibs_max
3289 allocate (send_buf(buf_size), recv_bufs(buf_size, max_nbrs))
3290
3291 ! Write placeholder count at position 0
3292 pack_pos = 0
3293 call mpi_pack(0, 1, mpi_integer, send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3294
3295 ! pack new patches and count them
3296 new_count = 0
3297 do i = 1, num_local_ibs
3298 k = local_ib_patch_ids(i)
3299 is_new = .true.
3300 do j = 1, old_num_local_ibs
3301 if (patch_ib(k)%gbl_patch_id == local_ib_idx_old(j)) then
3302 is_new = .false.
3303 exit
3304 end if
3305 end do
3306 if (is_new) then
3307 call mpi_pack(patch_ib(k), patch_bytes, mpi_byte, send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3308 new_count = new_count + 1
3309 end if
3310 end do
3311
3312 ! Overwrite the placeholder with the real count
3313 pack_pos = 0
3314 call mpi_pack(new_count, 1, mpi_integer, send_buf, buf_size, pack_pos, mpi_comm_world, ierr)
3315 pack_pos = storage_size(0)/8 + new_count*patch_bytes
3316
3317 ! Post all receives first, then sends
3318 nreqs = 0
3319 nbr_idx = 0
3320 do dz = merge(-1, 0, num_dims == 3), merge(1, 0, num_dims == 3)
3321 do dy = -1, 1
3322 do dx = -1, 1
3323 if (dx == 0 .and. dy == 0 .and. dz == 0) cycle
3324 nbr_idx = nbr_idx + 1
3325 tag = 200 + (dx + 1)*9 + (dy + 1)*3 + (dz + 1)
3326 recv_neighbor = ib_neighbor_ranks(-dx, -dy, -dz)
3327 recv_neighbor_list(nbr_idx) = mpi_proc_null
3328 if (recv_neighbor < 0) cycle
3329 recv_neighbor_list(nbr_idx) = recv_neighbor
3330 nreqs = nreqs + 1
3331 call mpi_irecv(recv_bufs(:,nbr_idx), buf_size, mpi_packed, recv_neighbor, tag, mpi_comm_world, &
3332 & requests(nreqs), ierr)
3333 end do
3334 end do
3335 end do
3336
3337 do dz = merge(-1, 0, num_dims == 3), merge(1, 0, num_dims == 3)
3338 do dy = -1, 1
3339 do dx = -1, 1
3340 if (dx == 0 .and. dy == 0 .and. dz == 0) cycle
3341 tag = 200 + (dx + 1)*9 + (dy + 1)*3 + (dz + 1)
3342 send_neighbor = ib_neighbor_ranks(dx, dy, dz)
3343 if (send_neighbor < 0) cycle
3344 nreqs = nreqs + 1
3345 call mpi_isend(send_buf, pack_pos, mpi_packed, send_neighbor, tag, mpi_comm_world, requests(nreqs), ierr)
3346 end do
3347 end do
3348 end do
3349
3350 call mpi_waitall(nreqs, requests, mpi_statuses_ignore, ierr)
3351
3352 ! Unpack all received buffers
3353 do nbr_idx = 1, merge(26, 8, num_dims == 3)
3354 if (recv_neighbor_list(nbr_idx) == mpi_proc_null) cycle
3355 unpack_pos = 0
3356 call mpi_unpack(recv_bufs(:,nbr_idx), buf_size, unpack_pos, recv_count, 1, mpi_integer, mpi_comm_world, ierr)
3357 do i = 1, recv_count
3358 call mpi_unpack(recv_bufs(:,nbr_idx), buf_size, unpack_pos, tmp_patch, patch_bytes, mpi_byte, mpi_comm_world, &
3359 & ierr)
3360 call s_get_neighborhood_idx(tmp_patch%gbl_patch_id, j)
3361 if (j < 0) then
3362 num_ibs = num_ibs + 1
3363 if (.not. (num_ibs <= size(patch_ib))) then
3364# 1461 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3365 call s_mpi_abort("m_ibm.fpp:1461: " // "Assertion failed: num_ibs <= size(patch_ib). " &
3366# 1461 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3367 & // 'patch_ib overflow in neighborhood handoff')
3368# 1461 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3369 end if
3370 patch_ib(num_ibs) = tmp_patch
3371 end if
3372 end do
3373 end do
3374
3375 deallocate (send_buf, recv_bufs)
3376
3377# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3378#if defined(MFC_OpenACC)
3379# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3380!$acc update device(patch_ib)
3381# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3382#elif defined(MFC_OpenMP)
3383# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3384!$omp target update to(patch_ib)
3385# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3386#endif
3387 call s_update_ib_lookup()
3388 end if
3389#endif
3390
3391 end subroutine s_handoff_ib_ownership
3392
3393 subroutine s_get_neighborhood_idx(gbl_idx, neighborhood_idx)
3394
3395
3396# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3397#if MFC_OpenACC
3398# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3399!$acc routine seq
3400# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3401#elif MFC_OpenMP
3402# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3403
3404# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3405
3406# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3407!$omp declare target device_type(any)
3408# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3409#endif
3410
3411 integer, intent(in) :: gbl_idx
3412 integer, intent(out) :: neighborhood_idx
3413 integer :: i
3414
3415 neighborhood_idx = ib_gbl_idx_lookup(gbl_idx)
3416
3417 end subroutine s_get_neighborhood_idx
3418
3419 subroutine s_update_ib_lookup()
3420
3421 integer :: i
3422
3423 ib_gbl_idx_lookup = -1
3424
3425# 1492 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3426#if defined(MFC_OpenACC)
3427# 1492 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3428!$acc update device(ib_gbl_idx_lookup)
3429# 1492 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3430#elif defined(MFC_OpenMP)
3431# 1492 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3432!$omp target update to(ib_gbl_idx_lookup)
3433# 1492 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3434#endif
3435
3436
3437# 1494 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3438
3439# 1494 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3440#if defined(MFC_OpenACC)
3441# 1494 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3442!$acc parallel loop gang vector default(present) private(i)
3443# 1494 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3444#elif defined(MFC_OpenMP)
3445# 1494 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3446
3447# 1494 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3448
3449# 1494 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3450
3451# 1494 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3452!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i)
3453# 1494 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3454#endif
3455 do i = 1, num_ibs
3456 ib_gbl_idx_lookup(patch_ib(i)%gbl_patch_id) = i
3457 end do
3458
3459# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3460#if defined(MFC_OpenACC)
3461# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3462!$acc end parallel loop
3463# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3464#elif defined(MFC_OpenMP)
3465# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3466
3467# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3468!$omp end target teams loop
3469# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3470#endif
3471
3472
3473# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3474#if defined(MFC_OpenACC)
3475# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3476!$acc update host(ib_gbl_idx_lookup)
3477# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3478#elif defined(MFC_OpenMP)
3479# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3480!$omp target update from(ib_gbl_idx_lookup)
3481# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3482#endif
3483
3484 end subroutine s_update_ib_lookup
3485
3486 !> Finalize the IBM module
3487 impure subroutine s_finalize_ibm_module()
3488
3489 integer :: i
3490
3491#ifdef MFC_DEBUG
3492# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3493 block
3494# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3495 use iso_fortran_env, only: output_unit
3496# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3497
3498# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3499 print *, 'm_ibm.fpp:1509: ', '@:DEALLOCATE(ib_markers%sf)'
3500# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3501
3502# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3503 call flush (output_unit)
3504# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3505 end block
3506# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3507#endif
3508# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3509
3510# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3511#if defined(MFC_OpenACC)
3512# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3513!$acc exit data delete(ib_markers%sf)
3514# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3515#elif defined(MFC_OpenMP)
3516# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3517!$omp target exit data map(release:ib_markers%sf)
3518# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3519#endif
3520# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3521 deallocate (ib_markers%sf)
3522#ifdef MFC_DEBUG
3523# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3524 block
3525# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3526 use iso_fortran_env, only: output_unit
3527# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3528
3529# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3530 print *, 'm_ibm.fpp:1510: ', '@:DEALLOCATE(ib_gbl_idx_lookup)'
3531# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3532
3533# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3534 call flush (output_unit)
3535# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3536 end block
3537# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3538#endif
3539# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3540
3541# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3542#if defined(MFC_OpenACC)
3543# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3544!$acc exit data delete(ib_gbl_idx_lookup)
3545# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3546#elif defined(MFC_OpenMP)
3547# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3548!$omp target exit data map(release:ib_gbl_idx_lookup)
3549# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3550#endif
3551# 1510 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3552 deallocate (ib_gbl_idx_lookup)
3553 do i = 1, num_ib_airfoils_max
3554 if (allocated(ib_airfoil_grids(i)%upper)) then
3555#ifdef MFC_DEBUG
3556# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3557 block
3558# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3559 use iso_fortran_env, only: output_unit
3560# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3561
3562# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3563 print *, 'm_ibm.fpp:1513: ', '@:DEALLOCATE(ib_airfoil_grids(i)%upper)'
3564# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3565
3566# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3567 call flush (output_unit)
3568# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3569 end block
3570# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3571#endif
3572# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3573
3574# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3575#if defined(MFC_OpenACC)
3576# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3577!$acc exit data delete(ib_airfoil_grids(i)%upper)
3578# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3579#elif defined(MFC_OpenMP)
3580# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3581!$omp target exit data map(release:ib_airfoil_grids(i)%upper)
3582# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3583#endif
3584# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3585 deallocate (ib_airfoil_grids(i)%upper)
3586#ifdef MFC_DEBUG
3587# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3588 block
3589# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3590 use iso_fortran_env, only: output_unit
3591# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3592
3593# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3594 print *, 'm_ibm.fpp:1514: ', '@:DEALLOCATE(ib_airfoil_grids(i)%lower)'
3595# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3596
3597# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3598 call flush (output_unit)
3599# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3600 end block
3601# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3602#endif
3603# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3604
3605# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3606#if defined(MFC_OpenACC)
3607# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3608!$acc exit data delete(ib_airfoil_grids(i)%lower)
3609# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3610#elif defined(MFC_OpenMP)
3611# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3612!$omp target exit data map(release:ib_airfoil_grids(i)%lower)
3613# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3614#endif
3615# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3616 deallocate (ib_airfoil_grids(i)%lower)
3617 end if
3618 end do
3619 if (allocated(models)) then
3620#ifdef MFC_DEBUG
3621# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3622 block
3623# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3624 use iso_fortran_env, only: output_unit
3625# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3626
3627# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3628 print *, 'm_ibm.fpp:1518: ', '@:DEALLOCATE(models)'
3629# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3630
3631# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3632 call flush (output_unit)
3633# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3634 end block
3635# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3636#endif
3637# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3638
3639# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3640#if defined(MFC_OpenACC)
3641# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3642!$acc exit data delete(models)
3643# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3644#elif defined(MFC_OpenMP)
3645# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3646!$omp target exit data map(release:models)
3647# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3648#endif
3649# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3650 deallocate (models)
3651 end if
3652 if (allocated(ghost_points)) then
3653#ifdef MFC_DEBUG
3654# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3655 block
3656# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3657 use iso_fortran_env, only: output_unit
3658# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3659
3660# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3661 print *, 'm_ibm.fpp:1521: ', '@:DEALLOCATE(ghost_points)'
3662# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3663
3664# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3665 call flush (output_unit)
3666# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3667 end block
3668# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3669#endif
3670# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3671
3672# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3673#if defined(MFC_OpenACC)
3674# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3675!$acc exit data delete(ghost_points)
3676# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3677#elif defined(MFC_OpenMP)
3678# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3679!$omp target exit data map(release:ghost_points)
3680# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3681#endif
3682# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3683 deallocate (ghost_points)
3684 end if
3685 if (collision_model > 0) call s_finalize_collisions_module()
3686#ifdef MFC_MPI
3687 if (num_procs > 1) then
3688#ifdef MFC_DEBUG
3689# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3690 block
3691# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3692 use iso_fortran_env, only: output_unit
3693# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3694
3695# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3696 print *, 'm_ibm.fpp:1526: ', '@:DEALLOCATE(send_ids, send_ft)'
3697# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3698
3699# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3700 call flush (output_unit)
3701# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3702 end block
3703# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3704#endif
3705# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3706
3707# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3708#if defined(MFC_OpenACC)
3709# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3710!$acc exit data delete(send_ids, send_ft)
3711# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3712#elif defined(MFC_OpenMP)
3713# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3714!$omp target exit data map(release:send_ids, send_ft)
3715# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3716#endif
3717# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_ibm.fpp"
3718 deallocate (send_ids, send_ft)
3719 deallocate (recv_forces_snap, recv_torques_snap, recv_ids, recv_ft)
3720 end if
3721#endif
3722
3723 end subroutine s_finalize_ibm_module
3724
3725end module m_ibm
q_cons_vf
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
Definition m_phase_change.fpp.f90:1076
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1078
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1078
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1078
m_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:679
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:1927
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:2033
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:3420
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:2505
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:1599
m_ibm::s_handoff_ib_ownership
subroutine s_handoff_ib_ownership()
Definition m_ibm.fpp.f90:3224
m_ibm::s_finalize_ibm_module
impure subroutine, public s_finalize_ibm_module()
Finalize the IBM module.
Definition m_ibm.fpp.f90:3488
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:1737
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:2320
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:3394
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:2260
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:2408
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:791
m_derived_types::integer_field
Derived type annexing an integer scalar field (SF).
Definition m_derived_types.fpp.f90:347