vtf-logo

fsi/adlib-amroc/DetonatingCanister/src/combl.f

c     =====================================================
      subroutine combl()
c     =====================================================
c
c     Create and initialize application specific common-blocks.
c     
c     Copyright (C) 2003-2007 California Institute of Technology
c     Ralf Deiterding, ralf@amroc.net
c
      implicit double precision (a-h,o-z)
      include  "cuser.i"
c
      parameter( lin = 5, lmechout = 11 )
      character *16 cwork
      dimension cwork(2)
c
      open(unit=lin,status='old',form='formatted',file='init.dat')
      read (lin, *) gamma, qr, treac, f
      read (lin, *) sloc, moving, NCJ
      read (lin, *) rho0, P0
      read (lin, *) Wk(1), Wk(2), RU, PA
      read (lin, *) rf, rfi
      close (lin)
c
      cwork(1)= 'Product'
      cwork(2)= 'Reactant'
c      
      open(unit=lmechout, status='unknown', form='formatted', 
     &     file='chem.dat')
      write (lmechout,400) RU
      write (lmechout,401) PA
      write (lmechout,402) (k,cwork(k),k=1,2)        
      write (lmechout,403) (k,Wk(k),k=1,2)        
      close (lmechout)
c
 400  format('RU       ',e16.8)
 401  format('PA       ',e16.8)
 402  format('Sp(',i2.2,')     ',a16)
 403  format('W(',i2.2,')    ',e16.8)
c
      gamma1 = gamma-1.d0
      V0 = 1.d0/rho0
      U0 = dsqrt(P0*V0)
c
      if (NCJ.eq.1) then
         Dj = qr/U0
         qn = 0.5d0*((Dj+gamma/Dj)**2-4.d0*gamma)/
     &        (gamma**2-1.d0)
         q0 = qn*P0*V0
      else
         q0 = qr
         qn=q0/(P0*V0)
         Dj=dsqrt((gamma**2-1.d0)*qn/2.d0)
     &        +dsqrt((gamma**2-1.d0)*qn/2.d0+gamma)
      end if
c
      D=dsqrt(f)*Dj
      Vj=gamma*(1.d0+D**2)/((gamma+1.d0)*D**2)
      Pj=(1.d0+D**2)/(gamma+1.d0)
      clambda=(D**2-gamma)**2/(2.d0*(gamma**2
     &     -1.d0)*qn*D**2)
      cfact=(D**2-gamma)/(1.d0+D**2)
c
      Pact = P0*Pj/10.d0
c
      return
      end