2d/equations/euler/rp/rpn2euvijag.f

c
c
c     =====================================================
      subroutine rpn2eu(ixy,maxm,meqn,mwaves,mbc,mx,ql,qr,
     &     maux,auxl,auxr,wave,s,fl,fr)
c     =====================================================
c
c     # solve Riemann problems for the 2D Euler equations using 
c     # the Flux-Vector-Splitting of Vijayasundaram
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     # On output, wave contains the waves, s the speeds, 
c     # fl and fr the positive and negative flux.
c
c     # This data is along a slice in the x-direction if ixy=1 
c     #                            or the y-direction if ixy=2.
c
c     # Note that the i'th Riemann problem has left state qr(i-1,:)
c     #                                    and right state ql(i,:)
c     # From the routines, this routine is called with ql = qr
c
c     Author: Ralf Deiterding
c
      implicit double precision (a-h,o-z)
      dimension wave(1-mbc:maxm+mbc, meqn, mwaves)
      dimension    s(1-mbc:maxm+mbc, mwaves)
      dimension   ql(1-mbc:maxm+mbc, meqn)
      dimension   qr(1-mbc:maxm+mbc, meqn)
      dimension   fl(1-mbc:maxm+mbc, meqn)
      dimension   fr(1-mbc:maxm+mbc, meqn)
      double precision el(3), er(3)
      common /param/  gamma,gamma1
c
c     # Method returns fluxes
c     ------------
      common /rpnflx/ mrpnflx
      mrpnflx = 1
c
c     # set mu to point to  the component of the system that corresponds
c     # to momentum in the direction of this slice, mv to the orthogonal
c     # momentum:
c
      if (ixy.eq.1) then
	  mu = 2
	  mv = 3
	else
	  mu = 3
	  mv = 2
	endif
c
      do 10 i=2-mbc,mx+mbc
         rhol  = qr(i-1,1)
         rhor  = ql(i  ,1)
         rhoul = qr(i-1,mu)
         rhour = ql(i  ,mu)
         rhovl = qr(i-1,mv)
         rhovr = ql(i  ,mv)
         rhoEl = qr(i-1,4)
         rhoEr = ql(i  ,4)
c
         rho  = 0.5d0*(rhol  + rhor )
         rhou = 0.5d0*(rhoul + rhour)
         rhov = 0.5d0*(rhovl + rhovr)
         rhoE = 0.5d0*(rhoEl + rhoEr)
c
         u = rhou/rho
         v = rhov/rho
	 p = gamma1*(rhoE - 0.5d0*rho*(u**2+v**2))
         H = (rhoE+p)/rho
         if (p.le.0.d0.or.rho.le.0.d0) 
     &        write (6,*) 'Error in middle state in',i,p,pl,pr,
     &        rho,rhol,rhor,a,al,ar
         a = dsqrt(gamma*p/rho)
         f = 0.5d0/a**2
c
         el(1) = 0.5d0*(u-a + dabs(u-a))
         el(2) = 0.5d0*(u   + dabs(u)  )
         el(3) = 0.5d0*(u+a + dabs(u+a))
         er(1) = 0.5d0*(u-a - dabs(u-a))
         er(2) = 0.5d0*(u   - dabs(u)  )
         er(3) = 0.5d0*(u+a - dabs(u+a))
c
         zl = el(1)-el(3)
         zr = er(1)-er(3)
         ol = el(1)-2.d0*el(2)+el(3)
         or = er(1)-2.d0*er(2)+er(3)
         dul = a*(rhol*u-rhoul)
         dur = a*(rhor*u-rhour)
         dEl = gamma1*(rhoEl+0.5d0*rhol*(u**2+v**2)-
     &                 rhoul*u-rhovl*v)
         dEr = gamma1*(rhoEr+0.5d0*rhor*(u**2+v**2)-
     &                 rhour*u-rhovr*v)
         f1 =   f*(zl*dul + ol*dEl + zr*dur + or*dEr)
         f2 = a*f*(ol*dul + zl*dEl + or*dur + zr*dEr)
c
         fl(i,1)  = rhol *el(2) + rhor *er(2) + f1
         fl(i,mu) = rhoul*el(2) + rhour*er(2) + u*f1 -   f2
         fl(i,mv) = rhovl*el(2) + rhovr*er(2) + v*f1
         fl(i,4)  = rhoEl*el(2) + rhoEr*er(2) + H*f1 - u*f2
c
         do 20 m = 1,meqn
            fr(i,m) = -fl(i,m)
 20      continue
c
         do 10 mw=1,mwaves
            s(i,mw) = dmax1(dabs(el(mw)),dabs(er(mw)))
            do 10 m=1,meqn
               wave(i,m,mw) = 0.d0
 10   continue
c
      return
      end
c