/*
** (c) 1996-2000 The Regents of the University of California (through
** E.O. Lawrence Berkeley National Laboratory), subject to approval by
** the U.S. Department of Energy.  Your use of this software is under
** license -- the license agreement is attached and included in the
** directory as license.txt or you may contact Berkeley Lab's Technology
** Transfer Department at TTD@lbl.gov.  NOTICE OF U.S. GOVERNMENT RIGHTS.
** The Software was developed under funding from the U.S. Government
** which consequently retains certain rights as follows: the
** U.S. Government has been granted for itself and others acting on its
** behalf a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, and perform publicly
** and display publicly.  Beginning five (5) years after the date
** permission to assert copyright is obtained from the U.S. Department of
** Energy, and subject to any subsequent five (5) year renewals, the
** U.S. Government is granted for itself and others acting on its behalf
** a paid-up, nonexclusive, irrevocable, worldwide license in the
** Software to reproduce, prepare derivative works, distribute copies to
** the public, perform publicly and display publicly, and to permit
** others to do so.
*/

#include "REAL.H"
#include "CONSTANTS.H"
#include "GRID_F.H"
#include "BCTypes.H"

#define DIMS lo_1,lo_2,lo_3,hi_1,hi_2,hi_3

c *************************************************************************
c ** MKVELFLUX **
c ** Create the time-centered edge states for the velocity components
c ***************************************************************

      subroutine FORT_MKVELFLUX(s,sedgex,sedgey,sedgez,
     $                          slopex,slopey,slopez,uadv,vadv,wadv,
     $                          utrans,vtrans,wtrans,
     $                          rho,px,py,pz,lapu,
     $                          s_l,s_r,s_b,s_t,s_d,s_u,DIMS,
     $                          dx,dt,force,visc_coef,
     $                          bcx_lo,bcx_hi,bcy_lo,bcy_hi,bcz_lo,bcz_hi)

      implicit none

      integer DIMS

      REAL_T       s(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,3)
      REAL_T  sedgex(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,3)
      REAL_T  sedgey(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,3)
      REAL_T  sedgez(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,3)
      REAL_T  slopex(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,3)
      REAL_T  slopey(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,3)
      REAL_T  slopez(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,3)
      REAL_T    uadv(lo_1:hi_1+1,lo_2:hi_2  ,lo_3:hi_3  )
      REAL_T    vadv(lo_1:hi_1  ,lo_2:hi_2+1,lo_3:hi_3  )
      REAL_T    wadv(lo_1:hi_1  ,lo_2:hi_2  ,lo_3:hi_3+1)
      REAL_T  utrans(lo_1:hi_1+1,lo_2:hi_2  ,lo_3:hi_3  )
      REAL_T  vtrans(lo_1:hi_1  ,lo_2:hi_2+1,lo_3:hi_3  )
      REAL_T  wtrans(lo_1:hi_1  ,lo_2:hi_2  ,lo_3:hi_3+1)
      REAL_T     rho(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T      px(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T      py(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T      pz(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T    lapu(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,3)
      REAL_T   force(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,3)

      REAL_T    s_l(lo_1:hi_1+1,3)
      REAL_T    s_r(lo_1:hi_1+1,3)
      REAL_T    s_b(lo_2:hi_2+1,3)
      REAL_T    s_t(lo_2:hi_2+1,3)
      REAL_T    s_d(lo_3:hi_3+1,3)
      REAL_T    s_u(lo_3:hi_3+1,3)

      REAL_T  dx(3)
      REAL_T  dt
      REAL_T  visc_coef
      integer bcx_lo,bcx_hi
      integer bcy_lo,bcy_hi
      integer bcz_lo,bcz_hi

c     Local variables
      REAL_T ubardth, vbardth, wbardth
      REAL_T hx, hy, hz, dth
      REAL_T uplus,uminus,vplus,vminus,wplus,wminus,ut,vt,wt
      REAL_T utr,vtr,wtr,savg,uavg,vavg,wavg
      REAL_T uptop,upbot,umtop,umbot,uplft,uprgt,umlft,umrgt
      REAL_T vptop,vpbot,vmtop,vmbot,vplft,vprgt,vmlft,vmrgt
      REAL_T wptop,wpbot,wmtop,wmbot,wplft,wprgt,wmlft,wmrgt

      REAL_T eps

      logical ltm0,ltp0
      integer i,j,k,is,js,ks,ie,je,ke,n

      eps = 1.0e-8

      is = lo_1
      ie = hi_1
      js = lo_2
      je = hi_2
      ks = lo_3
      ke = hi_3

      dth = half*dt

      hx = dx(1)
      hy = dx(2)
      hz = dx(3)

      do k = ks,ke 
      do j = js,je 
        do i = is,ie 

c        ******************************************************************
c        MAKE TRANSVERSE DERIVATIVES IN Y-DIRECTION
c        ******************************************************************

          wpbot = s(i,j  ,k,3) + (half - dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,3) 
c    $            + dth * lapu(i,j  ,k,3) / rho(i,j,k)
          wptop = s(i,j+1,k,3) - (half + dth*s(i,j+1,k,2)/hy)*slopey(i,j+1,k,3)
c    $            + dth * lapu(i,j+1,k,3) / rho(i,j+1,k)
          vpbot = s(i,j  ,k,2) + (half - dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,2) 
c    $            + dth * lapu(i,j  ,k,2) / rho(i,j,k)
          vptop = s(i,j+1,k,2) - (half + dth*s(i,j+1,k,2)/hy)*slopey(i,j+1,k,2)
c    $            + dth * lapu(i,j+1,k,2) / rho(i,j+1,k)
          upbot = s(i,j  ,k,1) + (half - dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,1)
c    $            + dth * lapu(i,  j,k,1) / rho(i,j,k)
          uptop = s(i,j+1,k,1) - (half + dth*s(i,j+1,k,2)/hy)*slopey(i,j+1,k,1)
c    $            + dth * lapu(i,j+1,k,1) / rho(i,j+1,k)

          ltp0 = (j .eq. je  .and.  bcy_hi .eq. INLET)
          wptop = cvmgt(s(i,je+1,k,3),wptop,ltp0)
          wpbot = cvmgt(s(i,je+1,k,3),wpbot,ltp0)
          vptop = cvmgt(s(i,je+1,k,2),vptop,ltp0)
          vpbot = cvmgt(s(i,je+1,k,2),vpbot,ltp0)
          uptop = cvmgt(s(i,je+1,k,1),uptop,ltp0)
          upbot = cvmgt(s(i,je+1,k,1),upbot,ltp0)

          ltp0 = (j .eq. je  .and.  bcy_hi .eq. WALL)
          vptop = cvmgt(zero,vptop,ltp0)
          vpbot = cvmgt(zero,vpbot,ltp0)
          uptop = cvmgt(upbot,uptop,ltp0)
          wptop = cvmgt(wpbot,wptop,ltp0)

          ltp0 = (j .eq. je  .and.  bcy_hi .eq. WALL  .and.  visc_coef .gt. zero)
          uptop = cvmgt(zero,uptop,ltp0)
          upbot = cvmgt(zero,upbot,ltp0)
          wptop = cvmgt(zero,wptop,ltp0)
          wpbot = cvmgt(zero,wpbot,ltp0)

          uplus = cvmgp(upbot,uptop,vtrans(i,j+1,k))
          uavg  = half * (upbot + uptop)
          uplus = cvmgt(uplus, uavg, abs(vtrans(i,j+1,k)) .gt. eps)

          vplus = cvmgp(vpbot,vptop,vtrans(i,j+1,k))
          vavg  = half * (vpbot + vptop)
          vplus = cvmgt(vplus, vavg, abs(vtrans(i,j+1,k)) .gt. eps)

          wplus = cvmgp(wpbot,wptop,vtrans(i,j+1,k))
          wavg  = half * (wpbot + wptop)
          wplus = cvmgt(wplus, wavg, abs(vtrans(i,j+1,k)) .gt. eps)

          wmtop = s(i,j  ,k,3) - (half + dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,3)
c    $            + dth * lapu(i,j  ,k,3) / rho(i,j,k)
          wmbot = s(i,j-1,k,3) + (half - dth*s(i,j-1,k,2)/hy)*slopey(i,j-1,k,3)
c    $            + dth * lapu(i,j-1,k,3) / rho(i,j-1,k)
          vmtop = s(i,j  ,k,2) - (half + dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,2)
c    $            + dth * lapu(i,j  ,k,2) / rho(i,j,k)
          vmbot = s(i,j-1,k,2) + (half - dth*s(i,j-1,k,2)/hy)*slopey(i,j-1,k,2)
c    $            + dth * lapu(i,j-1,k,2) / rho(i,j-1,k)
          umtop = s(i,j  ,k,1) - (half + dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,1)
c    $            + dth * lapu(i,j  ,k,1) / rho(i,j,k)
          umbot = s(i,j-1,k,1) + (half - dth*s(i,j-1,k,2)/hy)*slopey(i,j-1,k,1)
c    $            + dth * lapu(i,j-1,k,1) / rho(i,j-1,k)

          ltm0 = (j .eq. js  .and.  bcy_lo .eq. INLET)
          wmtop = cvmgt(s(i,js-1,k,3),wmtop,ltm0)
          wmbot = cvmgt(s(i,js-1,k,3),wmbot,ltm0)
          vmtop = cvmgt(s(i,js-1,k,2),vmtop,ltm0)
          vmbot = cvmgt(s(i,js-1,k,2),vmbot,ltm0)
          umtop = cvmgt(s(i,js-1,k,1),umtop,ltm0)
          umbot = cvmgt(s(i,js-1,k,1),umbot,ltm0)

          ltm0 = (j .eq. js  .and.  bcy_lo .eq. WALL)
          vmtop = cvmgt(zero ,vmtop,ltm0)
          vmbot = cvmgt(zero ,vmbot,ltm0)
          umbot = cvmgt(umtop,umbot,ltm0)
          wmbot = cvmgt(wmtop,wmbot,ltm0)

          ltm0 = (j .eq. js  .and.  bcy_lo .eq. WALL  .and.  
     $            visc_coef .gt. zero)
          umtop = cvmgt(zero,umtop,ltm0)
          umbot = cvmgt(zero,umbot,ltm0)
          wmtop = cvmgt(zero,wmtop,ltm0)
          wmbot = cvmgt(zero,wmbot,ltm0)

          uminus = cvmgp(umbot,umtop,vtrans(i,j,k))
          uavg   = half * (umbot + umtop)
          uminus = cvmgt(uminus, uavg, abs(vtrans(i,j,k)) .gt. eps)

          vminus = cvmgp(vmbot,vmtop,vtrans(i,j,k))
          vavg   = half * (vmbot + vmtop)
          vminus = cvmgt(vminus, vavg, abs(vtrans(i,j,k)) .gt. eps)

          wminus = cvmgp(wmbot,wmtop,vtrans(i,j,k))
          wavg   = half * (wmbot + wmtop)
          wminus = cvmgt(wminus, wavg, abs(vtrans(i,j,k)) .gt. eps)

          utr =  half * (vtrans(i,j,k)+vtrans(i,j+1,k))*(uplus - uminus) / hy
          vtr =  half * (vtrans(i,j,k)+vtrans(i,j+1,k))*(vplus - vminus) / hy
          wtr =  half * (vtrans(i,j,k)+vtrans(i,j+1,k))*(wplus - wminus) / hy

c        ******************************************************************
c        MAKE TRANSVERSE DERIVATIVES IN Z-DIRECTION
c        ******************************************************************

          wpbot = s(i,j,k  ,3) + (half - dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,3) 
c    $            + dth * lapu(i,j,k  ,3) / rho(i,j,k)
          wptop = s(i,j,k+1,3) - (half + dth*s(i,j,k+1,3)/hz)*slopez(i,j,k+1,3)
c    $            + dth * lapu(i,j,k+1,3) / rho(i,j,k+1)
          vpbot = s(i,j,k  ,2) + (half - dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,2) 
c    $            + dth * lapu(i,j,k  ,2) / rho(i,j,k)
          vptop = s(i,j,k+1,2) - (half + dth*s(i,j,k+1,3)/hz)*slopez(i,j,k+1,2)
c    $            + dth * lapu(i,j,k+1,2) / rho(i,j,k+1)
          upbot = s(i,j,k  ,1) + (half - dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,1)
c    $            + dth * lapu(i,j,k  ,1) / rho(i,j,k)
          uptop = s(i,j,k+1,1) - (half + dth*s(i,j,k+1,3)/hz)*slopez(i,j,k+1,1)
c    $            + dth * lapu(i,j,k+1,1) / rho(i,j,k+1)

          ltp0 = (k .eq. ke  .and.  bcz_hi .eq. INLET)
          wptop = cvmgt(s(i,j,ke+1,3),wptop,ltp0)
          wpbot = cvmgt(s(i,j,ke+1,3),wpbot,ltp0)
          vptop = cvmgt(s(i,j,ke+1,2),vptop,ltp0)
          vpbot = cvmgt(s(i,j,ke+1,2),vpbot,ltp0)
          uptop = cvmgt(s(i,j,ke+1,1),uptop,ltp0)
          upbot = cvmgt(s(i,j,ke+1,1),upbot,ltp0)

          ltp0 = (k .eq. ke  .and.  bcz_hi .eq. WALL)
          wptop = cvmgt(zero,wptop,ltp0)
          wpbot = cvmgt(zero,wpbot,ltp0)
          uptop = cvmgt(upbot,uptop,ltp0)
          vptop = cvmgt(vpbot,vptop,ltp0)

          ltp0 = (k .eq. ke  .and.  bcz_hi .eq. WALL  .and.  visc_coef .gt. zero)
          uptop = cvmgt(zero,uptop,ltp0)
          upbot = cvmgt(zero,upbot,ltp0)
          vptop = cvmgt(zero,vptop,ltp0)
          vpbot = cvmgt(zero,vpbot,ltp0)

          uplus = cvmgp(upbot,uptop,wtrans(i,j,k+1))
          uavg  = half * (upbot + uptop)
          uplus = cvmgt(uplus, uavg, abs(wtrans(i,j,k+1)) .gt. eps)

          vplus = cvmgp(vpbot,vptop,wtrans(i,j,k+1))
          vavg  = half * (vpbot + vptop)
          vplus = cvmgt(vplus, vavg, abs(wtrans(i,j,k+1)) .gt. eps)

          wplus = cvmgp(wpbot,wptop,wtrans(i,j,k+1))
          wavg  = half * (wpbot + wptop)
          wplus = cvmgt(wplus, wavg, abs(wtrans(i,j,k+1)) .gt. eps)

          wmtop = s(i,j,k  ,3) - (half + dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,3)
c    $            + dth * lapu(i,j,k  ,3) / rho(i,j,k)
          wmbot = s(i,j,k-1,3) + (half - dth*s(i,j,k-1,3)/hz)*slopez(i,j,k-1,3)
c    $            + dth * lapu(i,j,k-1,3) / rho(i,j,k-1)
          vmtop = s(i,j,k  ,2) - (half + dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,2)
c    $            + dth * lapu(i,j,k  ,2) / rho(i,j,k)
          vmbot = s(i,j,k-1,2) + (half - dth*s(i,j,k-1,3)/hz)*slopez(i,j,k-1,2)
c    $            + dth * lapu(i,j,k-1,2) / rho(i,j,k-1)
          umtop = s(i,j,k  ,1) - (half + dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,1)
c    $            + dth * lapu(i,j,k  ,1) / rho(i,j,k)
          umbot = s(i,j,k-1,1) + (half - dth*s(i,j,k-1,3)/hz)*slopez(i,j,k-1,1)
c    $            + dth * lapu(i,j,k-1,1) / rho(i,j,k-1)

          ltm0 = (k .eq. ks  .and.  bcz_lo .eq. INLET)
          wmtop = cvmgt(s(i,j,ks-1,3),wmtop,ltm0)
          wmbot = cvmgt(s(i,j,ks-1,3),wmbot,ltm0)
          vmtop = cvmgt(s(i,j,ks-1,2),vmtop,ltm0)
          vmbot = cvmgt(s(i,j,ks-1,2),vmbot,ltm0)
          umtop = cvmgt(s(i,j,ks-1,1),umtop,ltm0)
          umbot = cvmgt(s(i,j,ks-1,1),umbot,ltm0)

          ltm0 = (k .eq. ks  .and.  bcz_lo .eq. WALL)
          wmtop = cvmgt(zero ,wmtop,ltm0)
          wmbot = cvmgt(zero ,wmbot,ltm0)
          umbot = cvmgt(umtop,umbot,ltm0)
          vmbot = cvmgt(vmtop,vmbot,ltm0)

          ltm0 = (k .eq. ks  .and.  bcz_lo .eq. WALL  .and.  
     $            visc_coef .gt. zero)
          umtop = cvmgt(zero,umtop,ltm0)
          umbot = cvmgt(zero,umbot,ltm0)
          vmtop = cvmgt(zero,vmtop,ltm0)
          vmbot = cvmgt(zero,vmbot,ltm0)

          uminus = cvmgp(umbot,umtop,wtrans(i,j,k))
          uavg   = half * (umbot + umtop)
          uminus = cvmgt(uminus, uavg, abs(wtrans(i,j,k)) .gt. eps)

          vminus = cvmgp(vmbot,vmtop,wtrans(i,j,k))
          vavg   = half * (vmbot + vmtop)
          vminus = cvmgt(vminus, vavg, abs(wtrans(i,j,k)) .gt. eps)

          wminus = cvmgp(wmbot,wmtop,wtrans(i,j,k))
          wavg   = half * (wmbot + wmtop)
          wminus = cvmgt(wminus, wavg, abs(wtrans(i,j,k)) .gt. eps)

          utr = utr + 
     $            half * (wtrans(i,j,k)+wtrans(i,j,k+1))*(uplus - uminus) / hz
          vtr = vtr + 
     $            half * (wtrans(i,j,k)+wtrans(i,j,k+1))*(vplus - vminus) / hz
          wtr = wtr +    
     $            half * (wtrans(i,j,k)+wtrans(i,j,k+1))*(wplus - wminus) / hz

c        ******************************************************************
c        MAKE LEFT AND RIGHT STATES
c        ******************************************************************

          ut = (lapu(i,j,k,1)-px(i,j,k))/rho(i,j,k) - utr + force(i,j,k,1)
          vt = (lapu(i,j,k,2)-py(i,j,k))/rho(i,j,k) - vtr + force(i,j,k,2)
          wt = (lapu(i,j,k,3)-pz(i,j,k))/rho(i,j,k) - wtr + force(i,j,k,3)

          ubardth = dth*s(i,j,k,1)/hx

          s_l(i+1,1)= s(i,j,k,1) + (half-ubardth)*slopex(i,j,k,1) + dth*ut
          s_l(i+1,2)= s(i,j,k,2) + (half-ubardth)*slopex(i,j,k,2) + dth*vt
          s_l(i+1,3)= s(i,j,k,3) + (half-ubardth)*slopex(i,j,k,3) + dth*wt

          s_r(i  ,1)= s(i,j,k,1) - (half+ubardth)*slopex(i,j,k,1) + dth*ut
          s_r(i  ,2)= s(i,j,k,2) - (half+ubardth)*slopex(i,j,k,2) + dth*vt
          s_r(i  ,3)= s(i,j,k,3) - (half+ubardth)*slopex(i,j,k,3) + dth*wt

        enddo

        if (bcx_lo .eq. PERIODIC) then
          s_l(is  ,1) = s_l(ie+1,1)
          s_l(is  ,2) = s_l(ie+1,2)
          s_l(is  ,3) = s_l(ie+1,3)
        elseif (bcx_lo .eq. WALL) then
          s_l(is  ,1) = zero
          s_r(is  ,1) = zero
          s_l(is  ,2) = s_r(is  ,2)
          s_l(is  ,3) = s_r(is  ,3)
        elseif (bcx_lo .eq. INLET) then
          s_l(is  ,1) = s(is-1,j,k,1)
          s_l(is  ,2) = s(is-1,j,k,2)
          s_l(is  ,3) = s(is-1,j,k,3)
        elseif (bcx_lo .eq. OUTLET) then
          s_l(is  ,1) = s_r(is  ,1)
          s_l(is  ,2) = s_r(is  ,2)
          s_l(is  ,3) = s_r(is  ,3)
        else
          print *,'bogus bcx_lo in mkvelflux ',bcx_lo
          stop
        endif

        if (bcx_hi .eq. PERIODIC) then
          s_r(ie+1,1) = s_r(is  ,1)
          s_r(ie+1,2) = s_r(is  ,2)
          s_r(ie+1,3) = s_r(is  ,3)
        elseif (bcx_hi .eq. WALL) then
          s_l(ie+1,1) = zero
          s_r(ie+1,1) = zero
          s_r(ie+1,2) = s_l(ie+1,2)
          s_r(ie+1,3) = s_l(ie+1,3)
        elseif (bcx_hi .eq. INLET) then
          s_r(ie+1,1) = s(ie+1,j,k,1)
          s_r(ie+1,2) = s(ie+1,j,k,2)
          s_r(ie+1,3) = s(ie+1,j,k,3)
        elseif (bcx_hi .eq. OUTLET) then
          s_r(ie+1,1) = s_l(ie+1,1)
          s_r(ie+1,2) = s_l(ie+1,2)
          s_r(ie+1,3) = s_l(ie+1,3)
        else
          print *,'bogus bcx_hi in mkvelflux ',bcx_hi
          stop
        endif

        do n = 1,3
        do i = is, ie+1 
          sedgex(i,j,k,n)=cvmgp(s_l(i,n),s_r(i,n),uadv(i,j,k))
          savg = half*(s_r(i,n) + s_l(i,n))
          sedgex(i,j,k,n)=cvmgt(savg,sedgex(i,j,k,n),abs(uadv(i,j,k)) .lt. eps)
        enddo
        enddo

        if (visc_coef .gt. 0.  .and. bcx_lo .eq. WALL) then
          sedgex(is  ,j,k,3) = zero
          sedgex(is  ,j,k,2) = zero
          sedgex(is  ,j,k,1) = zero
        endif

        if (visc_coef .gt. 0.  .and. bcx_hi .eq. WALL) then
          sedgex(ie+1,j,k,3) = zero
          sedgex(ie+1,j,k,2) = zero
          sedgex(ie+1,j,k,1) = zero
        endif
      enddo
      enddo

c        ******************************************************************
c        ******************************************************************
c        ******************************************************************

c ::: loop for y fluxes

      do k = ks, ke 
      do i = is, ie 
        do j = js, je 

c        ******************************************************************
c        MAKE TRANSVERSE DERIVATIVES IN X-DIRECTION
c        ******************************************************************

          wplft = s(i  ,j,k,3) + (half - dth*s(i  ,j,k,1)/hx)*slopex(i  ,j,k,3)
c    $            + dth * lapu(i  ,j,k,3) / rho(i  ,j,k)
          wprgt = s(i+1,j,k,3) - (half + dth*s(i+1,j,k,1)/hx)*slopex(i+1,j,k,3)
c    $            + dth * lapu(i+1,j,k,3) / rho(i+1,j,k)
          vplft = s(i  ,j,k,2) + (half - dth*s(i  ,j,k,1)/hx)*slopex(i  ,j,k,2)
c    $            + dth * lapu(i  ,j,k,2) / rho(i  ,j,k)
          vprgt = s(i+1,j,k,2) - (half + dth*s(i+1,j,k,1)/hx)*slopex(i+1,j,k,2)
c    $            + dth * lapu(i+1,j,k,2) / rho(i+1,j,k)
          uplft = s(i  ,j,k,1) + (half - dth*s(i  ,j,k,1)/hx)*slopex(i  ,j,k,1)
c    $            + dth * lapu(i  ,j,k,1) / rho(i  ,j,k)
          uprgt = s(i+1,j,k,1) - (half + dth*s(i+1,j,k,1)/hx)*slopex(i+1,j,k,1)
c    $            + dth * lapu(i+1,j,k,1) / rho(i+1,j,k)

          ltp0 = (i .eq. ie  .and.  bcx_hi .eq. INLET)
          uprgt = cvmgt(s(ie+1,j,k,1),uprgt,ltp0)
          uplft = cvmgt(s(ie+1,j,k,1),uplft,ltp0)
          vprgt = cvmgt(s(ie+1,j,k,2),vprgt,ltp0)
          vplft = cvmgt(s(ie+1,j,k,2),vplft,ltp0)
          wprgt = cvmgt(s(ie+1,j,k,3),wprgt,ltp0)
          wplft = cvmgt(s(ie+1,j,k,3),wplft,ltp0)

          ltp0 = (i .eq. ie  .and.  bcx_hi .eq. WALL)
          uprgt = cvmgt(zero,uprgt,ltp0)
          uplft = cvmgt(zero,uplft,ltp0)
          vprgt = cvmgt(vplft,vprgt,ltp0)
          wprgt = cvmgt(wplft,wprgt,ltp0)

          ltp0 = (i .eq. ie  .and.  bcx_hi .eq. WALL  .and.  visc_coef .gt. zero)
          vprgt = cvmgt(zero,vprgt,ltp0)
          vplft = cvmgt(zero,vplft,ltp0)
          wprgt = cvmgt(zero,wprgt,ltp0)
          wplft = cvmgt(zero,wplft,ltp0)

          uplus = cvmgp(uplft,uprgt,utrans(i+1,j,k))
          uavg  = half * (uplft + uprgt)
          uplus = cvmgt(uplus, uavg, abs(utrans(i+1,j,k)) .gt. eps)

          vplus = cvmgp(vplft,vprgt,utrans(i+1,j,k))
          vavg  = half * (vplft + vprgt)
          vplus = cvmgt(vplus, vavg, abs(utrans(i+1,j,k)) .gt. eps)

          wplus = cvmgp(wplft,wprgt,utrans(i+1,j,k))
          wavg  = half * (wplft + wprgt)
          wplus = cvmgt(wplus, wavg, abs(utrans(i+1,j,k)) .gt. eps)

          wmrgt = s(i  ,j,k,3) - (half + dth*s(i  ,j,k,1)/hx)*slopex(i  ,j,k,3)
c    $            + dth * lapu(i  ,j,k,3) / rho(i  ,j,k)
          wmlft = s(i-1,j,k,3) + (half - dth*s(i-1,j,k,1)/hx)*slopex(i-1,j,k,3)
c    $            + dth * lapu(i-1,j,k,3) / rho(i-1,j,k)
          vmrgt = s(i  ,j,k,2) - (half + dth*s(i  ,j,k,1)/hx)*slopex(i  ,j,k,2)
c    $            + dth * lapu(i  ,j,k,2) / rho(i  ,j,k)
          vmlft = s(i-1,j,k,2) + (half - dth*s(i-1,j,k,1)/hx)*slopex(i-1,j,k,2)
c    $            + dth * lapu(i-1,j,k,2) / rho(i-1,j,k)
          umrgt = s(i  ,j,k,1) - (half + dth*s(i  ,j,k,1)/hx)*slopex(i  ,j,k,1)
c    $            + dth * lapu(i  ,j,k,1) / rho(i  ,j,k)
          umlft = s(i-1,j,k,1) + (half - dth*s(i-1,j,k,1)/hx)*slopex(i-1,j,k,1)
c    $            + dth * lapu(i-1,j,k,1) / rho(i-1,j,k)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. INLET)
          umrgt = cvmgt(s(is-1,j,k,1),umrgt,ltm0)
          umlft = cvmgt(s(is-1,j,k,1),umlft,ltm0)
          vmrgt = cvmgt(s(is-1,j,k,2),vmrgt,ltm0)
          vmlft = cvmgt(s(is-1,j,k,2),vmlft,ltm0)
          wmrgt = cvmgt(s(is-1,j,k,3),wmrgt,ltm0)
          wmlft = cvmgt(s(is-1,j,k,3),wmlft,ltm0)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. WALL)
          umrgt = cvmgt(zero ,umrgt,ltm0)
          umlft = cvmgt(zero ,umlft,ltm0)
          vmlft = cvmgt(vmrgt,vmlft,ltm0)
          wmlft = cvmgt(wmrgt,wmlft,ltm0)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. WALL  .and.  
     $            visc_coef .gt. zero)
          vmrgt = cvmgt(zero,vmrgt,ltm0)
          vmlft = cvmgt(zero,vmlft,ltm0)
          wmrgt = cvmgt(zero,wmrgt,ltm0)
          wmlft = cvmgt(zero,wmlft,ltm0)
 
          uminus = cvmgp(umlft,umrgt,utrans(i,j,k))
          uavg   = half * (umlft + umrgt)
          uminus = cvmgt(uminus, uavg, abs(utrans(i,j,k)) .gt. eps)

          vminus = cvmgp(vmlft,vmrgt,utrans(i,j,k))
          vavg   = half * (vmlft + vmrgt)
          vminus = cvmgt(vminus, vavg, abs(utrans(i,j,k)) .gt. eps)

          wminus = cvmgp(wmlft,wmrgt,utrans(i,j,k))
          wavg   = half * (wmlft + wmrgt)
          wminus = cvmgt(wminus, wavg, abs(utrans(i,j,k)) .gt. eps)

          utr = half * (utrans(i,j,k)+utrans(i+1,j,k))*(uplus - uminus) / hx
          vtr = half * (utrans(i,j,k)+utrans(i+1,j,k))*(vplus - vminus) / hx
          wtr = half * (utrans(i,j,k)+utrans(i+1,j,k))*(wplus - wminus) / hx

c        ******************************************************************
c        MAKE TRANSVERSE DERIVATIVES IN Z-DIRECTION
c        ******************************************************************

          wpbot = s(i,j,k  ,3) + (half - dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,3) 
c    $            + dth * lapu(i,j,k  ,3) / rho(i,j,k)
          wptop = s(i,j,k+1,3) - (half + dth*s(i,j,k+1,3)/hz)*slopez(i,j,k+1,3)
c    $            + dth * lapu(i,j,k+1,3) / rho(i,j,k+1)
          vpbot = s(i,j,k  ,2) + (half - dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,2) 
c    $            + dth * lapu(i,j,k  ,2) / rho(i,j,k)
          vptop = s(i,j,k+1,2) - (half + dth*s(i,j,k+1,3)/hz)*slopez(i,j,k+1,2)
c    $            + dth * lapu(i,j,k+1,2) / rho(i,j,k+1)
          upbot = s(i,j,k  ,1) + (half - dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,1)
c    $            + dth * lapu(i,j,k  ,1) / rho(i,j,k)
          uptop = s(i,j,k+1,1) - (half + dth*s(i,j,k+1,3)/hz)*slopez(i,j,k+1,1)
c    $            + dth * lapu(i,j,k+1,1) / rho(i,j,k+1)

          ltp0 = (k .eq. ke  .and.  bcz_hi .eq. INLET)
          wptop = cvmgt(s(i,j,ke+1,3),wptop,ltp0)
          wpbot = cvmgt(s(i,j,ke+1,3),wpbot,ltp0)
          vptop = cvmgt(s(i,j,ke+1,2),vptop,ltp0)
          vpbot = cvmgt(s(i,j,ke+1,2),vpbot,ltp0)
          uptop = cvmgt(s(i,j,ke+1,1),uptop,ltp0)
          upbot = cvmgt(s(i,j,ke+1,1),upbot,ltp0)

          ltp0 = (k .eq. ke  .and.  bcz_hi .eq. WALL)
          wptop = cvmgt(zero,wptop,ltp0)
          wpbot = cvmgt(zero,wpbot,ltp0)
          uptop = cvmgt(upbot,uptop,ltp0)
          vptop = cvmgt(vpbot,vptop,ltp0)

          ltp0 = (k .eq. ke  .and.  bcz_hi .eq. WALL  .and.  visc_coef .gt. zero)
          uptop = cvmgt(zero,uptop,ltp0)
          upbot = cvmgt(zero,upbot,ltp0)
          vptop = cvmgt(zero,vptop,ltp0)
          vpbot = cvmgt(zero,vpbot,ltp0)

          uplus = cvmgp(upbot,uptop,wtrans(i,j,k+1))
          uavg  = half * (upbot + uptop)
          uplus = cvmgt(uplus, uavg, abs(wtrans(i,j,k+1)) .gt. eps)

          vplus = cvmgp(vpbot,vptop,wtrans(i,j,k+1))
          vavg  = half * (vpbot + vptop)
          vplus = cvmgt(vplus, vavg, abs(wtrans(i,j,k+1)) .gt. eps)

          wplus = cvmgp(wpbot,wptop,wtrans(i,j,k+1))
          wavg  = half * (wpbot + wptop)
          wplus = cvmgt(wplus, wavg, abs(wtrans(i,j,k+1)) .gt. eps)

          wmtop = s(i,j,k  ,3) - (half + dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,3)
c    $            + dth * lapu(i,j,k  ,3) / rho(i,j,k)
          wmbot = s(i,j,k-1,3) + (half - dth*s(i,j,k-1,3)/hz)*slopez(i,j,k-1,3)
c    $            + dth * lapu(i,j,k-1,3) / rho(i,j,k-1)
          vmtop = s(i,j,k  ,2) - (half + dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,2)
c    $            + dth * lapu(i,j,k  ,2) / rho(i,j,k)
          vmbot = s(i,j,k-1,2) + (half - dth*s(i,j,k-1,3)/hz)*slopez(i,j,k-1,2)
c    $            + dth * lapu(i,j,k-1,2) / rho(i,j,k-1)
          umtop = s(i,j,k  ,1) - (half + dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,1)
c    $            + dth * lapu(i,j,k  ,1) / rho(i,j,k)
          umbot = s(i,j,k-1,1) + (half - dth*s(i,j,k-1,3)/hz)*slopez(i,j,k-1,1)
c    $            + dth * lapu(i,j,k-1,1) / rho(i,j,k-1)

          ltm0 = (k .eq. ks  .and.  bcz_lo .eq. INLET)
          wmtop = cvmgt(s(i,j,ks-1,3),wmtop,ltm0)
          wmbot = cvmgt(s(i,j,ks-1,3),wmbot,ltm0)
          vmtop = cvmgt(s(i,j,ks-1,2),vmtop,ltm0)
          vmbot = cvmgt(s(i,j,ks-1,2),vmbot,ltm0)
          umtop = cvmgt(s(i,j,ks-1,1),umtop,ltm0)
          umbot = cvmgt(s(i,j,ks-1,1),umbot,ltm0)

          ltm0 = (k .eq. ks  .and.  bcz_lo .eq. WALL)
          wmtop = cvmgt(zero ,wmtop,ltm0)
          wmbot = cvmgt(zero ,wmbot,ltm0)
          umbot = cvmgt(umtop,umbot,ltm0)
          vmbot = cvmgt(vmtop,vmbot,ltm0)

          ltm0 = (k .eq. ks  .and.  bcz_lo .eq. WALL  .and.  
     $            visc_coef .gt. zero)
          umtop = cvmgt(zero,umtop,ltm0)
          umbot = cvmgt(zero,umbot,ltm0)
          vmtop = cvmgt(zero,vmtop,ltm0)
          vmbot = cvmgt(zero,vmbot,ltm0)

          uminus = cvmgp(umbot,umtop,wtrans(i,j,k))
          uavg   = half * (umbot + umtop)
          uminus = cvmgt(uminus, uavg, abs(wtrans(i,j,k)) .gt. eps)

          vminus = cvmgp(vmbot,vmtop,wtrans(i,j,k))
          vavg   = half * (vmbot + vmtop)
          vminus = cvmgt(vminus, vavg, abs(wtrans(i,j,k)) .gt. eps)

          wminus = cvmgp(wmbot,wmtop,wtrans(i,j,k))
          wavg   = half * (wmbot + wmtop)
          wminus = cvmgt(wminus, wavg, abs(wtrans(i,j,k)) .gt. eps)

          utr = utr + 
     $            half * (wtrans(i,j,k)+wtrans(i,j,k+1))*(uplus - uminus) / hz
          vtr = vtr + 
     $            half * (wtrans(i,j,k)+wtrans(i,j,k+1))*(vplus - vminus) / hz
          wtr = wtr +    
     $            half * (wtrans(i,j,k)+wtrans(i,j,k+1))*(wplus - wminus) / hz

c        ******************************************************************
c        MAKE TOP AND BOTTOM STATES
c        ******************************************************************

          ut = (lapu(i,j,k,1)-px(i,j,k))/rho(i,j,k) - utr + force(i,j,k,1)
          vt = (lapu(i,j,k,2)-py(i,j,k))/rho(i,j,k) - vtr + force(i,j,k,2)
          wt = (lapu(i,j,k,3)-pz(i,j,k))/rho(i,j,k) - wtr + force(i,j,k,3)

          vbardth = dth*s(i,j,k,2)/hy

          s_b(j+1,1)= s(i,j,k,1) + (half-vbardth)*slopey(i,j,k,1) + dth*ut
          s_t(j  ,1)= s(i,j,k,1) - (half+vbardth)*slopey(i,j,k,1) + dth*ut
          s_b(j+1,2)= s(i,j,k,2) + (half-vbardth)*slopey(i,j,k,2) + dth*vt
          s_t(j  ,2)= s(i,j,k,2) - (half+vbardth)*slopey(i,j,k,2) + dth*vt
          s_b(j+1,3)= s(i,j,k,3) + (half-vbardth)*slopey(i,j,k,3) + dth*wt
          s_t(j  ,3)= s(i,j,k,3) - (half+vbardth)*slopey(i,j,k,3) + dth*wt

        enddo

        if (bcy_lo .eq. PERIODIC) then
          s_b(js  ,1) = s_b(je+1,1)
          s_b(js  ,2) = s_b(je+1,2)
          s_b(js  ,3) = s_b(je+1,3)
        elseif (bcy_lo .eq. WALL) then
          s_b(js  ,1) = s_t(js  ,1)
          s_b(js  ,3) = s_t(js  ,3)
          s_b(js  ,2) = zero
          s_t(js  ,2) = zero
        elseif (bcy_lo .eq. INLET) then
          s_b(js  ,1) = s(i,js-1,k,1)
          s_b(js  ,2) = s(i,js-1,k,2)
          s_b(js  ,3) = s(i,js-1,k,3)
        elseif (bcy_lo .eq. OUTLET) then
          s_b(js  ,1) = s_t(js  ,1)
          s_b(js  ,2) = s_t(js  ,2)
          s_b(js  ,3) = s_t(js  ,3)
        else
          print *,'bogus bcy_lo in mkvelflux ',bcy_lo
          stop
        endif

        if (bcy_hi .eq. PERIODIC) then
          s_t(je+1,1) = s_t(js  ,1)
          s_t(je+1,2) = s_t(js  ,2)
          s_t(je+1,3) = s_t(js  ,3)
        elseif (bcy_hi .eq. WALL) then
          s_t(je+1,1) = s_b(je+1,1)
          s_t(je+1,3) = s_b(je+1,3)
          s_b(je+1,2) = zero
          s_t(je+1,2) = zero
        elseif (bcy_hi .eq. INLET) then
          s_t(je+1,1) = s(i,je+1,k,1)
          s_t(je+1,2) = s(i,je+1,k,2)
          s_t(je+1,3) = s(i,je+1,k,3)
        elseif (bcy_hi .eq. OUTLET) then
          s_t(je+1,1) = s_b(je+1,1)
          s_t(je+1,2) = s_b(je+1,2)
          s_t(je+1,3) = s_b(je+1,3)
        else
          print *,'bogus bcy_hi in mkvelflux ',bcy_hi
          stop
        endif

        do n = 1,3
        do j = js, je+1 
          sedgey(i,j,k,n)=cvmgp(s_b(j,n),s_t(j,n),vadv(i,j,k))
          savg = half*(s_t(j,n) + s_b(j,n))
          sedgey(i,j,k,n)=cvmgt(savg,sedgey(i,j,k,n),abs(vadv(i,j,k)) .lt. eps)
        enddo
        enddo

        if (visc_coef .gt. 0.  .and. bcy_lo .eq. WALL) then
          sedgey(i,js  ,k,3) = zero
          sedgey(i,js  ,k,2) = zero
          sedgey(i,js  ,k,1) = zero
        endif

        if (visc_coef .gt. 0.  .and. bcy_hi .eq. WALL) then
          sedgey(i,je+1,k,3) = zero
          sedgey(i,je+1,k,2) = zero
          sedgey(i,je+1,k,1) = zero
        endif

      enddo
      enddo


c        ******************************************************************
c        ******************************************************************
c        ******************************************************************

c ::: loop for z fluxes

      do j = js, je 
      do i = is, ie 
        do k = ks, ke 

c        ******************************************************************
c        MAKE TRANSVERSE DERIVATIVES IN X-DIRECTION
c        ******************************************************************

          wplft = s(i  ,j,k,3) + (half - dth*s(i  ,j,k,1)/hx) * slopex(i  ,j,k,3)
c    $            + dth * lapu(i  ,j,k,3) / rho(i,j,k)
          wprgt = s(i+1,j,k,3) - (half + dth*s(i+1,j,k,1)/hx) * slopex(i+1,j,k,3)
c    $            + dth * lapu(i+1,j,k,3) / rho(i+1,j,k)
          vplft = s(i  ,j,k,2) + (half - dth*s(i  ,j,k,1)/hx) * slopex(i  ,j,k,2)
c    $            + dth * lapu(i  ,j,k,2) / rho(i,j,k)
          vprgt = s(i+1,j,k,2) - (half + dth*s(i+1,j,k,1)/hx) * slopex(i+1,j,k,2)
c    $            + dth * lapu(i+1,j,k,2) / rho(i+1,j,k)
          uplft = s(i  ,j,k,1) + (half - dth*s(i  ,j,k,1)/hx) * slopex(i  ,j,k,1)
c    $            + dth * lapu(i  ,j,k,1) / rho(i,j,k)
          uprgt = s(i+1,j,k,1) - (half + dth*s(i+1,j,k,1)/hx) * slopex(i+1,j,k,1)
c    $            + dth * lapu(i+1,j,k,1) / rho(i+1,j,k)

          ltp0 = (i .eq. ie  .and.  bcx_hi .eq. INLET)
          uprgt = cvmgt(s(ie+1,j,k,1),uprgt,ltp0)
          uplft = cvmgt(s(ie+1,j,k,1),uplft,ltp0)
          vprgt = cvmgt(s(ie+1,j,k,2),vprgt,ltp0)
          vplft = cvmgt(s(ie+1,j,k,2),vplft,ltp0)
          wprgt = cvmgt(s(ie+1,j,k,3),wprgt,ltp0)
          wplft = cvmgt(s(ie+1,j,k,3),wplft,ltp0)

          ltp0 = (i .eq. ie  .and.  bcx_hi .eq. WALL)
          uprgt = cvmgt(zero,uprgt,ltp0)
          uplft = cvmgt(zero,uplft,ltp0)
          vprgt = cvmgt(vplft,vprgt,ltp0)
          wprgt = cvmgt(wplft,wprgt,ltp0)

          ltp0 = (i .eq. ie  .and.  bcx_hi .eq. WALL  .and.  visc_coef .gt. zero)
          vprgt = cvmgt(zero,vprgt,ltp0)
          vplft = cvmgt(zero,vplft,ltp0)
          wprgt = cvmgt(zero,wprgt,ltp0)
          wplft = cvmgt(zero,wplft,ltp0)

          uplus = cvmgp(uplft,uprgt,utrans(i+1,j,k))
          uavg  = half * (uplft + uprgt)
          uplus = cvmgt(uplus, uavg, abs(utrans(i+1,j,k)) .gt. eps)

          vplus = cvmgp(vplft,vprgt,utrans(i+1,j,k))
          vavg  = half * (vplft + vprgt)
          vplus = cvmgt(vplus, vavg, abs(utrans(i+1,j,k)) .gt. eps)

          wplus = cvmgp(wplft,wprgt,utrans(i+1,j,k))
          wavg  = half * (wplft + wprgt)
          wplus = cvmgt(wplus, wavg, abs(utrans(i+1,j,k)) .gt. eps)

          wmrgt = s(i  ,j,k,3) - (half + dth*s(i  ,j,k,1)/hx)*slopex(i  ,j,k,3)
c    $            + dth * lapu(i  ,j,k,3) / rho(i  ,j,k)
          wmlft = s(i-1,j,k,3) + (half - dth*s(i-1,j,k,1)/hx)*slopex(i-1,j,k,3)
c    $            + dth * lapu(i-1,j,k,3) / rho(i-1,j,k)
          vmrgt = s(i  ,j,k,2) - (half + dth*s(i  ,j,k,1)/hx)*slopex(i  ,j,k,2)
c    $            + dth * lapu(i  ,j,k,2) / rho(i  ,j,k)
          vmlft = s(i-1,j,k,2) + (half - dth*s(i-1,j,k,1)/hx)*slopex(i-1,j,k,2)
c    $            + dth * lapu(i-1,j,k,2) / rho(i-1,j,k)
          umrgt = s(i  ,j,k,1) - (half + dth*s(i  ,j,k,1)/hx)*slopex(i  ,j,k,1)
c    $            + dth * lapu(i  ,j,k,1) / rho(i  ,j,k)
          umlft = s(i-1,j,k,1) + (half - dth*s(i-1,j,k,1)/hx)*slopex(i-1,j,k,1)
c    $            + dth * lapu(i-1,j,k,1) / rho(i-1,j,k)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. INLET)
          umrgt = cvmgt(s(is-1,j,k,1),umrgt,ltm0)
          umlft = cvmgt(s(is-1,j,k,1),umlft,ltm0)
          vmrgt = cvmgt(s(is-1,j,k,2),vmrgt,ltm0)
          vmlft = cvmgt(s(is-1,j,k,2),vmlft,ltm0)
          wmrgt = cvmgt(s(is-1,j,k,3),wmrgt,ltm0)
          wmlft = cvmgt(s(is-1,j,k,3),wmlft,ltm0)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. WALL)
          umrgt = cvmgt(zero ,umrgt,ltm0)
          umlft = cvmgt(zero ,umlft,ltm0)
          vmlft = cvmgt(vmrgt,vmlft,ltm0)
          wmlft = cvmgt(wmrgt,wmlft,ltm0)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. WALL  .and.  
     $            visc_coef .gt. zero)
          vmrgt = cvmgt(zero,vmrgt,ltm0)
          vmlft = cvmgt(zero,vmlft,ltm0)
          wmrgt = cvmgt(zero,wmrgt,ltm0)
          wmlft = cvmgt(zero,wmlft,ltm0)
 
          uminus = cvmgp(umlft,umrgt,utrans(i,j,k))
          uavg   = half * (umlft + umrgt)
          uminus = cvmgt(uminus, uavg, abs(utrans(i,j,k)) .gt. eps)

          vminus = cvmgp(vmlft,vmrgt,utrans(i,j,k))
          vavg   = half * (vmlft + vmrgt)
          vminus = cvmgt(vminus, vavg, abs(utrans(i,j,k)) .gt. eps)

          wminus = cvmgp(wmlft,wmrgt,utrans(i,j,k))
          wavg   = half * (wmlft + wmrgt)
          wminus = cvmgt(wminus, wavg, abs(utrans(i,j,k)) .gt. eps)

          utr = half * (utrans(i,j,k)+utrans(i+1,j,k))*(uplus - uminus) / hx
          vtr = half * (utrans(i,j,k)+utrans(i+1,j,k))*(vplus - vminus) / hx
          wtr = half * (utrans(i,j,k)+utrans(i+1,j,k))*(wplus - wminus) / hx

