|
rp1.f.html |
clawcode2html
|
|
Source file: rp1.f
|
|
Directory: /Users/rjl/rjlsvn/papers/pathconwb10/code
|
|
Converted: Fri Jan 8 2010 at 15:48:01
|
|
This documentation file will
not reflect any later changes in the source file.
|
c
c
c =========================================================
subroutine rp1(maxmx,meqn,mwaves,mbc,mx,ql,qr,auxl,auxr,
& fwave,s,amdq,apdq)
c =========================================================
c
c # solve Riemann problems for the 1D advection equation q_t + u*q_x = 0.
c # For constant advection velocity u, passed in common block.
c
c # The advection speed u is passed in the common block comrp
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 # On output, fwave contains the f-waves,
c # s the speeds,
c # amdq the left-going flux difference A^- \Delta q
c # apdq the right-going flux difference A^+ \Delta q
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 routine step1, rp is called with ql = qr = q.
c
c
implicit double precision (a-h,o-z)
dimension ql(1-mbc:maxmx+mbc, meqn)
dimension qr(1-mbc:maxmx+mbc, meqn)
dimension auxl(1-mbc:maxmx+mbc, 1)
dimension auxr(1-mbc:maxmx+mbc, 1)
dimension s(1-mbc:maxmx+mbc, mwaves)
dimension fwave(1-mbc:maxmx+mbc, meqn, mwaves)
dimension amdq(1-mbc:maxmx+mbc, meqn)
dimension apdq(1-mbc:maxmx+mbc, meqn)
common /comrp/ u
common /comsrc/ mthsrc
c
c
c
do 30 i=2-mbc,mx+mbc
c
c # Compute the wave and speed
c
Qim = qr(i-1,1)
Qi = ql(i,1)
sigim = auxr(i-1,1)
sigi = auxl(i,1)
if (mthsrc.eq.1) then
c # fractional step, source term done in src1
fwave(i,1,1) = u*(Qi - Qim)
else if (mthsrc.eq.2) then
c # f-wave includes arithmetic average
src = -0.5d0*(Qi+Qim) * (sigi-sigim)
fwave(i,1,1) = u*(Qi - Qim) - src
else if (mthsrc.eq.3) then
c # f-wave using path integrals
Qihat = Qim*dexp(-(sigi-sigim)/u)
Qimhat = Qi*dexp(+(sigi-sigim)/u)
fwave(i,1,1) = 0.5d0*u*(Qi - Qihat + Qimhat - Qim)
else if (mthsrc.eq.4) then
c # f-wave using proper path integral
Qihat = Qim*dexp(-(sigi-sigim)/u)
fwave(i,1,1) = u*(Qi - Qihat)
else
write(6,*) '*** invalid mthsrc: ',mthsrc
endif
s(i,1) = u
c # assumes u>0:
amdq(i,1) = 0.d0
apdq(i,1) = fwave(i,1,1)
30 continue
c
return
end