MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_assign_variables.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
2!>
3!! @file
4!! @brief Contains module m_assign_variables
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
7! This file exists so that Fypp can be run without generating case.fpp files for
8! each target. This is useful when generating documentation, for example. This
9! should also let MFC be built with CMake directly, without invoking mfc.sh.
10
11! For pre-process.
12# 8 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
13
14! For moving immersed boundaries in simulation
15# 12 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
16# 6 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp" 2
17# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
18# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
19# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
20# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
21# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
23# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
25
26# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
27# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29
30# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31
32# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
33
34# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
35
36# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37
38# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39
40# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45! New line at end of file is required for FYPP
46# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
47# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
48# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
49# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54
55# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58
59# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60
61# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
62
63# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
64
65# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
66
67# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68
69# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
70
71# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
72
73# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
74! New line at end of file is required for FYPP
75# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
76
77# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
78# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
80# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
82
83# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
84
85# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
86
87# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
88
89# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90
91# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
92
93# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
94
95# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
96
97# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
98
99# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
100
101# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
102
103# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
104
105# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
106
107# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
108
109# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
110
111# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
112
113# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151
152# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
153! New line at end of file is required for FYPP
154# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
155# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
156# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
157# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162
163# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
164# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166
167# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
168
169# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170
171# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172
173# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
174
175# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176
177# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
178
179# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
180
181# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
182! New line at end of file is required for FYPP
183# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
184
185# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
186
187# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
188
189# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
190
191# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
192
193# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
194
195# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
196
197# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
198
199# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
200
201# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
202
203# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
204
205# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
206
207# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236
237# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
238
239# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
240! New line at end of file is required for FYPP
241# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
242
243! GPU parallel region (scalar reductions, maxval/minval)
244# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
245
246! GPU parallel loop over threads (most common GPU macro)
247# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
248
249! Required closing for GPU_PARALLEL_LOOP
250# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
251
252! Mark routine for device compilation
253# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
254
255! Declare device-resident data
256# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
257
258! Inner loop within a GPU parallel region
259# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
260
261! Scoped GPU data region
262# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
263
264! Host code with device pointers (for MPI with GPU buffers)
265# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
266
267! Allocate device memory (unscoped)
268# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
269
270! Free device memory
271# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
272
273! Atomic operation on device
274# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
275
276! End atomic capture block
277# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
278
279! Copy data between host and device
280# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
281
282! Synchronization barrier
283# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
284
285! Import GPU library module (openacc or omp_lib)
286# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
287
288! Emit code only for AMD compiler
289# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
290
291! Emit code for non-Cray compilers
292# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
293
294! Emit code only for Cray compiler
295# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
296
297! Emit code for non-NVIDIA compilers
298# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
299
300# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
301# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
302! New line at end of file is required for FYPP
303# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
304
305# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
306
307! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
308! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
309! example see misc/nvidia_uvm/bind.sh.
310# 55 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312! Allocate and create GPU device memory
313# 75 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
314
315! Free GPU device memory and deallocate
316# 83 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
317
318! Cray-specific GPU pointer setup for vector fields
319# 107 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
320
321! Cray-specific GPU pointer setup for scalar fields
322# 123 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
323
324! Cray-specific GPU pointer setup for acoustic source spatials
325# 148 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
326
327# 154 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
328
329# 161 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
330! New line at end of file is required for FYPP
331# 7 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp" 2
332
333!> @brief Assigns initial primitive variables to computational cells based on patch geometry
335
340 use m_thermochem, only: num_species, gas_constant, get_mixture_molecular_weight
342
343 implicit none
344
345 public :: s_perturb_primitive
346
348
349 !> Pointer to mixture or species patch assignment routine
351 !> Abstract interface to the two subroutines that assign the patch primitive variables, either mixture or species, depending on
352 !! the subroutine, to a particular cell in the computational domain
353 abstract interface
354
355 !> Skeleton of s_assign_patch_mixture_primitive_variables and s_assign_patch_species_primitive_variables
356 subroutine s_assign_patch_xxxxx_primitive_variables(patch_id, j, k, l, eta, q_prim_vf, patch_id_fp)
357
358 import :: scalar_field, sys_size, n, m, p, wp
359
360 integer, intent(in) :: patch_id
361 integer, intent(in) :: j, k, l
362 real(wp), intent(in) :: eta
363 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
364
365#ifdef MFC_MIXED_PRECISION
366 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
367#else
368 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
369#endif
370
372 end interface
373
374 private
377
378contains
379
380 !> Allocate volume fraction sum and set the patch primitive variable assignment procedure pointer.
382
383 if (.not. igr) then
384 allocate (alf_sum%sf(0:m,0:n,0:p))
385 end if
386
387 ! Select procedure pointer based on multicomponent flow model
388
389 if (model_eqns == model_eqns_gamma_law) then ! Gamma/pi_inf model
391 else ! Volume fraction model
393 end if
394
396
397 !> Assign the mixture primitive variables of the patch designated by the patch_id to the cell that is designated by the indexes
398 !! (j,k,l). In addition, the variable bookkeeping the patch identities in the entire domain is updated with the new assignment.
399 !! Note that if the smoothing of the patch's boundaries is employed, the ensuing primitive variables in the cell will be a type
400 !! of combination of the current patch's primitive variables with those of the smoothing patch. The specific details of the
401 !! combination may be found in Shyue's work (1998).
402 subroutine s_assign_patch_mixture_primitive_variables(patch_id, j, k, l, eta, q_prim_vf, patch_id_fp)
403
404
405# 79 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
406#if MFC_OpenACC
407# 79 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
408!$acc routine seq
409# 79 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
410#elif MFC_OpenMP
411# 79 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
412
413# 79 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
414
415# 79 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
416!$omp declare target device_type(any)
417# 79 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
418#endif
419
420 integer, intent(in) :: patch_id
421 integer, intent(in) :: j, k, l
422 real(wp), intent(in) :: eta
423 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
424#ifdef MFC_MIXED_PRECISION
425 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
426#else
427 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
428#endif
429
430 real(wp) :: ys(1:num_species)
431 integer :: smooth_patch_id
432 integer :: i
433
434 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
435
436 q_prim_vf(1)%sf(j, k, l) = eta*patch_icpp(patch_id)%rho + (1._wp - eta)*patch_icpp(smooth_patch_id)%rho
437
438 do i = 1, eqn_idx%E - eqn_idx%mom%beg
439 q_prim_vf(i + 1)%sf(j, k, l) = 1._wp/q_prim_vf(1)%sf(j, k, &
440 & l)*(eta*patch_icpp(patch_id)%rho*patch_icpp(patch_id)%vel(i) + (1._wp - eta) &
441 & *patch_icpp(smooth_patch_id)%rho*patch_icpp(smooth_patch_id)%vel(i))
442 end do
443
444 q_prim_vf(eqn_idx%gamma)%sf(j, k, l) = eta*patch_icpp(patch_id)%gamma + (1._wp - eta)*patch_icpp(smooth_patch_id)%gamma
445
446 q_prim_vf(eqn_idx%E)%sf(j, k, l) = 1._wp/q_prim_vf(eqn_idx%gamma)%sf(j, k, &
447 & l)*(eta*patch_icpp(patch_id)%gamma*patch_icpp(patch_id)%pres + (1._wp - eta) &
448 & *patch_icpp(smooth_patch_id)%gamma*patch_icpp(smooth_patch_id)%pres)
449
450 q_prim_vf(eqn_idx%pi_inf)%sf(j, k, l) = eta*patch_icpp(patch_id)%pi_inf + (1._wp - eta)*patch_icpp(smooth_patch_id)%pi_inf
451
452 if (chemistry) then
453 block
454 real(wp) :: sum, term
455
456 sum = 0._wp
457 do i = 1, num_species
458 term = eta*patch_icpp(patch_id)%Y(i) + (1._wp - eta)*patch_icpp(smooth_patch_id)%Y(i)
459 q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l) = term
460 sum = sum + term
461 end do
462
463 sum = max(sum, verysmall)
464
465 do i = 1, num_species
466 q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l) = q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l)/sum
467 ys(i) = q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l)
468 end do
469 end block
470 end if
471
472 if (1._wp - eta < 1.e-16_wp) patch_id_fp(j, k, l) = patch_id
473
475
476 !> Apply a stable pressure perturbation following Ando's method for bubble-laden flows.
477 subroutine s_perturb_primitive(j, k, l, q_prim_vf)
478
479 integer, intent(in) :: j, k, l
480 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
481 integer :: i
482 real(wp) :: n_tait, b_tait, p0
483 real(wp) :: r3bar, n0, ratio, nh, vfh, velh, rhoh, deno
484
485 p0 = 101325._wp
486 n_tait = gs_min(1)
487 b_tait = ps_inf(1)
488
489 if (j < 177) then
490 q_prim_vf(eqn_idx%E)%sf(j, k, l) = 0.5_wp*q_prim_vf(eqn_idx%E)%sf(j, k, l)
491 end if
492
493 if (qbmm) then
494 do i = 1, nb
495 q_prim_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l) = q_prim_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, &
496 & k, l)*((p0 - bub_pp%pv)/(q_prim_vf(eqn_idx%E)%sf(j, k, l)*p0 - bub_pp%pv))**(1._wp/3._wp)
497 end do
498 end if
499
500 r3bar = 0._wp
501
502 if (qbmm) then
503 do i = 1, nb
504 r3bar = r3bar + weight(i)*0.5_wp*(q_prim_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l))**3._wp
505 end do
506 else
507 do i = 1, nb
508 if (polytropic) then
509 r3bar = r3bar + weight(i)*(q_prim_vf(eqn_idx%bub%beg + (i - 1)*2)%sf(j, k, l))**3._wp
510 else
511 r3bar = r3bar + weight(i)*(q_prim_vf(eqn_idx%bub%beg + (i - 1)*4)%sf(j, k, l))**3._wp
512 end if
513 end do
514 end if
515
516 n0 = 3._wp*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4._wp*pi*r3bar)
517
518 ratio = ((1._wp + b_tait)/(q_prim_vf(eqn_idx%E)%sf(j, k, l) + b_tait))**(1._wp/n_tait)
519
520 nh = n0/((1._wp - q_prim_vf(eqn_idx%alf)%sf(j, k, l))*ratio + (4._wp*pi/3._wp)*n0*r3bar)
521 vfh = (4._wp*pi/3._wp)*nh*r3bar
522 rhoh = (1._wp - vfh)/ratio
523 deno = 1._wp - (1._wp - q_prim_vf(eqn_idx%alf)%sf(j, k, l))/rhoh
524
525 if (f_approx_equal(deno, 0._wp)) then
526 velh = 0._wp
527 else
528 velh = (q_prim_vf(eqn_idx%E)%sf(j, k, l) - 1._wp)/(1._wp - q_prim_vf(eqn_idx%alf)%sf(j, k, l))/deno
529 velh = sqrt(velh)
530 velh = velh*deno
531 end if
532
533 do i = eqn_idx%cont%beg, eqn_idx%cont%end
534 q_prim_vf(i)%sf(j, k, l) = rhoh
535 end do
536
537 do i = eqn_idx%mom%beg, eqn_idx%mom%end
538 q_prim_vf(i)%sf(j, k, l) = velh
539 end do
540
541 q_prim_vf(eqn_idx%alf)%sf(j, k, l) = vfh
542
543 end subroutine s_perturb_primitive
544
545 !> Assign the species primitive variables, following s_assign_patch_species_primitive_variables with adaptation for
546 !! ensemble-averaged bubble modeling
547 impure subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, eta, q_prim_vf, patch_id_fp)
548
549
550# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
551#if MFC_OpenACC
552# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
553!$acc routine seq
554# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
555#elif MFC_OpenMP
556# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
557
558# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
559
560# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
561!$omp declare target device_type(any)
562# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
563#endif
564
565 integer, intent(in) :: patch_id
566 integer, intent(in) :: j, k, l
567 real(wp), intent(in) :: eta
568#ifdef MFC_MIXED_PRECISION
569 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
570#else
571 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
572#endif
573 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
574
575 ! Density, gamma, and liquid stiffness from current and smoothing patches
576 real(wp) :: rho !< density
577 real(wp) :: gamma
578 real(wp) :: pi_inf !< stiffness from SEOS
579 real(wp) :: qv !< reference energy from SEOS
580 real(wp) :: orig_rho
581 real(wp) :: orig_gamma
582 real(wp) :: orig_pi_inf
583 real(wp) :: orig_qv
584 real(wp) :: mur, muv
585 real(wp) :: r3bar
586 real(wp) :: ys(1:num_species)
587 real(stp), dimension(sys_size) :: orig_prim_vf !< Vector to hold original values of cell for smoothing purposes
588 integer :: i
589 integer :: smooth_patch_id
590
591 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
592
593 do i = 1, sys_size
594 orig_prim_vf(i) = q_prim_vf(i)%sf(j, k, l)
595 end do
596
597 if (mpp_lim .and. bubbles_euler) then
598 ! adjust volume fractions, according to modeled gas void fraction
599 alf_sum%sf = 0._wp
600 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
601 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf
602 end do
603
604 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
605 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/alf_sum%sf
606 end do
607 end if
608
609 call s_convert_to_mixture_variables(q_prim_vf, j, k, l, orig_rho, orig_gamma, orig_pi_inf, orig_qv)
610
611 if (.not. igr .or. num_fluids > 1) then
612 do i = eqn_idx%adv%beg, eqn_idx%adv%end
613 q_prim_vf(i)%sf(j, k, l) = patch_icpp(patch_id)%alpha(i - eqn_idx%E)
614 end do
615 end if
616
617 if (mpp_lim .and. bubbles_euler) then
618 ! adjust volume fractions, according to modeled gas void fraction
619 alf_sum%sf = 0._wp
620 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
621 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf
622 end do
623
624 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
625 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/alf_sum%sf
626 end do
627 end if
628
629 do i = 1, eqn_idx%cont%end
630 q_prim_vf(i)%sf(j, k, l) = patch_icpp(patch_id)%alpha_rho(i)
631 end do
632
633 call s_convert_to_mixture_variables(q_prim_vf, j, k, l, patch_icpp(patch_id)%rho, patch_icpp(patch_id)%gamma, &
634 & patch_icpp(patch_id)%pi_inf, patch_icpp(patch_id)%qv)
635
636 do i = 1, eqn_idx%cont%end
637 q_prim_vf(i)%sf(j, k, l) = patch_icpp(smooth_patch_id)%alpha_rho(i)
638 end do
639
640 if (.not. igr .or. num_fluids > 1) then
641 do i = eqn_idx%adv%beg, eqn_idx%adv%end
642 q_prim_vf(i)%sf(j, k, l) = patch_icpp(smooth_patch_id)%alpha(i - eqn_idx%E)
643 end do
644 end if
645
646 if (mpp_lim .and. bubbles_euler) then
647 ! adjust volume fractions, according to modeled gas void fraction
648 alf_sum%sf = 0._wp
649 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
650 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf
651 end do
652
653 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
654 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/alf_sum%sf
655 end do
656 end if
657
658 if (bubbles_euler) then
659 do i = 1, nb
660 mur = r0(i)*patch_icpp(smooth_patch_id)%r0/r0ref
661 muv = patch_icpp(smooth_patch_id)%v0
662 if (qbmm) then
663 ! Initialize the moment set
664 if (dist_type == 1) then
665 q_prim_vf(qbmm_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp
666 q_prim_vf(qbmm_idx%fullmom(i, 1, 0))%sf(j, k, l) = mur
667 q_prim_vf(qbmm_idx%fullmom(i, 0, 1))%sf(j, k, l) = muv
668 q_prim_vf(qbmm_idx%fullmom(i, 2, 0))%sf(j, k, l) = mur**2 + (sigr*r0ref)**2
669 q_prim_vf(qbmm_idx%fullmom(i, 1, 1))%sf(j, k, l) = mur*muv + rhorv*(sigr*r0ref)*(sigv*sqrt(p0ref/rho0ref))
670 q_prim_vf(qbmm_idx%fullmom(i, 0, 2))%sf(j, k, l) = muv**2 + (sigv*sqrt(p0ref/rho0ref))**2
671 else if (dist_type == 2) then
672 q_prim_vf(qbmm_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp
673 q_prim_vf(qbmm_idx%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigr**2)/2._wp)*mur
674 q_prim_vf(qbmm_idx%fullmom(i, 0, 1))%sf(j, k, l) = muv
675 q_prim_vf(qbmm_idx%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigr**2)*2._wp)*(mur**2)
676 q_prim_vf(qbmm_idx%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigr**2)/2._wp)*mur*muv
677 q_prim_vf(qbmm_idx%fullmom(i, 0, 2))%sf(j, k, l) = muv**2 + (sigv*sqrt(p0ref/rho0ref))**2
678 end if
679 else
680 q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l) = mur
681 q_prim_vf(qbmm_idx%vs(i))%sf(j, k, l) = muv
682 if (.not. polytropic) then
683 q_prim_vf(qbmm_idx%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0
684 q_prim_vf(qbmm_idx%ms(i))%sf(j, k, l) = patch_icpp(patch_id)%m0
685 end if
686 end if
687 end do
688
689 if (adv_n) then
690 ! Initialize number density
691 r3bar = 0._wp
692 do i = 1, nb
693 r3bar = r3bar + weight(i)*(q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l))**3._wp
694 end do
695 q_prim_vf(eqn_idx%n)%sf(j, k, l) = 3*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4*pi*r3bar)
696 end if
697 end if
698
699 call s_convert_to_mixture_variables(q_prim_vf, j, k, l, patch_icpp(smooth_patch_id)%rho, &
700 & patch_icpp(smooth_patch_id)%gamma, patch_icpp(smooth_patch_id)%pi_inf, &
701 & patch_icpp(smooth_patch_id)%qv)
702
703 q_prim_vf(eqn_idx%E)%sf(j, k, l) = (eta*patch_icpp(patch_id)%pres + (1._wp - eta)*orig_prim_vf(eqn_idx%E))
704
705 if (.not. igr .or. num_fluids > 1) then
706 do i = eqn_idx%adv%beg, eqn_idx%adv%end
707 q_prim_vf(i)%sf(j, k, l) = eta*patch_icpp(patch_id)%alpha(i - eqn_idx%E) + (1._wp - eta)*orig_prim_vf(i)
708 end do
709 end if
710
711 if (mhd) then
712 if (n == 0) then ! 1D: By, Bz
713 q_prim_vf(eqn_idx%B%beg)%sf(j, k, l) = eta*patch_icpp(patch_id)%By + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg)
714 q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, &
715 & l) = eta*patch_icpp(patch_id)%Bz + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg + 1)
716 else ! 2D/3D: Bx, By, Bz
717 q_prim_vf(eqn_idx%B%beg)%sf(j, k, l) = eta*patch_icpp(patch_id)%Bx + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg)
718 q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, &
719 & l) = eta*patch_icpp(patch_id)%By + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg + 1)
720 q_prim_vf(eqn_idx%B%beg + 2)%sf(j, k, &
721 & l) = eta*patch_icpp(patch_id)%Bz + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg + 2)
722 end if
723 end if
724
725 if (hypoelasticity) then
726 do i = 1, (eqn_idx%stress%end - eqn_idx%stress%beg) + 1
727 q_prim_vf(i + eqn_idx%stress%beg - 1)%sf(j, k, &
728 & l) = (eta*patch_icpp(patch_id)%tau_e(i) + (1._wp - eta)*orig_prim_vf(i + eqn_idx%stress%beg - 1))
729 end do
730 end if
731
732 if (mpp_lim .and. bubbles_euler) then
733 ! adjust volume fractions, according to modeled gas void fraction
734 alf_sum%sf = 0._wp
735 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
736 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf
737 end do
738
739 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
740 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/alf_sum%sf
741 end do
742 end if
743
744 ! mixture density is an input
745 do i = 1, eqn_idx%cont%end
746 q_prim_vf(i)%sf(j, k, l) = eta*patch_icpp(patch_id)%alpha_rho(i) + (1._wp - eta)*orig_prim_vf(i)
747 end do
748
749 call s_convert_to_mixture_variables(q_prim_vf, j, k, l, rho, gamma, pi_inf, qv)
750
751 do i = 1, eqn_idx%E - eqn_idx%mom%beg
752 q_prim_vf(i + eqn_idx%cont%end)%sf(j, k, &
753 & l) = (eta*patch_icpp(patch_id)%vel(i) + (1._wp - eta)*orig_prim_vf(i + eqn_idx%cont%end))
754 end do
755
756 if (chemistry) then
757 block
758 real(wp) :: sum, term
759
760 sum = 0._wp
761 do i = 1, num_species
762 term = eta*patch_icpp(patch_id)%Y(i) + (1._wp - eta)*patch_icpp(smooth_patch_id)%Y(i)
763 q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l) = term
764 sum = sum + term
765 end do
766
767 if (sum < verysmall) then
768 sum = 1._wp
769 end if
770
771 do i = 1, num_species
772 q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l) = q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l)/sum
773 ys(i) = q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l)
774 end do
775 end block
776 end if
777
778 ! Set streamwise velocity to hyperbolic tangent function of y
779 if (mixlayer_vel_profile) then
780 q_prim_vf(1 + eqn_idx%cont%end)%sf(j, k, &
781 & l) = (eta*patch_icpp(patch_id)%vel(1)*tanh(y_cc(k)*mixlayer_vel_coef) + (1._wp - eta)*orig_prim_vf(1 &
782 & + eqn_idx%cont%end))
783 end if
784
785 ! Set partial pressures to mixture pressure for the 6-eqn model
786 if (model_eqns == model_eqns_6eq) then
787 do i = eqn_idx%int_en%beg, eqn_idx%int_en%end
788 q_prim_vf(i)%sf(j, k, l) = q_prim_vf(eqn_idx%E)%sf(j, k, l)
789 end do
790 end if
791
792 if (bubbles_euler) then
793 do i = 1, nb
794 mur = r0(i)*patch_icpp(patch_id)%r0/r0ref
795 muv = patch_icpp(patch_id)%v0
796 if (qbmm) then
797 ! Initialize the moment set
798 if (dist_type == 1) then
799 q_prim_vf(qbmm_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp
800 q_prim_vf(qbmm_idx%fullmom(i, 1, 0))%sf(j, k, l) = mur
801 q_prim_vf(qbmm_idx%fullmom(i, 0, 1))%sf(j, k, l) = muv
802 q_prim_vf(qbmm_idx%fullmom(i, 2, 0))%sf(j, k, l) = mur**2 + (sigr*r0ref)**2
803 q_prim_vf(qbmm_idx%fullmom(i, 1, 1))%sf(j, k, l) = mur*muv + rhorv*(sigr*r0ref)*(sigv*sqrt(p0ref/rho0ref))
804 q_prim_vf(qbmm_idx%fullmom(i, 0, 2))%sf(j, k, l) = muv**2 + (sigv*sqrt(p0ref/rho0ref))**2
805 else if (dist_type == 2) then
806 q_prim_vf(qbmm_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp
807 q_prim_vf(qbmm_idx%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigr**2)/2._wp)*mur
808 q_prim_vf(qbmm_idx%fullmom(i, 0, 1))%sf(j, k, l) = muv
809 q_prim_vf(qbmm_idx%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigr**2)*2._wp)*(mur**2)
810 q_prim_vf(qbmm_idx%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigr**2)/2._wp)*mur*muv
811 q_prim_vf(qbmm_idx%fullmom(i, 0, 2))%sf(j, k, l) = muv**2 + (sigv*sqrt(p0ref/rho0ref))**2
812 end if
813 else
814 q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l) = mur
815 q_prim_vf(qbmm_idx%vs(i))%sf(j, k, l) = muv
816
817 if (.not. polytropic) then
818 q_prim_vf(qbmm_idx%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0
819 q_prim_vf(qbmm_idx%ms(i))%sf(j, k, l) = patch_icpp(patch_id)%m0
820 end if
821 end if
822 end do
823
824 if (adv_n) then
825 ! Initialize number density
826 r3bar = 0._wp
827 do i = 1, nb
828 r3bar = r3bar + weight(i)*(q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l))**3._wp
829 end do
830 q_prim_vf(eqn_idx%n)%sf(j, k, l) = 3*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4*pi*r3bar)
831 end if
832 end if
833
834 if (mpp_lim .and. bubbles_euler) then
835 ! adjust volume fractions, according to modeled gas void fraction
836 alf_sum%sf = 0._wp
837 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
838 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf
839 end do
840
841 do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1
842 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/alf_sum%sf
843 end do
844 end if
845
846 if (bubbles_euler .and. (.not. polytropic) .and. (.not. qbmm)) then
847 do i = 1, nb
848 if (f_is_default(real(q_prim_vf(qbmm_idx%ps(i))%sf(j, k, l), kind=wp))) then
849 q_prim_vf(qbmm_idx%ps(i))%sf(j, k, l) = pb0(i)
850 end if
851 if (f_is_default(real(q_prim_vf(qbmm_idx%ms(i))%sf(j, k, l), kind=wp))) then
852 q_prim_vf(qbmm_idx%ms(i))%sf(j, k, l) = mass_v0(i)
853 end if
854 end do
855 end if
856
857 if (surface_tension) then
858 q_prim_vf(eqn_idx%c)%sf(j, k, l) = eta*patch_icpp(patch_id)%cf_val + (1._wp - eta)*orig_prim_vf(eqn_idx%c)
859 end if
860
861 if (1._wp - eta < 1.e-16_wp) patch_id_fp(j, k, l) = patch_id
862
864
865 !> Nullify the patch primitive variable assignment procedure pointer.
871
872end module m_assign_variables
Abstract interface to the two subroutines that assign the patch primitive variables,...
integer, intent(in) k
integer, intent(in) j
integer, intent(in) l
Assigns initial primitive variables to computational cells based on patch geometry.
procedure(s_assign_patch_xxxxx_primitive_variables), pointer, public s_assign_patch_primitive_variables
Pointer to mixture or species patch assignment routine.
impure subroutine, public s_initialize_assign_variables_module
Allocate volume fraction sum and set the patch primitive variable assignment procedure pointer.
subroutine, public s_assign_patch_mixture_primitive_variables(patch_id, j, k, l, eta, q_prim_vf, patch_id_fp)
Assign the mixture primitive variables of the patch designated by the patch_id to the cell that is de...
impure subroutine, public s_finalize_assign_variables_module
Nullify the patch primitive variable assignment procedure pointer.
impure subroutine, public s_assign_patch_species_primitive_variables(patch_id, j, k, l, eta, q_prim_vf, patch_id_fp)
Assign the species primitive variables, following s_assign_patch_species_primitive_variables with ada...
subroutine, public s_perturb_primitive(j, k, l, q_prim_vf)
Apply a stable pressure perturbation following Ando's method for bubble-laden flows.
Compile-time constant parameters: default values, tolerances, and physical constants.
real(wp), parameter verysmall
Very small number.
integer, parameter model_eqns_6eq
integer, parameter model_eqns_gamma_law
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Derived type annexing a scalar field (SF).