vtf-logo

fsi/sfc-amroc/WaterBlastFracture/src/srczp3.f

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@amroc.net
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