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)
c
include "cuser.i"
character *16 cwork
parameter( lmechout = 13, lin=5, lblastout = 13 )
c
open(unit=lin,status='old',form='formatted',file='init.dat')
read (lin, *) x0, y0, z0, E0, R0
read (lin, *) pamb, tamb
close (lin)
c
Wref = 1.d0
a2ref = 1.d0
c Air
gamma = 1.4d0
gamma1 = 0.4d0
pi = 4.d0*atan(1.d0)
Wk = 29.08d-3/Wref
cwork= 'AIR'
RU = 0.83140000E+01/(Wref*a2ref)
PA = 0.10132500E+06/a2ref
c
open(unit=lmechout, status='unknown', form='formatted',
& file='chem.dat')
write (lmechout,400) RU
write (lmechout,401) PA
write (lmechout,402) gamma
write (lmechout,403) cwork
write (lmechout,404) Wk
close (lmechout)
c
400 format('RU ',e16.8)
401 format('PA ',e16.8)
402 format('Gamma ',e16.8)
403 format('Sp ',a16)
404 format('W ',e16.8)
c
c # Ambient
c
rhoamb = pamb*Wk/(RU*tamb)
c
c # Blast
K1 = (E0/0.8510d0/rhoamb)**(1.d0/5.d0)
time0 = (R0/K1)**(5.d0/2.d0)
c
open(unit=lblastout,status='unknown', form='formatted',
& file='blastout.dat')
write (lblastout,500) pamb
write (lblastout,501) tamb
write (lblastout,502) rhoamb
write (lblastout,503) E0
write (lblastout,504) R0
write (lblastout,505) K1
write (lblastout,506) time0
close (lblastout)
c
500 format('pamb ',e16.8)
501 format('tamb ',e16.8)
502 format('rhoamb ',e16.8)
503 format('E0 ',e16.8)
504 format('R0 ',e16.8)
505 format('K1 ',e16.8)
506 format('time0 ',e16.8)
c
return
end