MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_bubbles_EL_kernels.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
2!>
3!! @file
4!! @brief Contains module @ref m_bubbles_el_kernels "m_bubbles_EL_kernels"
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# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
21! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
22! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
23# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
24# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
25# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
26
27# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29
30# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31
32# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
33
34# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
35
36# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37
38# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39
40# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45! New line at end of file is required for FYPP
46# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
47# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
48# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
49# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54
55# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58
59# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
61! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
62! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
63# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
64# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
65# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
66
67# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73
74# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
75
76# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
77
78# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
79
80# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81
82# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83
84# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
85! New line at end of file is required for FYPP
86# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
87
88# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
92# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 95 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 100 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 105 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 110 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 115 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 120 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 125 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 130 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 135 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 165 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 219 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 233 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 258 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 269 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 271 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139# 282 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 332 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 342 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 361 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 378 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 388 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 395 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154
155# 401 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
156
157# 407 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
158
159# 413 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
160
161# 419 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
162
163# 425 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
164! New line at end of file is required for FYPP
165# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
166# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
167# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
168# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
180! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
181! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
182# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
183# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
184# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
185
186# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
187# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
188
189# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
190
191# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
192
193# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
194
195# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
196
197# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
198
199# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
200
201# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
202
203# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
204! New line at end of file is required for FYPP
205# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
206
207# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236
237# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
238
239# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
240
241# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
242
243# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
244
245# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
246
247# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
248
249# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
250
251# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
252
253# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
254
255# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
256
257# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
258
259# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
260
261# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
262! New line at end of file is required for FYPP
263# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
264
265! GPU parallel region (scalar reductions, maxval/minval)
266# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! GPU parallel loop over threads (most common GPU macro)
269# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Required closing for GPU_PARALLEL_LOOP
272# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Mark routine for device compilation
275# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Declare device-resident data
278# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Inner loop within a GPU parallel region
281# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Scoped GPU data region
284# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Host code with device pointers (for MPI with GPU buffers)
287# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Allocate device memory (unscoped)
290# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Free device memory
293# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Atomic operation on device
296# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! End atomic capture block
299# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301! Copy data between host and device
302# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303
304! Synchronization barrier
305# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
306
307! Import GPU library module (openacc or omp_lib)
308# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
309
310! Emit code only for AMD compiler
311# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
312
313! Emit code for non-Cray compilers
314# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
315
316! Emit code only for Cray compiler
317# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
318
319! Emit code for non-NVIDIA compilers
320# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
321
322# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
323# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
324! New line at end of file is required for FYPP
325# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
326
327# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
328
329! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
330! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
331! example see misc/nvidia_uvm/bind.sh.
332# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
333
334! Allocate and create GPU device memory
335# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
336
337! Free GPU device memory and deallocate
338# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
339
340! Cray-specific GPU pointer setup for vector fields
341# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
342
343! Cray-specific GPU pointer setup for scalar fields
344# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
345
346! Cray-specific GPU pointer setup for acoustic source spatials
347# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
348
349# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
350
351# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
352! New line at end of file is required for FYPP
353# 6 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp" 2
354
355!> @brief Kernel functions (Gaussian, delta) that smear Lagrangian bubble effects onto the Eulerian grid
356module m_bubbles_el_kernels
357
358 use m_mpi_proxy
359
360 implicit none
361
362 ! Cell-centered pressure gradients (precomputed for translational motion)
363 real(wp), allocatable, dimension(:,:,:) :: grad_p_x, grad_p_y, grad_p_z
364
365# 16 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
366#if defined(MFC_OpenACC)
367# 16 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
368!$acc declare create(grad_p_x, grad_p_y, grad_p_z)
369# 16 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
370#elif defined(MFC_OpenMP)
371# 16 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
372!$omp declare target (grad_p_x, grad_p_y, grad_p_z)
373# 16 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
374#endif
375# 17 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
376
377 ! Finite-difference coefficients for pressure gradient computation
378 real(wp), allocatable, dimension(:,:) :: fd_coeff_x_pgrad
379 real(wp), allocatable, dimension(:,:) :: fd_coeff_y_pgrad
380 real(wp), allocatable, dimension(:,:) :: fd_coeff_z_pgrad
381
382# 22 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
383#if defined(MFC_OpenACC)
384# 22 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
385!$acc declare create(fd_coeff_x_pgrad, fd_coeff_y_pgrad, fd_coeff_z_pgrad)
386# 22 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
387#elif defined(MFC_OpenMP)
388# 22 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
389!$omp declare target (fd_coeff_x_pgrad, fd_coeff_y_pgrad, fd_coeff_z_pgrad)
390# 22 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
391#endif
392# 23 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
393
394 ! Cell list for bubble-to-cell mapping (rebuilt each RK stage before smearing)
395 integer, allocatable, dimension(:,:,:) :: cell_list_start ! (0:m, 0:n, 0:p)
396 integer, allocatable, dimension(:,:,:) :: cell_list_count ! (0:m, 0:n, 0:p)
397 integer, allocatable, dimension(:) :: cell_list_idx ! (1:nBubs_glb) sorted bubble indices
398
399# 28 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
400#if defined(MFC_OpenACC)
401# 28 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
402!$acc declare create(cell_list_start, cell_list_count, cell_list_idx)
403# 28 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
404#elif defined(MFC_OpenMP)
405# 28 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
406!$omp declare target (cell_list_start, cell_list_count, cell_list_idx)
407# 28 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
408#endif
409# 29 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
410
411contains
412
413 !> Smear the Lagrangian bubble effects onto the Eulerian grid using the selected kernel
414 subroutine s_smoothfunction(nBubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar, kcomp)
415
416 integer, intent(in) :: nBubs
417 real(wp), dimension(1:lag_params%nBubs_glb,1:3,1:2), intent(in) :: lbk_s, lbk_pos
418 real(wp), dimension(1:lag_params%nBubs_glb,1:2), intent(in) :: lbk_rad, lbk_vel
419 type(scalar_field), dimension(:), intent(inout) :: updatedvar
420 type(scalar_field), dimension(:), intent(inout) :: kcomp
421
422 smoothfunc:select case(lag_params%smooth_type)
423 case (1)
424 call s_gaussian(nbubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar, kcomp)
425 case (2)
426 call s_deltafunc(nbubs, lbk_rad, lbk_vel, lbk_s, updatedvar, kcomp)
427 end select smoothfunc
428
429 end subroutine s_smoothfunction
430
431 !> Builds a sorted cell list mapping each interior cell (0:m,0:n,0:p) to its resident bubbles. Uses a counting-sort on the host
432 !! (O(nBubs + N_cells)). Must be called before s_gaussian each RK stage.
433 subroutine s_build_cell_list(nBubs, lbk_s)
434
435 integer, intent(in) :: nBubs
436 real(wp), dimension(1:lag_params%nBubs_glb,1:3,1:2), intent(in) :: lbk_s
437 integer :: l, ci, cj, ck, idx
438 real(wp), dimension(3) :: s_coord
439
440 ! Bring current bubble positions to host
441
442
443# 61 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
444#if defined(MFC_OpenACC)
445# 61 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
446!$acc update host(lbk_s)
447# 61 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
448#elif defined(MFC_OpenMP)
449# 61 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
450!$omp target update from(lbk_s)
451# 61 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
452#endif
453# 62 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
454
455 ! Pass 1: zero counts and count bubbles per cell
456 cell_list_count = 0
457 do l = 1, nbubs
458 s_coord(1:3) = lbk_s(l,1:3,2)
459 ci = int(s_coord(1))
460 cj = int(s_coord(2))
461 ck = int(s_coord(3))
462 ! Clamp to interior (bubbles should already be in [0:m,0:n,0:p])
463 ci = max(0, min(ci, m))
464 cj = max(0, min(cj, n))
465 ck = max(0, min(ck, p))
466 cell_list_count(ci, cj, ck) = cell_list_count(ci, cj, ck) + 1
467 end do
468
469 ! Prefix sum to compute start indices (1-based into cell_list_idx)
470 idx = 1
471 do ck = 0, p
472 do cj = 0, n
473 do ci = 0, m
474 cell_list_start(ci, cj, ck) = idx
475 idx = idx + cell_list_count(ci, cj, ck)
476 end do
477 end do
478 end do
479
480 ! Pass 2: place bubble indices into cell_list_idx Temporarily reuse cell_list_count as a running offset
481 cell_list_count = 0
482 do l = 1, nbubs
483 s_coord(1:3) = lbk_s(l,1:3,2)
484 ci = int(s_coord(1))
485 cj = int(s_coord(2))
486 ck = int(s_coord(3))
487 ci = max(0, min(ci, m))
488 cj = max(0, min(cj, n))
489 ck = max(0, min(ck, p))
490 cell_list_idx(cell_list_start(ci, cj, ck) + cell_list_count(ci, cj, ck)) = l
491 cell_list_count(ci, cj, ck) = cell_list_count(ci, cj, ck) + 1
492 end do
493
494 ! Send cell list arrays to GPU
495
496# 103 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
497#if defined(MFC_OpenACC)
498# 103 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
499!$acc update device(cell_list_start, cell_list_count, cell_list_idx)
500# 103 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
501#elif defined(MFC_OpenMP)
502# 103 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
503!$omp target update to(cell_list_start, cell_list_count, cell_list_idx)
504# 103 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
505#endif
506# 104 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
507
508 end subroutine s_build_cell_list
509
510 !> Cell-centric delta-function smearing using the cell list (no GPU atomics). Each bubble only affects the cell it resides in.
511 !! The outer GPU loop iterates over interior cells and sums contributions from resident bubbles.
512 subroutine s_deltafunc(nBubs, lbk_rad, lbk_vel, lbk_s, updatedvar, kcomp)
513
514 integer, intent(in) :: nBubs
515 real(wp), dimension(1:lag_params%nBubs_glb,1:3,1:2), intent(in) :: lbk_s
516 real(wp), dimension(1:lag_params%nBubs_glb,1:2), intent(in) :: lbk_rad, lbk_vel
517 type(scalar_field), dimension(:), intent(inout) :: updatedvar
518 type(scalar_field), dimension(:), intent(inout) :: kcomp
519 real(wp) :: strength_vel, strength_vol
520 real(wp) :: volpart, Vol
521 real(wp) :: y_kahan, t_kahan
522 integer :: i, j, k, lb, bub_idx
523
524
525# 121 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
526
527# 121 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
528#if defined(MFC_OpenACC)
529# 121 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
530!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, lb, bub_idx, volpart, Vol, strength_vel, strength_vol, y_kahan, t_kahan)
531# 121 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
532#elif defined(MFC_OpenMP)
533# 121 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
534
535# 121 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
536
537# 121 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
538
539# 121 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
540!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
541# 121 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
542!$omp& private(i, j, k, lb, bub_idx, volpart, Vol, strength_vel, strength_vol, y_kahan, t_kahan)
543# 121 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
544#endif
545# 123 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
546 do k = 0, p
547 do j = 0, n
548 do i = 0, m
549 ! Cell volume
550 if (num_dims == 2) then
551 vol = dx(i)*dy(j)*lag_params%charwidth
552 if (cyl_coord) vol = dx(i)*dy(j)*y_cc(j)*2._wp*pi
553 else
554 vol = dx(i)*dy(j)*dz(k)
555 end if
556
557 ! Loop over bubbles in this cell
558
559# 135 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
560#if defined(MFC_OpenACC)
561# 135 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
562!$acc loop seq
563# 135 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
564#elif defined(MFC_OpenMP)
565# 135 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
566
567# 135 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
568#endif
569# 136 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
570 do lb = cell_list_start(i, j, k), cell_list_start(i, j, k) + cell_list_count(i, j, k) - 1
571 bub_idx = cell_list_idx(lb)
572
573 volpart = 4._wp/3._wp*pi*lbk_rad(bub_idx, 2)**3._wp
574 strength_vol = volpart
575 strength_vel = 4._wp*pi*lbk_rad(bub_idx, 2)**2._wp*lbk_vel(bub_idx, 2)
576
577 if (lag_params%kahan_summation) then
578 ! Kahan summation for void fraction
579 y_kahan = real(strength_vol/vol, kind=wp) - kcomp(1)%sf(i, j, k)
580 t_kahan = updatedvar(1)%sf(i, j, k) + y_kahan
581 kcomp(1)%sf(i, j, k) = (t_kahan - updatedvar(1)%sf(i, j, k)) - y_kahan
582 updatedvar(1)%sf(i, j, k) = t_kahan
583
584 ! Kahan summation for time derivative of void fraction
585 y_kahan = real(strength_vel/vol, kind=wp) - kcomp(2)%sf(i, j, k)
586 t_kahan = updatedvar(2)%sf(i, j, k) + y_kahan
587 kcomp(2)%sf(i, j, k) = (t_kahan - updatedvar(2)%sf(i, j, k)) - y_kahan
588 updatedvar(2)%sf(i, j, k) = t_kahan
589 else
590 updatedvar(1)%sf(i, j, k) = updatedvar(1)%sf(i, j, k) + real(strength_vol/vol, kind=wp)
591 updatedvar(2)%sf(i, j, k) = updatedvar(2)%sf(i, j, k) + real(strength_vel/vol, kind=wp)
592 end if
593
594 ! Product of two smeared functions
595 if (lag_params%kahan_summation .and. lag_params%cluster_type >= 4) then
596 y_kahan = real((strength_vol*strength_vel)/vol, kind=wp) - kcomp(5)%sf(i, j, k)
597 t_kahan = updatedvar(5)%sf(i, j, k) + y_kahan
598 kcomp(5)%sf(i, j, k) = (t_kahan - updatedvar(5)%sf(i, j, k)) - y_kahan
599 updatedvar(5)%sf(i, j, k) = t_kahan
600 else if (lag_params%cluster_type >= 4) then
601 updatedvar(5)%sf(i, j, k) = updatedvar(5)%sf(i, j, k) + real((strength_vol*strength_vel)/vol, kind=wp)
602 end if
603 end do
604 end do
605 end do
606 end do
607
608# 173 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
609#if defined(MFC_OpenACC)
610# 173 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
611!$acc end parallel loop
612# 173 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
613#elif defined(MFC_OpenMP)
614# 173 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
615
616# 173 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
617!$omp end target teams loop
618# 173 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
619#endif
620# 174 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
621
622 end subroutine s_deltafunc
623
624 !> Cell-centric gaussian smearing using the cell list (no GPU atomics). Each grid cell accumulates contributions from nearby
625 !! bubbles looked up via cell_list_start/count/idx.
626 subroutine s_gaussian(nBubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar, kcomp)
627
628 integer, intent(in) :: nBubs
629 real(wp), dimension(1:lag_params%nBubs_glb,1:3,1:2), intent(in) :: lbk_s, lbk_pos
630 real(wp), dimension(1:lag_params%nBubs_glb,1:2), intent(in) :: lbk_rad, lbk_vel
631 type(scalar_field), dimension(:), intent(inout) :: updatedvar
632 type(scalar_field), dimension(:), intent(inout) :: kcomp
633 real(wp), dimension(3) :: center, nodecoord, s_coord
634 integer, dimension(3) :: cell, cellijk
635 real(wp) :: stddsv, volpart
636 real(wp) :: strength_vel, strength_vol
637 real(wp) :: func, func2
638 real(wp) :: y_kahan, t_kahan
639 integer :: i, j, k, di, dj, dk, lb, bub_idx
640 integer :: di_beg, di_end, dj_beg, dj_end, dk_beg, dk_end
641 integer :: smear_x_beg, smear_x_end
642 integer :: smear_y_beg, smear_y_end
643 integer :: smear_z_beg, smear_z_end
644
645 ! Extended grid range for smearing (includes buffer cells for MPI communication)
646
647 smear_x_beg = -mapcells - 1
648 smear_x_end = m + mapcells + 1
649 smear_y_beg = merge(-mapcells - 1, 0, n > 0)
650 smear_y_end = merge(n + mapcells + 1, n, n > 0)
651 smear_z_beg = merge(-mapcells - 1, 0, p > 0)
652 smear_z_end = merge(p + mapcells + 1, p, p > 0)
653
654
655# 207 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
656
657# 207 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
658#if defined(MFC_OpenACC)
659# 207 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
660!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, di, dj, dk, lb, bub_idx, center, nodecoord, s_coord, cell, cellijk, stddsv, volpart, strength_vel, strength_vol, func, &
661# 207 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
662!$acc& func2, y_kahan, t_kahan, di_beg, di_end, dj_beg, dj_end, dk_beg, dk_end) copyin(smear_x_beg, smear_x_end, smear_y_beg, smear_y_end, smear_z_beg, smear_z_end)
663# 207 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
664#elif defined(MFC_OpenMP)
665# 207 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
666
667# 207 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
668
669# 207 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
670
671# 207 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
672!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, di, dj, &
673# 207 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
674!$omp& dk, lb, bub_idx, center, nodecoord, s_coord, cell, cellijk, stddsv, volpart, strength_vel, strength_vol, func, func2, y_kahan, t_kahan, di_beg, di_end, dj_beg, dj_end, dk_beg, dk_end) &
675# 207 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
676!$omp& map(to:smear_x_beg, smear_x_end, smear_y_beg, smear_y_end, smear_z_beg, smear_z_end)
677# 207 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
678#endif
679# 210 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
680 do k = smear_z_beg, smear_z_end
681 do j = smear_y_beg, smear_y_end
682 do i = smear_x_beg, smear_x_end
683 cellijk(1) = i
684 cellijk(2) = j
685 cellijk(3) = k
686
687 nodecoord(1) = x_cc(i)
688 nodecoord(2) = y_cc(j)
689 nodecoord(3) = 0._wp
690 if (p > 0) nodecoord(3) = z_cc(k)
691
692 ! Neighbor cell range clamped to interior [0:m, 0:n, 0:p]
693 di_beg = max(i - mapcells, 0)
694 di_end = min(i + mapcells, m)
695 dj_beg = max(j - mapcells, 0)
696 dj_end = min(j + mapcells, n)
697 dk_beg = max(k - mapcells, 0)
698 dk_end = min(k + mapcells, p)
699
700
701# 230 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
702#if defined(MFC_OpenACC)
703# 230 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
704!$acc loop seq
705# 230 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
706#elif defined(MFC_OpenMP)
707# 230 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
708
709# 230 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
710#endif
711# 231 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
712 do dk = dk_beg, dk_end
713
714# 232 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
715#if defined(MFC_OpenACC)
716# 232 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
717!$acc loop seq
718# 232 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
719#elif defined(MFC_OpenMP)
720# 232 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
721
722# 232 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
723#endif
724# 233 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
725 do dj = dj_beg, dj_end
726
727# 234 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
728#if defined(MFC_OpenACC)
729# 234 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
730!$acc loop seq
731# 234 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
732#elif defined(MFC_OpenMP)
733# 234 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
734
735# 234 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
736#endif
737# 235 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
738 do di = di_beg, di_end
739
740# 236 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
741#if defined(MFC_OpenACC)
742# 236 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
743!$acc loop seq
744# 236 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
745#elif defined(MFC_OpenMP)
746# 236 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
747
748# 236 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
749#endif
750# 237 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
751 do lb = cell_list_start(di, dj, dk), cell_list_start(di, dj, dk) + cell_list_count(di, dj, dk) - 1
752 bub_idx = cell_list_idx(lb)
753
754 ! Bubble properties
755 volpart = 4._wp/3._wp*pi*lbk_rad(bub_idx, 2)**3._wp
756 s_coord(1:3) = lbk_s(bub_idx,1:3,2)
757 call s_get_cell(s_coord, cell)
758 call s_compute_stddsv(cell, volpart, stddsv)
759
760 strength_vol = volpart
761 strength_vel = 4._wp*pi*lbk_rad(bub_idx, 2)**2._wp*lbk_vel(bub_idx, 2)
762
763 center(1:2) = lbk_pos(bub_idx,1:2,2)
764 center(3) = 0._wp
765 if (p > 0) center(3) = lbk_pos(bub_idx, 3, 2)
766
767 call s_applygaussian(center, cellijk, nodecoord, stddsv, 0._wp, func)
768
769 ! Kahan summation for void fraction
770 y_kahan = real(func*strength_vol, kind=wp) - kcomp(1)%sf(i, j, k)
771 t_kahan = updatedvar(1)%sf(i, j, k) + y_kahan
772 kcomp(1)%sf(i, j, k) = (t_kahan - updatedvar(1)%sf(i, j, k)) - y_kahan
773 updatedvar(1)%sf(i, j, k) = t_kahan
774
775 ! Kahan summation for time derivative of void fraction
776 y_kahan = real(func*strength_vel, kind=wp) - kcomp(2)%sf(i, j, k)
777 t_kahan = updatedvar(2)%sf(i, j, k) + y_kahan
778 kcomp(2)%sf(i, j, k) = (t_kahan - updatedvar(2)%sf(i, j, k)) - y_kahan
779 updatedvar(2)%sf(i, j, k) = t_kahan
780
781 if (lag_params%cluster_type >= 4) then
782 call s_applygaussian(center, cellijk, nodecoord, stddsv, 1._wp, func2)
783 y_kahan = real(func2*strength_vol*strength_vel, kind=wp) - kcomp(5)%sf(i, j, k)
784 t_kahan = updatedvar(5)%sf(i, j, k) + y_kahan
785 kcomp(5)%sf(i, j, k) = (t_kahan - updatedvar(5)%sf(i, j, k)) - y_kahan
786 updatedvar(5)%sf(i, j, k) = t_kahan
787 end if
788 end do
789 end do
790 end do
791 end do
792 end do
793 end do
794 end do
795
796# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
797#if defined(MFC_OpenACC)
798# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
799!$acc end parallel loop
800# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
801#elif defined(MFC_OpenMP)
802# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
803
804# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
805!$omp end target teams loop
806# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
807#endif
808# 282 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
809
810 end subroutine s_gaussian
811
812 !> Evaluate the Gaussian kernel at a grid node for a given bubble center
813 subroutine s_applygaussian(center, cellaux, nodecoord, stddsv, strength_idx, func)
814
815
816# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
817#ifdef _CRAYFTN
818# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
819#if MFC_OpenACC
820# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
821!$acc routine seq
822# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
823#elif MFC_OpenMP
824# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
825
826# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
827
828# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
829!$omp declare target device_type(any)
830# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
831#else
832# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
833!DIR$ INLINEALWAYS s_applygaussian
834# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
835#endif
836# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
837#elif MFC_OpenACC
838# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
839!$acc routine seq
840# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
841#elif MFC_OpenMP
842# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
843
844# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
845
846# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
847!$omp declare target device_type(any)
848# 288 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
849#endif
850# 289 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
851
852 real(wp), dimension(3), intent(in) :: center
853 integer, dimension(3), intent(in) :: cellaux
854 real(wp), dimension(3), intent(in) :: nodecoord
855 real(wp), intent(in) :: stddsv
856 real(wp), intent(in) :: strength_idx
857 real(wp), intent(out) :: func
858 integer :: i
859 real(wp) :: distance
860 real(wp) :: theta, dtheta, L2, dzp, Lz2, zc
861 real(wp) :: Nr, Nr_count
862
863 distance = sqrt((center(1) - nodecoord(1))**2._wp + (center(2) - nodecoord(2))**2._wp + (center(3) - nodecoord(3))**2._wp)
864
865 if (num_dims == 3) then
866 !> 3D gaussian function
867 func = exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv)**3._wp
868 else
869 if (cyl_coord) then
870 !> 2D cylindrical function:
871 ! We smear particles in the azimuthal direction for given r
872 theta = 0._wp
873 nr = ceiling(2._wp*pi*nodecoord(2)/(y_cb(cellaux(2)) - y_cb(cellaux(2) - 1)))
874 dtheta = 2._wp*pi/nr
875 l2 = center(2)**2._wp + nodecoord(2)**2._wp - 2._wp*center(2)*nodecoord(2)*cos(theta)
876 distance = sqrt((center(1) - nodecoord(1))**2._wp + l2)
877 ! Factor 2._wp is for symmetry (upper half of the 2D field (+r) is considered)
878 func = dtheta/2._wp/pi*exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv)**3._wp
879 nr_count = 0._wp
880 do while (nr_count < nr - 1._wp)
881 nr_count = nr_count + 1._wp
882 theta = nr_count*dtheta
883 ! trigonometric relation
884 l2 = center(2)**2._wp + nodecoord(2)**2._wp - 2._wp*center(2)*nodecoord(2)*cos(theta)
885 distance = sqrt((center(1) - nodecoord(1))**2._wp + l2)
886 ! nodecoord(2)*dtheta is the azimuthal width of the cell
887 func = func + dtheta/2._wp/pi*exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv) &
888 & **(3._wp*(strength_idx + 1._wp))
889 end do
890 else
891 !> 2D cartesian function: Equation (48) from Maeda and Colonius 2018
892 ! We smear particles considering a virtual depth (lag_params%charwidth) with lag_params%charNz cells
893 dzp = (lag_params%charwidth/(lag_params%charNz + 1._wp))
894
895 func = 0._wp
896 do i = 0, lag_params%charNz
897 zc = (-lag_params%charwidth/2._wp + dzp*(0.5_wp + i)) ! Center of virtual cell i in z-direction
898 lz2 = (center(3) - zc)**2._wp
899 distance = sqrt((center(1) - nodecoord(1))**2._wp + (center(2) - nodecoord(2))**2._wp + lz2)
900 func = func + dzp/lag_params%charwidth*exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv)**3._wp
901 end do
902 end if
903 end if
904
905 end subroutine s_applygaussian
906
907 !> Check if the current cell is outside the computational domain including ghost cells
908 subroutine s_check_celloutside(cellaux, celloutside)
909
910
911# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
912#ifdef _CRAYFTN
913# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
914#if MFC_OpenACC
915# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
916!$acc routine seq
917# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
918#elif MFC_OpenMP
919# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
920
921# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
922
923# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
924!$omp declare target device_type(any)
925# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
926#else
927# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
928!DIR$ INLINEALWAYS s_check_celloutside
929# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
930#endif
931# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
932#elif MFC_OpenACC
933# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
934!$acc routine seq
935# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
936#elif MFC_OpenMP
937# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
938
939# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
940
941# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
942!$omp declare target device_type(any)
943# 348 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
944#endif
945# 349 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
946
947 integer, dimension(3), intent(inout) :: cellaux
948 logical, intent(out) :: celloutside
949
950 celloutside = .false.
951
952 if (num_dims == 2) then
953 if ((cellaux(1) < -buff_size) .or. (cellaux(2) < -buff_size)) then
954 celloutside = .true.
955 end if
956 if (cyl_coord .and. y_cc(cellaux(2)) < 0._wp) then
957 celloutside = .true.
958 end if
959 if ((cellaux(2) > n + buff_size) .or. (cellaux(1) > m + buff_size)) then
960 celloutside = .true.
961 end if
962 else
963 if ((cellaux(3) < -buff_size) .or. (cellaux(1) < -buff_size) .or. (cellaux(2) < -buff_size)) then
964 celloutside = .true.
965 end if
966
967 if ((cellaux(3) > p + buff_size) .or. (cellaux(2) > n + buff_size) .or. (cellaux(1) > m + buff_size)) then
968 celloutside = .true.
969 end if
970 end if
971
972 end subroutine s_check_celloutside
973
974 !> Relocate cells that intersect a symmetric boundary
975 subroutine s_shift_cell_symmetric_bc(cellaux, cell)
976
977
978# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
979#ifdef _CRAYFTN
980# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
981#if MFC_OpenACC
982# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
983!$acc routine seq
984# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
985#elif MFC_OpenMP
986# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
987
988# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
989
990# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
991!$omp declare target device_type(any)
992# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
993#else
994# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
995!DIR$ INLINEALWAYS s_shift_cell_symmetric_bc
996# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
997#endif
998# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
999#elif MFC_OpenACC
1000# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1001!$acc routine seq
1002# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1003#elif MFC_OpenMP
1004# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1005
1006# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1007
1008# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1009!$omp declare target device_type(any)
1010# 380 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1011#endif
1012# 381 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1013
1014 integer, dimension(3), intent(inout) :: cellaux
1015 integer, dimension(3), intent(in) :: cell
1016
1017 ! x-dir
1018 if (bc_x%beg == bc_reflective .and. (cell(1) <= mapcells - 1)) then
1019 cellaux(1) = abs(cellaux(1)) - 1
1020 end if
1021 if (bc_x%end == bc_reflective .and. (cell(1) >= m + 1 - mapcells)) then
1022 cellaux(1) = cellaux(1) - (2*(cellaux(1) - m) - 1)
1023 end if
1024
1025 ! y-dir
1026 if (bc_y%beg == bc_reflective .and. (cell(2) <= mapcells - 1)) then
1027 cellaux(2) = abs(cellaux(2)) - 1
1028 end if
1029 if (bc_y%end == bc_reflective .and. (cell(2) >= n + 1 - mapcells)) then
1030 cellaux(2) = cellaux(2) - (2*(cellaux(2) - n) - 1)
1031 end if
1032
1033 if (p > 0) then
1034 ! z-dir
1035 if (bc_z%beg == bc_reflective .and. (cell(3) <= mapcells - 1)) then
1036 cellaux(3) = abs(cellaux(3)) - 1
1037 end if
1038 if (bc_z%end == bc_reflective .and. (cell(3) >= p + 1 - mapcells)) then
1039 cellaux(3) = cellaux(3) - (2*(cellaux(3) - p) - 1)
1040 end if
1041 end if
1042
1043 end subroutine s_shift_cell_symmetric_bc
1044
1045 !> Calculates the standard deviation of the bubble being smeared in the Eulerian framework.
1046 subroutine s_compute_stddsv(cell, volpart, stddsv)
1047
1048
1049# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1050#ifdef _CRAYFTN
1051# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1052#if MFC_OpenACC
1053# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1054!$acc routine seq
1055# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1056#elif MFC_OpenMP
1057# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1058
1059# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1060
1061# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1062!$omp declare target device_type(any)
1063# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1064#else
1065# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1066!DIR$ INLINEALWAYS s_compute_stddsv
1067# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1068#endif
1069# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1070#elif MFC_OpenACC
1071# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1072!$acc routine seq
1073# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1074#elif MFC_OpenMP
1075# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1076
1077# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1078
1079# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1080!$omp declare target device_type(any)
1081# 416 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1082#endif
1083# 417 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1084
1085 integer, dimension(3), intent(in) :: cell
1086 real(wp), intent(in) :: volpart
1087 real(wp), intent(out) :: stddsv
1088 real(wp) :: chardist, charvol
1089 real(wp) :: rad
1090
1091 !> Compute characteristic distance
1092 chardist = sqrt(dx(cell(1))*dy(cell(2)))
1093 if (p > 0) chardist = (dx(cell(1))*dy(cell(2))*dz(cell(3)))**(1._wp/3._wp)
1094
1095 !> Compute characteristic volume
1096 if (p > 0) then
1097 charvol = dx(cell(1))*dy(cell(2))*dz(cell(3))
1098 else
1099 if (cyl_coord) then
1100 charvol = dx(cell(1))*dy(cell(2))*y_cc(cell(2))*2._wp*pi
1101 else
1102 charvol = dx(cell(1))*dy(cell(2))*lag_params%charwidth
1103 end if
1104 end if
1105
1106 !> Compute Standard deviaton
1107 if ((volpart/charvol) > 0.5_wp*lag_params%valmaxvoid .or. (lag_params%smooth_type == 1)) then
1108 rad = (3._wp*volpart/(4._wp*pi))**(1._wp/3._wp)
1109 stddsv = 1._wp*lag_params%epsilonb*max(chardist, rad)
1110 else
1111 stddsv = 0._wp
1112 end if
1113
1114 end subroutine s_compute_stddsv
1115
1116 !> Compute the characteristic cell volume
1117 subroutine s_get_char_vol(cellx, celly, cellz, Charvol)
1118
1119
1120# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1121#ifdef _CRAYFTN
1122# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1123#if MFC_OpenACC
1124# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1125!$acc routine seq
1126# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1127#elif MFC_OpenMP
1128# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1129
1130# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1131
1132# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1133!$omp declare target device_type(any)
1134# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1135#else
1136# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1137!DIR$ INLINEALWAYS s_get_char_vol
1138# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1139#endif
1140# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1141#elif MFC_OpenACC
1142# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1143!$acc routine seq
1144# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1145#elif MFC_OpenMP
1146# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1147
1148# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1149
1150# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1151!$omp declare target device_type(any)
1152# 452 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1153#endif
1154# 453 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1155
1156 integer, intent(in) :: cellx, celly, cellz
1157 real(wp), intent(out) :: Charvol
1158
1159 if (p > 0) then
1160 charvol = dx(cellx)*dy(celly)*dz(cellz)
1161 else
1162 if (cyl_coord) then
1163 charvol = dx(cellx)*dy(celly)*y_cc(celly)*2._wp*pi
1164 else
1165 charvol = dx(cellx)*dy(celly)*lag_params%charwidth
1166 end if
1167 end if
1168
1169 end subroutine s_get_char_vol
1170
1171 !> Convert bubble computational coordinates from real to integer cell indices
1172 subroutine s_get_cell(s_cell, get_cell)
1173
1174
1175# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1176#ifdef _CRAYFTN
1177# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1178#if MFC_OpenACC
1179# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1180!$acc routine seq
1181# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1182#elif MFC_OpenMP
1183# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1184
1185# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1186
1187# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1188!$omp declare target device_type(any)
1189# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1190#else
1191# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1192!DIR$ INLINEALWAYS s_get_cell
1193# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1194#endif
1195# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1196#elif MFC_OpenACC
1197# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1198!$acc routine seq
1199# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1200#elif MFC_OpenMP
1201# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1202
1203# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1204
1205# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1206!$omp declare target device_type(any)
1207# 472 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1208#endif
1209# 473 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1210
1211 real(wp), dimension(3), intent(in) :: s_cell
1212 integer, dimension(3), intent(out) :: get_cell
1213 integer :: i
1214
1215 get_cell(:) = int(s_cell(:))
1216 do i = 1, num_dims
1217 if (s_cell(i) < 0._wp) get_cell(i) = get_cell(i) - 1
1218 end do
1219
1220 end subroutine s_get_cell
1221
1222 !> Precompute cell-centered pressure gradients (dp/dx, dp/dy, dp/dz)
1223 subroutine s_compute_pressure_gradients(q_prim_vf)
1224
1225 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1226 integer :: i, j, k, r
1227
1228 ! dp/dx at all cell centers
1229
1230
1231# 493 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1232
1233# 493 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1234#if defined(MFC_OpenACC)
1235# 493 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1236!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, r)
1237# 493 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1238#elif defined(MFC_OpenMP)
1239# 493 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1240
1241# 493 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1242
1243# 493 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1244
1245# 493 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1246!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, r)
1247# 493 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1248#endif
1249# 494 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1250 do k = 0, p
1251 do j = 0, n
1252 do i = 0, m
1253 grad_p_x(i, j, k) = 0._wp
1254
1255# 498 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1256#if defined(MFC_OpenACC)
1257# 498 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1258!$acc loop seq
1259# 498 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1260#elif defined(MFC_OpenMP)
1261# 498 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1262
1263# 498 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1264#endif
1265# 499 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1266 do r = -fd_number, fd_number
1267 grad_p_x(i, j, k) = grad_p_x(i, j, k) + q_prim_vf(eqn_idx%E)%sf(i + r, j, k)*fd_coeff_x_pgrad(r, i)
1268 end do
1269 end do
1270 end do
1271 end do
1272
1273# 505 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1274#if defined(MFC_OpenACC)
1275# 505 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1276!$acc end parallel loop
1277# 505 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1278#elif defined(MFC_OpenMP)
1279# 505 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1280
1281# 505 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1282!$omp end target teams loop
1283# 505 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1284#endif
1285# 506 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1286
1287 ! dp/dy at all cell centers
1288 if (n > 0) then
1289
1290# 509 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1291
1292# 509 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1293#if defined(MFC_OpenACC)
1294# 509 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1295!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, r)
1296# 509 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1297#elif defined(MFC_OpenMP)
1298# 509 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1299
1300# 509 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1301
1302# 509 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1303
1304# 509 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1305!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, r)
1306# 509 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1307#endif
1308# 510 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1309 do k = 0, p
1310 do j = 0, n
1311 do i = 0, m
1312 grad_p_y(i, j, k) = 0._wp
1313
1314# 514 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1315#if defined(MFC_OpenACC)
1316# 514 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1317!$acc loop seq
1318# 514 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1319#elif defined(MFC_OpenMP)
1320# 514 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1321
1322# 514 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1323#endif
1324# 515 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1325 do r = -fd_number, fd_number
1326 grad_p_y(i, j, k) = grad_p_y(i, j, k) + q_prim_vf(eqn_idx%E)%sf(i, j + r, k)*fd_coeff_y_pgrad(r, j)
1327 end do
1328 end do
1329 end do
1330 end do
1331
1332# 521 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1333#if defined(MFC_OpenACC)
1334# 521 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1335!$acc end parallel loop
1336# 521 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1337#elif defined(MFC_OpenMP)
1338# 521 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1339
1340# 521 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1341!$omp end target teams loop
1342# 521 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1343#endif
1344# 522 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1345 end if
1346
1347 ! dp/dz at all cell centers
1348 if (p > 0) then
1349
1350# 526 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1351
1352# 526 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1353#if defined(MFC_OpenACC)
1354# 526 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1355!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, r)
1356# 526 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1357#elif defined(MFC_OpenMP)
1358# 526 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1359
1360# 526 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1361
1362# 526 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1363
1364# 526 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1365!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, r)
1366# 526 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1367#endif
1368# 527 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1369 do k = 0, p
1370 do j = 0, n
1371 do i = 0, m
1372 grad_p_z(i, j, k) = 0._wp
1373
1374# 531 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1375#if defined(MFC_OpenACC)
1376# 531 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1377!$acc loop seq
1378# 531 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1379#elif defined(MFC_OpenMP)
1380# 531 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1381
1382# 531 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1383#endif
1384# 532 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1385 do r = -fd_number, fd_number
1386 grad_p_z(i, j, k) = grad_p_z(i, j, k) + q_prim_vf(eqn_idx%E)%sf(i, j, k + r)*fd_coeff_z_pgrad(r, k)
1387 end do
1388 end do
1389 end do
1390 end do
1391
1392# 538 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1393#if defined(MFC_OpenACC)
1394# 538 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1395!$acc end parallel loop
1396# 538 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1397#elif defined(MFC_OpenMP)
1398# 538 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1399
1400# 538 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1401!$omp end target teams loop
1402# 538 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1403#endif
1404# 539 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1405 end if
1406
1407 end subroutine s_compute_pressure_gradients
1408
1409 !! Interpolate the velocity of Eulerian field at the position of the bubble.
1410 function f_interpolate_velocity(pos, cell, i, q_prim_vf) result(v)
1411
1412
1413# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1414#ifdef _CRAYFTN
1415# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1416#if MFC_OpenACC
1417# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1418!$acc routine seq
1419# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1420#elif MFC_OpenMP
1421# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1422
1423# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1424
1425# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1426!$omp declare target device_type(any)
1427# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1428#else
1429# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1430!DIR$ NOINLINE f_interpolate_velocity
1431# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1432#endif
1433# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1434#elif MFC_OpenACC
1435# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1436!$acc routine seq
1437# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1438#elif MFC_OpenMP
1439# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1440
1441# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1442
1443# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1444!$omp declare target device_type(any)
1445# 546 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1446#endif
1447# 547 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1448
1449 real(wp), intent(in) :: pos
1450 integer, dimension(3), intent(in) :: cell
1451 integer, intent(in) :: i
1452 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1453 real(wp) :: v
1454 real(wp), dimension(5) :: xi, eta, l
1455
1456 if (fd_order == 2) then
1457 if (i == 1) then
1458 xi(1) = x_cc(cell(1) - 1)
1459 eta(1) = q_prim_vf(eqn_idx%mom%beg)%sf(cell(1) - 1, cell(2), cell(3))
1460 xi(2) = x_cc(cell(1))
1461 eta(2) = q_prim_vf(eqn_idx%mom%beg)%sf(cell(1), cell(2), cell(3))
1462 xi(3) = x_cc(cell(1) + 1)
1463 eta(3) = q_prim_vf(eqn_idx%mom%beg)%sf(cell(1) + 1, cell(2), cell(3))
1464 else if (i == 2) then
1465 xi(1) = y_cc(cell(2) - 1)
1466 eta(1) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(cell(1), cell(2) - 1, cell(3))
1467 xi(2) = y_cc(cell(2))
1468 eta(2) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(cell(1), cell(2), cell(3))
1469 xi(3) = y_cc(cell(2) + 1)
1470 eta(3) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(cell(1), cell(2) + 1, cell(3))
1471 else if (i == 3) then
1472 xi(1) = z_cc(cell(3) - 1)
1473 eta(1) = q_prim_vf(eqn_idx%mom%end)%sf(cell(1), cell(2), cell(3) - 1)
1474 xi(2) = z_cc(cell(3))
1475 eta(2) = q_prim_vf(eqn_idx%mom%end)%sf(cell(1), cell(2), cell(3))
1476 xi(3) = z_cc(cell(3) + 1)
1477 eta(3) = q_prim_vf(eqn_idx%mom%end)%sf(cell(1), cell(2), cell(3) + 1)
1478 end if
1479
1480 l(1) = ((pos - xi(2))*(pos - xi(3)))/((xi(1) - xi(2))*(xi(1) - xi(3)))
1481 l(2) = ((pos - xi(1))*(pos - xi(3)))/((xi(2) - xi(1))*(xi(2) - xi(3)))
1482 l(3) = ((pos - xi(1))*(pos - xi(2)))/((xi(3) - xi(1))*(xi(3) - xi(2)))
1483
1484 v = l(1)*eta(1) + l(2)*eta(2) + l(3)*eta(3)
1485 else if (fd_order == 4) then
1486 if (i == 1) then
1487 xi(1) = x_cc(cell(1) - 2)
1488 eta(1) = q_prim_vf(eqn_idx%mom%beg)%sf(cell(1) - 2, cell(2), cell(3))
1489 xi(2) = x_cc(cell(1) - 1)
1490 eta(2) = q_prim_vf(eqn_idx%mom%beg)%sf(cell(1) - 1, cell(2), cell(3))
1491 xi(3) = x_cc(cell(1))
1492 eta(3) = q_prim_vf(eqn_idx%mom%beg)%sf(cell(1), cell(2), cell(3))
1493 xi(4) = x_cc(cell(1) + 1)
1494 eta(4) = q_prim_vf(eqn_idx%mom%beg)%sf(cell(1) + 1, cell(2), cell(3))
1495 xi(5) = x_cc(cell(1) + 2)
1496 eta(5) = q_prim_vf(eqn_idx%mom%beg)%sf(cell(1) + 2, cell(2), cell(3))
1497 else if (i == 2) then
1498 xi(1) = y_cc(cell(2) - 2)
1499 eta(1) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(cell(1), cell(2) - 2, cell(3))
1500 xi(2) = y_cc(cell(2) - 1)
1501 eta(2) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(cell(1), cell(2) - 1, cell(3))
1502 xi(3) = y_cc(cell(2))
1503 eta(3) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(cell(1), cell(2), cell(3))
1504 xi(4) = y_cc(cell(2) + 1)
1505 eta(4) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(cell(1), cell(2) + 1, cell(3))
1506 xi(5) = y_cc(cell(2) + 2)
1507 eta(5) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(cell(1), cell(2) + 2, cell(3))
1508 else if (i == 3) then
1509 xi(1) = z_cc(cell(3) - 2)
1510 eta(1) = q_prim_vf(eqn_idx%mom%end)%sf(cell(1), cell(2), cell(3) - 2)
1511 xi(2) = z_cc(cell(3) - 1)
1512 eta(2) = q_prim_vf(eqn_idx%mom%end)%sf(cell(1), cell(2), cell(3) - 1)
1513 xi(3) = z_cc(cell(3))
1514 eta(3) = q_prim_vf(eqn_idx%mom%end)%sf(cell(1), cell(2), cell(3))
1515 xi(4) = z_cc(cell(3) + 1)
1516 eta(4) = q_prim_vf(eqn_idx%mom%end)%sf(cell(1), cell(2), cell(3) + 1)
1517 xi(5) = z_cc(cell(3) + 2)
1518 eta(5) = q_prim_vf(eqn_idx%mom%end)%sf(cell(1), cell(2), cell(3) + 2)
1519 end if
1520
1521 l(1) = ((pos - xi(2))*(pos - xi(3))*(pos - xi(4))*(pos - xi(5)))/((xi(1) - xi(2))*(xi(1) - xi(3))*(xi(1) - xi(4)) &
1522 & *(xi(1) - xi(5)))
1523 l(2) = ((pos - xi(1))*(pos - xi(3))*(pos - xi(4))*(pos - xi(5)))/((xi(2) - xi(1))*(xi(2) - xi(3))*(xi(2) - xi(4)) &
1524 & *(xi(2) - xi(5)))
1525 l(3) = ((pos - xi(1))*(pos - xi(2))*(pos - xi(4))*(pos - xi(5)))/((xi(3) - xi(1))*(xi(3) - xi(2))*(xi(3) - xi(4)) &
1526 & *(xi(3) - xi(5)))
1527 l(4) = ((pos - xi(1))*(pos - xi(2))*(pos - xi(3))*(pos - xi(5)))/((xi(4) - xi(1))*(xi(4) - xi(2))*(xi(4) - xi(3)) &
1528 & *(xi(4) - xi(5)))
1529 l(5) = ((pos - xi(1))*(pos - xi(2))*(pos - xi(3))*(pos - xi(4)))/((xi(5) - xi(1))*(xi(5) - xi(2))*(xi(5) - xi(3)) &
1530 & *(xi(5) - xi(4)))
1531
1532 v = l(1)*eta(1) + l(2)*eta(2) + l(3)*eta(3) + l(4)*eta(4) + l(5)*eta(5)
1533 end if
1534
1535 end function f_interpolate_velocity
1536
1537 !! Calculate the force on a bubble based on the pressure gradient, velocity, and drag model.
1538 !! @param mg Mass of the gas in the bubble
1539 !! @param mv Mass of the liquid in the bubble
1540 !! @param Re Reynolds number
1541 !! @param i Direction of the velocity (1: x, 2: y, 3: z)
1542 function f_get_bubble_force(pos, rad, rdot, vel, mg, mv, Re, rho, cell, i, q_prim_vf) result(force)
1543
1544
1545# 643 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1546#if MFC_OpenACC
1547# 643 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1548!$acc routine seq
1549# 643 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1550#elif MFC_OpenMP
1551# 643 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1552
1553# 643 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1554
1555# 643 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1556!$omp declare target device_type(any)
1557# 643 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1558#endif
1559# 644 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1560 real(wp), intent(in) :: pos, rad, rdot, mg, mv, re, rho, vel
1561 integer, dimension(3), intent(in) :: cell
1562 integer, intent(in) :: i
1563 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1564 real(wp) :: dp, vol, force
1565 real(wp) :: v_rel
1566
1567 if (fd_order > 1) then
1568 v_rel = vel - f_interpolate_velocity(pos, cell, i, q_prim_vf)
1569 else
1570 v_rel = vel - q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(cell(1), cell(2), cell(3))
1571 end if
1572
1573 force = 0._wp
1574
1575 if (lag_params%drag_model == 1) then ! Free slip Stokes drag
1576 force = force - (4._wp*pi*rad*v_rel)/re
1577 else if (lag_params%drag_model == 2) then ! No slip Stokes drag
1578 force = force - (6._wp*pi*rad*v_rel)/re
1579 else if (lag_params%drag_model == 3) then ! Levich drag
1580 force = force - (12._wp*pi*rad*v_rel)/re
1581 end if
1582
1583 if (lag_pressure_force) then
1584 ! Use precomputed cell-centered pressure gradients
1585 if (i == 1) then
1586 dp = grad_p_x(cell(1), cell(2), cell(3))
1587 else if (i == 2) then
1588 dp = grad_p_y(cell(1), cell(2), cell(3))
1589 else if (i == 3) then
1590 dp = grad_p_z(cell(1), cell(2), cell(3))
1591 end if
1592
1593 vol = (4._wp/3._wp)*pi*(rad**3._wp)
1594 force = force - vol*dp
1595 end if
1596
1597 if (lag_params%gravity_force) then
1598 force = force + (mg + mv)*accel_bf(i)
1599 end if
1600
1601 end function f_get_bubble_force
1602
1603end module m_bubbles_el_kernels
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1043
m_bubbles_el_kernels
Kernel functions (Gaussian, delta) that smear Lagrangian bubble effects onto the Eulerian grid.
Definition m_bubbles_EL_kernels.fpp.f90:356
m_bubbles_el_kernels::s_build_cell_list
subroutine s_build_cell_list(nbubs, lbk_s)
Builds a sorted cell list mapping each interior cell (0:m,0:n,0:p) to its resident bubbles....
Definition m_bubbles_EL_kernels.fpp.f90:434
m_bubbles_el_kernels::fd_coeff_z_pgrad
real(wp), dimension(:,:), allocatable fd_coeff_z_pgrad
Definition m_bubbles_EL_kernels.fpp.f90:380
m_bubbles_el_kernels::s_deltafunc
subroutine s_deltafunc(nbubs, lbk_rad, lbk_vel, lbk_s, updatedvar, kcomp)
Cell-centric delta-function smearing using the cell list (no GPU atomics). Each bubble only affects t...
Definition m_bubbles_EL_kernels.fpp.f90:513
m_bubbles_el_kernels::s_applygaussian
subroutine s_applygaussian(center, cellaux, nodecoord, stddsv, strength_idx, func)
Evaluate the Gaussian kernel at a grid node for a given bubble center.
Definition m_bubbles_EL_kernels.fpp.f90:814
m_bubbles_el_kernels::s_check_celloutside
subroutine s_check_celloutside(cellaux, celloutside)
Check if the current cell is outside the computational domain including ghost cells.
Definition m_bubbles_EL_kernels.fpp.f90:909
m_bubbles_el_kernels::grad_p_y
real(wp), dimension(:,:,:), allocatable grad_p_y
Definition m_bubbles_EL_kernels.fpp.f90:363
m_bubbles_el_kernels::s_compute_pressure_gradients
subroutine s_compute_pressure_gradients(q_prim_vf)
Precompute cell-centered pressure gradients (dp/dx, dp/dy, dp/dz).
Definition m_bubbles_EL_kernels.fpp.f90:1224
m_bubbles_el_kernels::f_get_bubble_force
real(wp) function f_get_bubble_force(pos, rad, rdot, vel, mg, mv, re, rho, cell, i, q_prim_vf)
Definition m_bubbles_EL_kernels.fpp.f90:1543
m_bubbles_el_kernels::cell_list_idx
integer, dimension(:), allocatable cell_list_idx
Definition m_bubbles_EL_kernels.fpp.f90:397
m_bubbles_el_kernels::f_interpolate_velocity
real(wp) function f_interpolate_velocity(pos, cell, i, q_prim_vf)
Definition m_bubbles_EL_kernels.fpp.f90:1411
m_bubbles_el_kernels::s_shift_cell_symmetric_bc
subroutine s_shift_cell_symmetric_bc(cellaux, cell)
Relocate cells that intersect a symmetric boundary.
Definition m_bubbles_EL_kernels.fpp.f90:976
m_bubbles_el_kernels::cell_list_start
integer, dimension(:,:,:), allocatable cell_list_start
Definition m_bubbles_EL_kernels.fpp.f90:395
m_bubbles_el_kernels::s_compute_stddsv
subroutine s_compute_stddsv(cell, volpart, stddsv)
Calculates the standard deviation of the bubble being smeared in the Eulerian framework.
Definition m_bubbles_EL_kernels.fpp.f90:1047
m_bubbles_el_kernels::grad_p_x
real(wp), dimension(:,:,:), allocatable grad_p_x
Definition m_bubbles_EL_kernels.fpp.f90:363
m_bubbles_el_kernels::fd_coeff_y_pgrad
real(wp), dimension(:,:), allocatable fd_coeff_y_pgrad
Definition m_bubbles_EL_kernels.fpp.f90:379
m_bubbles_el_kernels::grad_p_z
real(wp), dimension(:,:,:), allocatable grad_p_z
Definition m_bubbles_EL_kernels.fpp.f90:363
m_bubbles_el_kernels::s_get_char_vol
subroutine s_get_char_vol(cellx, celly, cellz, charvol)
Compute the characteristic cell volume.
Definition m_bubbles_EL_kernels.fpp.f90:1118
m_bubbles_el_kernels::s_smoothfunction
subroutine s_smoothfunction(nbubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar, kcomp)
Smear the Lagrangian bubble effects onto the Eulerian grid using the selected kernel.
Definition m_bubbles_EL_kernels.fpp.f90:415
m_bubbles_el_kernels::s_gaussian
subroutine s_gaussian(nbubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar, kcomp)
Cell-centric gaussian smearing using the cell list (no GPU atomics). Each grid cell accumulates contr...
Definition m_bubbles_EL_kernels.fpp.f90:627
m_bubbles_el_kernels::s_get_cell
subroutine s_get_cell(s_cell, get_cell)
Convert bubble computational coordinates from real to integer cell indices.
Definition m_bubbles_EL_kernels.fpp.f90:1173
m_bubbles_el_kernels::cell_list_count
integer, dimension(:,:,:), allocatable cell_list_count
Definition m_bubbles_EL_kernels.fpp.f90:396
m_bubbles_el_kernels::fd_coeff_x_pgrad
real(wp), dimension(:,:), allocatable fd_coeff_x_pgrad
Definition m_bubbles_EL_kernels.fpp.f90:378
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:367