Skip to content

Commit 579ae58

Browse files
sbryngelsonsbryngelson
committed
added inline riemann avg state
1 parent 8b0c57a commit 579ae58

File tree

2 files changed

+52
-116
lines changed

2 files changed

+52
-116
lines changed

‎src/simulation/inline_riemann.fpp‎

Lines changed: 39 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,39 @@
1+
#:def arithmetic_avg(rho_avg,rho_L,rho_R,vel_L,vel_R,vel_avg_rms,H_L,H_R,H_avg,gamma_L,gamma_R,gamma_avg)
2+
rho_avg = 5d-1*(rho_L + rho_R)
3+
vel_avg_rms = 0d0
4+
!$acc loop seq
5+
do i = 1, num_dims
6+
vel_avg_rms = vel_avg_rms + (5d-1*(vel_L(i) + vel_R(i)))**2d0
7+
end do
8+
9+
H_avg = 5d-1*(H_L + H_R)
10+
gamma_avg = 5d-1*(gamma_L + gamma_R)
11+
#:enddef arithmetic_avg
12+
13+
#:def roe_avg(rho_avg,rho_L,rho_R,vel_L,vel_R,vel_avg_rms,H_L,H_R,H_avg,gamma_L,gamma_R,gamma_avg)
14+
rho_avg = sqrt(rho_L*rho_R)
15+
vel_avg_rms = 0d0
16+
!$acc loop seq
17+
do i = 1, num_dims
18+
vel_avg_rms = vel_avg_rms + (sqrt(rho_L)*vel_L(i) + sqrt(rho_R)*vel_R(i))**2d0/ &
19+
(sqrt(rho_L) + sqrt(rho_R))**2d0
20+
end do
21+
22+
H_avg = (sqrt(rho_L)*H_L + sqrt(rho_R)*H_R)/ &
23+
(sqrt(rho_L) + sqrt(rho_R))
24+
25+
gamma_avg = (sqrt(rho_L)*gamma_L + sqrt(rho_R)*gamma_R)/ &
26+
(sqrt(rho_L) + sqrt(rho_R))
27+
#:enddef roe_avg
28+
29+
#:def compute_average_state(avg_state,rho_avg,rho_L,rho_R,vel_L,vel_R,vel_avg_rms,H_L,H_R,H_avg,gamma_L,gamma_R,gamma_avg)
30+
31+
if (avg_state == 1) then
32+
@:roe_avg(rho_avg,rho_L,rho_R,vel_L,vel_R,vel_avg_rms,H_L,H_R,H_avg,gamma_L,gamma_R,gamma_avg)
33+
end if
34+
35+
if (avg_state == 2) then
36+
@:arithmetic_avg(rho_avg,rho_L,rho_R,vel_L,vel_R,vel_avg_rms,H_L,H_R,H_avg,gamma_L,gamma_R,gamma_avg)
37+
end if
38+
39+
#:enddef compute_average_state

‎src/simulation/m_riemann_solvers.fpp‎

Lines changed: 13 additions & 116 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,8 @@
1717
!! 1) Harten-Lax-van Leer (HLL)
1818
!! 2) Harten-Lax-van Leer-Contact (HLLC)
1919
!! 3) Exact
20+
#:include 'inline_riemann.fpp'
21+
2022
module m_riemann_solvers
2123

2224
! Dependencies =============================================================
@@ -34,10 +36,10 @@ module m_riemann_solvers
3436
implicit none
3537

3638
private; public :: s_initialize_riemann_solvers_module, &
37-
s_riemann_solver, &
38-
s_hll_riemann_solver, &
39-
s_hllc_riemann_solver, &
40-
s_finalize_riemann_solvers_module
39+
s_riemann_solver, &
40+
s_hll_riemann_solver, &
41+
s_hllc_riemann_solver, &
42+
s_finalize_riemann_solvers_module
4143

4244
abstract interface ! =======================================================
4345

