/*
** (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 N_STATE 5
#define DIMS lo_1,lo_2,lo_3,hi_1,hi_2,hi_3

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

      subroutine FORT_MKFLUX(s,sedgex,sedgey,sedgez,
     $                       slopex,slopey,slopez,uadv,vadv,wadv,
     $                       utrans,vtrans,wtrans,force,
     $                       s_l,s_r,s_b,s_t,s_d,s_u,DIMS,
     $                       dx,dt,visc_coef,bc,velpred,nstart,nend)

      implicit none

      integer DIMS
      integer nstart,nend

      REAL_T       s(lo_1-3:hi_1+3,lo_2-3:hi_2+3,lo_3-3:hi_3+3,N_STATE)
      REAL_T  sedgex(lo_1  :hi_1+1,lo_2  :hi_2  ,lo_3  :hi_3  ,N_STATE)
      REAL_T  sedgey(lo_1  :hi_1  ,lo_2  :hi_2+1,lo_3  :hi_3  ,N_STATE)
      REAL_T  sedgez(lo_1  :hi_1  ,lo_2  :hi_2  ,lo_3  :hi_3+1,N_STATE)
      REAL_T  slopex(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,N_STATE)
      REAL_T  slopey(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,N_STATE)
      REAL_T  slopez(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,N_STATE)
      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-1:hi_1+2,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T  vtrans(lo_1-1:hi_1+1,lo_2-1:hi_2+2,lo_3-1:hi_3+1)
      REAL_T  wtrans(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+2)
      REAL_T   force(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,nstart:nend)

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

      REAL_T  dx(3)
      REAL_T  dt
      REAL_T  visc_coef
      integer bc(2,3)
      integer velpred

c     Local variables
      REAL_T ubardth, vbardth, wbardth
      REAL_T hx, hy, hz, dth
      REAL_T splus,sminus,st,str,savg
      REAL_T sptop,spbot,smtop,smbot,splft,sprgt,smlft,smrgt
      logical test

      REAL_T eps

      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)

c ::: loop for x fluxes

      do n = nstart,nend
       if (velpred .eq. 0 .or. n .eq. 1) then
        do k = ks,ke 
        do j = js,je 
         do i = is-1,ie+1 

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

          spbot = s(i,j  ,k,n) + (half - dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,n)
c    $            + dth * force(i,  j,k,n)
          sptop = s(i,j+1,k,n) - (half + dth*s(i,j+1,k,2)/hy)*slopey(i,j+1,k,n)
c    $            + dth * force(i,j+1,k,n)

          sptop = cvmgt(s(i,je+1,k,n),sptop,j.eq.je .and. BCY_HI .eq. INLET)
          spbot = cvmgt(s(i,je+1,k,n),spbot,j.eq.je .and. BCY_HI .eq. INLET)

          if (j .eq. je .and. BCY_HI .eq. WALL) then
            if (n .eq. 2) then
              sptop = zero
              spbot = zero
            else if (n .eq. 1 .or. n .eq. 3) then
              sptop = cvmgt(zero,spbot,visc_coef .gt. zero)
              spbot = cvmgt(zero,spbot,visc_coef .gt. zero)
            else
              sptop = spbot
            endif
          endif

          splus = cvmgp(spbot,sptop,vtrans(i,j+1,k))
          savg  = half * (spbot + sptop)
          splus = cvmgt(splus, savg, abs(vtrans(i,j+1,k)) .gt. eps)

          smtop = s(i,j  ,k,n) - (half + dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,n)
c    $            + dth * force(i,j  ,k,n)
          smbot = s(i,j-1,k,n) + (half - dth*s(i,j-1,k,2)/hy)*slopey(i,j-1,k,n)
c    $            + dth * force(i,j-1,k,n)

          smtop = cvmgt(s(i,js-1,k,n),smtop,j.eq.js .and. BCY_LO .eq. INLET)
          smbot = cvmgt(s(i,js-1,k,n),smbot,j.eq.js .and. BCY_LO .eq. INLET)

          if (j .eq. js .and. BCY_LO .eq. WALL) then
            if (n .eq. 2) then
              smtop = zero
              smbot = zero
            else if (n .eq. 1 .or. n .eq. 3) then
              smtop = cvmgt(zero,smtop,visc_coef .gt. zero)
              smbot = cvmgt(zero,smtop,visc_coef .gt. zero)
            else
              smbot = smtop
            endif
          endif

          sminus = cvmgp(smbot,smtop,vtrans(i,j,k))
          savg   = half * (smbot + smtop)
          sminus = cvmgt(sminus, savg, abs(vtrans(i,j,k)) .gt. eps)

          str =  half * (vtrans(i,j,k)+vtrans(i,j+1,k))*(splus - sminus) / hy

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

          spbot = s(i,j,k  ,n) + (half - dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,n)
c    $            + dth * force(i,j,k  ,n)
          sptop = s(i,j,k+1,n) - (half + dth*s(i,j,k+1,3)/hz)*slopez(i,j,k+1,n)
c    $            + dth * force(i,j,k+1,n)

          sptop = cvmgt(s(i,j,ke+1,n),sptop,k.eq.ke .and. BCZ_HI .eq. INLET)
          spbot = cvmgt(s(i,j,ke+1,n),spbot,k.eq.ke .and. BCZ_HI .eq. INLET)

          if (k .eq. ke .and. BCZ_HI .eq. WALL) then
            if (n .eq. 3) then
              sptop = zero
              spbot = zero
            else if (n .eq. 1 .or. n .eq. 2) then
              sptop = cvmgt(zero,spbot,visc_coef .gt. zero)
              spbot = cvmgt(zero,spbot,visc_coef .gt. zero)
            else
              sptop = spbot
            endif
          endif

          splus = cvmgp(spbot,sptop,wtrans(i,j,k+1))
          savg  = half * (spbot + sptop)
          splus = cvmgt(splus, savg, abs(wtrans(i,j,k+1)) .gt. eps)

          smtop = s(i,j,k  ,n) - (half + dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,n)
c    $            + dth * force(i,j,k  ,n)
          smbot = s(i,j,k-1,n) + (half - dth*s(i,j,k-1,3)/hz)*slopez(i,j,k-1,n)
c    $            + dth * force(i,j,k-1,n)

          smtop = cvmgt(s(i,j,ks-1,n),smtop,k.eq.ks .and. BCZ_LO .eq. INLET)
          smbot = cvmgt(s(i,j,ks-1,n),smbot,k.eq.ks .and. BCZ_LO .eq. INLET)

          if (k .eq. ks .and. BCZ_LO .eq. WALL) then
            if (n .eq. 3) then
              smtop = zero
              smbot = zero
            else if (n .eq. 1 .or. n .eq. 2) then
              smtop = cvmgt(zero,smtop,visc_coef .gt. zero)
              smbot = cvmgt(zero,smtop,visc_coef .gt. zero)
            else 
              smbot = smtop
            endif
          endif

          sminus = cvmgp(smbot,smtop,wtrans(i,j,k))
          savg   = half * (smbot + smtop)
          sminus = cvmgt(sminus, savg, abs(wtrans(i,j,k)) .gt. eps)

          str = str + half * (wtrans(i,j,k)+wtrans(i,j,k+1))*
     $                       (splus - sminus) / hz

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

          st = force(i,j,k,n) - str
          ubardth = dth*s(i,j,k,1)/hx

          s_l(i+1)= s(i,j,k,n) + (half-ubardth)*slopex(i,j,k,n) + dth*st
          s_r(i  )= s(i,j,k,n) - (half+ubardth)*slopex(i,j,k,n) + dth*st

        enddo

        if (velpred .eq. 1) then
          do i = is, ie+1 
            savg = half*(s_r(i) + s_l(i))
            test = ( (s_l(i) .le. zero  .and.
     $                s_r(i) .ge. zero)  .or.
     $              (abs(s_l(i) + s_r(i)) .lt. eps) )
            sedgex(i,j,k,n)=cvmgp(s_l(i),s_r(i),savg)
            sedgex(i,j,k,n)=cvmgt(savg,sedgex(i,j,k,n),test)
          enddo
        else
          do i = is, ie+1 
            sedgex(i,j,k,n)=cvmgp(s_l(i),s_r(i),uadv(i,j,k))
            savg = half*(s_r(i) + s_l(i))
            sedgex(i,j,k,n)=cvmgt(savg,sedgex(i,j,k,n),abs(uadv(i,j,k)) .lt. eps)
          enddo
        endif

        if (BCX_LO .eq. WALL) then
          if (n .eq. 1) then
            sedgex(is,j,k,n) = zero
          else if (n .eq. 2 .or. n .eq. 3) then
            sedgex(is,j,k,n) = cvmgt(zero,s_r(is),visc_coef .gt. 0.0)
          else 
            sedgex(is,j,k,n) = s_r(is)
          endif
        elseif (BCX_LO .eq. INLET) then
          sedgex(is,j,k,n) = s(is-1,j,k,n)
        elseif (BCX_LO .eq. OUTLET) then
          sedgex(is,j,k,n) = s_r(is)
        endif

        if (BCX_HI .eq. WALL) then
          if (n .eq. 1) then
            sedgex(ie+1,j,k,n) = zero
          else if (n .eq. 2 .or. n .eq. 3) then
            sedgex(ie+1,j,k,n) = cvmgt(zero,s_l(ie+1),visc_coef .gt. 0.0)
          else 
            sedgex(ie+1,j,k,n) = s_l(ie+1)
          endif
        elseif (BCX_HI .eq. INLET) then
          sedgex(ie+1,j,k,n) = s(ie+1,j,k,n)
        elseif (BCX_HI .eq. OUTLET) then
          sedgex(ie+1,j,k,n) = s_l(ie+1)
        endif

        if (velpred .eq. 1) then
          do i = is, ie+1 
            uadv(i,j,k) = sedgex(i,j,k,1)
          enddo
        endif

        enddo
        enddo
       endif
      enddo

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

c ::: loop for y fluxes

      do n = nstart,nend
       if (velpred .eq. 0 .or. n .eq. 2) then
       do k = ks, ke 
       do i = is, ie 
        do j = js-1, je+1 

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

          splft = s(i  ,j,k,n) + (half - dth*s(i  ,j,k,1)/hx)*slopex(i  ,j,k,n)
c    $            + dth * force(i  ,j,k,n)
          sprgt = s(i+1,j,k,n) - (half + dth*s(i+1,j,k,1)/hx)*slopex(i+1,j,k,n)
c    $            + dth * force(i+1,j,k,n)

          sprgt = cvmgt(s(ie+1,j,k,n),sprgt,i.eq.ie .and. BCX_HI .eq. INLET)
          splft = cvmgt(s(ie+1,j,k,n),splft,i.eq.ie .and. BCX_HI .eq. INLET)

          if (i .eq. ie .and. BCX_HI .eq. WALL) then
            if (n .eq. 1) then
              sprgt = zero
              splft = zero
            else if (n .eq. 2 .or. n .eq. 3) then
              sprgt = cvmgt(zero,splft,visc_coef .gt. zero)
              splft = cvmgt(zero,splft,visc_coef .gt. zero)
            else
              sprgt = splft
            endif
          endif

          splus = cvmgp(splft,sprgt,utrans(i+1,j,k))
          savg  = half * (splft + sprgt)
          splus = cvmgt(splus, savg, abs(utrans(i+1,j,k)) .gt. eps)

          smrgt = s(i  ,j,k,n) - (half + dth*s(i  ,j,k,1)/hx)*slopex(i  ,j,k,n)
c    $            + dth * force(i  ,j,k,n)
          smlft = s(i-1,j,k,n) + (half - dth*s(i-1,j,k,1)/hx)*slopex(i-1,j,k,n)
c    $            + dth * force(i-1,j,k,n)

          smrgt = cvmgt(s(is-1,j,k,n),smrgt,i.eq.is .and. BCX_LO .eq. INLET)
          smlft = cvmgt(s(is-1,j,k,n),smlft,i.eq.is .and. BCX_LO .eq. INLET)

          if (i .eq. is .and. BCX_LO .eq. WALL) then
            if (n .eq. 1) then
              smrgt = zero
              smlft = zero
            else if (n .eq. 2 .or. n .eq. 3) then
              smrgt = cvmgt(zero,smrgt,visc_coef .gt. zero)
              smlft = cvmgt(zero,smrgt,visc_coef .gt. zero)
            else
              smlft = smrgt
            endif
          endif
 
          sminus = cvmgp(smlft,smrgt,utrans(i,j,k))
          savg   = half * (smlft + smrgt)
          sminus = cvmgt(sminus, savg, abs(utrans(i,j,k)) .gt. eps)

          str    = half * (utrans(i,j,k)+utrans(i+1,j,k))*(splus - sminus) / hx

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

          spbot = s(i,j,k  ,n) + (half - dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,n)
c    $            + dth * force(i,j,k  ,n)
          sptop = s(i,j,k+1,n) - (half + dth*s(i,j,k+1,3)/hz)*slopez(i,j,k+1,n)
c    $            + dth * force(i,j,k+1,n)

          sptop = cvmgt(s(i,j,ke+1,n),sptop,k.eq.ke .and. BCZ_HI .eq. INLET)
          spbot = cvmgt(s(i,j,ke+1,n),spbot,k.eq.ke .and. BCZ_HI .eq. INLET)

          if (k .eq. ke .and. BCZ_HI .eq. WALL) then
            if (n .eq. 3) then
              sptop = zero
              spbot = zero
            else if (n .eq. 1 .or. n .eq. 2) then
              sptop = cvmgt(zero,spbot,visc_coef .gt. zero)
              spbot = cvmgt(zero,spbot,visc_coef .gt. zero)
            else
              sptop = spbot
            endif
          endif

          splus = cvmgp(spbot,sptop,wtrans(i,j,k+1))
          savg  = half * (spbot + sptop)
          splus = cvmgt(splus, savg, abs(wtrans(i,j,k+1)) .gt. eps)

          smtop = s(i,j,k  ,n) - (half + dth*s(i,j,k  ,3)/hz)*slopez(i,j,k  ,n)
c    $            + dth * force(i,j,k  ,n)
          smbot = s(i,j,k-1,n) + (half - dth*s(i,j,k-1,3)/hz)*slopez(i,j,k-1,n)
c    $            + dth * force(i,j,k-1,n)

          smtop = cvmgt(s(i,j,ks-1,n),smtop,k.eq.ke .and. BCZ_LO .eq. INLET)
          smbot = cvmgt(s(i,j,ks-1,n),smbot,k.eq.ke .and. BCZ_LO .eq. INLET)

          if (k .eq. ks  .and.  BCZ_LO .eq. WALL) then
            if (n .eq. 3) then
              smtop = zero
              smbot = zero
            else if (n .eq. 1 .or. n .eq. 2) then
              smbot = cvmgt(zero,smtop,visc_coef .gt. zero)
              smtop = cvmgt(zero,smtop,visc_coef .gt. zero)
            else
              smbot = smtop
            endif
          endif

          sminus = cvmgp(smbot,smtop,wtrans(i,j,k))
          savg   = half * (smbot + smtop)
          sminus = cvmgt(sminus, savg, abs(wtrans(i,j,k)) .gt. eps)

          str = str + half * (wtrans(i,j,k)+wtrans(i,j,k+1))*(splus - sminus) / hz

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

          st = force(i,j,k,n) - str

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

          s_b(j+1)= s(i,j,k,n) + (half-vbardth)*slopey(i,j,k,n) + dth*st
          s_t(j  )= s(i,j,k,n) - (half+vbardth)*slopey(i,j,k,n) + dth*st
        enddo

        if (velpred .eq. 1) then
          do j = js, je+1 
            savg = half*(s_t(j) + s_b(j))
            test = ( (s_b(j) .le. zero  .and.
     $                s_t(j) .ge. zero)  .or.
     $             (abs(s_b(j) + s_t(j)) .lt. eps) )
            sedgey(i,j,k,n)=cvmgp(s_b(j),s_t(j),savg)
            sedgey(i,j,k,n)=cvmgt(savg,sedgey(i,j,k,n),test)
          enddo
        else
          do j = js, je+1 
            sedgey(i,j,k,n)=cvmgp(s_b(j),s_t(j),vadv(i,j,k))
            savg = half*(s_t(j) + s_b(j))
            sedgey(i,j,k,n)=cvmgt(savg,sedgey(i,j,k,n),abs(vadv(i,j,k)) .lt. eps)
          enddo
        endif

        if (BCY_LO .eq. WALL) then
          if (n .eq. 2) then
            sedgey(i,js,k,n) = zero
          else if (n .eq. 1 .or. n .eq. 3) then
            sedgey(i,js,k,n) = cvmgt(zero,s_t(js),visc_coef .gt. 0.0)
          else
            sedgey(i,js,k,n) = s_t(js)
          endif
        elseif (BCY_LO .eq. INLET) then
          sedgey(i,js,k,n) = s(i,js-1,k,n)
        elseif (BCY_LO .eq. OUTLET) then
          sedgey(i,js,k,n) = s_t(js)
        endif

        if (BCY_HI .eq. WALL) then
          if (n .eq. 2) then
            sedgey(i,je+1,k,n) = zero
          else if (n .eq. 1 .or. n .eq. 3) then
            sedgey(i,je+1,k,n) = cvmgt(zero,s_b(je+1),visc_coef .gt. 0.0)
          else
            sedgey(i,je+1,k,n) = s_b(je+1)
          endif
        elseif (BCY_HI .eq. INLET) then
          sedgey(i,je+1,k,n) = s(i,je+1,k,n)
        elseif (BCY_HI .eq. OUTLET) then
          sedgey(i,je+1,k,n) = s_b(je+1)
        endif

        if (velpred .eq. 1) then
          do j = js, je+1 
            vadv(i,j,k) = sedgey(i,j,k,2)
          enddo
        endif

        enddo
        enddo
       endif
      enddo

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

c ::: loop for z fluxes

      do n = nstart,nend
        if (velpred .eq. 0 .or. n .eq. 3) then
        do j = js, je 
        do i = is, ie 
          do k = ks-1, ke+1 

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

          splft = s(i  ,j,k,n) + (half - dth*s(i  ,j,k,1)/hx) * slopex(i  ,j,k,n)
c    $            + dth * force(i  ,j,k,n)
          sprgt = s(i+1,j,k,n) - (half + dth*s(i+1,j,k,1)/hx) * slopex(i+1,j,k,n)
c    $            + dth * force(i+1,j,k,n)

          sprgt = cvmgt(s(ie+1,j,k,n),sprgt,i.eq.ie .and. BCX_HI .eq. INLET)
          splft = cvmgt(s(ie+1,j,k,n),splft,i.eq.ie .and. BCX_HI .eq. INLET)

          if (i .eq. ie  .and.  BCX_HI .eq. WALL) then
            if (n .eq. 1) then
              sprgt = zero
              splft = zero
            else if (n .eq. 2 .or. n .eq. 3) then
              sprgt = cvmgt(zero,splft,visc_coef .gt. zero)
              splft = cvmgt(zero,splft,visc_coef .gt. zero)
            else
              sprgt = splft
            endif
          endif

          splus = cvmgp(splft,sprgt,utrans(i+1,j,k))
          savg  = half * (splft + sprgt)
          splus = cvmgt(splus, savg, abs(utrans(i+1,j,k)) .gt. eps)

          smrgt = s(i  ,j,k,n) - (half + dth*s(i  ,j,k,1)/hx)*slopex(i  ,j,k,n)
c    $            + dth * force(i  ,j,k,n)
          smlft = s(i-1,j,k,n) + (half - dth*s(i-1,j,k,1)/hx)*slopex(i-1,j,k,n)
c    $            + dth * force(i-1,j,k,n)

          smrgt = cvmgt(s(is-1,j,k,n),smrgt,i.eq.is .and. BCX_LO .eq. INLET)
          smlft = cvmgt(s(is-1,j,k,n),smlft,i.eq.is .and. BCX_LO .eq. INLET)

          if (i .eq. is  .and.  BCX_LO .eq. WALL) then
            if (n .eq. 1) then
              smrgt = zero
              smlft = zero
            else if (n .eq. 2 .or. n .eq. 3) then
              smrgt = cvmgt(zero,smrgt,visc_coef .gt. zero)
              smlft = cvmgt(zero,smrgt,visc_coef .gt. zero)
            else
              smlft = smrgt
            endif
          endif
 
          sminus = cvmgp(smlft,smrgt,utrans(i,j,k))
          savg   = half * (smlft + smrgt)
          sminus = cvmgt(sminus, savg, abs(utrans(i,j,k)) .gt. eps)

          str = half * (utrans(i,j,k)+utrans(i+1,j,k))*(splus - sminus) / hx

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

          spbot = s(i,j  ,k,n) + (half - dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,n)
c    $            + dth * force(i,  j,k,n)
          sptop = s(i,j+1,k,n) - (half + dth*s(i,j+1,k,2)/hy)*slopey(i,j+1,k,n)
c    $            + dth * force(i,j+1,k,n)

          sptop = cvmgt(s(i,je+1,k,n),sptop,j.eq.je .and. BCY_HI .eq. INLET)
          spbot = cvmgt(s(i,je+1,k,n),spbot,j.eq.je .and. BCY_HI .eq. INLET)

          if (j .eq. je .and. BCY_HI .eq. WALL) then
            if (n .eq. 2) then
              sptop = zero
              spbot = zero
            else if (n .eq. 1 .or. n .eq. 3) then
              sptop = cvmgt(zero,spbot,visc_coef .gt. zero)
              spbot = cvmgt(zero,spbot,visc_coef .gt. zero)
            else
              sptop = spbot
            endif
          endif

          splus = cvmgp(spbot,sptop,vtrans(i,j+1,k))
          savg  = half * (spbot + sptop)
          splus = cvmgt(splus, savg, abs(vtrans(i,j+1,k)) .gt. eps)

          smtop = s(i,j  ,k,n) - (half + dth*s(i,j  ,k,2)/hy)*slopey(i,j  ,k,n)
c    $            + dth * force(i,j  ,k,n)
          smbot = s(i,j-1,k,n) + (half - dth*s(i,j-1,k,2)/hy)*slopey(i,j-1,k,n)
c    $            + dth * force(i,j-1,k,n)

          smtop = cvmgt(s(i,js-1,k,n),smtop,j.eq.js .and. BCY_LO .eq. INLET)
          smbot = cvmgt(s(i,js-1,k,n),smbot,j.eq.js .and. BCY_LO .eq. INLET)

          if (j .eq. js  .and.  BCY_LO .eq. WALL) then
            if (n .eq. 2) then
              smtop = zero
              smbot = zero
            else if (n .eq. 1 .or. n .eq. 3) then
              smtop = cvmgt(zero,smtop,visc_coef .gt. zero)
              smbot = cvmgt(zero,smtop,visc_coef .gt. zero)
            else
              smbot = smtop
            endif
          endif

          sminus = cvmgp(smbot,smtop,vtrans(i,j,k))
          savg   = half * (smbot + smtop)
          sminus = cvmgt(sminus, savg, abs(vtrans(i,j,k)) .gt. eps)

          str =  str + half * (vtrans(i,j,k)+vtrans(i,j+1,k))*(splus - sminus) / hy

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

          st = force(i,j,k,n) - str

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

          s_d(k+1)= s(i,j,k,n) + (half-wbardth)*slopez(i,j,k,n) + dth*st
          s_u(k  )= s(i,j,k,n) - (half+wbardth)*slopez(i,j,k,n) + dth*st

        enddo

        if (velpred .eq. 1) then
          do k = ks, ke+1 
            savg = half*(s_d(k) + s_u(k))
            test = ( (s_d(k) .le. zero  .and.
     $                s_u(k) .ge. zero)  .or.
     $             (abs(s_d(k) + s_u(k)) .lt. eps) )
            sedgez(i,j,k,n)=cvmgp(s_d(k),s_u(k),savg)
            sedgez(i,j,k,n)=cvmgt(savg,sedgez(i,j,k,n),test)
          enddo
        else
          do k = ks, ke+1 
            sedgez(i,j,k,n)=cvmgp(s_d(k),s_u(k),wadv(i,j,k))
            savg = half*(s_d(k) + s_u(k))
            sedgez(i,j,k,n)=cvmgt(savg,sedgez(i,j,k,n),abs(wadv(i,j,k)) .lt. eps)
          enddo
        endif

        if (BCZ_LO .eq. WALL) then
          if (n .eq. 3) then
            sedgez(i,j,ks,n) = zero
          else if (n .eq. 1 .or. n .eq. 2) then
            sedgez(i,j,ks,n) = cvmgt(zero,s_u(ks),visc_coef .gt. 0.0)
          else
            sedgez(i,j,ks,n) = s_u(ks)
          endif
        elseif (BCZ_LO .eq. INLET) then
          sedgez(i,j,ks,n) = s(i,j,ks-1,n)
        elseif (BCZ_LO .eq. OUTLET) then
          sedgez(i,j,ks,n) = s_u(ks)
        endif

        if (BCZ_HI .eq. WALL) then
          if (n .eq. 3) then
            sedgez(i,j,ke+1,n) = zero
          else if (n .eq. 1 .or. n .eq. 2) then
            sedgez(i,j,ke+1,n) = cvmgt(zero,s_d(ke+1),visc_coef .gt. 0.0)
          else
            sedgez(i,j,ke+1,n) = s_d(ke+1)
          endif
        elseif (BCZ_HI .eq. INLET) then
          sedgez(i,j,ke+1,n) = s(i,j,ke+1,n)
        elseif (BCZ_HI .eq. OUTLET) then
          sedgez(i,j,ke+1,n) = s_d(ke+1)
        endif

        if (velpred .eq. 1) then
          do k = ks, ke+1 
            wadv(i,j,k) = sedgez(i,j,k,3)
          enddo
        endif

        enddo
        enddo
       endif
      enddo

      return
      end
