1515module m_reactive_burn
1616
1717 use m_global_parameters
18- use m_variables_conversion, only: f_sg_thermal
18+ use m_variables_conversion, only: f_sg_thermal, s_compute_mixture_coefficients, f_pressure
1919
2020 implicit none
2121
22- private; public :: s_compute_reactive_burn
22+ private; public :: s_compute_reactive_burn, s_reactive_burn_substep
2323
2424contains
2525
26+ !> Programmed- burn rate dlambda/ dt for one cell state. Both the RHS source and the operator - split integrator call this, so the
27+ !! rate law is stated once.
28+ !! @param pres Mixture pressure
29+ !! @param lambda Reaction progress, i.e. the product volume fraction
30+ !! @param alpha_rho_react Reactant partial density, for the optional Arrhenius factor
31+ !! @param alpha_react Reactant volume fraction, for the optional Arrhenius factor
32+ !! @param rate dlambda/ dt; zero below the ignition pressure and once the reactant is spent
33+ subroutine s_burn_rate (pres , lambda , alpha_rho_react , alpha_react , rate )
34+
35+ $:GPU_ROUTINE(function_name= ' s_burn_rate' , parallelism= ' [seq]' , cray_inline= True)
36+
37+ real (wp), intent (in ) :: pres, lambda, alpha_rho_react, alpha_react
38+ real (wp), intent (out ) :: rate
39+ real (wp) :: drive
40+
41+ ! Pressure- driven programmed burn: fires only behind the shock (p > rburn%pign).
42+ drive = (pres - rburn%pign)/ rburn%pref
43+ if (drive > 0._wp .and. lambda < 1._wp ) then
44+ rate = rburn%k* (1._wp - lambda)* drive** rburn%n
45+ ! Optional Arrhenius dependence on the reactant phasic temperature from the stiffened- gas
46+ ! EOS. rburn%ta = 0 , the default, leaves the pure pressure- driven rate unchanged.
47+ if (rburn%ta > 0._wp ) then
48+ rate = rate* exp (- rburn%ta/ f_sg_thermal(pres, alpha_rho_react/ alpha_react, isentrope_n(1 ), isentrope_B(1 ), cvs(1 )))
49+ end if
50+ else
51+ rate = 0._wp
52+ end if
53+
54+ end subroutine s_burn_rate
55+
2656 !> Add the programmed- burn reaction source to the continuity and volume- fraction RHS.
2757 !! @param rhs_vf Right- hand- side accumulator (inout )
2858 !! @param q_cons_vf Conserved variables (partial densities live here)
@@ -34,9 +64,9 @@ contains
3464 type(scalar_field), dimension (sys_size), intent (in ) :: q_cons_vf, q_prim_vf
3565 type(int_bounds_info), dimension (1 :3 ), intent (in ) :: bounds
3666 integer :: x, y, z
37- real (wp) :: rho, pres, lambda, rate, mdot, drive, T_r
67+ real (wp) :: rho, pres, lambda, rate, mdot
3868
39- $:GPU_PARALLEL_LOOP(collapse= 3 , private= ' [rho, pres, lambda, rate, mdot, drive, T_r ]' , copyin= ' [bounds]' )
69+ $:GPU_PARALLEL_LOOP(collapse= 3 , private= ' [rho, pres, lambda, rate, mdot]' , copyin= ' [bounds]' )
4070 do z = bounds(3 )%beg, bounds(3 )%end
4171 do y = bounds(2 )%beg, bounds(2 )%end
4272 do x = bounds(1 )%beg, bounds(1 )%end
@@ -45,20 +75,9 @@ contains
4575 pres = q_prim_vf(eqn_idx%E)%sf(x, y, z)
4676 lambda = q_prim_vf(eqn_idx%adv%beg + 1 )%sf(x, y, z) ! reaction progress = product volume fraction
4777
48- ! pressure- driven programmed burn: fires only behind the shock (p > rburn%pign)
49- drive = (pres - rburn%pign)/ rburn%pref
50- if (drive > 0._wp .and. lambda < 1._wp ) then
51- rate = rburn%k* (1._wp - lambda)* drive** rburn%n ! dlambda/ dt
52-
53- ! Optional Arrhenius temperature dependence: rate *= exp (- rburn%ta/ T_r), with T_r the
54- ! reactant phasic temperature from the stiffened- gas EOS T = (p + pi_inf)/ ((Gamma-1 ) rho cv).
55- ! rburn%ta = 0 (default) leaves the pure pressure- driven rate unchanged.
56- if (rburn%ta > 0._wp ) then
57- T_r = f_sg_thermal(pres, q_cons_vf(eqn_idx%cont%beg)%sf(x, y, z)/ q_prim_vf(eqn_idx%adv%beg)%sf(x, y, &
58- & z), isentrope_n(1 ), isentrope_B(1 ), cvs(1 ))
59- rate = rate* exp (- rburn%ta/ T_r)
60- end if
61-
78+ call s_burn_rate(pres, lambda, q_cons_vf(eqn_idx%cont%beg)%sf(x, y, z), q_prim_vf(eqn_idx%adv%beg)%sf(x, y, &
79+ & z), rate)
80+ if (rate > 0._wp ) then
6281 mdot = rho* rate ! mass reactant - > product
6382
6483 ! continuity: reactant loses mass, product gains it
@@ -76,4 +95,84 @@ contains
7695
7796 end subroutine s_compute_reactive_burn
7897
98+ !> Operator - split alternative to s_compute_reactive_burn, used when rburn%substeps > 0 . The flow is frozen and the burn ODE is
99+ !! integrated over one time step in equal sub- steps, so the reaction time scale is decoupled from the acoustic CFL. The mixture
100+ !! pressure is re- evaluated from the frozen internal energy each sub- step, which is what carries the rate' s own feedback: the
101+ !! coefficients move as the reactant becomes product.
102+ !! @param q_cons_vf Conserved variables, updated in place
103+ !! @param dtime Time step to integrate across
104+ !! @param bounds Interior cell bounds
105+ subroutine s_reactive_burn_substep(q_cons_vf, dtime, bounds)
106+
107+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
108+ real(wp), intent(in) :: dtime
109+ type(int_bounds_info), dimension(1:3), intent(in) :: bounds
110+ integer :: x, y, z, i, sub
111+ real(wp) :: rho, pres, lambda, rate
112+ real(wp) :: dt_sub, e_int, gamma_mix, pi_inf_mix, qv_mix
113+ real(wp) :: rho_mix, dlambda, dmass
114+
115+ #:if not MFC_CASE_OPTIMIZATION and USING_AMD
116+ real(wp), dimension(3) :: alpha_rho, alpha
117+ #:else
118+ real(wp), dimension(num_fluids) :: alpha_rho, alpha
119+ #:endif
120+
121+ dt_sub = dtime/real(rburn%substeps, wp)
122+
123+ $:GPU_PARALLEL_LOOP(collapse=3, private=' [alpha_rho, alpha, rho, pres, lambda, rate, e_int, gamma_mix, pi_inf_mix, &
124+ & qv_mix, rho_mix, dlambda, dmass, i, sub]' , copyin=' [bounds, dt_sub]' )
125+ do z = bounds(3)%beg, bounds(3)%end
126+ do y = bounds(2)%beg, bounds(2)%end
127+ do x = bounds(1)%beg, bounds(1)%end
128+ $:GPU_LOOP(parallelism=' [seq]' )
129+ do i = 1, num_fluids
130+ alpha_rho(i) = q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(x, y, z)
131+ alpha(i) = q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(x, y, z)
132+ end do
133+ rho = alpha_rho(1) + alpha_rho(2)
134+
135+ ! Internal energy per unit volume is what the burn conserves: it moves mass and volume
136+ ! between the phases, and the qv difference surfaces as pressure through the mixture EOS.
137+ e_int = q_cons_vf(eqn_idx%E)%sf(x, y, z)
138+ $:GPU_LOOP(parallelism=' [seq]' )
139+ do i = eqn_idx%mom%beg, eqn_idx%mom%end
140+ e_int = e_int - 0.5_wp*q_cons_vf(i)%sf(x, y, z)**2/rho
141+ end do
142+
143+ $:GPU_LOOP(parallelism=' [seq]' )
144+ do sub = 1, rburn%substeps
145+ lambda = alpha(2)
146+ call s_compute_mixture_coefficients(alpha_rho, alpha, rho_mix, gamma_mix, pi_inf_mix, qv_mix)
147+ pres = f_pressure(e_int, gamma_mix, pi_inf_mix, qv_mix)
148+ call s_burn_rate(pres, lambda, alpha_rho(1), alpha(1), rate)
149+ if (rate <= 0._wp) exit
150+ ! A sub-step longer than the reaction time would carry the progress variable past one.
151+ ! Stop it there and hand over the reactant' s remaining mass in the same sub- step: capping
152+ ! the two independently strands mass at zero volume, and the EOS divides one by the other.
153+ if (rate* dt_sub >= 1._wp - lambda) then
154+ dlambda = 1._wp - lambda
155+ dmass = alpha_rho(1 )
156+ else
157+ dlambda = rate* dt_sub
158+ dmass = min (rho* dlambda, alpha_rho(1 ))
159+ end if
160+ alpha(1 ) = alpha(1 ) - dlambda
161+ alpha(2 ) = alpha(2 ) + dlambda
162+ alpha_rho(1 ) = alpha_rho(1 ) - dmass
163+ alpha_rho(2 ) = alpha_rho(2 ) + dmass
164+ end do
165+
166+ $:GPU_LOOP(parallelism= ' [seq]' )
167+ do i = 1 , num_fluids
168+ q_cons_vf(i + eqn_idx%cont%beg - 1 )%sf(x, y, z) = alpha_rho(i)
169+ q_cons_vf(i + eqn_idx%adv%beg - 1 )%sf(x, y, z) = alpha(i)
170+ end do
171+ end do
172+ end do
173+ end do
174+ $:END_GPU_PARALLEL_LOOP()
175+
176+ end subroutine s_reactive_burn_substep
177+
79178end module m_reactive_burn
0 commit comments