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
33# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
34! New line at end of file is required for FYPP
35# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
36# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
37# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
38# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
46# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49
50# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63! New line at end of file is required for FYPP
64# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
65
66# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
67# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
68# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
69# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
70# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
71
72# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
73
74# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75
76# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77
78# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142! New line at end of file is required for FYPP
143# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
144# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
145# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
146# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
147# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
148# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
149# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
150# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
151
152# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
153# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
154# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155
156# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157
158# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159
160# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161
162# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165
166# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171! New line at end of file is required for FYPP
172# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
173
174# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
175
176# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
177
178# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
179
180# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
181
182# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229! New line at end of file is required for FYPP
230# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
231
232! GPU parallel region (scalar reductions, maxval/minval)
233# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
234
235! GPU parallel loop over threads (most common GPU macro)
236# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
237
238! Required closing for GPU_PARALLEL_LOOP
239# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
240
241! Mark routine for device compilation
242# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
243
244! Declare device-resident data
245# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247! Inner loop within a GPU parallel region
248# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250! Scoped GPU data region
251# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253! Host code with device pointers (for MPI with GPU buffers)
254# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256! Allocate device memory (unscoped)
257# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259! Free device memory
260# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262! Atomic operation on device
263# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265! End atomic capture block
266# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! Copy data between host and device
269# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Synchronization barrier
272# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Import GPU library module (openacc or omp_lib)
275# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Emit code only for AMD compiler
278# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Emit code for non-Cray compilers
281# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Emit code only for Cray compiler
284# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Emit code for non-NVIDIA compilers
287# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
290# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291! New line at end of file is required for FYPP
292# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
293
294# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
295
296! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
297! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
298! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
299# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
300
301! Allocate and create GPU device memory
302# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
303
304! Free GPU device memory and deallocate
305# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
306
307! Cray-specific GPU pointer setup for vector fields
308# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
309
310! Cray-specific GPU pointer setup for scalar fields
311# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
312
313! Cray-specific GPU pointer setup for acoustic source spatials
314# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
315
316# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
317
318# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
319! New line at end of file is required for FYPP
320# 6 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp" 2
321
322!> @brief Kernel functions (Gaussian, delta) that smear Lagrangian bubble effects onto the Eulerian grid
323module m_bubbles_el_kernels
324
325 use m_mpi_proxy
326
327 implicit none
328
329contains
330
331 !> Smear the Lagrangian bubble effects onto the Eulerian grid using the selected kernel
332 subroutine s_smoothfunction(nBubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar)
333
334 integer, intent(in) :: nBubs
335 real(wp), dimension(1:lag_params%nBubs_glb,1:3,1:2), intent(in) :: lbk_s, lbk_pos
336 real(wp), dimension(1:lag_params%nBubs_glb,1:2), intent(in) :: lbk_rad, lbk_vel
337 type(scalar_field), dimension(:), intent(inout) :: updatedvar
338
339 smoothfunc:select case(lag_params%smooth_type)
340 case (1)
341 call s_gaussian(nbubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar)
342 case (2)
343 call s_deltafunc(nbubs, lbk_rad, lbk_vel, lbk_s, updatedvar)
344 end select smoothfunc
345
346 end subroutine s_smoothfunction
347
348 !> Apply the delta kernel function to map bubble effects onto the containing cell
349 subroutine s_deltafunc(nBubs, lbk_rad, lbk_vel, lbk_s, updatedvar)
350
351 integer, intent(in) :: nBubs
352 real(wp), dimension(1:lag_params%nBubs_glb,1:3,1:2), intent(in) :: lbk_s
353 real(wp), dimension(1:lag_params%nBubs_glb,1:2), intent(in) :: lbk_rad, lbk_vel
354 type(scalar_field), dimension(:), intent(inout) :: updatedvar
355 integer, dimension(3) :: cell
356 real(wp) :: strength_vel, strength_vol
357 real(wp) :: addFun1, addFun2, addFun3
358 real(wp) :: volpart, Vol
359 real(wp), dimension(3) :: s_coord
360 integer :: l
361
362
363# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
364
365# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
366#if defined(MFC_OpenACC)
367# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
368!$acc parallel loop gang vector default(present) private(l, s_coord, cell)
369# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
370#elif defined(MFC_OpenMP)
371# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
372
373# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
374
375# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
376
377# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
378!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(l, s_coord, cell)
379# 47 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
380#endif
381 do l = 1, nbubs
382 volpart = 4._wp/3._wp*pi*lbk_rad(l, 2)**3._wp
383 s_coord(1:3) = lbk_s(l,1:3,2)
384 call s_get_cell(s_coord, cell)
385
386 strength_vol = volpart
387 strength_vel = 4._wp*pi*lbk_rad(l, 2)**2._wp*lbk_vel(l, 2)
388
389 if (num_dims == 2) then
390 vol = dx(cell(1))*dy(cell(2))*lag_params%charwidth
391 if (cyl_coord) vol = dx(cell(1))*dy(cell(2))*y_cc(cell(2))*2._wp*pi
392 else
393 vol = dx(cell(1))*dy(cell(2))*dz(cell(3))
394 end if
395
396 ! Update void fraction field
397 addfun1 = strength_vol/vol
398
399# 65 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
400#if defined(MFC_OpenACC)
401# 65 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
402!$acc atomic update
403# 65 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
404#elif defined(MFC_OpenMP)
405# 65 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
406!$omp atomic update
407# 65 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
408#endif
409 updatedvar(1)%sf(cell(1), cell(2), cell(3)) = updatedvar(1)%sf(cell(1), cell(2), cell(3)) + real(addfun1, kind=stp)
410
411 ! Update time derivative of void fraction
412 addfun2 = strength_vel/vol
413
414# 70 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
415#if defined(MFC_OpenACC)
416# 70 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
417!$acc atomic update
418# 70 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
419#elif defined(MFC_OpenMP)
420# 70 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
421!$omp atomic update
422# 70 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
423#endif
424 updatedvar(2)%sf(cell(1), cell(2), cell(3)) = updatedvar(2)%sf(cell(1), cell(2), cell(3)) + real(addfun2, kind=stp)
425
426 ! Product of two smeared functions Update void fraction * time derivative of void fraction
427 if (lag_params%cluster_type >= 4) then
428 addfun3 = (strength_vol*strength_vel)/vol
429
430# 76 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
431#if defined(MFC_OpenACC)
432# 76 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
433!$acc atomic update
434# 76 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
435#elif defined(MFC_OpenMP)
436# 76 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
437!$omp atomic update
438# 76 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
439#endif
440 updatedvar(5)%sf(cell(1), cell(2), cell(3)) = updatedvar(5)%sf(cell(1), cell(2), cell(3)) + real(addfun3, kind=stp)
441 end if
442 end do
443
444# 80 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
445#if defined(MFC_OpenACC)
446# 80 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
447!$acc end parallel loop
448# 80 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
449#elif defined(MFC_OpenMP)
450# 80 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
451
452# 80 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
453!$omp end target teams loop
454# 80 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
455#endif
456
457 end subroutine s_deltafunc
458
459 !> Apply the Gaussian kernel function to smear bubble effects onto surrounding cells
460 subroutine s_gaussian(nBubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar)
461
462 integer, intent(in) :: nBubs
463 real(wp), dimension(1:lag_params%nBubs_glb,1:3,1:2), intent(in) :: lbk_s, lbk_pos
464 real(wp), dimension(1:lag_params%nBubs_glb,1:2), intent(in) :: lbk_rad, lbk_vel
465 type(scalar_field), dimension(:), intent(inout) :: updatedvar
466 real(wp), dimension(3) :: center
467 integer, dimension(3) :: cell
468 real(wp) :: stddsv
469 real(wp) :: strength_vel, strength_vol
470 real(wp), dimension(3) :: nodecoord
471 real(wp) :: addFun1, addFun2, addFun3
472 real(wp) :: func, func2, volpart
473 integer, dimension(3) :: cellaux
474 real(wp), dimension(3) :: s_coord
475 integer :: l, i, j, k
476 logical :: celloutside
477 integer :: smearGrid, smearGridz
478
479 smeargrid = mapcells - (-mapcells) + 1 ! Include the cell that contains the bubble (3+1+3)
480 smeargridz = smeargrid
481 if (p == 0) smeargridz = 1
482
483
484# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
485
486# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
487#if defined(MFC_OpenACC)
488# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
489!$acc parallel loop gang vector default(present) private(nodecoord, l, s_coord, cell, center) copyin(smearGrid, smearGridz)
490# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
491#elif defined(MFC_OpenMP)
492# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
493
494# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
495
496# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
497
498# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
499!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
500# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
501!$omp& private(nodecoord, l, s_coord, cell, center) map(to:smearGrid, smearGridz)
502# 108 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
503#endif
504 do l = 1, nbubs
505 nodecoord(1:3) = 0
506 center(1:3) = 0._wp
507 volpart = 4._wp/3._wp*pi*lbk_rad(l, 2)**3._wp
508 s_coord(1:3) = lbk_s(l,1:3,2)
509 center(1:2) = lbk_pos(l,1:2,2)
510 if (p > 0) center(3) = lbk_pos(l, 3, 2)
511 call s_get_cell(s_coord, cell)
512 call s_compute_stddsv(cell, volpart, stddsv)
513
514 strength_vol = volpart
515 strength_vel = 4._wp*pi*lbk_rad(l, 2)**2._wp*lbk_vel(l, 2)
516
517
518# 122 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
519#if defined(MFC_OpenACC)
520# 122 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
521!$acc loop collapse(3) private(cellaux, nodecoord)
522# 122 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
523#elif defined(MFC_OpenMP)
524# 122 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
525
526# 122 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
527#endif
528 do i = 1, smeargrid
529 do j = 1, smeargrid
530 do k = 1, smeargridz
531 cellaux(1) = cell(1) + i - (mapcells + 1)
532 cellaux(2) = cell(2) + j - (mapcells + 1)
533 cellaux(3) = cell(3) + k - (mapcells + 1)
534 if (p == 0) cellaux(3) = 0
535
536 ! Check if the cells intended to smear the bubbles in are in the computational domain and redefine the cells
537 ! for symmetric boundary
538 call s_check_celloutside(cellaux, celloutside)
539
540 if (.not. celloutside) then
541 nodecoord(1) = x_cc(cellaux(1))
542 nodecoord(2) = y_cc(cellaux(2))
543 if (p > 0) nodecoord(3) = z_cc(cellaux(3))
544 call s_applygaussian(center, cellaux, nodecoord, stddsv, 0._wp, func)
545 if (lag_params%cluster_type >= 4) call s_applygaussian(center, cellaux, nodecoord, stddsv, 1._wp, func2)
546
547 ! Relocate cells for bubbles intersecting symmetric boundaries
548 if (any((/bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end/) == bc_reflective)) then
549 call s_shift_cell_symmetric_bc(cellaux, cell)
550 end if
551 else
552 func = 0._wp
553 func2 = 0._wp
554 cellaux(1) = cell(1)
555 cellaux(2) = cell(2)
556 cellaux(3) = cell(3)
557 if (p == 0) cellaux(3) = 0
558 end if
559
560 ! Update void fraction field
561 addfun1 = func*strength_vol
562
563# 157 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
564#if defined(MFC_OpenACC)
565# 157 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
566!$acc atomic update
567# 157 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
568#elif defined(MFC_OpenMP)
569# 157 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
570!$omp atomic update
571# 157 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
572#endif
573 updatedvar(1)%sf(cellaux(1), cellaux(2), cellaux(3)) = updatedvar(1)%sf(cellaux(1), cellaux(2), &
574 & cellaux(3)) + real(addfun1, kind=stp)
575
576 ! Update time derivative of void fraction
577 addfun2 = func*strength_vel
578
579# 163 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
580#if defined(MFC_OpenACC)
581# 163 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
582!$acc atomic update
583# 163 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
584#elif defined(MFC_OpenMP)
585# 163 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
586!$omp atomic update
587# 163 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
588#endif
589 updatedvar(2)%sf(cellaux(1), cellaux(2), cellaux(3)) = updatedvar(2)%sf(cellaux(1), cellaux(2), &
590 & cellaux(3)) + real(addfun2, kind=stp)
591
592 ! Product of two smeared functions Update void fraction * time derivative of void fraction
593 if (lag_params%cluster_type >= 4) then
594 addfun3 = func2*strength_vol*strength_vel
595
596# 170 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
597#if defined(MFC_OpenACC)
598# 170 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
599!$acc atomic update
600# 170 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
601#elif defined(MFC_OpenMP)
602# 170 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
603!$omp atomic update
604# 170 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
605#endif
606 updatedvar(5)%sf(cellaux(1), cellaux(2), cellaux(3)) = updatedvar(5)%sf(cellaux(1), cellaux(2), &
607 & cellaux(3)) + real(addfun3, kind=stp)
608 end if
609 end do
610 end do
611 end do
612 end do
613
614# 178 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
615#if defined(MFC_OpenACC)
616# 178 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
617!$acc end parallel loop
618# 178 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
619#elif defined(MFC_OpenMP)
620# 178 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
621
622# 178 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
623!$omp end target teams loop
624# 178 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
625#endif
626
627 end subroutine s_gaussian
628
629 !> Evaluate the Gaussian kernel at a grid node for a given bubble center
630 subroutine s_applygaussian(center, cellaux, nodecoord, stddsv, strength_idx, func)
631
632
633# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
634#ifdef _CRAYFTN
635# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
636#if MFC_OpenACC
637# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
638!$acc routine seq
639# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
640#elif MFC_OpenMP
641# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
642
643# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
644
645# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
646!$omp declare target device_type(any)
647# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
648#else
649# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
650!DIR$ INLINEALWAYS s_applygaussian
651# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
652#endif
653# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
654#elif MFC_OpenACC
655# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
656!$acc routine seq
657# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
658#elif MFC_OpenMP
659# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
660
661# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
662
663# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
664!$omp declare target device_type(any)
665# 185 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
666#endif
667
668 real(wp), dimension(3), intent(in) :: center
669 integer, dimension(3), intent(in) :: cellaux
670 real(wp), dimension(3), intent(in) :: nodecoord
671 real(wp), intent(in) :: stddsv
672 real(wp), intent(in) :: strength_idx
673 real(wp), intent(out) :: func
674 real(wp) :: distance
675 real(wp) :: theta, dtheta, L2, dzp, Lz2
676 real(wp) :: Nr, Nr_count
677
678 distance = sqrt((center(1) - nodecoord(1))**2._wp + (center(2) - nodecoord(2))**2._wp + (center(3) - nodecoord(3))**2._wp)
679
680 if (num_dims == 3) then
681 !> 3D gaussian function
682 func = exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv)**3._wp
683 else
684 if (cyl_coord) then
685 !> 2D cylindrical function:
686 ! We smear particles in the azimuthal direction for given r
687 theta = 0._wp
688 nr = ceiling(2._wp*pi*nodecoord(2)/(y_cb(cellaux(2)) - y_cb(cellaux(2) - 1)))
689 dtheta = 2._wp*pi/nr
690 l2 = center(2)**2._wp + nodecoord(2)**2._wp - 2._wp*center(2)*nodecoord(2)*cos(theta)
691 distance = sqrt((center(1) - nodecoord(1))**2._wp + l2)
692 ! Factor 2._wp is for symmetry (upper half of the 2D field (+r) is considered)
693 func = dtheta/2._wp/pi*exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv)**3._wp
694 nr_count = 0._wp
695 do while (nr_count < nr - 1._wp)
696 nr_count = nr_count + 1._wp
697 theta = nr_count*dtheta
698 ! trigonometric relation
699 l2 = center(2)**2._wp + nodecoord(2)**2._wp - 2._wp*center(2)*nodecoord(2)*cos(theta)
700 distance = sqrt((center(1) - nodecoord(1))**2._wp + l2)
701 ! nodecoord(2)*dtheta is the azimuthal width of the cell
702 func = func + dtheta/2._wp/pi*exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv) &
703 & **(3._wp*(strength_idx + 1._wp))
704 end do
705 else
706 !> 2D cartesian function:
707 ! We smear particles considering a virtual depth (lag_params%charwidth)
708 theta = 0._wp
709 nr = ceiling(lag_params%charwidth/(y_cb(cellaux(2)) - y_cb(cellaux(2) - 1)))
710 nr_count = 1._wp - mapcells*1._wp
711 dzp = y_cb(cellaux(2) + 1) - y_cb(cellaux(2))
712 lz2 = (center(3) - (dzp*(0.5_wp + nr_count) - lag_params%charwidth/2._wp))**2._wp
713 distance = sqrt((center(1) - nodecoord(1))**2._wp + (center(2) - nodecoord(2))**2._wp + lz2)
714 func = dzp/lag_params%charwidth*exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv)**3._wp
715 do while (nr_count < nr - 1._wp + ((mapcells - 1)*1._wp))
716 nr_count = nr_count + 1._wp
717 lz2 = (center(3) - (dzp*(0.5_wp + nr_count) - lag_params%charwidth/2._wp))**2._wp
718 distance = sqrt((center(1) - nodecoord(1))**2._wp + (center(2) - nodecoord(2))**2._wp + lz2)
719 func = func + dzp/lag_params%charwidth*exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv) &
720 & **(3._wp*(strength_idx + 1._wp))
721 end do
722 end if
723 end if
724
725 end subroutine s_applygaussian
726
727 !> Check if the current cell is outside the computational domain including ghost cells
728 subroutine s_check_celloutside(cellaux, celloutside)
729
730
731# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
732#ifdef _CRAYFTN
733# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
734#if MFC_OpenACC
735# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
736!$acc routine seq
737# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
738#elif MFC_OpenMP
739# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
740
741# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
742
743# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
744!$omp declare target device_type(any)
745# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
746#else
747# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
748!DIR$ INLINEALWAYS s_check_celloutside
749# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
750#endif
751# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
752#elif MFC_OpenACC
753# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
754!$acc routine seq
755# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
756#elif MFC_OpenMP
757# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
758
759# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
760
761# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
762!$omp declare target device_type(any)
763# 249 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
764#endif
765
766 integer, dimension(3), intent(inout) :: cellaux
767 logical, intent(out) :: celloutside
768
769 celloutside = .false.
770
771 if (num_dims == 2) then
772 if ((cellaux(1) < -buff_size) .or. (cellaux(2) < -buff_size)) then
773 celloutside = .true.
774 end if
775 if (cyl_coord .and. y_cc(cellaux(2)) < 0._wp) then
776 celloutside = .true.
777 end if
778 if ((cellaux(2) > n + buff_size) .or. (cellaux(1) > m + buff_size)) then
779 celloutside = .true.
780 end if
781 else
782 if ((cellaux(3) < -buff_size) .or. (cellaux(1) < -buff_size) .or. (cellaux(2) < -buff_size)) then
783 celloutside = .true.
784 end if
785
786 if ((cellaux(3) > p + buff_size) .or. (cellaux(2) > n + buff_size) .or. (cellaux(1) > m + buff_size)) then
787 celloutside = .true.
788 end if
789 end if
790
791 end subroutine s_check_celloutside
792
793 !> Relocate cells that intersect a symmetric boundary
794 subroutine s_shift_cell_symmetric_bc(cellaux, cell)
795
796
797# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
798#ifdef _CRAYFTN
799# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
800#if MFC_OpenACC
801# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
802!$acc routine seq
803# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
804#elif MFC_OpenMP
805# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
806
807# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
808
809# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
810!$omp declare target device_type(any)
811# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
812#else
813# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
814!DIR$ INLINEALWAYS s_shift_cell_symmetric_bc
815# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
816#endif
817# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
818#elif MFC_OpenACC
819# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
820!$acc routine seq
821# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
822#elif MFC_OpenMP
823# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
824
825# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
826
827# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
828!$omp declare target device_type(any)
829# 281 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
830#endif
831
832 integer, dimension(3), intent(inout) :: cellaux
833 integer, dimension(3), intent(in) :: cell
834
835 ! x-dir
836 if (bc_x%beg == bc_reflective .and. (cell(1) <= mapcells - 1)) then
837 cellaux(1) = abs(cellaux(1)) - 1
838 end if
839 if (bc_x%end == bc_reflective .and. (cell(1) >= m + 1 - mapcells)) then
840 cellaux(1) = cellaux(1) - (2*(cellaux(1) - m) - 1)
841 end if
842
843 ! y-dir
844 if (bc_y%beg == bc_reflective .and. (cell(2) <= mapcells - 1)) then
845 cellaux(2) = abs(cellaux(2)) - 1
846 end if
847 if (bc_y%end == bc_reflective .and. (cell(2) >= n + 1 - mapcells)) then
848 cellaux(2) = cellaux(2) - (2*(cellaux(2) - n) - 1)
849 end if
850
851 if (p > 0) then
852 ! z-dir
853 if (bc_z%beg == bc_reflective .and. (cell(3) <= mapcells - 1)) then
854 cellaux(3) = abs(cellaux(3)) - 1
855 end if
856 if (bc_z%end == bc_reflective .and. (cell(3) >= p + 1 - mapcells)) then
857 cellaux(3) = cellaux(3) - (2*(cellaux(3) - p) - 1)
858 end if
859 end if
860
861 end subroutine s_shift_cell_symmetric_bc
862
863 !> Calculates the standard deviation of the bubble being smeared in the Eulerian framework.
864 subroutine s_compute_stddsv(cell, volpart, stddsv)
865
866
867# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
868#ifdef _CRAYFTN
869# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
870#if MFC_OpenACC
871# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
872!$acc routine seq
873# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
874#elif MFC_OpenMP
875# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
876
877# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
878
879# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
880!$omp declare target device_type(any)
881# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
882#else
883# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
884!DIR$ INLINEALWAYS s_compute_stddsv
885# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
886#endif
887# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
888#elif MFC_OpenACC
889# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
890!$acc routine seq
891# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
892#elif MFC_OpenMP
893# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
894
895# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
896
897# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
898!$omp declare target device_type(any)
899# 317 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
900#endif
901
902 integer, dimension(3), intent(in) :: cell
903 real(wp), intent(in) :: volpart
904 real(wp), intent(out) :: stddsv
905 real(wp) :: chardist, charvol
906 real(wp) :: rad
907
908 !> Compute characteristic distance
909 chardist = sqrt(dx(cell(1))*dy(cell(2)))
910 if (p > 0) chardist = (dx(cell(1))*dy(cell(2))*dz(cell(3)))**(1._wp/3._wp)
911
912 !> Compute characteristic volume
913 if (p > 0) then
914 charvol = dx(cell(1))*dy(cell(2))*dz(cell(3))
915 else
916 if (cyl_coord) then
917 charvol = dx(cell(1))*dy(cell(2))*y_cc(cell(2))*2._wp*pi
918 else
919 charvol = dx(cell(1))*dy(cell(2))*lag_params%charwidth
920 end if
921 end if
922
923 !> Compute Standard deviaton
924 if (((volpart/charvol) > 0.5_wp*lag_params%valmaxvoid) .or. (lag_params%smooth_type == 1)) then
925 rad = (3._wp*volpart/(4._wp*pi))**(1._wp/3._wp)
926 stddsv = 1._wp*lag_params%epsilonb*max(chardist, rad)
927 else
928 stddsv = 0._wp
929 end if
930
931 end subroutine s_compute_stddsv
932
933 !> Compute the characteristic cell volume
934 subroutine s_get_char_vol(cellx, celly, cellz, Charvol)
935
936
937# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
938#ifdef _CRAYFTN
939# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
940#if MFC_OpenACC
941# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
942!$acc routine seq
943# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
944#elif MFC_OpenMP
945# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
946
947# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
948
949# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
950!$omp declare target device_type(any)
951# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
952#else
953# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
954!DIR$ INLINEALWAYS s_get_char_vol
955# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
956#endif
957# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
958#elif MFC_OpenACC
959# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
960!$acc routine seq
961# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
962#elif MFC_OpenMP
963# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
964
965# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
966
967# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
968!$omp declare target device_type(any)
969# 353 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
970#endif
971
972 integer, intent(in) :: cellx, celly, cellz
973 real(wp), intent(out) :: Charvol
974
975 if (p > 0) then
976 charvol = dx(cellx)*dy(celly)*dz(cellz)
977 else
978 if (cyl_coord) then
979 charvol = dx(cellx)*dy(celly)*y_cc(celly)*2._wp*pi
980 else
981 charvol = dx(cellx)*dy(celly)*lag_params%charwidth
982 end if
983 end if
984
985 end subroutine s_get_char_vol
986
987 !> Convert bubble computational coordinates from real to integer cell indices
988 subroutine s_get_cell(s_cell, get_cell)
989
990
991# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
992#ifdef _CRAYFTN
993# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
994#if MFC_OpenACC
995# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
996!$acc routine seq
997# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
998#elif MFC_OpenMP
999# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1000
1001# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1002
1003# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1004!$omp declare target device_type(any)
1005# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1006#else
1007# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1008!DIR$ INLINEALWAYS s_get_cell
1009# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1010#endif
1011# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1012#elif MFC_OpenACC
1013# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1014!$acc routine seq
1015# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1016#elif MFC_OpenMP
1017# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1018
1019# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1020
1021# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1022!$omp declare target device_type(any)
1023# 373 "/home/runner/work/MFC/MFC/src/simulation/m_bubbles_EL_kernels.fpp"
1024#endif
1025
1026 real(wp), dimension(3), intent(in) :: s_cell
1027 integer, dimension(3), intent(out) :: get_cell
1028 integer :: i
1029
1030 get_cell(:) = int(s_cell(:))
1031 do i = 1, num_dims
1032 if (s_cell(i) < 0._wp) get_cell(i) = get_cell(i) - 1
1033 end do
1034
1035 end subroutine s_get_cell
1036
1037end 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:323
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:333
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:631
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:729
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:461
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:795
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:865
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:935
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:989
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:350
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:334