c ===================================================== subroutine combl() c ===================================================== c c Create and initialize application specific common-blocks. 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, *) xc0, yc0, zc0, rc0 read (lin, *) tnts, ts 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 # State in sphere c es = 4520d3*tnts ps = (3.d0*gamma-3.d0)/(4.d0*pi)*es/rc0**3 rhos = ps*Wk/(RU*ts) c c # Ambient c rhoamb = pamb*Wk/(RU*tamb) 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) ps write (lblastout,504) ts write (lblastout,505) rhos close (lblastout) c 500 format('pamb ',e16.8) 501 format('tamb ',e16.8) 502 format('rhoamb ',e16.8) 503 format('ps ',e16.8) 504 format('ts ',e16.8) 505 format('rhos ',e16.8) c return end