/*
** (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 ** MKADVVEL **
c ** Predict normal edge velocities to be MAC-projected and used
c **  for advection velocities
c ***************************************************************

      subroutine FORT_MKADVVEL(u,ux,uy,uz,v,vx,vy,vz,w,wx,wy,wz,
     $                         rho,force,px,py,pz,lapu,
     $                         dx,dt,DIMS,
     $                         stleft,strght,stbot,sttop,stdwn,stup,
     $                         uadv,vadv,wadv,utrans,vtrans,wtrans,
     $                         bcx_lo,bcx_hi,bcy_lo,bcy_hi,bcz_lo,bcz_hi,
     $                         visc_coef)

      implicit none

      integer DIMS

      REAL_T      u(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T     ux(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T     uy(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T     uz(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T      v(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T     vx(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T     vy(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T     vz(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T      w(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T     wx(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T     wy(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T     wz(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1: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  force(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,3)
      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  stleft(lo_1-1:hi_1+1)
      REAL_T  strght(lo_1-1:hi_1+1)
      REAL_T   stbot(lo_2-1:hi_2+1)
      REAL_T   sttop(lo_2-1:hi_2+1)
      REAL_T   stdwn(lo_3-1:hi_3+1)
      REAL_T    stup(lo_3-1:hi_3+1)

      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  dx(3)
      REAL_T  dt
      integer bcx_lo, bcx_hi, bcy_lo, bcy_hi, bcz_lo, bcz_hi
      REAL_T  visc_coef

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
      REAL_T ulft,urgt
      REAL_T vtop,vbot
      REAL_T wtop,wbot
      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 flgp,flgm

      REAL_T eps

      REAL_T umax,umin,vmax,vmin,wmax,wmin,rhomax,rhomin

      logical ltp,ltm,ltx,lty,ltz,ltm0,ltp0
      integer i,j,k,is,js,ks,ie,je,ke

      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)

      umax   = -1.e30
      vmax   = -1.e30
      wmax   = -1.e30
      rhomax = -1.e30
      umin   =  1.e30
      vmin   =  1.e30
      wmin   =  1.e30
      rhomin =  1.e30
      do k = lo_3, hi_3
      do j = lo_2, hi_2
      do i = lo_1, hi_1
         umax = max(u(i,j,k),umax)
         umin = min(u(i,j,k),umin)
         vmax = max(v(i,j,k),vmax)
         vmin = min(v(i,j,k),vmin)
         wmax = max(w(i,j,k),wmax)
         wmin = min(w(i,j,k),wmin)
         rhomax = max(rho(i,j,k),rhomax)
         rhomin = min(rho(i,j,k),rhomin)
      enddo
      enddo
      enddo

      write(6,1000) umax,umin
      write(6,1001) vmax,vmin
      write(6,1002) wmax,wmin
      write(6,1003) rhomax,rhomin

 1000 format(' U  MAX/MIN : ',e21.14,2x,e21.14)
 1001 format(' V  MAX/MIN : ',e21.14,2x,e21.14)
 1002 format(' W  MAX/MIN : ',e21.14,2x,e21.14)
 1003 format('RHO MAX/MIN : ',e21.14,2x,e21.14)

c     Create the z-velocity to be used for transverse derivatives.
      do k = ks,ke+1
        do j = js,je
        do i = is,ie

          wtop = w(i,j,k  ) - (half + dth*w(i,j,k  )/hz) * wz(i,j,k  )
c    $           + dth * lapu(i,j,k  ,3) / rho(i,j,k  )
          wbot = w(i,j,k-1) + (half - dth*w(i,j,k-1)/hz) * wz(i,j,k-1)
c    $           + dth * lapu(i,j,k-1,3) / rho(i,j,k-1)

          wtop = cvmgt(w(i,j,ks-1),wtop,k.eq.ks   .and. BCZ_LO .eq. INLET)
          wtop = cvmgt(w(i,j,ke+1),wtop,k.eq.ke+1 .and. BCZ_HI .eq. INLET)
          wtop = cvmgt(zero       ,wtop,k.eq.ks   .and. BCZ_LO .eq. WALL)
          wtop = cvmgt(zero       ,wtop,k.eq.ke+1 .and. BCZ_HI .eq. WALL)

          wbot = cvmgt(w(i,j,ks-1),wbot,k.eq.ks   .and. BCZ_LO .eq. INLET)
          wbot = cvmgt(w(i,j,ke+1),wbot,k.eq.ke+1 .and. BCZ_HI .eq. INLET)
          wbot = cvmgt(zero       ,wbot,k.eq.ks   .and. BCZ_LO .eq. WALL)
          wbot = cvmgt(zero       ,wbot,k.eq.ke+1 .and. BCZ_HI .eq. WALL)

          wtrans(i,j,k)=cvmgp(wbot,wtop,wbot+wtop)
          ltm = ( (wbot .le. zero  .and.  wtop .ge. zero)  .or.
     $             (abs(wbot+wtop) .lt. eps))
          wtrans(i,j,k) = cvmgt(zero,wtrans(i,j,k),ltm)

        enddo
        enddo
      enddo

c     Create the y-velocity to be used for transverse derivatives.
      do j = js,je+1
        do k = ks,ke
        do i = is,ie

          vtop = v(i,j ,k) - (half + dth*v(i,j,k)/hy) * vy(i,j,k)
c    $           + dth * lapu(i,j  ,k,2) / rho(i,j  ,k)
          vbot = v(i,j-1,k) + (half - dth*v(i,j-1,k)/hy) * vy(i,j-1,k)
c    $           + dth * lapu(i,j-1,k,2) / rho(i,j-1,k)

          vtop = cvmgt(v(i,js-1,k),vtop,j.eq.js   .and. BCY_LO .eq. INLET)
          vtop = cvmgt(v(i,je+1,k),vtop,j.eq.je+1 .and. BCY_HI .eq. INLET)
          vtop = cvmgt(zero       ,vtop,j.eq.js   .and. BCY_LO .eq. WALL)
          vtop = cvmgt(zero       ,vtop,j.eq.je+1 .and. BCY_HI .eq. WALL)

          vbot = cvmgt(v(i,js-1,k),vbot,j.eq.js   .and. BCY_LO .eq. INLET)
          vbot = cvmgt(v(i,je+1,k),vbot,j.eq.je+1 .and. BCY_HI .eq. INLET)
          vbot = cvmgt(zero       ,vbot,j.eq.js   .and. BCY_LO .eq. WALL)
          vbot = cvmgt(zero       ,vbot,j.eq.je+1 .and. BCY_HI .eq. WALL)

          vtrans(i,j,k)=cvmgp(vbot,vtop,vbot+vtop)
          ltm = ( (vbot .le. zero  .and.  vtop .ge. zero)  .or.
     $             (abs(vbot+vtop) .lt. eps))
          vtrans(i,j,k) = cvmgt(zero,vtrans(i,j,k),ltm)

        enddo
        enddo
      enddo

c     Create the x-velocity to be used for transverse derivatives.
      do k = ks,ke
      do j = js,je
        do i = is,ie+1

          urgt = u(i,j ,k) - (half + dth*u(i,j,k)/hx) * ux(i,j,k)
c    $           + dth * lapu(i  ,j,k,1) / rho(i  ,j,k)
          ulft = u(i-1,j,k) + (half - dth*u(i-1,j,k)/hx) * ux(i-1,j,k)
c    $           + dth * lapu(i-1,j,k,1) / rho(i-1,j,k)

          urgt = cvmgt(u(is-1,j,k),urgt,i.eq.is   .and. BCX_LO .eq. INLET)
          urgt = cvmgt(u(ie+1,j,k),urgt,i.eq.ie+1 .and. BCX_HI .eq. INLET)
          urgt = cvmgt(zero       ,urgt,i.eq.is   .and. BCX_LO .eq. WALL)
          urgt = cvmgt(zero       ,urgt,i.eq.ie+1 .and. BCX_HI .eq. WALL)

          ulft = cvmgt(u(is-1,j,k),ulft,i.eq.is   .and. BCX_LO .eq. INLET)
          ulft = cvmgt(u(ie+1,j,k),ulft,i.eq.ie+1 .and. BCX_HI .eq. INLET)
          ulft = cvmgt(zero       ,ulft,i.eq.is   .and. BCX_LO .eq. WALL)
          ulft = cvmgt(zero       ,ulft,i.eq.ie+1 .and. BCX_HI .eq. WALL)

          utrans(i,j,k) = cvmgp(ulft,urgt,ulft+urgt)
          ltm=( (ulft .le. zero  .and.  urgt .ge. zero)  .or.
     $          (abs(ulft+urgt) .lt. eps) )
          utrans(i,j,k) = cvmgt(zero,utrans(i,j,k),ltm)

        enddo
        enddo
      enddo

c ::: loop for x fluxes

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

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

          upbot = u(i,j  ,k) + (half - dth*v(i,j  ,k)/hy) * uy(i,j  ,k)
c    $            + dth * lapu(i,j  ,k,1) / rho(i,j  ,k)
          uptop = u(i,j+1,k) - (half + dth*v(i,j+1,k)/hy) * uy(i,j+1,k)
c    $            + dth * lapu(i,j+1,k,1) / rho(i,j+1,k)

          uptop = cvmgt(u(i,je+1,k),uptop,j.eq.je .and. bcy_hi.eq.INLET)
          upbot = cvmgt(u(i,je+1,k),upbot,j.eq.je .and. bcy_hi.eq.INLET)

          uptop = cvmgt(upbot,uptop,j.eq.je .and. bcy_hi.eq.WALL)

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

          flgp=cvmgt(zero,one,abs(vtrans(i,j+1,k)).lt.eps)
          uplus = cvmgp(upbot,uptop,vtrans(i,j+1,k))
          uplus = flgp * uplus + (one - flgp)*half*(uptop+upbot)

          umtop = u(i,j  ,k) - (half + dth*v(i,j  ,k)/hy) * uy(i,j,k)
c    $            + dth * lapu(i,j  ,k,1) / rho(i,j  ,k)
          umbot = u(i,j-1,k) + (half - dth*v(i,j-1,k)/hy) * uy(i,j-1,k)
c    $            + dth * lapu(i,j-1,k,1) / rho(i,j-1,k)

          umtop = cvmgt(u(i,js-1,k),umtop,j.eq.js .and. bcy_lo.eq.INLET)
          umbot = cvmgt(u(i,js-1,k),umbot,j.eq.js .and. bcy_lo.eq.INLET)

          umbot = cvmgt(umtop,umbot,j.eq.js .and. bcy_lo.eq.WALL)

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

          flgm=cvmgt(zero,one,abs(vtrans(i,j,k)).lt.eps)
          uminus = cvmgp(umbot,umtop,vtrans(i,j,k))
          uminus = flgm * uminus + (one - flgm)*half*(umtop+umbot)

          utr = half * (vtrans(i,j,k)+vtrans(i,j+1,k))*(uplus - uminus) / hy

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

          upbot = u(i,j,k  ) + (half - dth*w(i,j,k  )/hz) * uz(i,j,k  )
c    $            + dth * lapu(i,j,k  ,1) / rho(i,j,k  )
          uptop = u(i,j,k+1) - (half + dth*w(i,j,k+1)/hz) * uz(i,j,k+1)
c    $            + dth * lapu(i,j,k+1,1) / rho(i,j,k+1)

          uptop = cvmgt(u(i,j,ke+1),uptop,k.eq.ke .and. bcz_hi.eq.INLET)
          upbot = cvmgt(u(i,j,ke+1),upbot,k.eq.ke .and. bcz_hi.eq.INLET)

          uptop = cvmgt(upbot,uptop,k.eq.ke .and. bcz_hi.eq.WALL)

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

          flgp=cvmgt(zero,one,abs(wtrans(i,j,k+1)).lt.eps)
          uplus = cvmgp(upbot,uptop,wtrans(i,j,k+1))
          uplus = flgp * uplus + (one - flgp)*half*(uptop+upbot)

          umtop = u(i,j,k  ) - (half + dth*w(i,j,k  )/hz) * uz(i,j,k)
c    $            + dth * lapu(i,j,k  ,1) / rho(i,j,k  )
          umbot = u(i,j,k-1) + (half - dth*w(i,j,k-1)/hz) * uz(i,j,k-1)
c    $            + dth * lapu(i,j,k-1,1) / rho(i,j,k-1)

          umtop = cvmgt(u(i,j,ks-1),umtop,k.eq.ks .and. bcz_lo.eq.INLET)
          umbot = cvmgt(u(i,j,ks-1),umbot,k.eq.ks .and. bcz_lo.eq.INLET)

          umbot = cvmgt(umtop,umbot,k.eq.ks .and. bcz_lo.eq.WALL)

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

          flgm=cvmgt(zero,one,abs(wtrans(i,j,k)).lt.eps)
          uminus = cvmgp(umbot,umtop,wtrans(i,j,k))
          uminus = flgm * uminus + (one - flgm)*half*(umtop+umbot)

          utr = utr + half * (wtrans(i,j,k)+wtrans(i,j,k+1))*(uplus - uminus) / hz

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

          ut = (lapu(i,j,k,1)-px(i,j,k))/rho(i,j,k) - utr + force(i,j,k,1)

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

          stleft(i  )= u(i,j,k) + (half-ubardth)*ux(i,j,k) + dth*ut
          strght(i-1)= u(i,j,k) - (half+ubardth)*ux(i,j,k) + dth*ut

        enddo

        if (bcx_lo .eq. PERIODIC) then
          stleft(is-1) = stleft(ie  )
        elseif (bcx_lo .eq. WALL) then
          stleft(is-1) = zero
          strght(is-1) = zero
        elseif (bcx_lo .eq. INLET) then
          stleft(is-1) = u(is-1,j,k)
          strght(is-1) = u(is-1,j,k)
        elseif (bcx_lo .eq. OUTLET) then
          stleft(is-1) = strght(is-1)
        else
          print *,'bogus bcx_lo in mkadvvel ',bcx_lo
          stop
        endif

        if (bcx_hi .eq. PERIODIC) then
          strght(ie  ) = strght(is-1)
        elseif (bcx_hi .eq. WALL) then
          stleft(ie  ) = zero
          strght(ie  ) = zero
        elseif (bcx_hi .eq. INLET) then
          stleft(ie  ) = u(ie+1,j,k)
          strght(ie  ) = u(ie+1,j,k)
        elseif (bcx_hi .eq. OUTLET) then
          strght(ie  ) = stleft(ie)
        else
          print *,'bogus bcx_hi in mkadvvel ',bcx_hi
          stop
        endif

        do i = is-1, ie 

          savg = half*(strght(i) + stleft(i))
          ltx = ( (stleft(i) .le. zero  .and.  
     $             strght(i) .ge. zero)  .or.  
     $           (abs(stleft(i) + strght(i)) .lt. eps) )

          uadv(i+1,j,k)=cvmgp(stleft(i),strght(i),savg)
          uadv(i+1,j,k)=cvmgt(savg,uadv(i+1,j,k),ltx)

        enddo

        if (bcx_lo .eq. WALL) then
          uadv(is  ,j,k) = zero
        endif

        if (bcx_hi .eq. WALL) then
          uadv(ie+1,j,k) = 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        ******************************************************************

          vplft = v(i  ,j,k) + (half - dth*u(i  ,j,k)/hx) * vx(i  ,j,k)
c    $            + dth * lapu(i  ,j,k,2) / rho(i  ,j,k)
          vprgt = v(i+1,j,k) - (half + dth*u(i+1,j,k)/hx) * vx(i+1,j,k)
c    $            + dth * lapu(i+1,j,k,2) / rho(i+1,j,k)

          ltp0 = (i .eq. ie  .and.  bcx_hi .eq. INLET)
          vprgt = cvmgt(v(ie+1,j,k),vprgt,ltp0)
          vplft = cvmgt(v(ie+1,j,k),vplft,ltp0)

          ltp0 = (i .eq. ie  .and.  bcx_hi .eq. WALL)
          vprgt = cvmgt(vplft,vprgt,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)

          flgp=cvmgt(zero,one,abs(utrans(i+1,j,k)).lt.eps)
          vplus = cvmgp(vplft,vprgt,utrans(i+1,j,k))
          vplus = flgp * vplus + (one - flgp)*half*(vprgt+vplft)

          vmrgt = v(i  ,j,k) - (half + dth*u(i  ,j,k)/hx) * vx(i  ,j,k)
c    $            + dth * lapu(i  ,j,k,2) / rho(i  ,j,k)
          vmlft = v(i-1,j,k) + (half - dth*u(i-1,j,k)/hx) * vx(i-1,j,k)
c    $            + dth * lapu(i-1,j,k,2) / rho(i-1,j,k)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. INLET)
          vmrgt = cvmgt(v(is-1,j,k),vmrgt,ltm0)
          vmlft = cvmgt(v(is-1,j,k),vmlft,ltm0)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. WALL)
          vmlft = cvmgt(vmrgt,vmlft,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)

          flgm=cvmgt(zero,one,abs(utrans(i,j,k)).lt.eps)
          vminus = cvmgp(vmlft,vmrgt,utrans(i,j,k))
          vminus = flgm * vminus + (one - flgm)*half*(vmrgt+vmlft)

          vtr = half * (utrans(i,j,k)+utrans(i+1,j,k))*(vplus - vminus) / hx


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

          vplft = v(i,j,k  ) + (half - dth*w(i,j,k  )/hz) * vz(i,j,k  )
c    $            + dth * lapu(i,j,k  ,2) / rho(i,j,k  )
          vprgt = v(i,j,k+1) - (half + dth*w(i,j,k+1)/hz) * vz(i,j,k+1)
c    $            + dth * lapu(i,j,k+1,2) / rho(i,j,k+1)

          ltp0 = (k .eq. ke  .and.  bcz_hi .eq. INLET)
          uptop = cvmgt(u(i,j,ke+1),uptop,ltp0)
          upbot = cvmgt(u(i,j,ke+1),upbot,ltp0)

          ltp0 = (k .eq. ke  .and.  bcz_hi .eq. WALL)
          vprgt = cvmgt(vplft,vprgt,ltp0)

          ltp0 = (k .eq. ke  .and.  bcz_hi .eq. WALL  .and.  visc_coef .gt. zero)
          vprgt = cvmgt(zero,vprgt,ltp0)
          vplft = cvmgt(zero,vplft,ltp0)

          flgp=cvmgt(zero,one,abs(wtrans(i,j,k+1)).lt.eps)
          vplus = cvmgp(vplft,vprgt,wtrans(i,j,k+1))
          vplus = flgp * vplus + (one - flgp)*half*(vprgt+vplft)

          vmrgt = v(i,j,k  ) - (half + dth*w(i,j,k  )/hz) * vz(i,j,k  )
c    $            + dth * lapu(i,j,k  ,2) / rho(i,j,k  )
          vmlft = v(i,j,k-1) + (half - dth*w(i,j,k-1)/hz) * vz(i,j,k-1)
c    $            + dth * lapu(i,j,k-1,2) / rho(i,j,k-1)

          ltm0 = (k .eq. ks  .and.  bcz_lo .eq. INLET)
          vmrgt = cvmgt(v(i,j,ks-1),vmrgt,ltm0)
          vmlft = cvmgt(v(i,j,ks-1),vmlft,ltm0)

          ltm0 = (k .eq. ks  .and.  bcz_lo .eq. WALL)
          vmlft = cvmgt(vmrgt,vmlft,ltm0)

          ltm0 = (k .eq. ks  .and.  bcz_lo .eq. WALL  .and.  visc_coef .gt. zero)
          vmrgt = cvmgt(zero,vmrgt,ltm0)
          vmlft = cvmgt(zero,vmlft,ltm0)

          flgm=cvmgt(zero,one,abs(wtrans(i,j,k)).lt.eps)
          vminus = cvmgp(vmlft,vmrgt,wtrans(i,j,k))
          vminus = flgm * vminus + (one - flgm)*half*(vmrgt+vmlft)

          vtr = vtr + half * (wtrans(i,j,k)+wtrans(i,j,k+1))*(vplus - vminus) / hz

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

          vt = (lapu(i,j,k,2)-py(i,j,k))/rho(i,j,k) - vtr + force(i,j,k,2)
          vbardth = dth*v(i,j,k)/hy

          stbot(j  )= v(i,j,k) + (half-vbardth)*vy(i,j,k) + dth*vt
          sttop(j-1)= v(i,j,k) - (half+vbardth)*vy(i,j,k) + dth*vt

        enddo

        if (bcy_lo .eq. PERIODIC) then
          stbot(js-1) = stbot(je  )
        elseif (bcy_lo .eq. WALL) then
          stbot(js-1) = zero
          sttop(js-1) = zero
        elseif (bcy_lo .eq. INLET) then
          stbot(js-1) = v(i,js-1,k)
          sttop(js-1) = v(i,js-1,k)
        elseif (bcy_lo .eq. OUTLET) then
          stbot(js-1) = sttop(js-1)
        else
          print *,'bogus bcy_lo in mkadvvel ',bcy_lo
          stop
        endif

        if (bcy_hi .eq. PERIODIC) then
          sttop(je  ) = sttop(js-1)
        elseif (bcy_hi .eq. WALL) then
          stbot(je  ) = zero
          sttop(je  ) = zero
        elseif (bcy_hi .eq. INLET) then
          sttop(je  ) = v(i,je+1,k)
          sttop(je  ) = v(i,je+1,k)
        elseif (bcy_hi .eq. OUTLET) then
          sttop(je  ) = stbot(je)
        else
          print *,'bogus bcy_hi in mkadvvel ',bcy_hi
          stop
        endif

        do j = js-1, je 
          savg = half*(stbot(j)+sttop(j))
          lty = ( (stbot(j) .le. zero  .and.  sttop(j) .ge. zero) .or.
     $            (abs(stbot(j) + sttop(j)) .lt. eps) )

          vadv(i,j+1,k)=cvmgp(stbot(j),sttop(j),savg)
          vadv(i,j+1,k)=cvmgt(savg,vadv(i,j+1,k),lty)

        enddo

        if (bcy_lo .eq. WALL) then
          vadv(i,js  ,k) = zero
        endif

        if (bcy_hi .eq. WALL) then
          vadv(i,je+1,k) = 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 = w(i  ,j,k) + (half - dth*u(i  ,j,k)/hx) * wx(i  ,j,k)
c    $            + dth * lapu(i  ,j,k,3) / rho(i  ,j,k)
          wprgt = w(i+1,j,k) - (half + dth*u(i+1,j,k)/hx) * wx(i+1,j,k)
c    $            + dth * lapu(i+1,j,k,3) / rho(i+1,j,k)

          ltp0 = (i .eq. ie  .and.  bcx_hi .eq. INLET)
          wprgt = cvmgt(w(ie+1,j,k),wprgt,ltp0)
          wplft = cvmgt(w(ie+1,j,k),wplft,ltp0)

          ltp0 = (i .eq. ie  .and.  bcx_hi .eq. WALL)
          wprgt = cvmgt(wplft,wprgt,ltp0)

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

          flgp=cvmgt(zero,one,abs(utrans(i+1,j,k)).lt.eps)
          wplus = cvmgp(wplft,wprgt,utrans(i+1,j,k))
          wplus = flgp * wplus + (one - flgp)*half*(wprgt+wplft)

          wmrgt = w(i  ,j,k) - (half + dth*u(i  ,j,k)/hx) * wx(i  ,j,k)
c    $            + dth * lapu(i  ,j,k,3) / rho(i  ,j,k)
          wmlft = w(i-1,j,k) + (half - dth*u(i-1,j,k)/hx) * wx(i-1,j,k)
c    $            + dth * lapu(i-1,j,k,3) / rho(i-1,j,k)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. INLET)
          wmrgt = cvmgt(w(is-1,j,k),wmrgt,ltm0)
          wmlft = cvmgt(w(is-1,j,k),wmlft,ltm0)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. WALL)
          wmlft = cvmgt(wmrgt,wmlft,ltm0)

          ltm0 = (i .eq. is  .and.  bcx_lo .eq. WALL  .and.  visc_coef .gt. zero)
          wmrgt = cvmgt(zero,wmrgt,ltm0)
          wmlft = cvmgt(zero,wmlft,ltm0)

          flgm=cvmgt(zero,one,abs(utrans(i,j,k)).lt.eps)
          wminus = cvmgp(wmlft,wmrgt,utrans(i,j,k))
          wminus = flgm * wminus + (one - flgm)*half*(wmrgt+wmlft)

          wtr = half * (utrans(i,j,k)+utrans(i+1,j,k))*(wplus - wminus) / hx

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

          wpbot = w(i,j  ,k) + (half - dth*v(i,j  ,k)/hy) * wy(i,j  ,k)
c    $            + dth * lapu(i,j  ,k,3) / rho(i,j  ,k)
          wptop = w(i,j+1,k) - (half + dth*v(i,j+1,k)/hy) * wy(i,j+1,k)
c    $            + dth * lapu(i,j+1,k,3) / rho(i,j+1,k)

          ltp0 = (j .eq. je  .and.  bcy_hi .eq. INLET)
          wptop = cvmgt(w(i,je+1,k),wptop,ltp0)
          wpbot = cvmgt(w(i,je+1,k),wpbot,ltp0)

          ltp0 = (j .eq. je  .and.  bcy_hi .eq. WALL)
          wptop = cvmgt(wpbot,wptop,ltp0)

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

          flgp=cvmgt(zero,one,abs(vtrans(i,j+1,k)).lt.eps)
          wplus = cvmgp(wpbot,wptop,vtrans(i,j+1,k))
          wplus = flgp * wplus + (one - flgp)*half*(wptop+wpbot)

          wmtop = w(i,j  ,k) - (half + dth*v(i,j  ,k)/hy) * wy(i,j  ,k)
c    $            + dth * lapu(i,j  ,k,3) / rho(i,j  ,k)
          wmbot = w(i,j-1,k) + (half - dth*v(i,j-1,k)/hy) * wy(i,j-1,k)
c    $            + dth * lapu(i,j-1,k,3) / rho(i,j-1,k)

          ltm0 = (j .eq. js  .and.  bcy_lo .eq. INLET)
          wmtop = cvmgt(w(i,js-1,k),wmtop,ltm0)
          wmbot = cvmgt(w(i,js-1,k),wmbot,ltm0)

          ltm0 = (j .eq. js  .and.  bcy_lo .eq. WALL)
          wmbot = cvmgt(wmtop,wmbot,ltm0)

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

          flgm=cvmgt(zero,one,abs(vtrans(i,j,k)).lt.eps)
          wminus = cvmgp(wmbot,wmtop,vtrans(i,j,k))
          wminus = flgm * wminus + (one - flgm)*half*(wmtop+wmbot)

          wtr = wtr + half * (vtrans(i,j,k)+vtrans(i,j+1,k))*(wplus - wminus) / hy

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

          wt = (lapu(i,j,k,3)-pz(i,j,k))/rho(i,j,k) - wtr + force(i,j,k,3)
          wbardth = dth*w(i,j,k)/hz

          stdwn(k  )= w(i,j,k) + (half-wbardth)*wz(i,j,k) + dth*wt
           stup(k-1)= w(i,j,k) - (half+wbardth)*wz(i,j,k) + dth*wt

        enddo

        if (bcz_lo .eq. PERIODIC) then
          stdwn(ks-1) = stdwn(ke  )
        elseif (bcz_lo .eq. WALL) then
          stdwn(ks-1) = zero
           stup(ks-1) = zero
        elseif (bcz_lo .eq. INLET) then
          stdwn(ks-1) = w(i,j,ks-1)
           stup(ks-1) = w(i,j,ks-1)
        elseif (bcz_lo .eq. OUTLET) then
          stdwn(ks-1) = stup(ks-1)
        else
          print *,'bogus bcz_lo in mkadvvel ',bcz_lo
          stop
        endif

        if (bcz_hi .eq. PERIODIC) then
           stup(ke  ) =  stup(ks-1)
        elseif (bcz_hi .eq. WALL) then
          stdwn(ke  ) = zero
           stup(ke  ) = zero
        elseif (bcz_hi .eq. INLET) then
          stdwn(ke  ) = w(i,j,ke+1)
           stup(ke  ) = w(i,j,ke+1)
        elseif (bcz_hi .eq. OUTLET) then
           stup(ke  ) = stdwn(ke)
        else
          print *,'bogus bcz_hi in mkadvvel ',bcz_hi
          stop
        endif

        do k = ks-1, ke 
          savg = half*(stdwn(k)+stup(k))
          ltz = ( (stdwn(k) .le. zero  .and.  stup(k) .ge. zero) .or.
     $            (abs(stdwn(k) + stup(k)) .lt. eps) )

          wadv(i,j,k+1)=cvmgp(stdwn(k),stup(k),savg)
          wadv(i,j,k+1)=cvmgt(savg,wadv(i,j,k+1),ltz)
        enddo

        if (bcz_lo .eq. WALL) then
          wadv(i,j,ks  ) = zero
        endif

        if (bcz_hi .eq. WALL) then
          wadv(i,j,ke+1) = zero
        endif

      enddo
      enddo

      return
      end
