/*
** (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,hi_1,hi_2

c *************************************************************************
c ** MKUTRANS **
c ** Construct the velocities to be used in defining transverse derivatives.
c ***************************************************************

      subroutine FORT_MKUTRANS(utrans,vtrans,vel,velx,vely,force,
     $                         dx,dt,DIMS,bc)

      implicit none

      integer DIMS

      REAL_T utrans(lo_1-1:hi_1+2,lo_2-1:hi_2+1)
      REAL_T vtrans(lo_1-1:hi_1+1,lo_2-1:hi_2+2)
      REAL_T    vel(lo_1-3:hi_1+3,lo_2-3:hi_2+3,2)
      REAL_T   velx(lo_1-1:hi_1+1,lo_2-1:hi_2+1,2)
      REAL_T   vely(lo_1-1:hi_1+1,lo_2-1:hi_2+1,2)
      REAL_T  force(lo_1-1:hi_1+1,lo_2-1:hi_2+1,2)
      REAL_T  dx(2)
      REAL_T  dt
      integer bc(2,2)

c     Local variables
      REAL_T hx,hy,dth
      REAL_T ulft,urgt,vbot,vtop
      REAL_T eps

      integer i,j,is,js,ie,je
      logical test

      eps = 1.0e-8

      is = lo_1
      ie = hi_1
      js = lo_2
      je = hi_2
      dth = half*dt
      hx = dx(1)
      hy = dx(2)

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

          urgt = vel(i  ,j,1) - (half + dth*vel(i  ,j,1)/hx) * velx(i  ,j,1)
c    $           + dth * force(i  ,j,1)
          ulft = vel(i-1,j,1) + (half - dth*vel(i-1,j,1)/hx) * velx(i-1,j,1)
c    $           + dth * force(i-1,j,1)

          urgt = cvmgt(vel(is-1,j,1),urgt,i.eq.is   .and. BCX_LO .eq. INLET)
          urgt = cvmgt(vel(ie+1,j,1),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(vel(is-1,j,1),ulft,i.eq.is   .and. BCX_LO .eq. INLET)
          ulft = cvmgt(vel(ie+1,j,1),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) = cvmgp(ulft,urgt,ulft+urgt)
          test = ( (ulft .le. zero  .and.  urgt .ge. zero)  .or.  
     $             (abs(ulft+urgt) .lt. eps) )
          utrans(i,j) = cvmgt(zero,utrans(i,j),test)

        enddo
      enddo

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

          vtop = vel(i,j  ,2) - (half + dth*vel(i,j  ,2)/hy) * vely(i,j  ,2)
c    $           + dth * force(i,j  ,2)
          vbot = vel(i,j-1,2) + (half - dth*vel(i,j-1,2)/hy) * vely(i,j-1,2)
c    $           + dth * force(i,j-1,2)

          vtop = cvmgt(vel(i,js-1,2),vtop,j.eq.js   .and. BCY_LO .eq. INLET)
          vtop = cvmgt(vel(i,je+1,2),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(vel(i,js-1,2),vbot,j.eq.js   .and. BCY_LO .eq. INLET)
          vbot = cvmgt(vel(i,je+1,2),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)=cvmgp(vbot,vtop,vbot+vtop)
          test = ( (vbot .le. zero  .and.  vtop .ge. zero)  .or.  
     $             (abs(vbot+vtop) .lt. eps))
          vtrans(i,j) = cvmgt(zero,vtrans(i,j),test)
        enddo
      enddo

      return
      end
