c
c =====================================================
subroutine setaux(maxmx,maxmy,maxmz,meqn,mbc,ibx,iby,ibz,
& mx,my,mz,q,aux,maux,xc,yc,zc,dx,dy,dz,t,dt)
c =====================================================
c
c # Multi-dimensional computation of wave speeds, used in
c # multi-dimensional entropy correction in rpn2euefix.
c
c # Copyright (C) 2002 Ralf Deiterding
c # Brandenburgische Universitaet Cottbus
c
implicit double precision (a-h, o-z)
c
dimension q(meqn, 1-ibx*mbc:maxmx+ibx*mbc,
& 1-iby*mbc:maxmy+iby*mbc,1-ibz*mbc:maxmz+ibz*mbc)
dimension aux(maux, 1-ibx*mbc:maxmx+ibx*mbc,
& 1-iby*mbc:maxmy+iby*mbc,1-ibz*mbc:maxmz+ibz*mbc)
common /param/ gamma,gamma1
c
do 10 k = 1-ibz*mbc, mz+ibz*mbc
do 10 j = 1-iby*mbc, my+iby*mbc
do 10 i = 1-ibx*mbc, mx+ibx*mbc
p = gamma1*(q(5,i,j,k) - 0.5d0*(q(2,i,j,k)**2 +
& q(3,i,j,k)**2 + q(4,i,j,k)**2)/q(1,i,j,k))
a = dsqrt(gamma*p/q(1,i,j,k))
u = q(2,i,j,k)/q(1,i,j,k)
v = q(3,i,j,k)/q(1,i,j,k)
w = q(4,i,j,k)/q(1,i,j,k)
c
if (i.gt.1-ibx*mbc) then
pl = gamma1*(q(5,i-1,j,k) - 0.5d0*(q(2,i-1,j,k)**2 +
& q(3,i-1,j,k)**2 + q(4,i-1,j,k)**2)/q(1,i-1,j,k))
al = dsqrt(gamma*pl/q(1,i-1,j,k))
ul = q(2,i-1,j,k)/q(1,i-1,j,k)
aux(4,i,j,k) = dmax1(dabs(u-a-(ul-al)),dabs(u-ul),
& dabs(u+a-(ul+al)))
else
aux(4,i,j,k) = 0.d0
endif
c
if (j.gt.1-iby*mbc) then
pd = gamma1*(q(5,i,j-1,k) - 0.5d0*(q(2,i,j-1,k)**2 +
& q(3,i,j-1,k)**2 + q(4,i,j-1,k)**2)/q(1,i,j-1,k))
ad = dsqrt(gamma*pd/q(1,i,j-1,k))
vd = q(3,i,j-1,k)/q(1,i,j-1,k)
aux(5,i,j,k) = dmax1(dabs(v-a-(vd-ad)),dabs(v-vd),
& dabs(v+a-(vd+ad)))
else
aux(5,i,j,k) = 0.d0
endif
c
if (k.gt.1-ibz*mbc) then
pb = gamma1*(q(5,i,j,k-1) - 0.5d0*(q(2,i,j,k-1)**2 +
& q(3,i,j,k-1)**2 + q(4,i,j,k-1)**2)/q(1,i,j,k-1))
ab = dsqrt(gamma*pb/q(1,i,j,k-1))
wb = q(3,i,j,k-1)/q(1,i,j,k-1)
aux(6,i,j,k) = dmax1(dabs(w-a-(wb-ab)),dabs(w-wb),
& dabs(w+a-(wb+ab)))
else
aux(6,i,j,k) = 0.d0
endif
10 continue
c
do 11 j = 1-iby*mbc, my+iby*mbc
do 11 k = 1-ibz*mbc, mz+ibz*mbc
aux(1,1-ibx*mbc,j,k) = 0.d0
aux(2,1-ibx*mbc,j,k) = 0.d0
aux(3,1-ibx*mbc,j,k) = 0.d0
11 continue
c
do 12 i = 1-ibx*mbc, mx+ibx*mbc
do 12 k = 1-ibz*mbc, mz+ibz*mbc
aux(1,i,1-iby*mbc,k) = 0.d0
aux(2,i,1-iby*mbc,k) = 0.d0
aux(3,i,1-iby*mbc,k) = 0.d0
12 continue
c
do 13 i = 1-ibx*mbc, mx+ibx*mbc
do 13 j = 1-iby*mbc, my+iby*mbc
aux(1,i,j,1-ibz*mbc) = 0.d0
aux(2,i,j,1-ibz*mbc) = 0.d0
aux(3,i,j,1-ibz*mbc) = 0.d0
13 continue
c
do 20 k = 2-ibz*mbc, mz+ibz*mbc
do 20 j = 2-iby*mbc, my+iby*mbc
do 20 i = 2-ibx*mbc, mx+ibx*mbc
aux(1,i,j,k) = dmax1(aux(4,i,j,k),
& aux(5,i,j,k),aux(5,i-1,j,k),
& aux(6,i,j,k),aux(6,i-1,j,k))
if (j.lt.my+iby*mbc)
& aux(1,i,j,k) = dmax1(aux(1,i,j,k),aux(5,i ,j+1,k),
& aux(5,i-1,j+1,k))
if (k.lt.mz+ibz*mbc)
& aux(1,i,j,k) = dmax1(aux(1,i,j,k),aux(6,i ,j,k+1),
& aux(6,i-1,j,k+1))
c
aux(2,i,j,k) = dmax1(aux(5,i,j,k),
& aux(4,i,j,k),aux(4,i,j-1,k),
& aux(6,i,j,k),aux(6,i,j-1,k))
if (i.lt.mx+ibx*mbc)
& aux(2,i,j,k) = dmax1(aux(2,i,j,k),aux(4,i+1,j ,k),
& aux(4,i+1,j-1,k))
if (k.lt.mz+ibz*mbc)
& aux(2,i,j,k) = dmax1(aux(2,i,j,k),aux(6,i,j ,k+1),
& aux(6,i,j-1,k+1))
c
aux(3,i,j,k) = dmax1(aux(6,i,j,k),
& aux(4,i,j,k),aux(4,i,j,k-1),
& aux(5,i,j,k),aux(5,i,j,k-1))
if (i.lt.mx+ibx*mbc)
& aux(3,i,j,k) = dmax1(aux(3,i,j,k),aux(4,i+1,j,k ),
& aux(4,i+1,j,k-1))
if (j.lt.my+iby*mbc)
& aux(3,i,j,k) = dmax1(aux(3,i,j,k),aux(5,i,j+1,k ),
& aux(5,i,j+1,k-1))
20 continue
c
return
end
c