vtf-logo

src/2d/equations/euler/rpznd/rpt2euznd.f

c
c
c     =====================================================
      subroutine rpt2euznd(ixy,maxm,meqn,mwaves,mbc,mx,
     &   ql,qr,maux,aux1,aux2,aux3,ilr,asdq,bmasdq,bpasdq)
c     =====================================================
      implicit double precision (a-h,o-z)
c
c     # Riemann solver in the transverse direction for the 2D ZND-Euler equations.
c     # Split asdq (= A^* \Delta q, where * = + or -)
c     # into down-going flux difference bmasdq (= B^- A^* \Delta q)
c     #    and up-going flux difference bpasdq (= B^+ A^* \Delta q)
c
c     # Uses Roe averages and other quantities which were 
c     # computed in rpn2euznd and stored in the common block comroe.
c
c     # Author: Ralf Deiterding
c
      dimension     ql(1-mbc:maxm+mbc, meqn)
      dimension     qr(1-mbc:maxm+mbc, meqn)
      dimension   asdq(1-mbc:maxm+mbc, meqn)
      dimension bmasdq(1-mbc:maxm+mbc, meqn)
      dimension bpasdq(1-mbc:maxm+mbc, meqn)
c
      dimension waveb(5,3),sb(3)
      parameter (maxm2 = 10005)  !# assumes at most 10000x10000 grid with mbc=5
      parameter (minm2 = -4)     !# assumes at most mbc=5
      dimension delta(5)
      logical efix, pfix
      common /param/  gamma,gamma1,q0
      common /comroe/ u2v2(minm2:maxm2),u(minm2:maxm2),v(minm2:maxm2),
     &                enth(minm2:maxm2),a(minm2:maxm2),Y(2,minm2:maxm2)
c
      if (minm2.gt.1-mbc .or. maxm2 .lt. maxm+mbc) then
         write(6,*) 'need to increase maxm2 in rpB'
         stop
      endif
c
      if (ixy.eq.1) then
         mu = 3
         mv = 4
      else
         mu = 4
         mv = 3
      endif
c
      do 20 i = 2-mbc, mx+mbc
         drho = asdq(i,1) + asdq(i,2)
         a2 = gamma1/a(i)**2 * (drho*0.5d0*u2v2(i) - asdq(i,2)*q0 
     &        - (u(i)*asdq(i,mu)+v(i)*asdq(i,mv)) + asdq(i,5))
         a3 = asdq(i,mu) - u(i)*drho
         a4 = 0.5d0*( a2 - ( v(i)*drho - asdq(i,mv) )/a(i) )
         a1 = a2 - a4 
c     
         waveb(1,1)  = a1*Y(1,i)
         waveb(2,1)  = a1*Y(2,i)
         waveb(mu,1) = a1*u(i)
         waveb(mv,1) = a1*(v(i) - a(i))
         waveb(5,1)  = a1*(enth(i) - v(i)*a(i))
         sb(1) = v(i)-a(i)
c     
         waveb(1,2)  = asdq(i,1) - Y(1,i)*a2
         waveb(2,2)  = asdq(i,2) - Y(2,i)*a2              
         waveb(mu,2) = (drho - a2)*u(i)  + a3
         waveb(mv,2) = (drho - a2)*v(i)
         waveb(5,2)  = (drho - a2)*0.5d0*u2v2(i) + 
     &        q0*(asdq(i,2) - Y(2,i)*a2) + a3*u(i)
         sb(2) = v(i)
c     
         waveb(1,3)  = a4*Y(1,i)
         waveb(2,3)  = a4*Y(2,i)
         waveb(mu,3) = a4*u(i)
         waveb(mv,3) = a4*(v(i) + a(i))
         waveb(5,3)  = a4*(enth(i) + v(i)*a(i))
         sb(3) = v(i)+a(i)
c     
c     # compute the flux differences bmasdq and bpasdq
c     
         do 10 m=1,meqn
            bmasdq(i,m) = 0.d0
            bpasdq(i,m) = 0.d0
            do 10 mw=1,mwaves
               bmasdq(i,m) = bmasdq(i,m) 
     &              + dmin1(sb(mw), 0.d0) * waveb(m,mw)
               bpasdq(i,m) = bpasdq(i,m)
     &              + dmax1(sb(mw), 0.d0) * waveb(m,mw)
 10      continue
c     
 20   continue
c
      return
      end

<