c        ******************************************************************
c        MAKE TRANSVERSE DERIVATIVES IN Y-DIRECTION
c        ******************************************************************

          wpbot = s(i,j  ,k,3) + (half - dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,3) 
c    $            + dth * lapu(i,j  ,k,3) / rho(i,j,k)
          wptop = s(i,j+1,k,3) - (half + dth*s(i,j+1,k,2)/hy)*slopey(i,j+1,k,3)
c    $            + dth * lapu(i,j+1,k,3) / rho(i,j+1,k)
          vpbot = s(i,j  ,k,2) + (half - dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,2) 
c    $            + dth * lapu(i,j  ,k,2) / rho(i,j,k)
          vptop = s(i,j+1,k,2) - (half + dth*s(i,j+1,k,2)/hy)*slopey(i,j+1,k,2)
c    $            + dth * lapu(i,j+1,k,2) / rho(i,j+1,k)
          upbot = s(i,j  ,k,1) + (half - dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,1)
c    $            + dth * lapu(i,  j,k,1) / rho(i,j,k)
          uptop = s(i,j+1,k,1) - (half + dth*s(i,j+1,k,2)/hy)*slopey(i,j+1,k,1)
c    $            + dth * lapu(i,j+1,k,1) / rho(i,j+1,k)

          ltp0 = (j .eq. je  .and.  bcy_hi .eq. INLET)
          wptop = cvmgt(s(i,je+1,k,3),wptop,ltp0)
          wpbot = cvmgt(s(i,je+1,k,3),wpbot,ltp0)
          vptop = cvmgt(s(i,je+1,k,2),vptop,ltp0)
          vpbot = cvmgt(s(i,je+1,k,2),vpbot,ltp0)
          uptop = cvmgt(s(i,je+1,k,1),uptop,ltp0)
          upbot = cvmgt(s(i,je+1,k,1),upbot,ltp0)

          ltp0 = (j .eq. je  .and.  bcy_hi .eq. WALL)
          vptop = cvmgt(zero,vptop,ltp0)
          vpbot = cvmgt(zero,vpbot,ltp0)
          uptop = cvmgt(upbot,uptop,ltp0)
          wptop = cvmgt(wpbot,wptop,ltp0)

          ltp0 = (j .eq. je  .and.  bcy_hi .eq. WALL  .and.  visc_coef .gt. zero)
          uptop = cvmgt(zero,uptop,ltp0)
          upbot = cvmgt(zero,upbot,ltp0)
          wptop = cvmgt(zero,wptop,ltp0)
          wpbot = cvmgt(zero,wpbot,ltp0)

          uplus = cvmgp(upbot,uptop,vtrans(i,j+1,k))
          uavg  = half * (upbot + uptop)
          uplus = cvmgt(uplus, uavg, abs(vtrans(i,j+1,k)) .gt. eps)

          vplus = cvmgp(vpbot,vptop,vtrans(i,j+1,k))
          vavg  = half * (vpbot + vptop)
          vplus = cvmgt(vplus, vavg, abs(vtrans(i,j+1,k)) .gt. eps)

          wplus = cvmgp(wpbot,wptop,vtrans(i,j+1,k))
          wavg  = half * (wpbot + wptop)
          wplus = cvmgt(wplus, wavg, abs(vtrans(i,j+1,k)) .gt. eps)

          wmtop = s(i,j  ,k,3) - (half + dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,3)
