c
c =====================================================
subroutine setaux(maxmx,maxmy,meqn,mbc,ibx,iby,mx,my,q,
& aux,maux,xc,yc,dx,dy,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
include "ck.i"
c
dimension q(meqn, 1-ibx*mbc:maxmx+ibx*mbc,
& 1-iby*mbc:maxmy+iby*mbc)
dimension aux(maux, 1-ibx*mbc:maxmx+ibx*mbc,
& 1-iby*mbc:maxmy+iby*mbc)
dimension rk(LeNsp), rkl(LeNsp), rkd(LeNsp)
c
mu = Nsp+1
mv = Nsp+2
mE = Nsp+3
mT = Nsp+4
c
do 5 j = 1-iby*mbc, my+iby*mbc
do 5 i = 1-ibx*mbc, mx+ibx*mbc
rho = 0.d0
rhoW = 0.d0
do k = 1, Nsp
rk(k) = q(k,i,j)
rho = rho + q(k,i,j)
rhoW = rhoW + q(k,i,j)/Wk(k)
enddo
rhoe = q(mE,i,j)-0.5d0*(q(mu,i,j)**2+q(mv,i,j)**2)/rho
call SolveTrhok(q(mT,i,j),rhoe,rhoW,rk,Nsp,ifail)
5 continue
c
do 10 j = 1-iby*mbc, my+iby*mbc
do 10 i = 1-ibx*mbc, mx+ibx*mbc
rho = 0.d0
rhoW = 0.d0
do k = 1, Nsp
rk(k) = q(k,i,j)
rho = rho + q(k,i,j)
rhoW = rhoW + q(k,i,j)/Wk(k)
enddo
u = q(mu,i,j)/rho
v = q(mv,i,j)/rho
T0 = q(mT,i,j)
p = rhoW*RU*T0
rhoCp = avgtabip( T0, rk, cpk, Nsp )
gamma = RU / ( rhoCp/rhoW - RU ) + 1.d0
a = dsqrt(gamma*p/rho)
c
if (i.gt.1-ibx*mbc) then
rhol = 0.d0
rhoWl = 0.d0
do k = 1, Nsp
rkl(k) = q(k,i-1,j)
rhol = rhol + q(k,i-1,j)
rhoWl = rhoWl + q(k,i-1,j)/Wk(k)
enddo
ul = q(mu,i-1,j)/rhol
Tl = q(mT,i-1,j)
pl = rhoWl*RU*Tl
rhoCpl = avgtabip( Tl, rkl, cpk, Nsp )
gammal = RU / ( rhoCpl/rhoWl - RU ) + 1.d0
al = dsqrt(gammal*pl/rhol)
aux(3,i,j) = dmax1(dmax1(dabs(u-a-(ul-al)),dabs(u-ul)),
& dabs(u+a-(ul+al)))
else
aux(3,i,j) = 0.d0
endif
c
if (j.gt.1-iby*mbc) then
rhod = 0.d0
rhoWd = 0.d0
do k = 1, Nsp
rkd(k) = q(k,i,j-1)
rhod = rhod + q(k,i,j-1)
rhoWd = rhoWd + q(k,i,j-1)/Wk(k)
enddo
vd = q(mv,i,j-1)/rhod
Td = q(mT,i,j-1)
pd = rhoWd*RU*Td
rhoCpd = avgtabip( Td, rkd, cpk, Nsp )
gammad = RU / ( rhoCpd/rhoWd - RU ) + 1.d0
ad = dsqrt(gammad*pd/rhod)
aux(4,i,j) = dmax1(dmax1(dabs(v-a-(vd-ad)),dabs(v-vd)),
& dabs(v+a-(vd+ad)))
else
aux(4,i,j) = 0.d0
endif
10 continue
c
do 11 j = 1-iby*mbc, my+iby*mbc
aux(1,1-ibx*mbc,j) = 0.d0
aux(2,1-ibx*mbc,j) = 0.d0
11 continue
c
do 12 i = 1-ibx*mbc, mx+ibx*mbc
aux(1,i,1-iby*mbc) = 0.d0
aux(2,i,1-iby*mbc) = 0.d0
12 continue
c
do 20 j = 2-iby*mbc, my+iby*mbc
do 20 i = 2-ibx*mbc, mx+ibx*mbc
aux(1,i,j) = dmax1(dmax1(aux(3,i,j),aux(4,i ,j )),
& aux(4,i-1,j ))
if (j.lt.my+iby*mbc)
& aux(1,i,j) = dmax1(dmax1(aux(1,i,j),aux(4,i ,j+1)),
& aux(4,i-1,j+1))
c
aux(2,i,j) = dmax1(dmax1(aux(4,i,j),aux(3,i ,j )),
& aux(3,i ,j-1))
if (i.lt.mx+ibx*mbc)
& aux(2,i,j) = dmax1(dmax1(aux(2,i,j),aux(3,i+1,j )),
& aux(3,i+1,j-1))
20 continue
c
return
end
c