c
c =========================================================
subroutine src(maxmx,maxmy,maxmz,meqn,mbc,ibx,iby,ibz,
& mx,my,mz,q,aux,maux,t,dt,ibnd)
c =========================================================
c
c # alter total energy to set negative pressures to zero
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)
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)
c
do 10 k=1-ibz*ibnd*mbc,mz+ibz*ibnd*mbc
do 10 j=1-iby*ibnd*mbc,my+iby*ibnd*mbc
do 10 i=1-ibx*ibnd*mbc,mx+ibx*ibnd*mbc
rho = 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)
p = (q(5,i,j,k) - 0.5d0*rho*(u**2+v**2+w**2) -
& q(7,i,j,k))/q(6,i,j,k)
if (p.lt.0.d0) q(5,i,j,k) =
& 0.5d0*rho*(u**2+v**2+w**2)+q(7,i,j,k)
10 continue
c
return
end