45 SUBROUTINE riemann(x0,gamma_,rho_l_,u_l_,p_l_,rho_r_,u_r_,p_r_,t,x,pvar)
48 REAL :: gamma_,t,x0,rho_l_,u_l_,p_l_,rho_r_,u_r_,p_r_
49 REAL,
DIMENSION(:) :: x
50 REAL,
DIMENSION(:,:) :: pvar
53 Real :: rho_lstar, rho_rstar, p_star, u_star, &
55 s_l, s_hl, s_tl, s_r, s_hr, s_tr
84 CALL getroot(
f, 0., 2.e+3, p_star, error)
90 IF (p_star >
p_l)
THEN
99 IF (p_star >
p_r)
THEN
120 s_tl = u_star - c_lstar
121 s_tr = u_star + c_rstar
124 CALL sample(x(i),pvar(i,1),pvar(i,2),pvar(i,3))
136 INTENT(OUT) :: rho, u, p
141 IF (s <= u_star)
THEN
143 IF (p_star >
p_l)
THEN
163 ELSE IF (s > s_tl)
THEN
171 *(
u_l - (x-x0)/t) ) ** (2.0/(
gamma-1.0))
179 IF (p_star >
p_r)
THEN
196 ELSE IF (s < s_tr)
THEN
202 * (
u_r - (x-x0)/t) ) ** (2.0/(
gamma-1.0))
214 PURE SUBROUTINE f(p,fx,plist)
217 REAL,
INTENT(IN) :: p
218 REAL,
INTENT(OUT) :: fx
219 REAL,
INTENT(IN),
DIMENSION(:),
OPTIONAL :: plist
227 REAL PURE function
f_x(p, rho_x, u_x, p_x, a_x, b_x, c_x)
230 REAL,
INTENT(IN) :: p, rho_x, u_x, p_x, a_x, b_x, c_x
233 f_x = (p-p_x) * sqrt(a_x/(p+b_x))
subroutine, public getroot_newton(funcd, x1, x2, root, error, plist, xm, iterations)
subroutine, public riemann(x0, gamma_, rho_l_, u_l_, p_l_, rho_r_, u_r_, p_r_, t, x, pvar)
real pure function f_x(p, rho_x, u_x, p_x, A_x, B_x, c_x)
pure subroutine f(p, fx, plist)
subroutine sample(x, rho, u, p)