vtf-logo

clawpack/applications/euler_znd/1d/FracTubeCJBurn/src/src1cjburn.f

c     
c     # CJ volume burn in the line of pages 316-317,
c     # Charles L. Mader, Numerical Modelling of Detonations,
c     # Los Alamos series in basic and applied sciences,
c     # University of California Press, Berkeley and 
c     # Los Angeles, 1979.
c
c     # Ynew satisfies
c     # rho.lt.rho0  ->  1.d0.lt.Ynew 
c     # rho0.le.rho.le.rhoJ  ->  0.d0.le.Ynew.lt.1.d0 
c     # rhoJ.lt.rho  ->  Ynew.lt.0.d0 
c     # which means burning for Ynew.le.1.d0
c
c     Copyright (C) 2003-2007 California Institute of Technology
c     Ralf Deiterding, ralf@amroc.net
c
c =========================================================
      subroutine src(maxmx,meqn,mbc,ibx,mx,q,
     &               aux,maux,t,dt,ibnd)
c =========================================================
      implicit double precision(a-h,o-z)
      include  "cuser.i"
c      
      dimension q(meqn, 1-ibx*mbc:maxmx+ibx*mbc)
      dimension aux(maux, 1-ibx*mbc:maxmx+ibx*mbc)
c
      do 10 i=1-ibnd*ibx*mbc,mx+ibnd*ibx*mbc
         rho=q(1,i)+q(2,i)
         u=q(3,i)/rho
         Yold=q(2,i)/rho
         Ynew=1.d0-(1.d0/rho-V0)/(Vj-V0)
         if (Ynew.gt.1.d0.or.Yold.lt.Yact) goto 10
         if (Yold.lt.Ynew.and.Ynew.lt.0.9d0) Ynew = 0.d0
         if (Ynew.lt.0.d0) Ynew = 0.d0
         if (Yold.le.Ynew) goto 10
         Ps = gamma1*(q(4,i)-q(2,i)*q0-0.5d0*rho*u**2)
         if (Ynew.lt.0.99d0) Ps = (1.d0-Ynew)*Pj
         q(2,i)=rho*Ynew
         q(1,i)=rho-q(2,i)
         q(4,i)=Ps/gamma1+q(2,i)*q0+0.5d0*rho*u**2
 10   continue
c
      return
      end
c