MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_pressure_relaxation.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
2!>
3!! @file
4!! @brief Contains module m_pressure_relaxation
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/simulation/m_pressure_relaxation.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# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
32! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
33! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
34# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
35# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
36# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
37
38# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40
41# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42
43# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44
45# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
46
47# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
48
49# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50
51# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52
53# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54
55# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56! New line at end of file is required for FYPP
57# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
58# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
59# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
60# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
62# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
64# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
72! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
73! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
74# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
75# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
76# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
77
78# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
79# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
80
81# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
82
83# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
84
85# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
86
87# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
88
89# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
90
91# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
92
93# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
94
95# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
96! New line at end of file is required for FYPP
97# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
98
99# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
100# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
102# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
104
105# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
106
107# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
108
109# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
110
111# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
112
113# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 95 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 100 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 105 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 110 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 115 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 120 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 125 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 130 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 135 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 165 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 219 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 233 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 258 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 269 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 271 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150# 282 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151
152# 332 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
153
154# 342 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
155
156# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
157
158# 361 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
159
160# 378 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
161
162# 388 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
163
164# 395 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
165
166# 401 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
167
168# 407 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
169
170# 413 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
171
172# 419 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
173
174# 425 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
175! New line at end of file is required for FYPP
176# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
177# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
178# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
179# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
180# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
181# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
182# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
183# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
184
185# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
186# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
187# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
188
189# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
190# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
191! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
192! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
193# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
194# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
195# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
196
197# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
198# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
199
200# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
201
202# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
203
204# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
205
206# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
207
208# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
209
210# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
211
212# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
213
214# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
215! New line at end of file is required for FYPP
216# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
217
218# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233
234# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
235
236# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
237
238# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
239
240# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
241
242# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
243
244# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
245
246# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
247
248# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
249
250# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
251
252# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
253
254# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
255
256# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
257
258# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
259
260# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
261
262# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
263
264# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
265
266# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
267
268# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
269
270# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
271
272# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
273! New line at end of file is required for FYPP
274# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
275
276! GPU parallel region (scalar reductions, maxval/minval)
277# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
278
279! GPU parallel loop over threads (most common GPU macro)
280# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
281
282! Required closing for GPU_PARALLEL_LOOP
283# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
284
285! Mark routine for device compilation
286# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
287
288! Declare device-resident data
289# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
290
291! Inner loop within a GPU parallel region
292# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
293
294! Scoped GPU data region
295# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
296
297! Host code with device pointers (for MPI with GPU buffers)
298# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
299
300! Allocate device memory (unscoped)
301# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
302
303! Free device memory
304# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
305
306! Atomic operation on device
307# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
308
309! End atomic capture block
310# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
311
312! Copy data between host and device
313# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
314
315! Synchronization barrier
316# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
317
318! Import GPU library module (openacc or omp_lib)
319# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
320
321! Emit code only for AMD compiler
322# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
323
324! Emit code for non-Cray compilers
325# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
326
327! Emit code only for Cray compiler
328# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
329
330! Emit code for non-NVIDIA compilers
331# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
332
333# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
334# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
335! New line at end of file is required for FYPP
336# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
337
338# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
339
340! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
341! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
342! example see misc/nvidia_uvm/bind.sh.
343# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
344
345! Allocate and create GPU device memory
346# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
347
348! Free GPU device memory and deallocate
349# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
350
351! Cray-specific GPU pointer setup for vector fields
352# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
353
354! Cray-specific GPU pointer setup for scalar fields
355# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
356
357! Cray-specific GPU pointer setup for acoustic source spatials
358# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
359
360# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
361
362# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
363! New line at end of file is required for FYPP
364# 7 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp" 2
365
366!> @brief Pressure relaxation for the six-equation multi-component model via Newton--Raphson equilibration and volume-fraction
367!! correction
368module m_pressure_relaxation
369
370 use m_derived_types
371 use m_global_parameters
372 use m_mpi_proxy, only: s_mpi_abort
373 use m_variables_conversion, only: s_convert_species_to_mixture_variables_kernel
374 use m_eos, only: f_pressure, s_phase_internal_energy, s_phase_coefficients, s_phase_density_on_isentrope, f_is_state_dependent
375
376 implicit none
377
378 private; public :: s_pressure_relaxation_procedure, s_report_pressure_relaxation
379
380 !> Cell updates in which the Newton below stopped on its iteration cap rather than on the tolerance. Counted because the answer
381 !! then depends on that cap, and nothing else in the code says so.
382 integer :: n_hit_cap = 0
383 real(wp) :: worst_residual = 0._wp !< Largest |f| left behind when the cap was reached
384
385contains
386
387 !> The main pressure relaxation procedure
388 subroutine s_pressure_relaxation_procedure(q_cons_vf)
389
390 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
391 integer :: i, j, k, l
392
393# 38 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
394 real(wp), dimension(num_fluids) :: alpha_rho, alpha
395# 40 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
396 real(wp) :: rho, gamma, pi_inf, qv_mix
397 integer :: hit_cap, hit_cap_sum, unusable, unusable_sum
398 real(wp) :: resid, resid_max
399
400 ! Formed here, not one call deeper: CCE OpenACC accepts a num_fluids-sized array passed to a device routine from a
401 ! parallel-loop body, and rejects the same call from inside another acc routine seq.
402 hit_cap_sum = 0
403 unusable_sum = 0
404 resid_max = 0._wp
405
406# 49 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
407
408# 49 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
409#if defined(MFC_OpenACC)
410# 49 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
411!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, alpha_rho, alpha, rho, gamma, pi_inf, qv_mix, hit_cap, resid, unusable) reduction(+:hit_cap_sum, unusable_sum) &
412# 49 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
413!$acc& reduction(max:resid_max)
414# 49 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
415#elif defined(MFC_OpenMP)
416# 49 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
417
418# 49 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
419
420# 49 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
421
422# 49 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
423!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
424# 49 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
425!$omp& private(i, j, k, l, alpha_rho, alpha, rho, gamma, pi_inf, qv_mix, hit_cap, resid, unusable) reduction(+:hit_cap_sum, unusable_sum) reduction(max:resid_max)
426# 49 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
427#endif
428# 51 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
429 do l = 0, p
430 do k = 0, n
431 do j = 0, m
432 if (mpp_lim) call s_correct_volume_fractions(q_cons_vf, j, k, l)
433
434 hit_cap = 0
435 resid = 0._wp
436 unusable = 0
437 if (s_needs_pressure_relaxation(q_cons_vf, j, k, l)) then
438 call s_equilibrate_pressure(q_cons_vf, j, k, l, hit_cap, resid, unusable)
439 end if
440 hit_cap_sum = hit_cap_sum + hit_cap
441 unusable_sum = unusable_sum + unusable
442 resid_max = max(resid_max, resid)
443
444
445# 66 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
446#if defined(MFC_OpenACC)
447# 66 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
448!$acc loop seq
449# 66 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
450#elif defined(MFC_OpenMP)
451# 66 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
452
453# 66 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
454#endif
455# 67 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
456 do i = 1, num_fluids
457 alpha_rho(i) = q_cons_vf(i)%sf(j, k, l)
458 alpha(i) = q_cons_vf(eqn_idx%E + i)%sf(j, k, l)
459 end do
460
461 call s_convert_species_to_mixture_variables_kernel(rho, gamma, pi_inf, qv_mix, alpha, alpha_rho)
462
463 call s_correct_internal_energies(q_cons_vf, j, k, l, rho, gamma, pi_inf, qv_mix)
464 end do
465 end do
466 end do
467
468# 78 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
469#if defined(MFC_OpenACC)
470# 78 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
471!$acc end parallel loop
472# 78 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
473#elif defined(MFC_OpenMP)
474# 78 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
475
476# 78 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
477!$omp end target teams loop
478# 78 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
479#endif
480# 79 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
481 n_hit_cap = n_hit_cap + hit_cap_sum
482 worst_residual = max(worst_residual, resid_max)
483
484 ! Equilibration produced a density that is not a usable number. Continuing means advancing a cell that has
485 ! no physical state, which is the kind of quiet wrongness that only shows up as a bad answer much later.
486 if (unusable_sum > 0) then
487 call s_mpi_abort('Pressure relaxation produced a non-physical phasic density. Exiting.')
488 end if
489
490 end subroutine s_pressure_relaxation_procedure
491
492 !> One line at the end of a run if the equilibration ever stopped on its iteration cap. Silence means every cell reached the
493 !! tolerance.
494 impure subroutine s_report_pressure_relaxation
495
496 if (n_hit_cap > 0 .and. proc_rank == 0) then
497 print '(A,I0,A,ES10.3,A)', ' Pressure relaxation reached its iteration cap in ', n_hit_cap, &
498 & ' cell updates; worst residual left behind ', worst_residual, ' against a 1e-10 tolerance.'
499 end if
500
501 end subroutine s_report_pressure_relaxation
502
503 !> Check if pressure relaxation is needed for this cell
504 logical function s_needs_pressure_relaxation(q_cons_vf, j, k, l)
505
506
507# 104 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
508#if MFC_OpenACC
509# 104 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
510!$acc routine seq
511# 104 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
512#elif MFC_OpenMP
513# 104 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
514
515# 104 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
516
517# 104 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
518!$omp declare target device_type(any)
519# 104 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
520#endif
521# 105 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
522
523 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
524 integer, intent(in) :: j, k, l
525 integer :: i
526
527 s_needs_pressure_relaxation = .true.
528
529# 111 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
530#if defined(MFC_OpenACC)
531# 111 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
532!$acc loop seq
533# 111 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
534#elif defined(MFC_OpenMP)
535# 111 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
536
537# 111 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
538#endif
539# 112 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
540 do i = 1, num_fluids
541 if (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) > (1._wp - sgm_eps)) then
542 s_needs_pressure_relaxation = .false.
543 end if
544 end do
545
546 end function s_needs_pressure_relaxation
547
548 !> Correct volume fractions to physical bounds
549 subroutine s_correct_volume_fractions(q_cons_vf, j, k, l)
550
551
552# 123 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
553#if MFC_OpenACC
554# 123 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
555!$acc routine seq
556# 123 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
557#elif MFC_OpenMP
558# 123 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
559
560# 123 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
561
562# 123 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
563!$omp declare target device_type(any)
564# 123 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
565#endif
566# 124 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
567
568 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
569 integer, intent(in) :: j, k, l
570 real(wp) :: sum_alpha
571 integer :: i
572
573 sum_alpha = 0._wp
574
575# 131 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
576#if defined(MFC_OpenACC)
577# 131 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
578!$acc loop seq
579# 131 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
580#elif defined(MFC_OpenMP)
581# 131 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
582
583# 131 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
584#endif
585# 132 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
586 do i = 1, num_fluids
587 if ((q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l) < 0._wp) .or. (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, &
588 & l) < 0._wp)) then
589 q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l) = 0._wp
590 q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) = 0._wp
591 q_cons_vf(i + eqn_idx%int_en%beg - 1)%sf(j, k, l) = 0._wp
592 end if
593 if (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) > 1._wp) q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) = 1._wp
594 sum_alpha = sum_alpha + q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)
595 end do
596
597
598# 143 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
599#if defined(MFC_OpenACC)
600# 143 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
601!$acc loop seq
602# 143 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
603#elif defined(MFC_OpenMP)
604# 143 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
605
606# 143 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
607#endif
608# 144 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
609 do i = 1, num_fluids
610 q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) = q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)/sum_alpha
611 end do
612
613 end subroutine s_correct_volume_fractions
614
615 !> Main pressure equilibration using Newton-Raphson
616 subroutine s_equilibrate_pressure(q_cons_vf, j, k, l, hit_cap, resid, unusable)
617
618
619# 153 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
620#if MFC_OpenACC
621# 153 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
622!$acc routine seq
623# 153 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
624#elif MFC_OpenMP
625# 153 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
626
627# 153 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
628
629# 153 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
630!$omp declare target device_type(any)
631# 153 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
632#endif
633# 154 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
634
635 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
636 integer, intent(in) :: j, k, l
637 integer, intent(out) :: hit_cap, unusable
638 real(wp), intent(out) :: resid
639 real(wp) :: pres_relax, f_pres, df_pres
640# 163 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
641 real(wp), dimension(num_fluids) :: pres_K_init, rho_K_init, rho_K_s
642# 165 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
643 real(wp) :: gamma_K, pi_inf_K, dpi_K, dgamma_K, c2_K, alpha_i, alpha_rho_i, rho_i, p_i, rho_s_i
644 integer, parameter :: MAX_ITER = 50
645 ! Pressure relaxation convergence tolerance
646 real(wp), parameter :: TOLERANCE = 1.e-10_wp
647 integer :: iter, i
648 logical :: usable
649
650 ! Initialize pressures
651 pres_relax = 0._wp
652
653# 174 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
654#if defined(MFC_OpenACC)
655# 174 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
656!$acc loop seq
657# 174 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
658#elif defined(MFC_OpenMP)
659# 174 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
660
661# 174 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
662#endif
663# 175 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
664 do i = 1, num_fluids
665 if (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) > sgm_eps) then
666 ! Phasic internal energy carries the formation energy: alpha_rho_k*qv_k must be
667 ! removed before inverting the stiffened-gas EOS, or a nonzero qv inflates the
668 ! phasic pressure by rho_k*qv_k/gamma_k (this is what breaks the reactive burn).
669 alpha_rho_i = q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)
670 alpha_i = q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)
671 call s_phase_coefficients(alpha_rho_i, alpha_i, i, rho_i, gamma_k, pi_inf_k, dpi_k, dgamma_k)
672 rho_k_init(i) = rho_i
673 pres_k_init(i) = ((q_cons_vf(i + eqn_idx%int_en%beg - 1)%sf(j, k, l) - q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, &
674 & k, l)*qvs(i))/q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) - pi_inf_k)/gamma_k
675 if (.not. f_is_state_dependent(i)) then
676 if (pres_k_init(i) <= -(1._wp - 1.e-8_wp)*isentrope_b(i) + 1.e-8_wp) pres_k_init(i) = -(1._wp - 1.e-8_wp) &
677 & *isentrope_b(i) + 1.e-8_wp
678 end if
679 else
680 pres_k_init(i) = 0._wp
681 end if
682 pres_relax = pres_relax + q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)*pres_k_init(i)
683 end do
684
685 ! Newton-Raphson iteration
686 f_pres = 1.e-9_wp
687 df_pres = 1.e9_wp
688
689# 199 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
690#if defined(MFC_OpenACC)
691# 199 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
692!$acc loop seq
693# 199 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
694#elif defined(MFC_OpenMP)
695# 199 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
696
697# 199 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
698#endif
699# 200 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
700 do iter = 0, max_iter - 1
701 if (abs(f_pres) > tolerance) then
702 pres_relax = pres_relax - f_pres/df_pres
703
704 ! Enforce pressure bounds
705 do i = 1, num_fluids
706 if (.not. f_is_state_dependent(i)) then
707 if (pres_relax <= -(1._wp - 1.e-8_wp)*isentrope_b(i) + 1.e-8_wp) pres_relax = -(1._wp - 1.e-8_wp) &
708 & *isentrope_b(i) + 1.e-8_wp
709 end if
710 end do
711
712 ! Newton-Raphson step
713 f_pres = -1._wp
714 df_pres = 0._wp
715
716# 215 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
717#if defined(MFC_OpenACC)
718# 215 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
719!$acc loop seq
720# 215 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
721#elif defined(MFC_OpenMP)
722# 215 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
723
724# 215 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
725#endif
726# 216 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
727 do i = 1, num_fluids
728 if (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) > sgm_eps .and. any_state_dependent_eos) then
729 rho_i = rho_k_init(i)
730 p_i = pres_k_init(i)
731 call s_phase_density_on_isentrope(i, rho_i, p_i, pres_relax, rho_s_i, c2_k)
732 rho_k_s(i) = rho_s_i
733 f_pres = f_pres + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)/rho_k_s(i)
734 df_pres = df_pres - q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)/(rho_k_s(i)**2*c2_k)
735 else if (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) > sgm_eps) then
736 ! Isentropic relation: rho = rho0 * (p/p0)^(1/gamma), Saurel et al. JFM (2009)
737 rho_k_s(i) = q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)/max(q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, &
738 & k, l), &
739 & sgm_eps)*((pres_relax + isentrope_b(i))/(pres_k_init(i) + isentrope_b(i)))**(1._wp/isentrope_n(i))
740 f_pres = f_pres + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)/rho_k_s(i)
741 df_pres = df_pres - q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, &
742 & l)/(isentrope_n(i)*rho_k_s(i)*(pres_relax + isentrope_b(i)))
743 end if
744 end do
745 end if
746 end do
747
748 ! Written as .not. (<=) so a NaN residual is reported as a miss, like a diverged one.
749 hit_cap = 0
750 resid = 0._wp
751 unusable = 0
752 if (.not. (abs(f_pres) <= tolerance)) then
753 hit_cap = 1
754 ! A NaN residual has to be mapped, not passed on: max() with a NaN keeps the other operand, so the
755 ! reduction would report the miss as zero.
756 resid = abs(f_pres)
757 if (f_pres /= f_pres) resid = huge(1._wp)
758 end if
759
760 ! An unconverged-but-physical density is still used: the Newton often stops on the iteration cap and the
761 ! answer then depends on that cap, so refusing it would move every six-equation result. A density that is
762 ! not a usable number is different -- the equilibration has failed, and the cell has no physical state to
763 ! continue from. Flag it and let the caller stop the run rather than quietly leaving the cell unrelaxed.
764 ! Written as .not. (> 0) so a NaN takes the same path as a non-positive value.
765 ! No early return: Cray OpenACC rejects a RETURN inside an accelerator loop.
766 usable = .true.
767
768# 256 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
769#if defined(MFC_OpenACC)
770# 256 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
771!$acc loop seq
772# 256 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
773#elif defined(MFC_OpenMP)
774# 256 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
775
776# 256 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
777#endif
778# 257 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
779 do i = 1, num_fluids
780 if (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) > sgm_eps .and. .not. (rho_k_s(i) > 0._wp)) usable = .false.
781 end do
782
783 if (usable) then
784
785# 262 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
786#if defined(MFC_OpenACC)
787# 262 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
788!$acc loop seq
789# 262 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
790#elif defined(MFC_OpenMP)
791# 262 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
792
793# 262 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
794#endif
795# 263 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
796 do i = 1, num_fluids
797 if (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) > sgm_eps) q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, &
798 & l) = q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)/rho_k_s(i)
799 end do
800 else
801 unusable = 1
802 end if
803
804 end subroutine s_equilibrate_pressure
805
806 !> Correct internal energies using equilibrated pressure
807 subroutine s_correct_internal_energies(q_cons_vf, j, k, l, rho, gamma, pi_inf, qv_mix)
808
809
810# 276 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
811#if MFC_OpenACC
812# 276 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
813!$acc routine seq
814# 276 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
815#elif MFC_OpenMP
816# 276 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
817
818# 276 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
819
820# 276 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
821!$omp declare target device_type(any)
822# 276 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
823#endif
824# 277 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
825
826 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
827 integer, intent(in) :: j, k, l
828 real(wp), intent(in) :: rho, gamma, pi_inf, qv_mix
829 real(wp) :: dyn_pres, pres_relax, alpha_i, alpha_rho_i, e_i
830 integer :: i
831
832 dyn_pres = 0._wp
833
834# 285 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
835#if defined(MFC_OpenACC)
836# 285 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
837!$acc loop seq
838# 285 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
839#elif defined(MFC_OpenMP)
840# 285 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
841
842# 285 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
843#endif
844# 286 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
845 do i = eqn_idx%mom%beg, eqn_idx%mom%end
846 dyn_pres = dyn_pres + 5.e-1_wp*q_cons_vf(i)%sf(j, k, l)*q_cons_vf(i)%sf(j, k, l)/max(rho, sgm_eps)
847 end do
848
849 pres_relax = f_pressure(q_cons_vf(eqn_idx%E)%sf(j, k, l) - dyn_pres, gamma, pi_inf, qv_mix)
850
851
852# 292 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
853#if defined(MFC_OpenACC)
854# 292 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
855!$acc loop seq
856# 292 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
857#elif defined(MFC_OpenMP)
858# 292 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
859
860# 292 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
861#endif
862# 293 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
863 do i = 1, num_fluids
864 alpha_i = q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)
865 alpha_rho_i = q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)
866 call s_phase_internal_energy(pres_relax, alpha_i, alpha_rho_i, i, e_i)
867 q_cons_vf(i + eqn_idx%int_en%beg - 1)%sf(j, k, l) = e_i
868 end do
869
870 end subroutine s_correct_internal_energies
871
872end module m_pressure_relaxation
q_cons_vf
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
Definition m_phase_change.fpp.f90:1041
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1043
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1043
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1043
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:356
m_eos
Equations of state in Gamma/Pi form, rho e = Gamma(rho) p + Pi(rho).
Definition m_eos.fpp.f90:402
m_eos::s_phase_density_on_isentrope
subroutine, public s_phase_density_on_isentrope(i, rho_from, p_from, p_to, rho_to, c2_to)
Density of phase i on the isentrope through (rho_from, p_from) at p_to, and c^2 there: Newton on the ...
Definition m_eos.fpp.f90:1684
m_eos::s_phase_coefficients
subroutine, public s_phase_coefficients(alpha_rho, alpha, i, rho, gamma, pi_inf, dpi, dgamma)
Coefficients of phase i at its own density alpha_rho/alpha: the per-cell dispatch when some fluid's E...
Definition m_eos.fpp.f90:1345
m_eos::f_is_state_dependent
logical function, public f_is_state_dependent(i)
Whether the EOS of fluid i is a family whose coefficients vary with density.
Definition m_eos.fpp.f90:966
m_eos::s_phase_internal_energy
subroutine, public s_phase_internal_energy(pres, alpha, alpha_rho, i, e_phase)
Internal energy per unit volume of phase i at pressure pres: alpha (Gamma p + Pi) + alpha_rho qv,...
Definition m_eos.fpp.f90:1733
m_eos::f_pressure
real(wp) function, public f_pressure(e_int, gamma, pi_inf, qv)
Pressure of a stiffened gas from its internal energy density - the inverse of s_compute_energy....
Definition m_eos.fpp.f90:1835
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:367
m_global_parameters::proc_rank
integer proc_rank
Rank of the local processor.
Definition m_global_parameters.fpp.f90:386
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:367
m_pressure_relaxation
Pressure relaxation for the six-equation multi-component model via Newton–Raphson equilibration and v...
Definition m_pressure_relaxation.fpp.f90:368
m_pressure_relaxation::s_equilibrate_pressure
subroutine s_equilibrate_pressure(q_cons_vf, j, k, l, hit_cap, resid, unusable)
Main pressure equilibration using Newton-Raphson.
Definition m_pressure_relaxation.fpp.f90:617
m_pressure_relaxation::s_pressure_relaxation_procedure
subroutine, public s_pressure_relaxation_procedure(q_cons_vf)
The main pressure relaxation procedure.
Definition m_pressure_relaxation.fpp.f90:389
m_pressure_relaxation::s_needs_pressure_relaxation
logical function s_needs_pressure_relaxation(q_cons_vf, j, k, l)
Check if pressure relaxation is needed for this cell.
Definition m_pressure_relaxation.fpp.f90:505
m_pressure_relaxation::s_correct_internal_energies
subroutine s_correct_internal_energies(q_cons_vf, j, k, l, rho, gamma, pi_inf, qv_mix)
Correct internal energies using equilibrated pressure.
Definition m_pressure_relaxation.fpp.f90:808
m_pressure_relaxation::n_hit_cap
integer n_hit_cap
Cell updates in which the Newton below stopped on its iteration cap rather than on the tolerance....
Definition m_pressure_relaxation.fpp.f90:382
m_pressure_relaxation::worst_residual
real(wp) worst_residual
Largest |f| left behind when the cap was reached.
Definition m_pressure_relaxation.fpp.f90:383
m_pressure_relaxation::s_report_pressure_relaxation
impure subroutine, public s_report_pressure_relaxation
One line at the end of a run if the equilibration ever stopped on its iteration cap....
Definition m_pressure_relaxation.fpp.f90:495
m_pressure_relaxation::s_correct_volume_fractions
subroutine s_correct_volume_fractions(q_cons_vf, j, k, l)
Correct volume fractions to physical bounds.
Definition m_pressure_relaxation.fpp.f90:550
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:367
m_variables_conversion::s_convert_species_to_mixture_variables_kernel
subroutine, public s_convert_species_to_mixture_variables_kernel(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, alpha_rho_k, re_k, g_k, g)
Host- and device-callable conversion kernel for species and mixture variables.
Definition m_variables_conversion.fpp.f90:602
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:370