c c ===================================================== subroutine ic(maxmx,maxmy,maxmz,meqn,mbc,mx,my,mz, & x,y,z,dx,dy,dz,q) c ===================================================== 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) c include "cuser.i" c dimension q(meqn, 1-mbc:maxmx+mbc, 1-mbc:maxmy+mbc, & 1-mbc:maxmz+mbc) dimension x(1-mbc:maxmx+mbc),y(1-mbc:maxmy+mbc), & z(1-mbc:maxmz+mbc) c do 60 k = 1, mz do 60 j = 1, my do 60 i = 1, mx q(3,i,j,k) = 0.d0 q(4,i,j,k) = 0.d0 rd = dsqrt(x(i)**2+y(j)**2) if (z(k) .lt. sloc) then q(1,i,j,k) = (1.d0-Yl)*rhol q(2,i,j,k) = Yl*rhol q(5,i,j,k) = ul*rhol q(6,i,J,k) = pl/gamma1 + Yl*rhol*q0 + & 0.5d0*rhol*ul**2 else q(1,i,j,k) = (1.d0-Yr)*rhor q(2,i,j,k) = Yr*rhor q(5,i,j,k) = ur*rhor q(6,i,j,k) = pr/gamma1 + Yr*rhor*q0 + & 0.5d0*rhor*ur**2 endif if (rd.gt.rf) then q(1,i,j,k) = (1.d0-Yo)*rhoo q(2,i,j,k) = Yo*rhoo q(5,i,j,k) = uo*rhoo q(6,i,J,k) = po/gamma1 + 0.5d0*rhoo*uo**2 else call tintp(z(k),q(1,i,j,k),meqn) endif 60 continue c return end c c ************************************************************** c subroutine tintp(x,q,meqn) implicit double precision(a-h,o-z) c include "cuser.i" dimension q(meqn) c do i = 1, Nread-1 if (x.ge.xtab(i).and.x.le.xtab(i+1)) then alpha = (x-xtab(i))/(xtab(i+1)-xtab(i)) rho = (1.d0-alpha)*qtab(1,i) + alpha*qtab(1,i+1) u = (1.d0-alpha)*qtab(2,i) + alpha*qtab(2,i+1) p = (1.d0-alpha)*qtab(3,i) + alpha*qtab(3,i+1) Y = (1.d0-alpha)*qtab(4,i) + alpha*qtab(4,i+1) q(1) = (1.d0-Y)*rho q(2) = Y*rho q(5) = u*rho q(6) = p/gamma1 + Y*rho*q0 + 0.5d0*rho*u**2 endif enddo c 100 return end