MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_collisions.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
2!>
3!! @file
4!! @brief Contains module m_collisions
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! New line at end of file is required for FYPP
33# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
34# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
35# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
36# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45
46# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49
50# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59! New line at end of file is required for FYPP
60# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
61
62# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
63# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
64# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
65# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
66# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
67
68# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
69
70# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
71
72# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
73
74# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75
76# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77
78# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138! New line at end of file is required for FYPP
139# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
140# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
141# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
142# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
143# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
144# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
145# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
146# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
147
148# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
149# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
150# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
151
152# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
153
154# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155
156# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157
158# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159
160# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161
162# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165! New line at end of file is required for FYPP
166# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
167
168# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
169
170# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
171
172# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
173
174# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
175
176# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
177
178# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
179
180# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
181
182# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223! New line at end of file is required for FYPP
224# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
225
226! GPU parallel region (scalar reductions, maxval/minval)
227# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
228
229! GPU parallel loop over threads (most common GPU macro)
230# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
231
232! Required closing for GPU_PARALLEL_LOOP
233# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
234
235! Mark routine for device compilation
236# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
237
238! Declare device-resident data
239# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
240
241! Inner loop within a GPU parallel region
242# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
243
244! Scoped GPU data region
245# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247! Host code with device pointers (for MPI with GPU buffers)
248# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250! Allocate device memory (unscoped)
251# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253! Free device memory
254# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256! Atomic operation on device
257# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259! End atomic capture block
260# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262! Copy data between host and device
263# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265! Synchronization barrier
266# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! Import GPU library module (openacc or omp_lib)
269# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Emit code only for AMD compiler
272# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Emit code for non-Cray compilers
275# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Emit code only for Cray compiler
278# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Emit code for non-NVIDIA compilers
281# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
284# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285! New line at end of file is required for FYPP
286# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
287
288# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
289
290! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
291! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
292! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
293# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
294
295! Allocate and create GPU device memory
296# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
297
298! Free GPU device memory and deallocate
299# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
300
301! Cray-specific GPU pointer setup for vector fields
302# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
303
304! Cray-specific GPU pointer setup for scalar fields
305# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
306
307! Cray-specific GPU pointer setup for acoustic source spatials
308# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
309
310# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
313! New line at end of file is required for FYPP
314# 6 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp" 2
315
316!> @brief Ghost-node immersed boundary method: locates ghost/image points, computes interpolation coefficients, and corrects the
317!! flow state
318module m_collisions
319
320 use m_derived_types !< definitions of the derived types
321 use m_global_parameters !< definitions of the global parameters
322 use m_helper
323 use m_helper_basic !< functions to compare floating point numbers
324 use m_constants
325 use m_compute_levelset
326 use m_ib_patches
327 use m_model
328
329 implicit none
330
331 private; public :: s_apply_collision_forces, s_initialize_collisions_module, s_finalize_collisions_module
332 ! overlap distances for computing collisions
333 integer, allocatable, dimension(:,:) :: collision_lookup
334 real(wp), allocatable, dimension(:,:) :: wall_overlap_distances
335 real(wp) :: spring_stiffness, damping_parameter
336
337# 27 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
338#if defined(MFC_OpenACC)
339# 27 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
340!$acc declare create(spring_stiffness, damping_parameter)
341# 27 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
342#elif defined(MFC_OpenMP)
343# 27 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
344!$omp declare target (spring_stiffness, damping_parameter)
345# 27 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
346#endif
347
348# 28 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
349#if defined(MFC_OpenACC)
350# 28 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
351!$acc declare create(collision_lookup, wall_overlap_distances)
352# 28 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
353#elif defined(MFC_OpenMP)
354# 28 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
355!$omp declare target (collision_lookup, wall_overlap_distances)
356# 28 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
357#endif
358
359contains
360
361 subroutine s_initialize_collisions_module()
362
363 real(wp) :: e
364
365 e = coefficient_of_restitution
366 damping_parameter = -2._wp*log(e)/collision_time
367 spring_stiffness = (pi**2 + log(e)**2)/(collision_time**2)
368
369# 39 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
370#if defined(MFC_OpenACC)
371# 39 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
372!$acc update device(damping_parameter, spring_stiffness)
373# 39 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
374#elif defined(MFC_OpenMP)
375# 39 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
376!$omp target update to(damping_parameter, spring_stiffness)
377# 39 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
378#endif
379
380#ifdef MFC_DEBUG
381# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
382 block
383# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
384 use iso_fortran_env, only: output_unit
385# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
386
387# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
388 print *, 'm_collisions.fpp:41: ', '@:ALLOCATE(collision_lookup(num_ibs * 8, 4))'
389# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
390
391# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
392 call flush (output_unit)
393# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
394 end block
395# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
396#endif
397# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
398 allocate (collision_lookup(num_ibs * 8, 4))
399# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
400
401# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
402
403# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
404#if defined(MFC_OpenACC)
405# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
406!$acc enter data create(collision_lookup)
407# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
408#elif defined(MFC_OpenMP)
409# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
410!$omp target enter data map(always,alloc:collision_lookup)
411# 41 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
412#endif
413#ifdef MFC_DEBUG
414# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
415 block
416# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
417 use iso_fortran_env, only: output_unit
418# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
419
420# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
421 print *, 'm_collisions.fpp:42: ', '@:ALLOCATE(wall_overlap_distances(num_ibs, 6))'
422# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
423
424# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
425 call flush (output_unit)
426# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
427 end block
428# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
429#endif
430# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
431 allocate (wall_overlap_distances(num_ibs, 6))
432# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
433
434# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
435
436# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
437#if defined(MFC_OpenACC)
438# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
439!$acc enter data create(wall_overlap_distances)
440# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
441#elif defined(MFC_OpenMP)
442# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
443!$omp target enter data map(always,alloc:wall_overlap_distances)
444# 42 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
445#endif
446
447 wall_overlap_distances = 0
448
449# 45 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
450#if defined(MFC_OpenACC)
451# 45 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
452!$acc update device(wall_overlap_distances)
453# 45 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
454#elif defined(MFC_OpenMP)
455# 45 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
456!$omp target update to(wall_overlap_distances)
457# 45 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
458#endif
459
460# 46 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
461#if defined(MFC_OpenACC)
462# 46 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
463!$acc update device(ib_coefficient_of_friction)
464# 46 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
465#elif defined(MFC_OpenMP)
466# 46 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
467!$omp target update to(ib_coefficient_of_friction)
468# 46 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
469#endif
470
471 end subroutine s_initialize_collisions_module
472
473 subroutine s_apply_collision_forces(ghost_points, num_gps, ib_markers, forces, torques)
474
475 type(ghost_point), dimension(:), intent(in) :: ghost_points
476 integer, intent(in) :: num_gps
477 type(integer_field), intent(in) :: ib_markers
478 real(wp), dimension(num_ibs, 3), intent(inout) :: forces, torques
479 integer :: num_considered_collisions
480
481 ! return if no collisions
482
483 if (collision_model == 0) return
484
485 ! get is distance used in the force calculation with each IB and each wall
486 call s_detect_wall_collisions()
487 call s_detect_ib_collisions(ghost_points, ib_markers, num_gps, num_considered_collisions)
488
489 select case (collision_model)
490 case (1) ! soft sphere model
491 call s_apply_wall_collision_forces_soft_sphere(forces, torques)
492 call s_apply_ib_collision_forces_soft_sphere(num_considered_collisions, forces, torques)
493 end select
494
495 end subroutine s_apply_collision_forces
496
497 !> @brief applies collision forces to IBs assuming a soft-sphere collision model (all IBs are circles or spheres)
498 subroutine s_apply_ib_collision_forces_soft_sphere(num_considered_collisions, forces, torques)
499
500 integer, intent(in) :: num_considered_collisions
501 real(wp), dimension(num_ibs, 3), intent(inout) :: forces, torques
502 integer :: i, encoded_pid1, encoded_pid2, xp1, xp2, yp1, yp2, zp1, zp2, pid1, pid2, l ! iterators and patch IDs
503 real(wp) :: overlap_distance
504 real(wp), dimension(3) :: normal_vector, centroid_1, centroid_2
505 real(wp), dimension(3) :: normal_velocity, tangental_vector, normal_force, tangental_force, torque, radial_vector, &
506 & rotation_velocity, vel1, vel2
507 real(wp) :: k, eta, effective_mass ! the spring stiffness and damping coefficient and mass of a specific interaction
508
509 if (num_considered_collisions == 0) return
510
511 ! print *, "Checking Collisions: ", num_considered_collisions, " on rank ", proc_rank
512
513 ! Iterate over all collisions detected
514
515# 91 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
516
517# 91 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
518#if defined(MFC_OpenACC)
519# 91 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
520!$acc parallel loop gang vector default(present) private(i, l, encoded_pid1, encoded_pid2, xp1, xp2, yp1, yp2, zp1, zp2, pid1, pid2, centroid_1, centroid_2, normal_vector, overlap_distance, effective_mass, k, eta, normal_velocity, tangental_vector, normal_force, tangental_force, torque, radial_vector, rotation_velocity, vel1, vel2) copy(forces, torques)
521# 91 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
522#elif defined(MFC_OpenMP)
523# 91 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
524
525# 91 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
526
527# 91 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
528
529# 91 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
530!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, l, encoded_pid1, encoded_pid2, xp1, xp2, yp1, yp2, zp1, zp2, pid1, pid2, centroid_1, centroid_2, normal_vector, overlap_distance, effective_mass, k, eta, normal_velocity, tangental_vector, normal_force, tangental_force, torque, radial_vector, rotation_velocity, vel1, vel2) map(tofrom:forces, torques)
531# 91 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
532#endif
533# 95 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
534 do i = 1, num_considered_collisions
535 encoded_pid1 = collision_lookup(i, 3)
536 encoded_pid2 = collision_lookup(i, 4)
537 call s_decode_patch_periodicity(encoded_pid1, pid1, xp1, yp1, zp1)
538 call s_decode_patch_periodicity(encoded_pid2, pid2, xp2, yp2, zp2)
539
540 centroid_1(1) = patch_ib(pid1)%x_centroid + real(xp1, wp)*(x_domain%end - x_domain%beg)
541 centroid_1(2) = patch_ib(pid1)%y_centroid + real(yp1, wp)*(y_domain%end - y_domain%beg)
542 centroid_1(3) = 0._wp
543 centroid_2(1) = patch_ib(pid2)%x_centroid + real(xp2, wp)*(x_domain%end - x_domain%beg)
544 centroid_2(2) = patch_ib(pid2)%y_centroid + real(yp2, wp)*(y_domain%end - y_domain%beg)
545 centroid_2(3) = 0._wp
546 if (num_dims == 3) then
547 centroid_1(3) = patch_ib(pid1)%z_centroid + real(zp1, wp)*(z_domain%end - z_domain%beg)
548 centroid_2(3) = patch_ib(pid2)%z_centroid + real(zp2, wp)*(z_domain%end - z_domain%beg)
549 end if
550
551 normal_vector = centroid_2 - centroid_1
552 overlap_distance = patch_ib(pid1)%radius + patch_ib(pid2)%radius - norm2(normal_vector)
553 if (overlap_distance > 0._wp) then ! if the two patches are close enough to collide
554 normal_vector = normal_vector/norm2(normal_vector)
555 if (f_local_rank_owns_collision(centroid_1)) then
556 ! compute constants of the collision
557 effective_mass = 1.0_wp/((1.0_wp/patch_ib(pid1)%mass) + (1._wp/(patch_ib(pid2)%mass)))
558 k = spring_stiffness*effective_mass
559 eta = damping_parameter*effective_mass
560
561 ! Get the vectors and velcoities
562 radial_vector = normal_vector*(patch_ib(pid1)%radius - 0.5_wp*overlap_distance)
563 call s_cross_product(patch_ib(pid1)%angular_vel, radial_vector, rotation_velocity)
564 vel1 = patch_ib(pid1)%vel + rotation_velocity
565 radial_vector = normal_vector*(-1.0_wp)*(patch_ib(pid2)%radius - 0.5_wp*overlap_distance)
566 call s_cross_product(patch_ib(pid2)%angular_vel, radial_vector, rotation_velocity)
567 vel2 = patch_ib(pid2)%vel + rotation_velocity
568
569 normal_velocity = dot_product(vel1 - vel2, normal_vector)*normal_vector
570 tangental_vector = (vel1 - vel2) - normal_velocity
571 if (.not. f_approx_equal(norm2(tangental_vector), &
572 & 0._wp)) tangental_vector = tangental_vector/norm2(tangental_vector)
573
574 ! compute force and torque
575 normal_force = -k*overlap_distance*normal_vector - eta*normal_velocity
576 tangental_force = -ib_coefficient_of_friction*norm2(normal_force)*tangental_vector
577 call s_cross_product(normal_vector*patch_ib(pid1)%radius, tangental_force, torque)
578
579 do l = 1, num_dims
580 ! update the first IB
581
582# 142 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
583#if defined(MFC_OpenACC)
584# 142 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
585!$acc atomic update
586# 142 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
587#elif defined(MFC_OpenMP)
588# 142 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
589!$omp atomic update
590# 142 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
591#endif
592 forces(pid1, l) = forces(pid1, l) + (normal_force(l) + tangental_force(l))
593
594# 144 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
595#if defined(MFC_OpenACC)
596# 144 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
597!$acc atomic update
598# 144 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
599#elif defined(MFC_OpenMP)
600# 144 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
601!$omp atomic update
602# 144 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
603#endif
604 torques(pid1, l) = torques(pid1, l) + torque(l)
605
606 ! apply equal and opposite force/torque to second IB
607
608# 148 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
609#if defined(MFC_OpenACC)
610# 148 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
611!$acc atomic update
612# 148 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
613#elif defined(MFC_OpenMP)
614# 148 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
615!$omp atomic update
616# 148 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
617#endif
618 forces(pid2, l) = forces(pid2, l) - (normal_force(l) + tangental_force(l))
619
620# 150 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
621#if defined(MFC_OpenACC)
622# 150 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
623!$acc atomic update
624# 150 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
625#elif defined(MFC_OpenMP)
626# 150 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
627!$omp atomic update
628# 150 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
629#endif
630 torques(pid2, l) = torques(pid2, l) - torque(l)*patch_ib(pid2)%radius/patch_ib(pid1)%radius
631 end do
632 end if
633 end if
634 end do
635
636# 156 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
637#if defined(MFC_OpenACC)
638# 156 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
639!$acc end parallel loop
640# 156 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
641#elif defined(MFC_OpenMP)
642# 156 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
643
644# 156 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
645!$omp end target teams loop
646# 156 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
647#endif
648
649 end subroutine s_apply_ib_collision_forces_soft_sphere
650
651 !> @brief applies collision forces to IBs assuming a soft-sphere collision model (all IBs are circles or spheres)
652 subroutine s_apply_wall_collision_forces_soft_sphere(forces, torques)
653
654 real(wp), dimension(num_ibs, 3), intent(inout) :: forces, torques
655 integer :: patch_id, i, l
656 real(wp), dimension(3) :: normal_force, tangental_force, normal_vector, normal_velocity, tangental_vector, &
657 & collision_location, torque, radial_vector, rotation_velocity, velocity
658 real(wp) :: k, eta ! the spring stiffness and damping coefficient for a specific IB
659
660
661# 169 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
662
663# 169 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
664#if defined(MFC_OpenACC)
665# 169 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
666!$acc parallel loop collapse(2) gang vector default(present) private(patch_id, i, l, collision_location, normal_vector, k, eta, normal_velocity, tangental_vector, normal_force, tangental_force, torque, radial_vector, rotation_velocity, velocity) copy(forces, torques)
667# 169 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
668#elif defined(MFC_OpenMP)
669# 169 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
670
671# 169 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
672
673# 169 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
674
675# 169 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
676!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(2) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(patch_id, i, l, collision_location, normal_vector, k, eta, normal_velocity, tangental_vector, normal_force, tangental_force, torque, radial_vector, rotation_velocity, velocity) map(tofrom:forces, torques)
677# 169 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
678#endif
679# 172 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
680 do patch_id = 1, num_ibs
681 do i = 1, num_dims*2
682 ! only compute force contributions if there was an overlap
683 if (f_approx_equal(wall_overlap_distances(patch_id, i), 0._wp)) cycle
684
685 select case (i)
686 case (1) ! x domain left
687 normal_vector = [-1._wp, 0._wp, 0._wp]
688 case (2) ! x domain right
689 normal_vector = [1._wp, 0._wp, 0._wp]
690 case (3) ! y domain bottom
691 normal_vector = [0._wp, -1._wp, 0._wp]
692 case (4) ! y domain top
693 normal_vector = [0._wp, 1._wp, 0._wp]
694 case (5) ! z domain back
695 normal_vector = [0._wp, 0._wp, -1._wp]
696 case (6) ! z domain front
697 normal_vector = [0._wp, 0._wp, 1._wp]
698 end select
699
700 ! ensure the local rank owns that collision before proceeding
701 collision_location = [patch_ib(patch_id)%x_centroid, patch_ib(patch_id)%y_centroid, 0._wp]
702 if (num_dims == 3) collision_location(3) = patch_ib(patch_id)%z_centroid
703 if (f_local_rank_owns_collision(collision_location)) then
704 k = spring_stiffness*patch_ib(patch_id)%mass
705 eta = damping_parameter*patch_ib(patch_id)%mass
706
707 ! get the vector that points from the centroid to the point of collision
708 radial_vector = normal_vector*(patch_ib(patch_id)%radius - wall_overlap_distances(patch_id, i))
709 ! convert the angular velocity to linear velocity
710 call s_cross_product(patch_ib(patch_id)%angular_vel, radial_vector, rotation_velocity)
711 velocity = patch_ib(patch_id)%vel + rotation_velocity
712
713 ! standard soft-sphere collision with the wall
714 normal_velocity = dot_product(velocity, normal_vector)*normal_vector
715 tangental_vector = velocity - normal_velocity
716 if (.not. f_approx_equal(norm2(tangental_vector), &
717 & 0._wp)) tangental_vector = tangental_vector/norm2(tangental_vector)
718 normal_force = -k*wall_overlap_distances(patch_id, i)*normal_vector - eta*normal_velocity
719 tangental_force = -ib_coefficient_of_friction*norm2(normal_force)*tangental_vector
720 call s_cross_product(normal_vector*patch_ib(patch_id)%radius, tangental_force, torque)
721
722 do l = 1, num_dims
723
724# 215 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
725#if defined(MFC_OpenACC)
726# 215 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
727!$acc atomic update
728# 215 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
729#elif defined(MFC_OpenMP)
730# 215 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
731!$omp atomic update
732# 215 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
733#endif
734 forces(patch_id, l) = forces(patch_id, l) + (normal_force(l) + tangental_force(l))
735
736# 217 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
737#if defined(MFC_OpenACC)
738# 217 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
739!$acc atomic update
740# 217 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
741#elif defined(MFC_OpenMP)
742# 217 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
743!$omp atomic update
744# 217 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
745#endif
746 torques(patch_id, l) = torques(patch_id, l) + torque(l)
747 end do
748 end if
749 end do
750 end do
751
752# 223 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
753#if defined(MFC_OpenACC)
754# 223 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
755!$acc end parallel loop
756# 223 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
757#elif defined(MFC_OpenMP)
758# 223 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
759
760# 223 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
761!$omp end target teams loop
762# 223 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
763#endif
764
765 end subroutine s_apply_wall_collision_forces_soft_sphere
766
767 !> uses ghost-point/image-point information to determine if it is possible if two IBs are colliding, effectively an optimized
768 !! nearest neighbor search
769 subroutine s_detect_ib_collisions(gps, ib_markers, num_gps, num_considered_collisions)
770
771 type(ghost_point), dimension(num_gps), intent(in) :: gps
772 type(integer_field), intent(in) :: ib_markers
773 integer, intent(in) :: num_gps
774 integer, intent(out) :: num_considered_collisions
775 integer :: i, j, k, z_bound, ii, jj, kk
776 integer, dimension(2) :: decoded_pairs
777 integer :: gp_idx, gp_patch_id, neighbor_patch_id
778 integer :: pair_idx, out_idx
779 logical :: already_found
780
781 ! Temporary array to hold all detected pairs (with potential duplicates)
782 integer, dimension(num_gps, 2) :: raw_pairs
783 integer :: num_raw, local_num_raw
784
785 num_raw = 0
786 z_bound = 0; if (num_dims == 3) z_bound = 1
787
788
789# 248 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
790
791# 248 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
792#if defined(MFC_OpenACC)
793# 248 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
794!$acc parallel loop gang vector default(present) private(gp_idx, gp_patch_id, neighbor_patch_id, local_num_raw, i, j, k, ii, jj, kk) copy(raw_pairs, num_raw) copyin(z_bound)
795# 248 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
796#elif defined(MFC_OpenMP)
797# 248 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
798
799# 248 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
800
801# 248 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
802
803# 248 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
804!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(gp_idx, gp_patch_id, neighbor_patch_id, local_num_raw, i, j, k, ii, jj, kk) map(tofrom:raw_pairs, num_raw) map(to:z_bound)
805# 248 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
806#endif
807# 250 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
808 do gp_idx = 1, num_gps
809 i = gps(gp_idx)%loc(1)
810 j = gps(gp_idx)%loc(2)
811 k = 0; if (num_dims == 3) k = gps(gp_idx)%loc(3)
812 gp_patch_id = ib_markers%sf(i, j, k)
813
814 ! search in a cube around the BG for Ib markers belonging to another patch
815 neighbor_search: do ii = i - 1, i + 1
816 do jj = j - 1, j + 1
817 do kk = k - z_bound, k + z_bound
818 neighbor_patch_id = ib_markers%sf(ii, jj, kk)
819
820 ! If any neighbors are of a different/higher marker value, we consider it for possible collision
821 if (gp_patch_id < neighbor_patch_id) then
822
823# 264 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
824#if defined(MFC_OpenACC)
825# 264 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
826!$acc atomic capture
827# 264 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
828#elif defined(MFC_OpenMP)
829# 264 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
830!$omp atomic capture
831# 264 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
832#endif
833 num_raw = num_raw + 1
834 local_num_raw = num_raw
835#if defined(MFC_OpenACC)
836# 267 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
837!$acc end atomic
838# 267 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
839#elif defined(MFC_OpenMP)
840# 267 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
841!$omp end atomic
842# 267 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
843#endif
844
845 ! Store with smaller ID first for consistent ordering
846 raw_pairs(local_num_raw, 1) = gp_patch_id
847 raw_pairs(local_num_raw, 2) = neighbor_patch_id
848 exit neighbor_search
849 end if
850 end do
851 end do
852 end do neighbor_search
853 end do
854
855# 278 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
856#if defined(MFC_OpenACC)
857# 278 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
858!$acc end parallel loop
859# 278 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
860#elif defined(MFC_OpenMP)
861# 278 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
862
863# 278 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
864!$omp end target teams loop
865# 278 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
866#endif
867
868 ! Coalesce collisions unique pairs
869 num_considered_collisions = 0
870 collision_lookup = 0
871 ! for each pair found in the raw collection
872 do pair_idx = 1, num_raw
873 already_found = .false.
874
875 ! get the decoded pairs for checking if they exist, using ii,jj,kk as dummy indices
876 call s_decode_patch_periodicity(raw_pairs(pair_idx, 1), decoded_pairs(1), ii, jj, kk)
877 call s_decode_patch_periodicity(raw_pairs(pair_idx, 2), decoded_pairs(2), ii, jj, kk)
878
879 ! skip self-collisions (an IB cannot collide with its own periodic image)
880 if (decoded_pairs(1) == decoded_pairs(2)) cycle
881
882 ! need to swap to guarantee the smaller decoded marker value is in index 1 and prevent double-counting
883 if (decoded_pairs(2) < decoded_pairs(1)) then
884 decoded_pairs(1) = decoded_pairs(1) + decoded_pairs(2)
885 decoded_pairs(2) = decoded_pairs(1) - decoded_pairs(2)
886 decoded_pairs(1) = decoded_pairs(1) - decoded_pairs(2)
887 raw_pairs(pair_idx, 1) = raw_pairs(pair_idx, 1) + raw_pairs(pair_idx, 2)
888 raw_pairs(pair_idx, 2) = raw_pairs(pair_idx, 1) - raw_pairs(pair_idx, 2)
889 raw_pairs(pair_idx, 1) = raw_pairs(pair_idx, 1) - raw_pairs(pair_idx, 2)
890 end if
891
892 ! check if it is already in the list
893 do out_idx = 1, num_considered_collisions
894 if (collision_lookup(out_idx, 1) == decoded_pairs(1) .and. collision_lookup(out_idx, 2) == decoded_pairs(2)) then
895 already_found = .true.
896 exit
897 end if
898 end do
899
900 ! and if it is not, append it to the list of pairs
901 if (.not. already_found) then
902 num_considered_collisions = num_considered_collisions + 1
903 collision_lookup(num_considered_collisions, 1) = decoded_pairs(1)
904 collision_lookup(num_considered_collisions, 2) = decoded_pairs(2)
905 collision_lookup(num_considered_collisions, 3) = raw_pairs(pair_idx, 1)
906 collision_lookup(num_considered_collisions, 4) = raw_pairs(pair_idx, 2)
907 end if
908 end do
909
910# 321 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
911#if defined(MFC_OpenACC)
912# 321 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
913!$acc update device(collision_lookup)
914# 321 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
915#elif defined(MFC_OpenMP)
916# 321 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
917!$omp target update to(collision_lookup)
918# 321 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
919#endif
920
921 end subroutine s_detect_ib_collisions
922
923 subroutine s_detect_ib_collisions_n2(num_considered_collisions)
924
925 integer, intent(out) :: num_considered_collisions
926 integer :: pid1, pid2, encoded_pid1, encoded_pid2, current_collisions
927 real(wp), dimension(3) :: centroid_1, centroid_2, distance_vec
928
929 num_considered_collisions = 0
930
931
932# 333 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
933
934# 333 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
935#if defined(MFC_OpenACC)
936# 333 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
937!$acc parallel loop gang vector default(present) private(pid1, pid2, centroid_1, centroid_2, distance_vec, current_collisions) copy(num_considered_collisions)
938# 333 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
939#elif defined(MFC_OpenMP)
940# 333 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
941
942# 333 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
943
944# 333 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
945
946# 333 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
947!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(pid1, pid2, centroid_1, centroid_2, distance_vec, current_collisions) map(tofrom:num_considered_collisions)
948# 333 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
949#endif
950# 335 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
951 do pid1 = 1, num_ibs - 1
952 do pid2 = pid1 + 1, num_ibs
953 centroid_1 = [patch_ib(pid1)%x_centroid, patch_ib(pid1)%y_centroid, 0._wp]
954 centroid_2 = [patch_ib(pid2)%x_centroid, patch_ib(pid2)%y_centroid, 0._wp]
955 if (num_dims == 3) then
956 centroid_1(3) = patch_ib(pid1)%z_centroid
957 centroid_2(3) = patch_ib(pid2)%z_centroid
958 end if
959 distance_vec = centroid_2 - centroid_1
960
961 if (norm2(distance_vec) < patch_ib(pid1)%radius + patch_ib(pid2)%radius) then
962
963# 346 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
964#if defined(MFC_OpenACC)
965# 346 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
966!$acc atomic capture
967# 346 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
968#elif defined(MFC_OpenMP)
969# 346 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
970!$omp atomic capture
971# 346 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
972#endif
973 num_considered_collisions = num_considered_collisions + 1
974 current_collisions = num_considered_collisions
975#if defined(MFC_OpenACC)
976# 349 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
977!$acc end atomic
978# 349 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
979#elif defined(MFC_OpenMP)
980# 349 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
981!$omp end atomic
982# 349 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
983#endif
984
985 collision_lookup(current_collisions, 1) = pid1
986 collision_lookup(current_collisions, 2) = pid2
987 end if
988 end do
989 end do
990
991# 356 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
992#if defined(MFC_OpenACC)
993# 356 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
994!$acc end parallel loop
995# 356 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
996#elif defined(MFC_OpenMP)
997# 356 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
998
999# 356 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1000!$omp end target teams loop
1001# 356 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1002#endif
1003
1004 end subroutine s_detect_ib_collisions_n2
1005
1006 !> @brief uses boundary conditions and particle locations to check for wall conditions
1007 subroutine s_detect_wall_collisions()
1008
1009 integer :: gp_idx, i, j, k, patch_id
1010 real(wp) :: edge_location, overlap_distance
1011
1012 ! iterate over all ghost points to detect the one that is most-overlapping in each direction
1013
1014
1015# 368 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1016
1017# 368 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1018#if defined(MFC_OpenACC)
1019# 368 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1020!$acc parallel loop gang vector default(present) private(patch_id, edge_location, overlap_distance)
1021# 368 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1022#elif defined(MFC_OpenMP)
1023# 368 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1024
1025# 368 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1026
1027# 368 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1028
1029# 368 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1030!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(patch_id, edge_location, overlap_distance)
1031# 368 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1032#endif
1033 do patch_id = 1, num_ibs
1034# 371 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1035 ! check if the boundaries are either of the two conditions we should compute collisions with
1036 if (ib_bc_x%beg == bc_slip_wall .or. ib_bc_x%beg == bc_no_slip_wall) then
1037 ! get the location of the true IB surface towards the domain boundary
1038 edge_location = patch_ib(patch_id)%x_centroid - patch_ib(patch_id)%radius
1039 ! check if that edge actually extends out of the comutational domain
1040 if (edge_location < x_domain%beg) then
1041 overlap_distance = x_domain%beg - edge_location ! the distance that the IB extends out of the domain
1042 else
1043 overlap_distance = 0._wp
1044 end if
1045 wall_overlap_distances(patch_id, 1) = overlap_distance
1046 end if
1047
1048 if (ib_bc_x%end == bc_slip_wall .or. ib_bc_x%end == bc_no_slip_wall) then
1049 edge_location = patch_ib(patch_id)%x_centroid + patch_ib(patch_id)%radius
1050 if (edge_location > x_domain%end) then
1051 overlap_distance = edge_location - x_domain%end
1052 else
1053 overlap_distance = 0._wp
1054 end if
1055 wall_overlap_distances(patch_id, 1 + 1) = overlap_distance
1056 end if
1057# 371 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1058 ! check if the boundaries are either of the two conditions we should compute collisions with
1059 if (ib_bc_y%beg == bc_slip_wall .or. ib_bc_y%beg == bc_no_slip_wall) then
1060 ! get the location of the true IB surface towards the domain boundary
1061 edge_location = patch_ib(patch_id)%y_centroid - patch_ib(patch_id)%radius
1062 ! check if that edge actually extends out of the comutational domain
1063 if (edge_location < y_domain%beg) then
1064 overlap_distance = y_domain%beg - edge_location ! the distance that the IB extends out of the domain
1065 else
1066 overlap_distance = 0._wp
1067 end if
1068 wall_overlap_distances(patch_id, 3) = overlap_distance
1069 end if
1070
1071 if (ib_bc_y%end == bc_slip_wall .or. ib_bc_y%end == bc_no_slip_wall) then
1072 edge_location = patch_ib(patch_id)%y_centroid + patch_ib(patch_id)%radius
1073 if (edge_location > y_domain%end) then
1074 overlap_distance = edge_location - y_domain%end
1075 else
1076 overlap_distance = 0._wp
1077 end if
1078 wall_overlap_distances(patch_id, 3 + 1) = overlap_distance
1079 end if
1080# 371 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1081 ! check if the boundaries are either of the two conditions we should compute collisions with
1082 if (ib_bc_z%beg == bc_slip_wall .or. ib_bc_z%beg == bc_no_slip_wall) then
1083 ! get the location of the true IB surface towards the domain boundary
1084 edge_location = patch_ib(patch_id)%z_centroid - patch_ib(patch_id)%radius
1085 ! check if that edge actually extends out of the comutational domain
1086 if (edge_location < z_domain%beg) then
1087 overlap_distance = z_domain%beg - edge_location ! the distance that the IB extends out of the domain
1088 else
1089 overlap_distance = 0._wp
1090 end if
1091 wall_overlap_distances(patch_id, 5) = overlap_distance
1092 end if
1093
1094 if (ib_bc_z%end == bc_slip_wall .or. ib_bc_z%end == bc_no_slip_wall) then
1095 edge_location = patch_ib(patch_id)%z_centroid + patch_ib(patch_id)%radius
1096 if (edge_location > z_domain%end) then
1097 overlap_distance = edge_location - z_domain%end
1098 else
1099 overlap_distance = 0._wp
1100 end if
1101 wall_overlap_distances(patch_id, 5 + 1) = overlap_distance
1102 end if
1103# 394 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1104 end do
1105
1106# 395 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1107#if defined(MFC_OpenACC)
1108# 395 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1109!$acc end parallel loop
1110# 395 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1111#elif defined(MFC_OpenMP)
1112# 395 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1113
1114# 395 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1115!$omp end target teams loop
1116# 395 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1117#endif
1118
1119 end subroutine s_detect_wall_collisions
1120
1121 !> @brief function checks if this local MPI processor owns this specific collision
1122 function f_local_rank_owns_collision(collision_location) result(owns_collision)
1123
1124
1125# 402 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1126#if MFC_OpenACC
1127# 402 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1128!$acc routine seq
1129# 402 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1130#elif MFC_OpenMP
1131# 402 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1132
1133# 402 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1134
1135# 402 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1136!$omp declare target device_type(any)
1137# 402 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1138#endif
1139
1140 real(wp), dimension(3), intent(in) :: collision_location
1141 logical :: owns_collision
1142 real(wp), dimension(3) :: projected_location
1143
1144# 435 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1145 owns_collision = .true.
1146# 437 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1147
1148 end function f_local_rank_owns_collision
1149
1150 subroutine s_finalize_collisions_module()
1151
1152#ifdef MFC_DEBUG
1153# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1154 block
1155# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1156 use iso_fortran_env, only: output_unit
1157# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1158
1159# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1160 print *, 'm_collisions.fpp:442: ', '@:DEALLOCATE(collision_lookup)'
1161# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1162
1163# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1164 call flush (output_unit)
1165# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1166 end block
1167# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1168#endif
1169# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1170
1171# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1172#if defined(MFC_OpenACC)
1173# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1174!$acc exit data delete(collision_lookup)
1175# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1176#elif defined(MFC_OpenMP)
1177# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1178!$omp target exit data map(release:collision_lookup)
1179# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1180#endif
1181# 442 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1182 deallocate (collision_lookup)
1183#ifdef MFC_DEBUG
1184# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1185 block
1186# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1187 use iso_fortran_env, only: output_unit
1188# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1189
1190# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1191 print *, 'm_collisions.fpp:443: ', '@:DEALLOCATE(wall_overlap_distances)'
1192# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1193
1194# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1195 call flush (output_unit)
1196# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1197 end block
1198# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1199#endif
1200# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1201
1202# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1203#if defined(MFC_OpenACC)
1204# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1205!$acc exit data delete(wall_overlap_distances)
1206# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1207#elif defined(MFC_OpenMP)
1208# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1209!$omp target exit data map(release:wall_overlap_distances)
1210# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1211#endif
1212# 443 "/home/runner/work/MFC/MFC/src/simulation/m_collisions.fpp"
1213 deallocate (wall_overlap_distances)
1214
1215 end subroutine s_finalize_collisions_module
1216
1217end module m_collisions
m_collisions
Ghost-node immersed boundary method: locates ghost/image points, computes interpolation coefficients,...
Definition m_collisions.fpp.f90:318
m_collisions::damping_parameter
real(wp) damping_parameter
Definition m_collisions.fpp.f90:335
m_collisions::f_local_rank_owns_collision
logical function f_local_rank_owns_collision(collision_location)
function checks if this local MPI processor owns this specific collision
Definition m_collisions.fpp.f90:1123
m_collisions::wall_overlap_distances
real(wp), dimension(:,:), allocatable wall_overlap_distances
Definition m_collisions.fpp.f90:334
m_collisions::s_detect_wall_collisions
subroutine s_detect_wall_collisions()
uses boundary conditions and particle locations to check for wall conditions
Definition m_collisions.fpp.f90:1008
m_collisions::s_finalize_collisions_module
subroutine, public s_finalize_collisions_module()
Definition m_collisions.fpp.f90:1151
m_collisions::s_detect_ib_collisions
subroutine s_detect_ib_collisions(gps, ib_markers, num_gps, num_considered_collisions)
uses ghost-point/image-point information to determine if it is possible if two IBs are colliding,...
Definition m_collisions.fpp.f90:770
m_collisions::s_initialize_collisions_module
subroutine, public s_initialize_collisions_module()
Definition m_collisions.fpp.f90:362
m_collisions::s_apply_ib_collision_forces_soft_sphere
subroutine s_apply_ib_collision_forces_soft_sphere(num_considered_collisions, forces, torques)
applies collision forces to IBs assuming a soft-sphere collision model (all IBs are circles or sphere...
Definition m_collisions.fpp.f90:499
m_collisions::spring_stiffness
real(wp) spring_stiffness
Definition m_collisions.fpp.f90:335
m_collisions::s_apply_collision_forces
subroutine, public s_apply_collision_forces(ghost_points, num_gps, ib_markers, forces, torques)
Definition m_collisions.fpp.f90:474
m_collisions::collision_lookup
integer, dimension(:,:), allocatable collision_lookup
Definition m_collisions.fpp.f90:333
m_collisions::s_apply_wall_collision_forces_soft_sphere
subroutine s_apply_wall_collision_forces_soft_sphere(forces, torques)
applies collision forces to IBs assuming a soft-sphere collision model (all IBs are circles or sphere...
Definition m_collisions.fpp.f90:653
m_collisions::s_detect_ib_collisions_n2
subroutine s_detect_ib_collisions_n2(num_considered_collisions)
Definition m_collisions.fpp.f90:924
m_compute_levelset
Computes signed-distance level-set fields and surface normals for immersed-boundary patch geometries.
Definition m_compute_levelset.fpp.f90:317
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::pi
real(wp), parameter pi
Pi.
Definition m_constants.fpp.f90:16
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:317
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:328
m_global_parameters::collision_time
real(wp) collision_time
Definition m_global_parameters.fpp.f90:983
m_global_parameters::coefficient_of_restitution
real(wp) coefficient_of_restitution
Definition m_global_parameters.fpp.f90:982
m_global_parameters::num_ibs
integer num_ibs
Definition m_global_parameters.fpp.f90:980
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:317
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:328
m_ib_patches
Allocate memory and read initial condition data for IC extrusion.
Definition m_ib_patches.fpp.f90:387
m_model
Binary STL file reader and processor for immersed boundary geometry.
Definition m_model.fpp.f90:318