@@ -600,40 +602,9 @@ contains
600602
end if
601603
end do
602604
end if
603-
604-
if (avg_state == 2) then
605-
rho_avg = 5d-1*(rho_L + rho_R)
606-
607-
!$acc loop seq
608-
do i = 1, num_dims
609-
vel_avg(i) = 5d-1*(vel_L(i) + vel_R(i))
610-
end do
611-
612-
H_avg = 5d-1*(H_L + H_R)
613-
614-
gamma_avg = 5d-1*(gamma_L + gamma_R)
615-
elseif (avg_state == 1) then
616-
rho_avg = sqrt(rho_L*rho_R)
617-
618-
!$acc loop seq
619-
do i = 1, num_dims
620-
vel_avg(i) = (sqrt(rho_L)*vel_L(i) + sqrt(rho_R)*vel_R(i))/ &
621-
(sqrt(rho_L) + sqrt(rho_R))
622-
end do
623-
624-
H_avg = (sqrt(rho_L)*H_L + sqrt(rho_R)*H_R)/ &
625-
(sqrt(rho_L) + sqrt(rho_R))
626-
627-
gamma_avg = (sqrt(rho_L)*gamma_L + sqrt(rho_R)*gamma_R)/ &
628-
(sqrt(rho_L) + sqrt(rho_R))
629-
end if
630-
631-
vel_avg_rms = 0d0
632-
633-
!$acc loop seq
634-
do i = 1, num_dims
635-
vel_avg_rms = vel_avg_rms + vel_avg(i)**2d0
636-
end do
605+
606+
! compute avg state goes here
607+
@:compute_average_state(avg_state,rho_avg,rho_L,rho_R,vel_L,vel_R,vel_avg_rms,H_L,H_R,H_avg,gamma_L,gamma_R,gamma_avg)
637608

