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