c
c
c =====================================================
subroutine rp1euznd(maxmx,meqn,mwaves,mbc,mx,ql,qr,
& maux,auxl,auxr,wave,s,fl,fr)
c =====================================================
c
c # solve Riemann problems for the 1D ZND-Euler equations using
c # van Leer's Flux Vector Splitting following Shuen's approach for
c # multicomponent gas mixtures
c
c # On input, ql contains the state vector at the left edge of each cell
c # qr contains the state vector at the right edge of each cell
c
c # On output, wave contains the waves, s the speeds,
c # fl and fr the positive and negative flux.
c
c # Note that the i'th Riemann problem has left state qr(i-1,:)
c # and right state ql(i,:)
c # From the basic clawpack routines, this routine is called with ql = qr
c
c # Copyright (C) 2002 Ralf Deiterding
c # Brandenburgische Universitaet Cottbus
c
implicit double precision (a-h,o-z)
c
dimension wave(1-mbc:maxmx+mbc, meqn, mwaves)
dimension s(1-mbc:maxmx+mbc, mwaves)
dimension ql(1-mbc:maxmx+mbc, meqn)
dimension qr(1-mbc:maxmx+mbc, meqn)
dimension fl(1-mbc:maxmx+mbc, meqn)
dimension fr(1-mbc:maxmx+mbc, meqn)
double precision Ml, Mr
dimension fvl(4), fvr(4), sl(3), sr(3)
common /param/ gamma,gamma1,q0
c
c # Method returns fluxes
c ------------
common /rpnflx/ mrpnflx
mrpnflx = 1
c
c # Van Leer's Flux Vector Splitting
c
gamma2 = gamma**2-1
do 10 i=2-mbc,mx+mbc
rhol = qr(i-1,1)+qr(i-1,2)
rhor = ql(i ,1)+ql(i ,2)
Y1l = qr(i-1,1)/rhol
Y2l = qr(i-1,2)/rhol
Y1r = ql(i ,1)/rhor
Y2r = ql(i ,2)/rhor
ul = qr(i-1,3)/rhol
ur = ql(i ,3)/rhor
El = qr(i-1,4)/rhol
Er = ql(i ,4)/rhor
pl = gamma1*(qr(i-1,4) - qr(i-1,2)*q0
& - 0.5d0*qr(i-1,3)**2/rhol)
pr = gamma1*(ql(i ,4) - ql(i ,2)*q0
& - 0.5d0*ql(i ,3)**2/rhor)
Hl = El+pl/rhol
Hr = Er+pr/rhor
c
al2 = gamma*pl/rhol
al = dsqrt(al2)
ar2 = gamma*pr/rhor
ar = dsqrt(ar2)
c
Ml = ul/al
Mr = ur/ar
c
sl(1) = ul-al
sl(2) = ul
sl(3) = ul+al
sr(1) = ur-ar
sr(2) = ur
sr(3) = ur+ar
c
if (Ml.ge.1.d0) then
facl = rhol*ul
fvl(1) = facl*Y1l
fvl(2) = facl*Y2l
fvl(3) = facl*ul+pl
fvl(4) = facl*El+ul*pl
else if (Ml.le.-1.d0) then
do m = 1,meqn
fvl(m) = 0.d0
enddo
else
fhl = gamma*(El - Y2l*q0 - 0.5d0*ul**2)/al2
xl = fhl/(1.d0+2.d0*fhl)
facl = 0.25d0*rhol*al*(Ml+1.d0)**2
fvl(1) = facl*Y1l
fvl(2) = facl*Y2l
fvl(3) = facl*2.d0*al/gamma*(0.5d0*gamma1*Ml+1.d0)
fvl(4) = facl*(Hl-xl*(ul-al)**2)
endif
c
if (Mr.le.-1.d0) then
facr = rhor*ur
fvr(1) = facr*Y1r
fvr(2) = facr*Y2r
fvr(3) = facr*ur+pr
fvr(4) = facr*Er+ur*pr
else if (Mr.ge.1.d0) then
do m = 1,meqn
fvr(m) = 0.d0
enddo
else
fhr = gamma*(Er - Y2r*q0 - 0.5d0*ur**2)/ar2
xr = fhr/(1.d0+2.d0*fhr)
facr = -0.25d0*rhor*ar*(Mr-1.d0)**2
fvr(1) = facr*Y1r
fvr(2) = facr*Y2r
fvr(3) = facr*2.d0*ar/gamma*(0.5d0*gamma1*Mr-1.d0)
fvr(4) = facr*(Hr-xr*(ur+ar)**2)
endif
c
do 20 m = 1,meqn
fl(i,m) = fvl(m) + fvr(m)
fr(i,m) = -fl(i,m)
20 continue
c
if (dabs(Ml).lt.1.d0) then
facl = (gamma+3.d0)/(2.d0*gamma+dabs(Ml)*(3.d0-gamma))
else
facl = 1.d0
endif
if (dabs(Mr).lt.1.d0) then
facr = (gamma+3.d0)/(2.d0*gamma+dabs(Mr)*(3.d0-gamma))
else
facr = 1.d0
endif
c
do 10 mw=1,mwaves
s(i,mw) = dmax1(dabs(facl*sl(mw)),dabs(facr*sr(mw)))
do 10 m=1,meqn
wave(i,m,mw) = 0.d0
10 continue
c
return
end
c