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# 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_bubbles_EL_kernels.fpp" 2
315
316!> @brief Kernel functions (Gaussian, delta) that smear Lagrangian bubble effects onto the Eulerian grid
317module m_bubbles_el_kernels
318
319 use m_mpi_proxy
320
321 implicit none
322
323contains
324
325 !> Smear the Lagrangian bubble effects onto the Eulerian grid using the selected kernel
326 subroutine s_smoothfunction(nBubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar)
327
328 integer, intent(in) :: nBubs
329 real(wp), dimension(1:lag_params%nBubs_glb,1:3,1:2), intent(in) :: lbk_s, lbk_pos
330 real(wp), dimension(1:lag_params%nBubs_glb,1:2), intent(in) :: lbk_rad, lbk_vel
331 type(scalar_field), dimension(:), intent(inout) :: updatedvar
332
333 smoothfunc:select case(lag_params%smooth_type)
334 case (1)
335 call s_gaussian(nbubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar)
336 case (2)
337 call s_deltafunc(nbubs, lbk_rad, lbk_vel, lbk_s, updatedvar)
338 end select smoothfunc
339
340 end subroutine s_smoothfunction
341
342 !> Apply the delta kernel function to map bubble effects onto the containing cell
343 subroutine s_deltafunc(nBubs, lbk_rad, lbk_vel, lbk_s, updatedvar)
344
345 integer, intent(in) :: nBubs
346 real(wp), dimension(1:lag_params%nBubs_glb,1:3,1:2), intent(in) :: lbk_s
347 real(wp), dimension(1:lag_params%nBubs_glb,1:2), intent(in) :: lbk_rad, lbk_vel
348 type(scalar_field), dimension(:), intent(inout) :: updatedvar
349 integer, dimension(3) :: cell
350 real(wp) :: strength_vel, strength_vol
351 real(wp) :: addFun1, addFun2, addFun3
352 real(wp) :: volpart, Vol
353 real(wp), dimension(3) :: s_coord
354 integer :: l
355
356
357# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
358
359# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
360#if defined(MFC_OpenACC)
361# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
362!$acc parallel loop gang vector default(present) private(l, s_coord, cell)
363# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
364#elif defined(MFC_OpenMP)
365# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
366
367# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
368
369# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
370
371# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
372!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, s_coord, cell)
373# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
374#endif
375 do l = 1, nbubs
376 volpart = 4._wp/3._wp*pi*lbk_rad(l, 2)**3._wp
377 s_coord(1:3) = lbk_s(l,1:3,2)
378 call s_get_cell(s_coord, cell)
379
380 strength_vol = volpart
381 strength_vel = 4._wp*pi*lbk_rad(l, 2)**2._wp*lbk_vel(l, 2)
382
383 if (num_dims == 2) then
384 vol = dx(cell(1))*dy(cell(2))*lag_params%charwidth
385 if (cyl_coord) vol = dx(cell(1))*dy(cell(2))*y_cc(cell(2))*2._wp*pi
386 else
387 vol = dx(cell(1))*dy(cell(2))*dz(cell(3))
388 end if
389
390 ! Update void fraction field
391 addfun1 = strength_vol/vol
392
393# 65 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
394#if defined(MFC_OpenACC)
395# 65 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
396!$acc atomic update
397# 65 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
398#elif defined(MFC_OpenMP)
399# 65 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
400!$omp atomic update
401# 65 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
402#endif
403 updatedvar(1)%sf(cell(1), cell(2), cell(3)) = updatedvar(1)%sf(cell(1), cell(2), cell(3)) + real(addfun1, kind=stp)
404
405 ! Update time derivative of void fraction
406 addfun2 = strength_vel/vol
407
408# 70 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
409#if defined(MFC_OpenACC)
410# 70 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
411!$acc atomic update
412# 70 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
413#elif defined(MFC_OpenMP)
414# 70 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
415!$omp atomic update
416# 70 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
417#endif
418 updatedvar(2)%sf(cell(1), cell(2), cell(3)) = updatedvar(2)%sf(cell(1), cell(2), cell(3)) + real(addfun2, kind=stp)
419
420 ! Product of two smeared functions Update void fraction * time derivative of void fraction
421 if (lag_params%cluster_type >= 4) then
422 addfun3 = (strength_vol*strength_vel)/vol
423
424# 76 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
425#if defined(MFC_OpenACC)
426# 76 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
427!$acc atomic update
428# 76 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
429#elif defined(MFC_OpenMP)
430# 76 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
431!$omp atomic update
432# 76 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
433#endif
434 updatedvar(5)%sf(cell(1), cell(2), cell(3)) = updatedvar(5)%sf(cell(1), cell(2), cell(3)) + real(addfun3, kind=stp)
435 end if
436 end do
437
438# 80 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
439#if defined(MFC_OpenACC)
440# 80 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
441!$acc end parallel loop
442# 80 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
443#elif defined(MFC_OpenMP)
444# 80 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
445
446# 80 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
447!$omp end target teams loop
448# 80 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
449#endif
450
451 end subroutine s_deltafunc
452
453 !> Apply the Gaussian kernel function to smear bubble effects onto surrounding cells
454 subroutine s_gaussian(nBubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar)
455
456 integer, intent(in) :: nBubs
457 real(wp), dimension(1:lag_params%nBubs_glb,1:3,1:2), intent(in) :: lbk_s, lbk_pos
458 real(wp), dimension(1:lag_params%nBubs_glb,1:2), intent(in) :: lbk_rad, lbk_vel
459 type(scalar_field), dimension(:), intent(inout) :: updatedvar
460 real(wp), dimension(3) :: center
461 integer, dimension(3) :: cell
462 real(wp) :: stddsv
463 real(wp) :: strength_vel, strength_vol
464 real(wp), dimension(3) :: nodecoord
465 real(wp) :: addFun1, addFun2, addFun3
466 real(wp) :: func, func2, volpart
467 integer, dimension(3) :: cellaux
468 real(wp), dimension(3) :: s_coord
469 integer :: l, i, j, k
470 logical :: celloutside
471 integer :: smearGrid, smearGridz
472
473 smeargrid = mapcells - (-mapcells) + 1 ! Include the cell that contains the bubble (3+1+3)
474 smeargridz = smeargrid
475 if (p == 0) smeargridz = 1
476
477
478# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
479
480# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
481#if defined(MFC_OpenACC)
482# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
483!$acc parallel loop gang vector default(present) private(nodecoord, l, s_coord, cell, center) copyin(smearGrid, smearGridz)
484# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
485#elif defined(MFC_OpenMP)
486# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
487
488# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
489
490# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
491
492# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
493!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(nodecoord, l, s_coord, cell, center) map(to:smearGrid, smearGridz)
494# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
495#endif
496 do l = 1, nbubs
497 nodecoord(1:3) = 0
498 center(1:3) = 0._wp
499 volpart = 4._wp/3._wp*pi*lbk_rad(l, 2)**3._wp
500 s_coord(1:3) = lbk_s(l,1:3,2)
501 center(1:2) = lbk_pos(l,1:2,2)
502 if (p > 0) center(3) = lbk_pos(l, 3, 2)
503 call s_get_cell(s_coord, cell)
504 call s_compute_stddsv(cell, volpart, stddsv)
505
506 strength_vol = volpart
507 strength_vel = 4._wp*pi*lbk_rad(l, 2)**2._wp*lbk_vel(l, 2)
508
509
510# 122 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
511#if defined(MFC_OpenACC)
512# 122 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
513!$acc loop collapse(3) private(cellaux, nodecoord)
514# 122 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
515#elif defined(MFC_OpenMP)
516# 122 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
517
518# 122 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
519#endif
520 do i = 1, smeargrid
521 do j = 1, smeargrid
522 do k = 1, smeargridz
523 cellaux(1) = cell(1) + i - (mapcells + 1)
524 cellaux(2) = cell(2) + j - (mapcells + 1)
525 cellaux(3) = cell(3) + k - (mapcells + 1)
526 if (p == 0) cellaux(3) = 0
527
528 ! Check if the cells intended to smear the bubbles in are in the computational domain and redefine the cells
529 ! for symmetric boundary
530 call s_check_celloutside(cellaux, celloutside)
531
532 if (.not. celloutside) then
533 nodecoord(1) = x_cc(cellaux(1))
534 nodecoord(2) = y_cc(cellaux(2))
535 if (p > 0) nodecoord(3) = z_cc(cellaux(3))
536 call s_applygaussian(center, cellaux, nodecoord, stddsv, 0._wp, func)
537 if (lag_params%cluster_type >= 4) call s_applygaussian(center, cellaux, nodecoord, stddsv, 1._wp, func2)
538
539 ! Relocate cells for bubbles intersecting symmetric boundaries
540 if (any((/bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end/) == bc_reflective)) then
541 call s_shift_cell_symmetric_bc(cellaux, cell)
542 end if
543 else
544 func = 0._wp
545 func2 = 0._wp
546 cellaux(1) = cell(1)
547 cellaux(2) = cell(2)
548 cellaux(3) = cell(3)
549 if (p == 0) cellaux(3) = 0
550 end if
551
552 ! Update void fraction field
553 addfun1 = func*strength_vol
554
555# 157 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
556#if defined(MFC_OpenACC)
557# 157 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
558!$acc atomic update
559# 157 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
560#elif defined(MFC_OpenMP)
561# 157 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
562!$omp atomic update
563# 157 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
564#endif
565 updatedvar(1)%sf(cellaux(1), cellaux(2), cellaux(3)) = updatedvar(1)%sf(cellaux(1), cellaux(2), &
566 & cellaux(3)) + real(addfun1, kind=stp)
567
568 ! Update time derivative of void fraction
569 addfun2 = func*strength_vel
570
571# 163 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
572#if defined(MFC_OpenACC)
573# 163 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
574!$acc atomic update
575# 163 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
576#elif defined(MFC_OpenMP)
577# 163 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
578!$omp atomic update
579# 163 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
580#endif
581 updatedvar(2)%sf(cellaux(1), cellaux(2), cellaux(3)) = updatedvar(2)%sf(cellaux(1), cellaux(2), &
582 & cellaux(3)) + real(addfun2, kind=stp)
583
584 ! Product of two smeared functions Update void fraction * time derivative of void fraction
585 if (lag_params%cluster_type >= 4) then
586 addfun3 = func2*strength_vol*strength_vel
587
588# 170 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
589#if defined(MFC_OpenACC)
590# 170 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
591!$acc atomic update
592# 170 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
593#elif defined(MFC_OpenMP)
594# 170 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
595!$omp atomic update
596# 170 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
597#endif
598 updatedvar(5)%sf(cellaux(1), cellaux(2), cellaux(3)) = updatedvar(5)%sf(cellaux(1), cellaux(2), &
599 & cellaux(3)) + real(addfun3, kind=stp)
600 end if
601 end do
602 end do
603 end do
604 end do
605
606# 178 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
607#if defined(MFC_OpenACC)
608# 178 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
609!$acc end parallel loop
610# 178 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
611#elif defined(MFC_OpenMP)
612# 178 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
613
614# 178 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
615!$omp end target teams loop
616# 178 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
617#endif
618
619 end subroutine s_gaussian
620
621 !> Evaluate the Gaussian kernel at a grid node for a given bubble center
622 subroutine s_applygaussian(center, cellaux, nodecoord, stddsv, strength_idx, func)
623
624
625# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
626#ifdef _CRAYFTN
627# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
628#if MFC_OpenACC
629# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
630!$acc routine seq
631# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
632#elif MFC_OpenMP
633# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
634
635# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
636
637# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
638!$omp declare target device_type(any)
639# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
640#else
641# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
642!DIR$ INLINEALWAYS s_applygaussian
643# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
644#endif
645# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
646#elif MFC_OpenACC
647# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
648!$acc routine seq
649# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
650#elif MFC_OpenMP
651# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
652
653# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
654
655# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
656!$omp declare target device_type(any)
657# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
658#endif
659
660 real(wp), dimension(3), intent(in) :: center
661 integer, dimension(3), intent(in) :: cellaux
662 real(wp), dimension(3), intent(in) :: nodecoord
663 real(wp), intent(in) :: stddsv
664 real(wp), intent(in) :: strength_idx
665 real(wp), intent(out) :: func
666 real(wp) :: distance
667 real(wp) :: theta, dtheta, L2, dzp, Lz2
668 real(wp) :: Nr, Nr_count
669
670 distance = sqrt((center(1) - nodecoord(1))**2._wp + (center(2) - nodecoord(2))**2._wp + (center(3) - nodecoord(3))**2._wp)
671
672 if (num_dims == 3) then
673 !> 3D gaussian function
674 func = exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv)**3._wp
675 else
676 if (cyl_coord) then
677 !> 2D cylindrical function:
678 ! We smear particles in the azimuthal direction for given r
679 theta = 0._wp
680 nr = ceiling(2._wp*pi*nodecoord(2)/(y_cb(cellaux(2)) - y_cb(cellaux(2) - 1)))
681 dtheta = 2._wp*pi/nr
682 l2 = center(2)**2._wp + nodecoord(2)**2._wp - 2._wp*center(2)*nodecoord(2)*cos(theta)
683 distance = sqrt((center(1) - nodecoord(1))**2._wp + l2)
684 ! Factor 2._wp is for symmetry (upper half of the 2D field (+r) is considered)
685 func = dtheta/2._wp/pi*exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv)**3._wp
686 nr_count = 0._wp
687 do while (nr_count < nr - 1._wp)
688 nr_count = nr_count + 1._wp
689 theta = nr_count*dtheta
690 ! trigonometric relation
691 l2 = center(2)**2._wp + nodecoord(2)**2._wp - 2._wp*center(2)*nodecoord(2)*cos(theta)
692 distance = sqrt((center(1) - nodecoord(1))**2._wp + l2)
693 ! nodecoord(2)*dtheta is the azimuthal width of the cell
694 func = func + dtheta/2._wp/pi*exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv) &
695 & **(3._wp*(strength_idx + 1._wp))
696 end do
697 else
698 !> 2D cartesian function:
699 ! We smear particles considering a virtual depth (lag_params%charwidth)
700 theta = 0._wp
701 nr = ceiling(lag_params%charwidth/(y_cb(cellaux(2)) - y_cb(cellaux(2) - 1)))
702 nr_count = 1._wp - mapcells*1._wp
703 dzp = y_cb(cellaux(2) + 1) - y_cb(cellaux(2))
704 lz2 = (center(3) - (dzp*(0.5_wp + nr_count) - lag_params%charwidth/2._wp))**2._wp
705 distance = sqrt((center(1) - nodecoord(1))**2._wp + (center(2) - nodecoord(2))**2._wp + lz2)
706 func = dzp/lag_params%charwidth*exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv)**3._wp
707 do while (nr_count < nr - 1._wp + ((mapcells - 1)*1._wp))
708 nr_count = nr_count + 1._wp
709 lz2 = (center(3) - (dzp*(0.5_wp + nr_count) - lag_params%charwidth/2._wp))**2._wp
710 distance = sqrt((center(1) - nodecoord(1))**2._wp + (center(2) - nodecoord(2))**2._wp + lz2)
711 func = func + dzp/lag_params%charwidth*exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv) &
712 & **(3._wp*(strength_idx + 1._wp))
713 end do
714 end if
715 end if
716
717 end subroutine s_applygaussian
718
719 !> Check if the current cell is outside the computational domain including ghost cells
720 subroutine s_check_celloutside(cellaux, celloutside)
721
722
723# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
724#ifdef _CRAYFTN
725# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
726#if MFC_OpenACC
727# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
728!$acc routine seq
729# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
730#elif MFC_OpenMP
731# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
732
733# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
734
735# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
736!$omp declare target device_type(any)
737# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
738#else
739# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
740!DIR$ INLINEALWAYS s_check_celloutside
741# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
742#endif
743# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
744#elif MFC_OpenACC
745# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
746!$acc routine seq
747# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
748#elif MFC_OpenMP
749# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
750
751# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
752
753# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
754!$omp declare target device_type(any)
755# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
756#endif
757
758 integer, dimension(3), intent(inout) :: cellaux
759 logical, intent(out) :: celloutside
760
761 celloutside = .false.
762
763 if (num_dims == 2) then
764 if ((cellaux(1) < -buff_size) .or. (cellaux(2) < -buff_size)) then
765 celloutside = .true.
766 end if
767 if (cyl_coord .and. y_cc(cellaux(2)) < 0._wp) then
768 celloutside = .true.
769 end if
770 if ((cellaux(2) > n + buff_size) .or. (cellaux(1) > m + buff_size)) then
771 celloutside = .true.
772 end if
773 else
774 if ((cellaux(3) < -buff_size) .or. (cellaux(1) < -buff_size) .or. (cellaux(2) < -buff_size)) then
775 celloutside = .true.
776 end if
777
778 if ((cellaux(3) > p + buff_size) .or. (cellaux(2) > n + buff_size) .or. (cellaux(1) > m + buff_size)) then
779 celloutside = .true.
780 end if
781 end if
782
783 end subroutine s_check_celloutside
784
785 !> Relocate cells that intersect a symmetric boundary
786 subroutine s_shift_cell_symmetric_bc(cellaux, cell)
787
788
789# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
790#ifdef _CRAYFTN
791# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
792#if MFC_OpenACC
793# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
794!$acc routine seq
795# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
796#elif MFC_OpenMP
797# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
798
799# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
800
801# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
802!$omp declare target device_type(any)
803# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
804#else
805# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
806!DIR$ INLINEALWAYS s_shift_cell_symmetric_bc
807# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
808#endif
809# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
810#elif MFC_OpenACC
811# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
812!$acc routine seq
813# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
814#elif MFC_OpenMP
815# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
816
817# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
818
819# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
820!$omp declare target device_type(any)
821# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
822#endif
823
824 integer, dimension(3), intent(inout) :: cellaux
825 integer, dimension(3), intent(in) :: cell
826
827 ! x-dir
828 if (bc_x%beg == bc_reflective .and. (cell(1) <= mapcells - 1)) then
829 cellaux(1) = abs(cellaux(1)) - 1
830 end if
831 if (bc_x%end == bc_reflective .and. (cell(1) >= m + 1 - mapcells)) then
832 cellaux(1) = cellaux(1) - (2*(cellaux(1) - m) - 1)
833 end if
834
835 ! y-dir
836 if (bc_y%beg == bc_reflective .and. (cell(2) <= mapcells - 1)) then
837 cellaux(2) = abs(cellaux(2)) - 1
838 end if
839 if (bc_y%end == bc_reflective .and. (cell(2) >= n + 1 - mapcells)) then
840 cellaux(2) = cellaux(2) - (2*(cellaux(2) - n) - 1)
841 end if
842
843 if (p > 0) then
844 ! z-dir
845 if (bc_z%beg == bc_reflective .and. (cell(3) <= mapcells - 1)) then
846 cellaux(3) = abs(cellaux(3)) - 1
847 end if
848 if (bc_z%end == bc_reflective .and. (cell(3) >= p + 1 - mapcells)) then
849 cellaux(3) = cellaux(3) - (2*(cellaux(3) - p) - 1)
850 end if
851 end if
852
853 end subroutine s_shift_cell_symmetric_bc
854
855 !> Calculates the standard deviation of the bubble being smeared in the Eulerian framework.
856 subroutine s_compute_stddsv(cell, volpart, stddsv)
857
858
859# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
860#ifdef _CRAYFTN
861# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
862#if MFC_OpenACC
863# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
864!$acc routine seq
865# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
866#elif MFC_OpenMP
867# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
868
869# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
870
871# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
872!$omp declare target device_type(any)
873# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
874#else
875# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
876!DIR$ INLINEALWAYS s_compute_stddsv
877# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
878#endif
879# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
880#elif MFC_OpenACC
881# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
882!$acc routine seq
883# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
884#elif MFC_OpenMP
885# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
886
887# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
888
889# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
890!$omp declare target device_type(any)
891# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
892#endif
893
894 integer, dimension(3), intent(in) :: cell
895 real(wp), intent(in) :: volpart
896 real(wp), intent(out) :: stddsv
897 real(wp) :: chardist, charvol
898 real(wp) :: rad
899
900 !> Compute characteristic distance
901 chardist = sqrt(dx(cell(1))*dy(cell(2)))
902 if (p > 0) chardist = (dx(cell(1))*dy(cell(2))*dz(cell(3)))**(1._wp/3._wp)
903
904 !> Compute characteristic volume
905 if (p > 0) then
906 charvol = dx(cell(1))*dy(cell(2))*dz(cell(3))
907 else
908 if (cyl_coord) then
909 charvol = dx(cell(1))*dy(cell(2))*y_cc(cell(2))*2._wp*pi
910 else
911 charvol = dx(cell(1))*dy(cell(2))*lag_params%charwidth
912 end if
913 end if
914
915 !> Compute Standard deviaton
916 if (((volpart/charvol) > 0.5_wp*lag_params%valmaxvoid) .or. (lag_params%smooth_type == 1)) then
917 rad = (3._wp*volpart/(4._wp*pi))**(1._wp/3._wp)
918 stddsv = 1._wp*lag_params%epsilonb*max(chardist, rad)
919 else
920 stddsv = 0._wp
921 end if
922
923 end subroutine s_compute_stddsv
924
925 !> Compute the characteristic cell volume
926 subroutine s_get_char_vol(cellx, celly, cellz, Charvol)
927
928
929# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
930#ifdef _CRAYFTN
931# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
932#if MFC_OpenACC
933# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
934!$acc routine seq
935# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
936#elif MFC_OpenMP
937# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
938
939# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
940
941# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
942!$omp declare target device_type(any)
943# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
944#else
945# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
946!DIR$ INLINEALWAYS s_get_char_vol
947# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
948#endif
949# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
950#elif MFC_OpenACC
951# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
952!$acc routine seq
953# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
954#elif MFC_OpenMP
955# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
956
957# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
958
959# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
960!$omp declare target device_type(any)
961# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
962#endif
963
964 integer, intent(in) :: cellx, celly, cellz
965 real(wp), intent(out) :: Charvol
966
967 if (p > 0) then
968 charvol = dx(cellx)*dy(celly)*dz(cellz)
969 else
970 if (cyl_coord) then
971 charvol = dx(cellx)*dy(celly)*y_cc(celly)*2._wp*pi
972 else
973 charvol = dx(cellx)*dy(celly)*lag_params%charwidth
974 end if
975 end if
976
977 end subroutine s_get_char_vol
978
979 !> Convert bubble computational coordinates from real to integer cell indices
980 subroutine s_get_cell(s_cell, get_cell)
981
982
983# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
984#ifdef _CRAYFTN
985# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
986#if MFC_OpenACC
987# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
988!$acc routine seq
989# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
990#elif MFC_OpenMP
991# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
992
993# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
994
995# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
996!$omp declare target device_type(any)
997# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
998#else
999# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1000!DIR$ INLINEALWAYS s_get_cell
1001# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1002#endif
1003# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1004#elif MFC_OpenACC
1005# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1006!$acc routine seq
1007# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1008#elif MFC_OpenMP
1009# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1010
1011# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1012
1013# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1014!$omp declare target device_type(any)
1015# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1016#endif
1017
1018 real(wp), dimension(3), intent(in) :: s_cell
1019 integer, dimension(3), intent(out) :: get_cell
1020 integer :: i
1021
1022 get_cell(:) = int(s_cell(:))
1023 do i = 1, num_dims
1024 if (s_cell(i) < 0._wp) get_cell(i) = get_cell(i) - 1
1025 end do
1026
1027 end subroutine s_get_cell
1028
1029end module m_bubbles_el_kernels
m_bubbles_el_kernels
Kernel functions (Gaussian, delta) that smear Lagrangian bubble effects onto the Eulerian grid.
Definition m_bubbles_EL_kernels.fpp.f90:317
m_bubbles_el_kernels::s_smoothfunction
subroutine s_smoothfunction(nbubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar)
Smear the Lagrangian bubble effects onto the Eulerian grid using the selected kernel.
Definition m_bubbles_EL_kernels.fpp.f90:327
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:623
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:721
m_bubbles_el_kernels::s_gaussian
subroutine s_gaussian(nbubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar)
Apply the Gaussian kernel function to smear bubble effects onto surrounding cells.
Definition m_bubbles_EL_kernels.fpp.f90:455
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:787
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:857
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:927
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:981
m_bubbles_el_kernels::s_deltafunc
subroutine s_deltafunc(nbubs, lbk_rad, lbk_vel, lbk_s, updatedvar)
Apply the delta kernel function to map bubble effects onto the containing cell.
Definition m_bubbles_EL_kernels.fpp.f90:344
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:328