c    $            + dth * lapu(i,j  ,k,3) / rho(i,j,k)
          wmbot = s(i,j-1,k,3) + (half - dth*s(i,j-1,k,2)/hy)*slopey(i,j-1,k,3)
c    $            + dth * lapu(i,j-1,k,3) / rho(i,j-1,k)
          vmtop = s(i,j  ,k,2) - (half + dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,2)
c    $            + dth * lapu(i,j  ,k,2) / rho(i,j,k)
          vmbot = s(i,j-1,k,2) + (half - dth*s(i,j-1,k,2)/hy)*slopey(i,j-1,k,2)
c    $            + dth * lapu(i,j-1,k,2) / rho(i,j-1,k)
          umtop = s(i,j  ,k,1) - (half + dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,1)
c    $            + dth * lapu(i,j  ,k,1) / rho(i,j,k)
          umbot = s(i,j-1,k,1) + (half - dth*s(i,j-1,k,2)/hy)*slopey(i,j-1,k,1)
c    $            + dth * lapu(i,j-1,k,1) / rho(i,j-1,k)

          ltm0 = (j .eq. js  .and.  bcy_lo .eq. INLET)
          wmtop = cvmgt(s(i,js-1,k,3),wmtop,ltm0)
          wmbot = cvmgt(s(i,js-1,k,3),wmbot,ltm0)
          vmtop = cvmgt(s(i,js-1,k,2),vmtop,ltm0)
          vmbot = cvmgt(s(i,js-1,k,2),vmbot,ltm0)
          umtop = cvmgt(s(i,js-1,k,1),umtop,ltm0)
          umbot = cvmgt(s(i,js-1,k,1),umbot,ltm0)

          ltm0 = (j .eq. js  .and.  bcy_lo .eq. WALL)
          vmtop = cvmgt(zero ,vmtop,ltm0)
          vmbot = cvmgt(zero ,vmbot,ltm0)
          umbot = cvmgt(umtop,umbot,ltm0)
          wmbot = cvmgt(wmtop,wmbot,ltm0)

          ltm0 = (j .eq. js  .and.  bcy_lo .eq. WALL  .and. visc_coef .gt. zero)
          umtop = cvmgt(zero,umtop,ltm0)
          umbot = cvmgt(zero,umbot,ltm0)
          wmtop = cvmgt(zero,wmtop,ltm0)
          wmbot = cvmgt(zero,wmbot,ltm0)

          uminus = cvmgp(umbot,umtop,vtrans(i,j,k))
          uavg   = half * (umbot + umtop)
          uminus = cvmgt(uminus, uavg, abs(vtrans(i,j,k)) .gt. eps)

          vminus = cvmgp(vmbot,vmtop,vtrans(i,j,k))
          vavg   = half * (vmbot + vmtop)
          vminus = cvmgt(vminus, vavg, abs(vtrans(i,j,k)) .gt. eps)

          wminus = cvmgp(wmbot,wmtop,vtrans(i,j,k))
          wavg   = half * (wmbot + wmtop)
          wminus = cvmgt(wminus, wavg, abs(vtrans(i,j,k)) .gt. eps)

          utr =  utr  + 
     $              half * (vtrans(i,j,k)+vtrans(i,j+1,k))*(uplus - uminus) / hy
          vtr =  vtr + 
     $              half * (vtrans(i,j,k)+vtrans(i,j+1,k))*(vplus - vminus) / hy
          wtr =  wtr + 
     $              half * (vtrans(i,j,k)+vtrans(i,j+1,k))*(wplus - wminus) / hy

