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@cacr.caltech.edu c implicit double precision (a-h,o-z) include "cuser.i" c parameter( lin = 5, lmechout = 11, lrin = 13 ) character *16 cwork dimension cwork(3) character *256 filename c RU = 0.83140000d+01 PA = 0.10132500d+06 c cwork(1)= 'Water' cwork(2)= 'Air' Wk(1) = 18.015d-3 Wk(2) = 29.08d-3 g(1) = 7.415d0 g(2) = 1.4d0 pinf(1) = 296.2d6 pinf(2) = 0.d0 c cwork(3)= 'Pinf' Wkhelp = 1.d0 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,3) write (lmechout,403) (k,Wk(k),k=1,2) write (lmechout,403) 3,Wkhelp 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 open(unit=lin,status='old',form='formatted',file='init.dat') read (lin, *) rd, al, Np read (lin, *) v0, cm, Ninit read (lin, *) Nread, filename, sshift close (lin) c cw = 1482.d0 rhow = 1.d3 c rhoo = 1.d0 uo = 0.d0 po = PA as = 0.d0 c rhoi = rhow ui = 0.d0 pi = PA c xm = al vm = -v0 area = 4.d0*datan(1.d0)*rd**2 c c # Use p0 and theta if (Ninit.eq.1) then vm = -v0/(rhow*cw) cm = cm*area*rhow*cw endif c if (Nread.gt.0) then do k=1,256 if (filename(k:k).eq.' ') goto 100 enddo 100 Nread = Nread + 2 - 1 open(unit=lrin, status='old', form='formatted', & file=filename(1:k-1)) read (lrin,*) xm, vm do i=2,Nread-1 read (lrin,*) xtab(i),(qtab(k,i),k=1,3) xtab(i) = xtab(i)-sshift enddo close (lrin) xtab(1) = xtab(2) - 0.5d0*(xtab(3)-xtab(2)) alpha = (xtab(1)-xtab(2))/(xtab(3)-xtab(2)) do k=1,3 qtab(k,1) = (1.d0-alpha)*qtab(k,2) + alpha*qtab(k,3) enddo c xtab(Nread) = xtab(Nread-1)+0.5d0*(xtab(Nread-1)-xtab(Nread-2)) alpha = (xtab(Nread)-xtab(Nread-1))/ & (xtab(Nread-2)-xtab(Nread-1)) do k=1,3 qtab(k,Nread) = (1.d0-alpha)*qtab(k,Nread-1) + & alpha*qtab(k,Nread-2) enddo else write (6,*) 'Boundary velocity = ',vm write (6,*) 'Mass = ',cm write (6,*) 'Mass per unit area = ',cm/area write (6,*) 'Theta = ',cm/(area*rhow*cw) write (6,*) 'p0 = ',-vm*rhow*cw endif c return end c ===================================================== subroutine cblread(xmt,vmt,cmt,rdt,npt) c ===================================================== c implicit double precision (a-h,o-z) c include "cuser.i" c xmt = xm vmt = vm cmt = cm rdt = rd npt = Np c return end c ===================================================== subroutine cblwrite(xmt,vmt,cmt,rdt,npt) c ===================================================== c implicit double precision (a-h,o-z) c include "cuser.i" c xm = xmt vm = vmt cm = cmt rd = rdt Np = npt c return end