c c c ===================================================== subroutine ic(maxmx,maxmy,maxmz,meqn,mbc,mx,my,mz, & x,y,z,dx,dy,dz,q) c ===================================================== implicit double precision (a-h,o-z) c c Copyright (C) 2002 Ralf Deiterding c Brandenburgische Universitaet Cottbus 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 c rhor = 1.0d0 pr = 1.d0 ur = 0.d0 vr = 0.d0 wr = 0.d0 rhol = 0.1d0 pl = 1.d0 ul = 0.d0 vl = 0.d0 wl = 0.d0 do 10 k = 1, mz c c c # circle of concentration 1 against background concentration 0: if( z(k) .gt. 0.2 )then do 20 j = 1, my do 20 i = 1, mx q(1,i,j,k) = rhor q(2,i,j,k) = q(1,i,j,k)*ur q(3,i,j,k) = q(1,i,j,k)*vr q(4,i,j,k) = q(1,i,j,k)*wr q(5,i,j,k) = pr/gamma1 + $ .5d0*(q(2,i,j,k)*q(2,i,j,k) + $ q(3,i,j,k)*q(3,i,j,k) + q(4,i,j,k)*q(4,i,j,k))/ $ q(1,i,j,k) 20 continue else idisc = 2 r0 = sqrt(0.04d0 - z(k)**2) x0 = .4d0 y0 = .0d0 do 60 j = 1, my do 60 i = 1, mx call cellave(x(i)-dx/2.d0,y(j)-dy/2.d0,dx,dy,win) q(1,i,j,k) = win*rhol + (1.d0-win)*rhor q(2,i,j,k) = q(1,i,j,k) * (win*ul + (1.d0-win)*ur) q(3,i,j,k) = q(1,i,j,k) * (win*vl + (1.d0-win)*vr) q(4,i,j,k) = q(1,i,j,k) * (win*wl + (1.d0-win)*wr) q(5,i,j,k) = win*(pl/gamma1) + $ (1.d0-win)*(pr/gamma1) + $ .5d0*(q(2,i,j,k)*q(2,i,j,k) + $ q(3,i,j,k)*q(3,i,j,k) + q(4,i,j,k)*q(4,i,j,k)) $ / q(1,i,j,k) 60 continue endif 10 continue return end