• VTF
  • FSI
  • AMROC
  • SFC
  • Motion
  • STLIB
  • Main Page
  • src/1d/equations/euler/rpznd/rec1euznd.f

    c
    c     ===================================================================
          subroutine rec1(maxm,meqn,mwaves,mbc,mx,q,method,mthlim,ql,qr)
    c     ===================================================================
    c
    c     # Copyright (C) 2002 Ralf Deiterding
    c     # Brandenburgische Universitaet Cottbus
    c
    c     # Copyright (C) 2003-2007 California Institute of Technology
    c     # Ralf Deiterding, ralf@cacr.caltech.edu
    c
          implicit double precision (a-h,o-z)
    c
          dimension    q(1-mbc:maxm+mbc, meqn)
          dimension   ql(1-mbc:maxm+mbc, meqn)
          dimension   qr(1-mbc:maxm+mbc, meqn)
          dimension method(7),mthlim(mwaves),
         &          Yk1(2), Yk2(2), Ykl(2), Ykr(2)
          common /param/  gamma,gamma1,q0
    c
          mlim = 0
          do 90 mw=1,mwaves
             if (mthlim(mw) .gt. 0) then
                mlim = mthlim(mw)
                goto 95
             endif
     90   continue
     95   continue
    c
    c     # Linear interpolation: om=0.d0, quadratic interpolation: om!=0.d0,
    c     # Second order accuracte reconstruction for om=1.d0/3.d0
    c
          om = 0.d0
          do 110 i=2-mbc,mx+mbc-1
    c
    c     # Reconstruction of total density
    c
             rho  = q(i  ,1) + q(i  ,2)
             rho1 = q(i-1,1) + q(i-1,2)
             rho2 = q(i+1,1) + q(i+1,2)
             call reclim(rho,rho1,rho2,mlim,om,rhol,rhor)  
    c     
    c        # Reconstruction of mass fractions - if the same limiter value 
    c        # is choosen for left and right side and for all mass fractions,
    c        # the sum of the reconstructed mass fractions is 1.
    c     
             sl = 1.d0
             do k = 1, 2
                Yk1(k) = q(i  ,k)/rho  - q(i-1,k)/rho1
                Yk2(k) = q(i+1,k)/rho2 - q(i  ,k)/rho
                sl = dmin1(sl,slopelim(Yk1(k),Yk2(k),mlim))
                sl = dmin1(sl,slopelim(Yk2(k),Yk1(k),mlim))
             enddo
    c
             do k = 1, 2
                Ykl(k) = q(i,k)/rho - 0.25d0*((1.d0+om)*sl*Yk1(k) + 
         &                                    (1.d0-om)*sl*Yk2(k))
                Ykr(k) = q(i,k)/rho + 0.25d0*((1.d0-om)*sl*Yk1(k) + 
         &                                    (1.d0+om)*sl*Yk2(k))
                ql(i,k) = Ykl(k)*rhol
                qr(i,k) = Ykr(k)*rhor       
             enddo
    c
    c        # Reconstruction in conservative variables
    c        # ----------------------------------------------------------------
             if (method(2).eq.4) then
                do m=3,4
                   call reclim(q(i,m),q(i-1,m),q(i+1,m),
         &                     mlim,om,ql(i,m),qr(i,m))  
                enddo
    c
    c        # Reconstruction in primitive variables - not conservative
    c        # gives worse results thanmethod(2)=4 !
    c        # ----------------------------------------------------------------
             else if (method(2).eq.5) then
                u  = q(i  ,3)/rho
                u1 = q(i-1,3)/rho1
                u2 = q(i+1,3)/rho2
                p  = gamma1*(q(i  ,4) - q(i  ,2)*q0 - 0.5d0*rho*u**2)
                p1 = gamma1*(q(i-1,4) - q(i-1,2)*q0 - 0.5d0*rho1*u1**2)
                p2 = gamma1*(q(i+1,4) - q(i+1,2)*q0 - 0.5d0*rho2*u2**2)
    c
                call reclim(u,u1,u2,mlim,om,ul,ur)  
                call reclim(p,p1,p2,mlim,om,pl,pr)  
    c
                ql(i,3) = ul*rhol
                qr(i,3) = ur*rhor
                ql(i,4) = pl/gamma1+ql(i,2)*q0+0.5d0*rhol*ul**2
                qr(i,4) = pr/gamma1+qr(i,2)*q0+0.5d0*rhor*ur**2
             else if (method(2).eq.6) then
                u  = q(i  ,3)/rho
                u1 = q(i-1,3)/rho1
                u2 = q(i+1,3)/rho2
                p  = gamma1*(q(i  ,4) - q(i  ,2)*q0 - 0.5d0*rho*u**2)
                p1 = gamma1*(q(i-1,4) - q(i-1,2)*q0 - 0.5d0*rho1*u1**2)
                p2 = gamma1*(q(i+1,4) - q(i+1,2)*q0 - 0.5d0*rho2*u2**2)
    c
                call reclim(p,p1,p2,mlim,om,pl,pr)  
    c
                call reclim(q(i,3),q(i-1,3),q(i+1,3),
         &                  mlim,om,ql(i,3),qr(i,3))  
                ql(i,4) = pl/gamma1+ql(i,2)*q0+0.5d0*ql(i,3)**2/rhol
                qr(i,4) = pr/gamma1+qr(i,2)*q0+0.5d0*qr(i,3)**2/rhor
             else
                u  = q(i  ,3)/rho
                u1 = q(i-1,3)/rho1
                u2 = q(i+1,3)/rho2
                p  = gamma1*(q(i  ,4) - q(i  ,2)*q0 - 0.5d0*rho*u**2)
                p1 = gamma1*(q(i-1,4) - q(i-1,2)*q0 - 0.5d0*rho1*u1**2)
                p2 = gamma1*(q(i+1,4) - q(i+1,2)*q0 - 0.5d0*rho2*u2**2)
    c
                call reclim(p/rho,p1/rho1,p2/rho2,mlim,om,Tl,Tr)  
    c
                call reclim(q(i,3),q(i-1,3),q(i+1,3),
         &                  mlim,om,ql(i,3),qr(i,3))  
                ql(i,4) = Tl*rhol/gamma1+ql(i,2)*q0+0.5d0*ql(i,3)**2/rhol
                qr(i,4) = Tr*rhor/gamma1+qr(i,2)*q0+0.5d0*qr(i,3)**2/rhor
             endif
    c         if ((ql(i,4).lt.q(i-1,4).and.ql(i,4).lt.q(i+1,4)
    c     &        .and.ql(i,4).lt.q(i,4)).or.
    c     &        (ql(i,4).gt.q(i-1,4).and.ql(i,4).gt.q(i+1,4)
    c     &        .and.ql(i,4).gt.q(i,4)).or.
    c     &        (qr(i,4).lt.q(i-1,4).and.qr(i,4).lt.q(i+1,4)
    c     &        .and.qr(i,4).lt.q(i,4)).or.
    c     &        (qr(i,4).gt.q(i-1,4).and.qr(i,4).gt.q(i+1,4)
    c     &        .and.qr(i,4).gt.q(i,4))) write (6,*) 'TVD viol.', i
    c     
     110  continue
    c     
          return
          end
    c
    c
    

<