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# 9 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
13
14! For moving immersed boundaries in simulation
15# 14 "/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! New line at end of file is required for FYPP
44# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
45# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
46# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
47# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
48# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52
53# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56
57# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58
59# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60
61# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
62
63# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
64
65# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
66
67# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68
69# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
70! New line at end of file is required for FYPP
71# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
72
73# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
74# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
76# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
78
79# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
80
81# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
82
83# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
84
85# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
86
87# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
88
89# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90
91# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
92
93# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
94
95# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
96
97# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
98
99# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
100
101# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
102
103# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
104
105# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
106
107# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
108
109# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
110
111# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
112
113# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 207 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 232 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 243 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 245 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 283 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 293 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 303 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 312 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 329 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 346 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 358 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 364 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 370 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 376 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149! New line at end of file is required for FYPP
150# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
151# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
152# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
153# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
154# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
156# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158
159# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162
163# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
164
165# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166
167# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
168
169# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170
171# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172
173# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
174
175# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176! New line at end of file is required for FYPP
177# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
178
179# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
180
181# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
182
183# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
184
185# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
186
187# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
188
189# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
190
191# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
192
193# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
194
195# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
196
197# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
198
199# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
200
201# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
202
203# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
204
205# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
206
207# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 192 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 213 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 241 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 256 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 266 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 275 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 291 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 301 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 308 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234! New line at end of file is required for FYPP
235# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
236
237# 21 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
238
239# 37 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
240
241# 50 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
242
243# 76 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
244
245# 91 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247# 102 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
248
249# 115 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
250
251# 143 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253# 154 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
254
255# 165 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
256
257# 176 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259# 187 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
260
261# 198 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
262
263# 208 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265# 214 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
266
267# 220 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
268
269# 226 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271# 232 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
272
273# 234 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
274# 235 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
275! New line at end of file is required for FYPP
276# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
277
278# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
279
280! Caution:
281! This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI rank.
282! That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0.
283! For an example see misc/nvidia_uvm/bind.sh.
284# 63 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
285
286# 81 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
287
288# 88 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
289
290# 111 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
291
292# 127 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
293
294# 153 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
295
296# 159 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
297
298# 167 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
299! New line at end of file is required for FYPP
300# 7 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp" 2
301
302!> @brief Assigns initial primitive variables to computational cells based on patch geometry
303module m_assign_variables
304
305 use m_derived_types ! Definitions of the derived types
306
307 use m_global_parameters ! Global parameters for the code
308
309 use m_variables_conversion ! Subroutines to change the state variables from
310
311 use m_helper_basic !< functions to compare floating point numbers
312
313 use m_thermochem, only: num_species, gas_constant, get_mixture_molecular_weight
314
315 implicit none
316
317 public :: s_perturb_primitive
318
319 type(scalar_field) :: alf_sum
320
323 !! Depending on the multicomponent flow model, this variable is a pointer to
324 !! either the subroutine s_assign_patch_mixture_primitive_variables, or the
325 !! subroutine s_assign_patch_species_primitive_variables
326
327 !> Abstract interface to the two subroutines that assign the patch primitive
328 !! variables, either mixture or species, depending on the subroutine, to a
329 !! particular cell in the computational domain
330 abstract interface
331
332 !> Skeleton of s_assign_patch_mixture_primitive_variables
333 !! and s_assign_patch_species_primitive_variables
334 !! @param patch_id is the patch identifier
335 !! @param j (x) cell index in which the mixture or species primitive variables from the indicated patch areassigned
336 !! @param k (y,th) cell index in which the mixture or species primitive variables from the indicated patch areassigned
337 !! @param l (z) cell index in which the mixture or species primitive variables from the indicated patch areassigned
338 !! @param eta pseudo volume fraction
339 !! @param q_prim_vf Primitive variables
340 !! @param patch_id_fp Array to track patch ids
341 subroutine s_assign_patch_xxxxx_primitive_variables(patch_id, j, k, l, &
342 eta, q_prim_vf, patch_id_fp)
343
344 import :: scalar_field, sys_size, n, m, p, wp
345
346 integer, intent(in) :: patch_id
347 integer, intent(in) :: j, k, l
348 real(wp), intent(in) :: eta
349 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
350#ifdef MFC_MIXED_PRECISION
351 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
352#else
353 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
354#endif
355
356 end subroutine s_assign_patch_xxxxx_primitive_variables
357
358 end interface
359
360 private;
361 public :: s_initialize_assign_variables_module, &
362 s_assign_patch_primitive_variables, &
363 s_assign_patch_mixture_primitive_variables, &
364 s_assign_patch_species_primitive_variables, &
365 s_finalize_assign_variables_module
366
367contains
368
369 !> @brief Allocates volume fraction sum and sets the patch primitive variable assignment procedure pointer.
370 impure subroutine s_initialize_assign_variables_module
371
372 if (.not. igr) then
373 allocate (alf_sum%sf(0:m, 0:n, 0:p))
374 end if
375
376 ! Depending on multicomponent flow model, the appropriate procedure
377 ! for assignment of the patch mixture or species primitive variables
378 ! to a cell in the domain is targeted by the procedure pointer
379
380 if (model_eqns == 1) then ! Gamma/pi_inf model
381 s_assign_patch_primitive_variables => &
382 s_assign_patch_mixture_primitive_variables
383 else ! Volume fraction model
384 s_assign_patch_primitive_variables => &
385 s_assign_patch_species_primitive_variables
386 end if
387
388 end subroutine s_initialize_assign_variables_module
389
390 !> This subroutine assigns the mixture primitive variables
391 !! of the patch designated by the patch_id, to the cell that
392 !! is designated by the indexes (j,k,l). In addition, the
393 !! variable bookkeeping the patch identities in the entire
394 !! domain is updated with the new assignment. Note that if
395 !! the smoothing of the patch's boundaries is employed, the
396 !! ensuing primitive variables in the cell will be a type of
397 !! combination of the current patch's primitive variables
398 !! with those of the smoothing patch. The specific details
399 !! of the combination may be found in Shyue's work (1998).
400 !! @param patch_id the patch identifier
401 !! @param j the x-dir node index
402 !! @param k the y-dir node index
403 !! @param l the z-dir node index
404 !! @param eta pseudo volume fraction
405 !! @param q_prim_vf Primitive variables
406 !! @param patch_id_fp Array to track patch ids
407 subroutine s_assign_patch_mixture_primitive_variables(patch_id, j, k, l, &
408 eta, q_prim_vf, patch_id_fp)
409
410# 115 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
411#if MFC_OpenACC
412# 115 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
413!$acc routine seq
414# 115 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
415#elif MFC_OpenMP
416# 115 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
417
418# 115 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
419
420# 115 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
421!$omp declare target device_type(any)
422# 115 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
423#endif
424
425 integer, intent(in) :: patch_id
426 integer, intent(in) :: j, k, l
427 real(wp), intent(in) :: eta
428 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
429#ifdef MFC_MIXED_PRECISION
430 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
431#else
432 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
433#endif
434
435 real(wp) :: ys(1:num_species)
436
437 integer :: smooth_patch_id
438 integer :: i !< generic loop operator
439
440 ! Assigning the mixture primitive variables of a uniform state patch
441
442 ! Transferring the identity of the smoothing patch
443 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
444
445 ! Density
446 q_prim_vf(1)%sf(j, k, l) = &
447 eta*patch_icpp(patch_id)%rho &
448 + (1._wp - eta)*patch_icpp(smooth_patch_id)%rho
449
450 ! Velocity
451 do i = 1, e_idx - mom_idx%beg
452 q_prim_vf(i + 1)%sf(j, k, l) = &
453 1._wp/q_prim_vf(1)%sf(j, k, l)* &
454 (eta*patch_icpp(patch_id)%rho &
455 *patch_icpp(patch_id)%vel(i) &
456 + (1._wp - eta)*patch_icpp(smooth_patch_id)%rho &
457 *patch_icpp(smooth_patch_id)%vel(i))
458 end do
459
460 ! Specific heat ratio function
461 q_prim_vf(gamma_idx)%sf(j, k, l) = &
462 eta*patch_icpp(patch_id)%gamma &
463 + (1._wp - eta)*patch_icpp(smooth_patch_id)%gamma
464
465 ! Pressure
466 q_prim_vf(e_idx)%sf(j, k, l) = &
467 1._wp/q_prim_vf(gamma_idx)%sf(j, k, l)* &
468 (eta*patch_icpp(patch_id)%gamma &
469 *patch_icpp(patch_id)%pres &
470 + (1._wp - eta)*patch_icpp(smooth_patch_id)%gamma &
471 *patch_icpp(smooth_patch_id)%pres)
472
473 ! Liquid stiffness function
474 q_prim_vf(pi_inf_idx)%sf(j, k, l) = &
475 eta*patch_icpp(patch_id)%pi_inf &
476 + (1._wp - eta)*patch_icpp(smooth_patch_id)%pi_inf
477
478 ! Species Concentrations
479 if (chemistry) then
480 block
481 real(wp) :: sum, term
482
483 ! Accumulating the species concentrations
484 sum = 0._wp
485 do i = 1, num_species
486 term = &
487 eta*patch_icpp(patch_id)%Y(i) &
488 + (1._wp - eta)*patch_icpp(smooth_patch_id)%Y(i)
489 q_prim_vf(chemxb + i - 1)%sf(j, k, l) = term
490 sum = sum + term
491 end do
492
493 sum = max(sum, verysmall)
494
495 ! Normalizing the species concentrations
496 do i = 1, num_species
497 q_prim_vf(chemxb + i - 1)%sf(j, k, l) = &
498 q_prim_vf(chemxb + i - 1)%sf(j, k, l)/sum
499 ys(i) = q_prim_vf(chemxb + i - 1)%sf(j, k, l)
500 end do
501 end block
502 end if
503
504 ! Updating the patch identities bookkeeping variable
505 if (1._wp - eta < 1.e-16_wp) patch_id_fp(j, k, l) = patch_id
506
507 end subroutine s_assign_patch_mixture_primitive_variables
508
509 !> @brief Applies a stable pressure perturbation following Ando's method for bubble-laden flows.
510 !! @param j the x-dir node index
511 !! @param k the y-dir node index
512 !! @param l the z-dir node index
513 !! @param q_prim_vf Primitive variables
514 subroutine s_perturb_primitive(j, k, l, q_prim_vf)
515
516 integer, intent(in) :: j, k, l
517 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
518
519 integer :: i
520 real(wp) :: pres_mag, loc, n_tait, b_tait, p0
521 real(wp) :: r3bar, n0, ratio, nh, vfh, velh, rhoh, deno
522
523 p0 = 101325._wp
524 pres_mag = 1.e-1_wp
525 loc = x_cc(177)
526 n_tait = gs_min(1)
527 b_tait = ps_inf(1)
528
529 if (j < 177) then
530 q_prim_vf(e_idx)%sf(j, k, l) = 0.5_wp*q_prim_vf(e_idx)%sf(j, k, l)
531 end if
532
533 if (qbmm) then
534 do i = 1, nb
535 q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) = q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)*((p0 - bub_pp%pv)/(q_prim_vf(e_idx)%sf(j, k, l)*p0 - bub_pp%pv))**(1._wp/3._wp)
536 end do
537 end if
538
539 r3bar = 0._wp
540
541 if (qbmm) then
542 do i = 1, nb
543 r3bar = r3bar + weight(i)*0.5_wp*(q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l))**3._wp
544 r3bar = r3bar + weight(i)*0.5_wp*(q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l))**3._wp
545 end do
546 else
547 do i = 1, nb
548 if (polytropic) then
549 r3bar = r3bar + weight(i)*(q_prim_vf(bubxb + (i - 1)*2)%sf(j, k, l))**3._wp
550 else
551 r3bar = r3bar + weight(i)*(q_prim_vf(bubxb + (i - 1)*4)%sf(j, k, l))**3._wp
552 end if
553 end do
554 end if
555
556 n0 = 3._wp*q_prim_vf(alf_idx)%sf(j, k, l)/(4._wp*pi*r3bar)
557
558 ratio = ((1._wp + b_tait)/(q_prim_vf(e_idx)%sf(j, k, l) + b_tait))**(1._wp/n_tait)
559
560 nh = n0/((1._wp - q_prim_vf(alf_idx)%sf(j, k, l))*ratio + (4._wp*pi/3._wp)*n0*r3bar)
561 vfh = (4._wp*pi/3._wp)*nh*r3bar
562 rhoh = (1._wp - vfh)/ratio
563 deno = 1._wp - (1._wp - q_prim_vf(alf_idx)%sf(j, k, l))/rhoh
564
565 if (f_approx_equal(deno, 0._wp)) then
566 velh = 0._wp
567 else
568 velh = (q_prim_vf(e_idx)%sf(j, k, l) - 1._wp)/(1._wp - q_prim_vf(alf_idx)%sf(j, k, l))/deno
569 velh = sqrt(velh)
570 velh = velh*deno
571 end if
572
573 do i = cont_idx%beg, cont_idx%end
574 q_prim_vf(i)%sf(j, k, l) = rhoh
575 end do
576
577 do i = mom_idx%beg, mom_idx%end
578 q_prim_vf(i)%sf(j, k, l) = velh
579 end do
580
581 q_prim_vf(alf_idx)%sf(j, k, l) = vfh
582
583 end subroutine s_perturb_primitive
584
585 !> This subroutine assigns the species primitive variables. This follows
586 !! s_assign_patch_species_primitive_variables with adaptation for
587 !! ensemble-averaged bubble modeling
588 !! @param patch_id the patch identifier
589 !! @param j the x-dir node index
590 !! @param k the y-dir node index
591 !! @param l the z-dir node index
592 !! @param eta pseudo volume fraction
593 !! @param q_prim_vf Primitive variables
594 !! @param patch_id_fp Array to track patch ids
595 impure subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, &
596 eta, q_prim_vf, patch_id_fp)
597
598# 289 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
599#if MFC_OpenACC
600# 289 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
601!$acc routine seq
602# 289 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
603#elif MFC_OpenMP
604# 289 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
605
606# 289 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
607
608# 289 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
609!$omp declare target device_type(any)
610# 289 "/home/runner/work/MFC/MFC/src/pre_process/m_assign_variables.fpp"
611#endif
612
613 integer, intent(in) :: patch_id
614 integer, intent(in) :: j, k, l
615 real(wp), intent(in) :: eta
616#ifdef MFC_MIXED_PRECISION
617 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
618#else
619 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
620#endif
621 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
622
623 ! Density, the specific heat ratio function and the liquid stiffness
624 ! function, respectively, obtained from the combination of primitive
625 ! variables of the current and smoothing patches
626 real(wp) :: rho !< density
627 real(wp) :: gamma
628 real(wp) :: lit_gamma !< specific heat ratio
629 real(wp) :: pi_inf !< stiffness from SEOS
630 real(wp) :: qv !< reference energy from SEOS
631 real(wp) :: orig_rho
632 real(wp) :: orig_gamma
633 real(wp) :: orig_pi_inf
634 real(wp) :: orig_qv
635 real(wp) :: mur, muv
636 real(wp) :: r3bar
637 real(wp) :: rcoord, theta, phi, xi_sph
638 real(wp), dimension(3) :: xi_cart
639
640 real(wp) :: ys(1:num_species)
641
642 real(stp), dimension(sys_size) :: orig_prim_vf !<
643 !! Vector to hold original values of cell for smoothing purposes
644
645 integer :: i !< Generic loop iterator
646 integer :: smooth_patch_id
647
648 ! Transferring the identity of the smoothing patch
649 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
650
651 ! Transferring original primitive variables
652 do i = 1, sys_size
653 orig_prim_vf(i) = q_prim_vf(i)%sf(j, k, l)
654 end do
655
656 if (mpp_lim .and. bubbles_euler) then
657 !adjust volume fractions, according to modeled gas void fraction
658 alf_sum%sf = 0._wp
659 do i = adv_idx%beg, adv_idx%end - 1
660 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf
661 end do
662
663 do i = adv_idx%beg, adv_idx%end - 1
664 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) &
665 /alf_sum%sf
666 end do
667 end if
668
669 ! Computing Mixture Variables from Original Primitive Variables
670 ! call s_convert_species_to_mixture_variables( &
671 call s_convert_to_mixture_variables( &
672 q_prim_vf, j, k, l, &
673 orig_rho, &
674 orig_gamma, &
675 orig_pi_inf, orig_qv)
676
677 ! Computing Mixture Variables of Current Patch
678
679 if (.not. igr .or. num_fluids > 1) then
680 ! Volume fraction(s)
681 do i = adv_idx%beg, adv_idx%end
682 q_prim_vf(i)%sf(j, k, l) = patch_icpp(patch_id)%alpha(i - e_idx)
683 end do
684 end if
685
686 if (mpp_lim .and. bubbles_euler) then
687 !adjust volume fractions, according to modeled gas void fraction
688 alf_sum%sf = 0._wp
689 do i = adv_idx%beg, adv_idx%end - 1
690 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf
691 end do
692
693 do i = adv_idx%beg, adv_idx%end - 1
694 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) &
695 /alf_sum%sf
696 end do
697 end if
698
699 ! Partial densities
700 if (model_eqns /= 4) then
701 do i = 1, cont_idx%end
702 q_prim_vf(i)%sf(j, k, l) = patch_icpp(patch_id)%alpha_rho(i)
703 end do
704 end if
705
706 ! Density and the specific heat ratio and liquid stiffness functions
707 ! call s_convert_species_to_mixture_variables( &
708 call s_convert_to_mixture_variables( &
709 q_prim_vf, j, k, l, &
710 patch_icpp(patch_id)%rho, &
711 patch_icpp(patch_id)%gamma, &
712 patch_icpp(patch_id)%pi_inf, &
713 patch_icpp(patch_id)%qv)
714
715 ! Computing Mixture Variables of Smoothing Patch
716
717 if (model_eqns /= 4) then
718 ! Partial densities
719 do i = 1, cont_idx%end
720 q_prim_vf(i)%sf(j, k, l) = patch_icpp(smooth_patch_id)%alpha_rho(i)
721 end do
722 end if
723
724 if (.not. igr .or. num_fluids > 1) then
725 ! Volume fraction(s)
726 do i = adv_idx%beg, adv_idx%end
727 q_prim_vf(i)%sf(j, k, l) = patch_icpp(smooth_patch_id)%alpha(i - e_idx)
728 end do
729 end if
730
731 if (mpp_lim .and. bubbles_euler) then
732 !adjust volume fractions, according to modeled gas void fraction
733 alf_sum%sf = 0._wp
734 do i = adv_idx%beg, adv_idx%end - 1
735 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf
736 end do
737
738 do i = adv_idx%beg, adv_idx%end - 1
739 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) &
740 /alf_sum%sf
741 end do
742 end if
743
744 ! Bubbles euler variables
745 if (bubbles_euler) then
746 do i = 1, nb
747 mur = r0(i)*patch_icpp(smooth_patch_id)%r0/r0ref
748 muv = patch_icpp(smooth_patch_id)%v0
749 if (qbmm) then
750 ! Initialize the moment set
751 if (dist_type == 1) then
752 q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp
753 q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = mur
754 q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muv
755 q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = mur**2 + (sigr*r0ref)**2
756 q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = mur*muv + rhorv*(sigr*r0ref)*(sigv*sqrt(p0ref/rho0ref))
757 q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muv**2 + (sigv*sqrt(p0ref/rho0ref))**2
758 else if (dist_type == 2) then
759 q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp
760 q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigr**2)/2._wp)*mur
761 q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muv
762 q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigr**2)*2._wp)*(mur**2)
763 q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigr**2)/2._wp)*mur*muv
764 q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muv**2 + (sigv*sqrt(p0ref/rho0ref))**2
765 end if
766 else
767 q_prim_vf(bub_idx%rs(i))%sf(j, k, l) = mur
768 q_prim_vf(bub_idx%vs(i))%sf(j, k, l) = muv
769 if (.not. polytropic) then
770 q_prim_vf(bub_idx%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0
771 q_prim_vf(bub_idx%ms(i))%sf(j, k, l) = patch_icpp(patch_id)%m0
772 end if
773 end if
774 end do
775
776 if (adv_n) then
777 ! Initialize number density
778 r3bar = 0._wp
779 do i = 1, nb
780 r3bar = r3bar + weight(i)*(q_prim_vf(bub_idx%rs(i))%sf(j, k, l))**3._wp
781 end do
782 q_prim_vf(n_idx)%sf(j, k, l) = 3*q_prim_vf(alf_idx)%sf(j, k, l)/(4*pi*r3bar)
783 end if
784 end if
785
786 ! Density and the specific heat ratio and liquid stiffness functions
787 ! call s_convert_species_to_mixture_variables( &
788 call s_convert_to_mixture_variables( &
789 q_prim_vf, j, k, l, &
790 patch_icpp(smooth_patch_id)%rho, &
791 patch_icpp(smooth_patch_id)%gamma, &
792 patch_icpp(smooth_patch_id)%pi_inf, &
793 patch_icpp(smooth_patch_id)%qv)
794
795 ! Pressure
796 q_prim_vf(e_idx)%sf(j, k, l) = &
797 (eta*patch_icpp(patch_id)%pres &
798 + (1._wp - eta)*orig_prim_vf(e_idx))
799
800 if (.not. igr .or. num_fluids > 1) then
801 ! Volume fractions \alpha
802 do i = adv_idx%beg, adv_idx%end
803 q_prim_vf(i)%sf(j, k, l) = &
804 eta*patch_icpp(patch_id)%alpha(i - e_idx) &
805 + (1._wp - eta)*orig_prim_vf(i)
806 end do
807 end if
808
809 if (mhd) then
810 if (n == 0) then ! 1D: By, Bz
811 q_prim_vf(b_idx%beg)%sf(j, k, l) = &
812 eta*patch_icpp(patch_id)%By &
813 + (1._wp - eta)*orig_prim_vf(b_idx%beg)
814 q_prim_vf(b_idx%beg + 1)%sf(j, k, l) = &
815 eta*patch_icpp(patch_id)%Bz &
816 + (1._wp - eta)*orig_prim_vf(b_idx%beg + 1)
817 else ! 2D/3D: Bx, By, Bz
818 q_prim_vf(b_idx%beg)%sf(j, k, l) = &
819 eta*patch_icpp(patch_id)%Bx &
820 + (1._wp - eta)*orig_prim_vf(b_idx%beg)
821 q_prim_vf(b_idx%beg + 1)%sf(j, k, l) = &
822 eta*patch_icpp(patch_id)%By &
823 + (1._wp - eta)*orig_prim_vf(b_idx%beg + 1)
824 q_prim_vf(b_idx%beg + 2)%sf(j, k, l) = &
825 eta*patch_icpp(patch_id)%Bz &
826 + (1._wp - eta)*orig_prim_vf(b_idx%beg + 2)
827 end if
828 end if
829
830 ! Elastic Shear Stress
831 if (elasticity) then
832 do i = 1, (stress_idx%end - stress_idx%beg) + 1
833 q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = &
834 (eta*patch_icpp(patch_id)%tau_e(i) &
835 + (1._wp - eta)*orig_prim_vf(i + stress_idx%beg - 1))
836 end do
837 end if
838
839 ! Elastic Shear Stress
840 if (hyperelasticity) then
841
842 if (pre_stress) then ! pre stressed initial condition in spatial domain
843 rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2))
844 theta = atan2(y_cc(k), x_cc(j))
845 phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l))
846 !spherical coord, assuming Rmax=1
847 xi_sph = (rcoord**3 - r0ref**3 + 1._wp)**(1._wp/3._wp)
848 xi_cart(1) = xi_sph*sin(phi)*cos(theta)
849 xi_cart(2) = xi_sph*sin(phi)*sin(theta)
850 xi_cart(3) = xi_sph*cos(phi)
851 else
852 xi_cart(1) = x_cc(j)
853 xi_cart(2) = y_cc(k)
854 xi_cart(3) = z_cc(l)
855 end if
856
857 ! assigning the reference map to the q_prim vector field
858 do i = 1, num_dims
859 q_prim_vf(i + xibeg - 1)%sf(j, k, l) = eta*xi_cart(i) + &
860 (1._wp - eta)*orig_prim_vf(i + xibeg - 1)
861 end do
862 end if
863
864 if (mpp_lim .and. bubbles_euler) then
865 !adjust volume fractions, according to modeled gas void fraction
866 alf_sum%sf = 0._wp
867 do i = adv_idx%beg, adv_idx%end - 1
868 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf
869 end do
870
871 do i = adv_idx%beg, adv_idx%end - 1
872 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) &
873 /alf_sum%sf
874 end do
875 end if
876
877 ! Partial densities \alpha \rho
878 if (model_eqns /= 4) then
879 !mixture density is an input
880 do i = 1, cont_idx%end
881 q_prim_vf(i)%sf(j, k, l) = &
882 eta*patch_icpp(patch_id)%alpha_rho(i) &
883 + (1._wp - eta)*orig_prim_vf(i)
884 end do
885 else
886 !get mixture density from pressure via Tait EOS
887 pi_inf = pi_infs(1)
888 gamma = gammas(1)
889 lit_gamma = gs_min(1)
890
891 ! \rho = (( p_l + pi_inf)/( p_ref + pi_inf))**(1/little_gam) * rhoref(1-alf)
892 q_prim_vf(1)%sf(j, k, l) = &
893 (((q_prim_vf(e_idx)%sf(j, k, l) + pi_inf)/(pref + pi_inf))**(1/lit_gamma))* &
894 rhoref*(1 - q_prim_vf(alf_idx)%sf(j, k, l))
895 end if
896
897 ! Density and the specific heat ratio and liquid stiffness functions
898 ! call s_convert_species_to_mixture_variables(q_prim_vf, j, k, l, &
899 call s_convert_to_mixture_variables(q_prim_vf, j, k, l, &
900 rho, gamma, pi_inf, qv)
901
902 ! Velocity
903 do i = 1, e_idx - mom_idx%beg
904 q_prim_vf(i + cont_idx%end)%sf(j, k, l) = &
905 (eta*patch_icpp(patch_id)%vel(i) &
906 + (1._wp - eta)*orig_prim_vf(i + cont_idx%end))
907 end do
908
909 ! Species Concentrations
910 if (chemistry) then
911 block
912 real(wp) :: sum, term
913
914 ! Accumulating the species concentrations
915 sum = 0._wp
916 do i = 1, num_species
917 term = &
918 eta*patch_icpp(patch_id)%Y(i) &
919 + (1._wp - eta)*patch_icpp(smooth_patch_id)%Y(i)
920 q_prim_vf(chemxb + i - 1)%sf(j, k, l) = term
921 sum = sum + term
922 end do
923
924 if (sum < verysmall) then
925 sum = 1._wp
926 end if
927
928 ! Normalizing the species concentrations
929 do i = 1, num_species
930 q_prim_vf(chemxb + i - 1)%sf(j, k, l) = &
931 q_prim_vf(chemxb + i - 1)%sf(j, k, l)/sum
932 ys(i) = q_prim_vf(chemxb + i - 1)%sf(j, k, l)
933 end do
934 end block
935 end if
936
937 ! Set streamwise velocity to hyperbolic tangent function of y
938 if (mixlayer_vel_profile) then
939 q_prim_vf(1 + cont_idx%end)%sf(j, k, l) = &
940 (eta*patch_icpp(patch_id)%vel(1)*tanh(y_cc(k)*mixlayer_vel_coef) &
941 + (1._wp - eta)*orig_prim_vf(1 + cont_idx%end))
942 end if
943
944 ! Set partial pressures to mixture pressure for the 6-eqn model
945 if (model_eqns == 3) then
946 do i = internalenergies_idx%beg, internalenergies_idx%end
947 q_prim_vf(i)%sf(j, k, l) = q_prim_vf(e_idx)%sf(j, k, l)
948 end do
949 end if
950
951 ! Smoothed bubble variables
952 if (bubbles_euler) then
953 do i = 1, nb
954 mur = r0(i)*patch_icpp(patch_id)%r0/r0ref
955 muv = patch_icpp(patch_id)%v0
956 if (qbmm) then
957 ! Initialize the moment set
958 if (dist_type == 1) then
959 q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp
960 q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = mur
961 q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muv
962 q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = mur**2 + (sigr*r0ref)**2
963 q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = mur*muv + rhorv*(sigr*r0ref)*(sigv*sqrt(p0ref/rho0ref))
964 q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muv**2 + (sigv*sqrt(p0ref/rho0ref))**2
965 else if (dist_type == 2) then
966 q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp
967 q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigr**2)/2._wp)*mur
968 q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muv
969 q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigr**2)*2._wp)*(mur**2)
970 q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigr**2)/2._wp)*mur*muv
971 q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muv**2 + (sigv*sqrt(p0ref/rho0ref))**2
972 end if
973 else
974 q_prim_vf(bub_idx%rs(i))%sf(j, k, l) = mur
975 q_prim_vf(bub_idx%vs(i))%sf(j, k, l) = muv
976
977 if (.not. polytropic) then
978 q_prim_vf(bub_idx%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0
979 q_prim_vf(bub_idx%ms(i))%sf(j, k, l) = patch_icpp(patch_id)%m0
980 end if
981
982 end if
983 end do
984
985 if (adv_n) then
986 ! Initialize number density
987 r3bar = 0._wp
988 do i = 1, nb
989 r3bar = r3bar + weight(i)*(q_prim_vf(bub_idx%rs(i))%sf(j, k, l))**3._wp
990 end do
991 q_prim_vf(n_idx)%sf(j, k, l) = 3*q_prim_vf(alf_idx)%sf(j, k, l)/(4*pi*r3bar)
992 end if
993 end if
994
995 if (mpp_lim .and. bubbles_euler) then
996 !adjust volume fractions, according to modeled gas void fraction
997 alf_sum%sf = 0._wp
998 do i = adv_idx%beg, adv_idx%end - 1
999 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf
1000 end do
1001
1002 do i = adv_idx%beg, adv_idx%end - 1
1003 q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) &
1004 /alf_sum%sf
1005 end do
1006 end if
1007
1008 if (bubbles_euler .and. (.not. polytropic) .and. (.not. qbmm)) then
1009 do i = 1, nb
1010 if (f_is_default(real(q_prim_vf(bub_idx%ps(i))%sf(j, k, l), kind=wp))) then
1011 q_prim_vf(bub_idx%ps(i))%sf(j, k, l) = pb0(i)
1012 ! print *, 'setting to pb0'
1013 end if
1014 if (f_is_default(real(q_prim_vf(bub_idx%ms(i))%sf(j, k, l), kind=wp))) then
1015 q_prim_vf(bub_idx%ms(i))%sf(j, k, l) = mass_v0(i)
1016 end if
1017 end do
1018 end if
1019
1020 if (surface_tension) then
1021 q_prim_vf(c_idx)%sf(j, k, l) = eta*patch_icpp(patch_id)%cf_val + &
1022 (1._wp - eta)*orig_prim_vf(c_idx)
1023 end if
1024
1025 ! Updating the patch identities bookkeeping variable
1026 if (1._wp - eta < 1.e-16_wp) patch_id_fp(j, k, l) = patch_id
1027
1028 ! if (j == 1) then
1029 ! print *, (q_prim_vf(bub_idx%rs(i))%sf(j, k, l), i = 1, nb)
1030 ! print *, (q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l), i = 1, nb)
1031 ! print *, (R0(i), i = 1, nb)
1032 ! print *, patch_icpp(patch_id)%r0
1033 ! print *, (bub_idx%rs(i), i = 1, nb)
1034 ! print *, (bub_idx%fullmom(i, 1, 0), i = 1, nb)
1035 ! end if
1036
1037 end subroutine s_assign_patch_species_primitive_variables
1038
1039 !> @brief Nullifies the patch primitive variable assignment procedure pointer.
1040 impure subroutine s_finalize_assign_variables_module
1041
1042 ! Nullifying procedure pointer to the subroutine assigning either
1043 ! the patch mixture or species primitive variables to a cell in the
1044 ! computational domain
1045 s_assign_patch_primitive_variables => null()
1046
1047 end subroutine s_finalize_assign_variables_module
1048
1049end module m_assign_variables
m_assign_variables::s_assign_patch_xxxxx_primitive_variables
Abstract interface to the two subroutines that assign the patch primitive variables,...
Definition m_assign_variables.fpp.f90:341
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1121
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1121
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1121
m_assign_variables
Assigns initial primitive variables to computational cells based on patch geometry.
Definition m_assign_variables.fpp.f90:303
m_assign_variables::s_assign_patch_primitive_variables
procedure(s_assign_patch_xxxxx_primitive_variables), pointer, public s_assign_patch_primitive_variables
Definition m_assign_variables.fpp.f90:321
m_assign_variables::s_initialize_assign_variables_module
impure subroutine, public s_initialize_assign_variables_module
Allocates volume fraction sum and sets the patch primitive variable assignment procedure pointer.
Definition m_assign_variables.fpp.f90:371
m_assign_variables::s_assign_patch_mixture_primitive_variables
subroutine, public s_assign_patch_mixture_primitive_variables(patch_id, j, k, l, eta, q_prim_vf, patch_id_fp)
This subroutine assigns the mixture primitive variables of the patch designated by the patch_id,...
Definition m_assign_variables.fpp.f90:409
m_assign_variables::s_finalize_assign_variables_module
impure subroutine, public s_finalize_assign_variables_module
Nullifies the patch primitive variable assignment procedure pointer.
Definition m_assign_variables.fpp.f90:1041
m_assign_variables::s_assign_patch_species_primitive_variables
impure subroutine, public s_assign_patch_species_primitive_variables(patch_id, j, k, l, eta, q_prim_vf, patch_id_fp)
This subroutine assigns the species primitive variables. This follows s_assign_patch_species_primitiv...
Definition m_assign_variables.fpp.f90:597
m_assign_variables::s_perturb_primitive
subroutine, public s_perturb_primitive(j, k, l, q_prim_vf)
Applies a stable pressure perturbation following Ando's method for bubble-laden flows.
Definition m_assign_variables.fpp.f90:515
m_assign_variables::alf_sum
type(scalar_field) alf_sum
Definition m_assign_variables.fpp.f90:319
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:292
m_global_parameters
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
Definition m_global_parameters.fpp.f90:19
m_global_parameters::igr
logical igr
Use information geometric regularization.
Definition m_global_parameters.fpp.f90:113
m_global_parameters::chemistry
logical, parameter chemistry
Chemistry modeling.
Definition m_global_parameters.fpp.f90:115
m_global_parameters::mom_idx
type(int_bounds_info) mom_idx
Indexes of first & last momentum eqns.
Definition m_global_parameters.fpp.f90:119
m_global_parameters::sys_size
integer sys_size
Number of unknowns in the system of equations.
Definition m_global_parameters.fpp.f90:97
m_global_parameters::gamma_idx
integer gamma_idx
Index of specific heat ratio func. eqn.
Definition m_global_parameters.fpp.f90:126
m_global_parameters::chemxb
integer chemxb
Definition m_global_parameters.fpp.f90:294
m_global_parameters::model_eqns
integer model_eqns
Multicomponent flow model.
Definition m_global_parameters.fpp.f90:90
m_global_parameters::pi_inf_idx
integer pi_inf_idx
Index of liquid stiffness func. eqn.
Definition m_global_parameters.fpp.f90:127
m_global_parameters::patch_icpp
type(ic_patch_parameters), dimension(num_patches_max) patch_icpp
Database of the initial condition patch parameters (icpp) for each of the patches employed in the con...
Definition m_global_parameters.fpp.f90:207
m_global_parameters::p
integer p
Definition m_global_parameters.fpp.f90:50
m_global_parameters::e_idx
integer e_idx
Index of total energy equation.
Definition m_global_parameters.fpp.f90:120
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:49
m_global_parameters::m
integer m
Definition m_global_parameters.fpp.f90:48
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:292
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:303
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:307