c        ******************************************************************
c        MAKE DOWN AND UP STATES
c        ******************************************************************

          ut = (lapu(i,j,k,1)-px(i,j,k))/rho(i,j,k) - utr + force(i,j,k,1)
          vt = (lapu(i,j,k,2)-py(i,j,k))/rho(i,j,k) - vtr + force(i,j,k,2)
          wt = (lapu(i,j,k,3)-pz(i,j,k))/rho(i,j,k) - wtr + force(i,j,k,3)

          wbardth = dth*s(i,j,k,3)/hz

          s_d(k+1,1)= s(i,j,k,1) + (half-wbardth)*slopez(i,j,k,1) + dth*ut
          s_u(k  ,1)= s(i,j,k,1) - (half+wbardth)*slopez(i,j,k,1) + dth*ut
          s_d(k+1,2)= s(i,j,k,2) + (half-wbardth)*slopez(i,j,k,2) + dth*vt
          s_u(k  ,2)= s(i,j,k,2) - (half+wbardth)*slopez(i,j,k,2) + dth*vt
          s_d(k+1,3)= s(i,j,k,3) + (half-wbardth)*slopez(i,j,k,3) + dth*wt
          s_u(k  ,3)= s(i,j,k,3) - (half+wbardth)*slopez(i,j,k,3) + dth*wt

        enddo

        if (bcz_lo .eq. PERIODIC) then
          s_d(ks  ,1) = s_d(ke+1,1)
          s_d(ks  ,2) = s_d(ke+1,2)
          s_d(ks  ,3) = s_d(ke+1,3)
        elseif (bcz_lo .eq. WALL) then
          s_d(ks  ,1) = s_u(ks  ,1)
          s_d(ks  ,2) = s_u(ks  ,2)
          s_d(ks  ,3) = zero
          s_u(ks  ,3) = zero
        elseif (bcz_lo .eq. INLET) then
          s_d(ks  ,1) = s(i,j,ks-1,1)
          s_d(ks  ,2) = s(i,j,ks-1,2)
          s_d(ks  ,3) = s(i,j,ks-1,3)
        elseif (bcz_lo .eq. OUTLET) then
          s_d(ks  ,1) = s_u(ks  ,1)
          s_d(ks  ,2) = s_u(ks  ,2)
          s_d(ks  ,3) = s_u(ks  ,3)
        else
          print *,'bogus bcz_lo in mkvelflux ',bcz_lo
          stop
        endif

        if (bcz_hi .eq. PERIODIC) then
          s_u(ke+1,1) = s_u(ks  ,1)
          s_u(ke+1,2) = s_u(ks  ,2)
          s_u(ke+1,3) = s_u(ks  ,3)
        elseif (bcz_hi .eq. WALL) then
          s_u(ke+1,1) = s_d(ke+1,1)
          s_u(ke+1,2) = s_d(ke+1,2)
          s_d(ke+1,3) = zero
          s_u(ke+1,3) = zero
        elseif (bcz_hi .eq. INLET) then
          s_u(ke+1,1) = s(i,j,ke+1,1)
          s_u(ke+1,2) = s(i,j,ke+1,2)
          s_u(ke+1,3) = s(i,j,ke+1,3)
        elseif (bcz_hi .eq. OUTLET) then
          s_u(ke+1,1) = s_d(ke+1,1)
          s_u(ke+1,2) = s_d(ke+1,2)
          s_u(ke+1,3) = s_d(ke+1,3)
        else
          print *,'bogus bcz_hi in mkvelflux ',bcz_hi
          stop
        endif

        do n = 1,3
        do k = ks, ke+1 
          sedgez(i,j,k,n)=cvmgp(s_d(k,n),s_u(k,n),wadv(i,j,k))
          savg = half*(s_d(k,n) + s_u(k,n))
          sedgez(i,j,k,n)=cvmgt(savg,sedgez(i,j,k,n),abs(wadv(i,j,k)) .lt. eps)
        enddo
        enddo

        if ((visc_coef .gt. zero)  .and.  (bcz_lo .eq. WALL)) then
          sedgez(i,j,ks  ,1) = zero
          sedgez(i,j,ks  ,2) = zero
          sedgez(i,j,ks  ,3) = zero
        endif

        if ((visc_coef .gt. zero)  .and.  (bcz_hi .eq. WALL)) then
          sedgez(i,j,ke+1,1) = zero
          sedgez(i,j,ke+1,2) = zero
          sedgez(i,j,ke+1,3) = zero
        endif

      enddo
      enddo

      return
      end
