c
c Boundary conditions for ghost-fluid methods.
c
c Copyright (C) 2003-2007 California Institute of Technology
c Ralf Deiterding, ralf@amroc.net
c
c -----------------------------------------------------
c Internal reflecting physical boundary conditions
c for Euler equations for multiple thermally perfect species
c -----------------------------------------------------
c
c Transformation of vector of conserved quantities
c into (rho1,...,rhoK,u,v,w,p,T,...)
c
c =====================================================
subroutine it3eurhokrfl(mx,my,mz,meqn,q,qt)
c =====================================================
c
implicit double precision(a-h,o-z)
include "ck.i"
c
integer i, j, k, m, mx, my, mz, meqn
double precision q(meqn,mx,my,mz), qt(meqn,mx,my,mz)
c
do 10 k = 1, mz
do 10 j = 1, my
do 10 i = 1, mx
rho = 0.d0
rhoW = 0.d0
do m = 1, Nsp
rho = rho + q(m,i,j,k)
rhoW = rhoW + q(m,i,j,k)/Wk(m)
qt(m,i,j,k) = q(m,i,j,k)
enddo
qt(Nsp+1,i,j,k) = q(Nsp+1,i,j,k)/rho
qt(Nsp+2,i,j,k) = q(Nsp+2,i,j,k)/rho
qt(Nsp+3,i,j,k) = q(Nsp+3,i,j,k)/rho
qt(Nsp+4,i,j,k) = rhoW*RU*q(Nsp+5,i,j,k)
do m = Nsp+5, meqn
qt(m,i,j,k) = q(m,i,j,k)
enddo
10 continue
c
return
end
c
c -----------------------------------------------------
c
c Construction of reflective boundary conditions from
c mirrored primitive values and application in
c conservative form in local patch
c
c =====================================================
subroutine ip3eurhokrfl(q,mx,my,mz,lb,ub,meqn,nc,idx,
& qex,xc,phi,vn,maux,auex,dx,time)
c =====================================================
c
implicit double precision(a-h,o-z)
include "ck.i"
c
integer mx, my, mz, meqn, maux, nc, idx(3,nc), lb(3), ub(3)
double precision q(meqn,mx,my,mz), qex(meqn,nc), xc(3,nc),
& phi(nc), vn(3,nc), auex(maux,nc), dx(3), time
c
c Local variables
c
integer i, j, k, m, n, stride, getindx
double precision rho, rhoW, u, v, w, vl, p, T
c
stride = (ub(1) - lb(1))/(mx-1)
c
do 100 n = 1, nc
c
i = getindx(idx(1,n), lb(1), stride)
j = getindx(idx(2,n), lb(2), stride)
k = getindx(idx(3,n), lb(3), stride)
c
rho = 0.d0
rhoW = 0.d0
do m = 1, Nsp
rho = rho + qex(m,n)
rhoW = rhoW + qex(m,n)/Wk(m)
q(m,i,j,k) = qex(m,n)
enddo
c
u = -qex(Nsp+1,n)
v = -qex(Nsp+2,n)
w = -qex(Nsp+3,n)
p = qex(Nsp+4,n)
T = p/(rhoW*RU)
c
c # Add boundary velocities if available
if (maux.ge.3) then
u = u + auex(1,n)
v = v + auex(2,n)
w = w + auex(3,n)
endif
c
c # Construct normal velocity vector
c # Tangential velocity remains unchanged
vl = 2.d0*(u*vn(1,n)+v*vn(2,n)+w*vn(3,n))
u = qex(Nsp+1,n) + vl*vn(1,n)
v = qex(Nsp+2,n) + vl*vn(2,n)
w = qex(Nsp+3,n) + vl*vn(3,n)
c
q(Nsp+1,i,j,k) = u*rho
q(Nsp+2,i,j,k) = v*rho
q(Nsp+3,i,j,k) = w*rho
q(Nsp+4,i,j,k) = rho*0.5d0*(u**2+v**2+w**2) +
& avgtabip(T,q(1,i,j,k),hms,Nsp) - p
q(Nsp+5,i,j,k) = T
c
do m = Nsp+6, meqn
q(m,i,j,k) = qex(m,n)
enddo
c
100 continue
c
return
end
c
c
c -----------------------------------------------------
c
c Injection of conservative extrapolated values in local patch
c
c =====================================================
subroutine ip3eurhokex(q,mx,my,mz,lb,ub,meqn,nc,idx,
& qex,xc,phi,vn,maux,auex,dx,time)
c =====================================================
c
implicit double precision(a-h,o-z)
include "ck.i"
c
integer mx, my, mz, meqn, maux, nc, idx(3,nc), lb(3), ub(3)
double precision q(meqn,mx,my,mz), qex(meqn,nc), xc(3,nc),
& phi(nc), vn(3,nc), auex(maux,nc), dx(3), time
c
c Local variables
c
integer i, j, k, m, n, stride, getindx
double precision rho, rhoW, u, v, w, vl, p, T
c
stride = (ub(1) - lb(1))/(mx-1)
c
do 100 n = 1, nc
c
i = getindx(idx(1,n), lb(1), stride)
j = getindx(idx(2,n), lb(2), stride)
k = getindx(idx(3,n), lb(3), stride)
c
rho = 0.d0
rhoW = 0.d0
do m = 1, Nsp
rho = rho + qex(m,n)
rhoW = rhoW + qex(m,n)/Wk(m)
q(m,i,j,k) = qex(m,n)
enddo
c
u = qex(Nsp+1,n)
v = qex(Nsp+2,n)
w = qex(Nsp+3,n)
p = qex(Nsp+4,n)
T = p/(rhoW*RU)
c
c # Prescribe normal velocity vector
vl = u*vn(1,n)+v*vn(2,n)+w*vn(3,n)
u = vl*vn(1,n)
v = vl*vn(2,n)
w = vl*vn(3,n)
c
q(Nsp+1,i,j,k) = u*rho
q(Nsp+2,i,j,k) = v*rho
q(Nsp+3,i,j,k) = w*rho
q(Nsp+4,i,j,k) = rho*0.5d0*(u**2+v**2+w**2) +
& avgtabip(T,q(1,i,j,k),hms,Nsp) - p
q(Nsp+5,i,j,k) = T
c
do m = Nsp+6, meqn
q(m,i,j,k) = qex(m,n)
enddo
c
100 continue
c
return
end
c