638609
if (mixture_err) then
639610
if ((H_avg - 5d-1*vel_avg_rms) < 0d0) then
@@ -1210,35 +1181,8 @@ contains
12101181
12111182
H_L = (E_L + pres_L)/rho_L
12121183
H_R = (E_R + pres_R)/rho_R
1213-
if (avg_state == 2) then
1214-
1215-
rho_avg = 5d-1*(rho_L + rho_R)
1216-
vel_avg_rms = 0d0
1217-
!$acc loop seq
1218-
do i = 1, num_dims
1219-
vel_avg_rms = vel_avg_rms + (5d-1*(vel_L(i) + vel_R(i)))**2d0
1220-
end do
12211184
1222-
H_avg = 5d-1*(H_L + H_R)
1223-
1224-
gamma_avg = 5d-1*(gamma_L + gamma_R)
1225-
1226-
elseif (avg_state == 1) then
1227-
1228-
rho_avg = sqrt(rho_L*rho_R)
1229-
vel_avg_rms = 0d0
1230-
!$acc loop seq
1231-
do i = 1, num_dims
1232-
vel_avg_rms = vel_avg_rms + (sqrt(rho_L)*vel_L(i) + sqrt(rho_R)*vel_R(i))**2d0/ &
1233-
(sqrt(rho_L) + sqrt(rho_R))**2d0
1234-
end do
1235-
1236-
H_avg = (sqrt(rho_L)*H_L + sqrt(rho_R)*H_R)/ &
1237-
(sqrt(rho_L) + sqrt(rho_R))
1238-
1239-
gamma_avg = (sqrt(rho_L)*gamma_L + sqrt(rho_R)*gamma_R)/ &
1240-
(sqrt(rho_L) + sqrt(rho_R))
1241-
end if
1185+
@:compute_average_state(avg_state,rho_avg,rho_L,rho_R,vel_L,vel_R,vel_avg_rms,H_L,H_R,H_avg,gamma_L,gamma_R,gamma_avg)
12421186
12431187
if (mixture_err) then
12441188
if ((H_avg - 5d-1*vel_avg_rms) < 0d0) then
@@ -1545,39 +1489,8 @@ contains
15451489
15461490
H_L = (E_L + pres_L)/rho_L
15471491
H_R = (E_R + pres_R)/rho_R
1548-
if (avg_state == 2) then
1549-
1550-
rho_avg = 5d-1*(rho_L + rho_R)
1551-
!$acc loop seq
1552-
do i = 1, num_dims
1553-
vel_avg(i) = 5d-1*(vel_L(i) + vel_R(i))
1554-
end do
1555-
1556-
H_avg = 5d-1*(H_L + H_R)
15571492
1558-
gamma_avg = 5d-1*(gamma_L + gamma_R)
1559-
1560-
elseif (avg_state == 1) then
1561-
1562-
rho_avg = sqrt(rho_L*rho_R)
1563-
!$acc loop seq
1564-
do i = 1, num_dims
1565-
vel_avg(i) = (sqrt(rho_L)*vel_L(i) + sqrt(rho_R)*vel_R(i))/ &
1566-
(sqrt(rho_L) + sqrt(rho_R))
1567-
end do
1568-
1569-
H_avg = (sqrt(rho_L)*H_L + sqrt(rho_R)*H_R)/ &
1570-
(sqrt(rho_L) + sqrt(rho_R))
1571-
1572-
gamma_avg = (sqrt(rho_L)*gamma_L + sqrt(rho_R)*gamma_R)/ &
1573-
(sqrt(rho_L) + sqrt(rho_R))
1574-
end if
1575-
1576-
vel_avg_rms = 0d0
1577-
!$acc loop seq
1578-
do i = 1, num_dims
1579-
vel_avg_rms = vel_avg_rms + vel_avg(i)**2d0
1580-
end do
1493+
@:compute_average_state(avg_state,rho_avg,rho_L,rho_R,vel_L,vel_R,vel_avg_rms,H_L,H_R,H_avg,gamma_L,gamma_R,gamma_avg)
15811494
15821495
if (mixture_err) then
15831496
if ((H_avg - 5d-1*vel_avg_rms) < 0d0) then
@@ -1906,9 +1819,6 @@ contains
19061819
end if
19071820
end do
19081821
1909-
!call s_comp_n_from_prim(qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + num_fluids), R0_L, nbub_L)
1910-
!call s_comp_n_from_prim(qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + num_fluids), R0_R, nbub_R)
1911-
19121822
nbub_L_denom = 0d0
19131823
nbub_R_denom = 0d0
19141824
@@ -2001,21 +1911,7 @@ contains
20011911
end do
20021912
20031913
elseif (avg_state == 1) then
2004-
2005-
rho_avg = sqrt(rho_L*rho_R)
2006-
2007-
vel_avg_rms = 0d0
2008-
!$acc loop seq
2009-
do i = 1, num_dims
2010-
vel_avg_rms = vel_avg_rms + (sqrt(rho_L)*vel_L(i) + sqrt(rho_R)*vel_R(i))**2d0/ &
2011-
(sqrt(rho_L) + sqrt(rho_R))**2d0
2012-
end do
2013-
2014-
H_avg = (sqrt(rho_L)*H_L + sqrt(rho_R)*H_R)/ &
2015-
(sqrt(rho_L) + sqrt(rho_R))
2016-
2017-
gamma_avg = (sqrt(rho_L)*gamma_L + sqrt(rho_R)*gamma_R)/ &
2018-
(sqrt(rho_L) + sqrt(rho_R))
1914+
call s_mpi_abort()
20191915
end if
20201916
20211917
if (mixture_err) then
@@ -2394,6 +2290,7 @@ contains
23942290
vel_avg_rms = vel_avg_rms + (sqrt(rho_L)*vel_L(2) + sqrt(rho_R)*vel_R(2))**2d0/ &
23952291
(sqrt(rho_L) + sqrt(rho_R))**2d0
23962292
end if
2293+
23972294
if (num_dims == 3) then
23982295
vel_avg_rms = vel_avg_rms + (sqrt(rho_L)*vel_L(3) + sqrt(rho_R)*vel_R(3))**2d0/ &
23992296
(sqrt(rho_L) + sqrt(rho_R))**2d0

0 commit comments

Comments
 (0)