/*
** (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"

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

c *************************************************************************
c ** VELUPD **
c ** Update the velocity components using convective differencing of fluxes
c ** This field will then be projected to enforce the divergence constraint.
c *************************************************************************

      subroutine FORT_VELUPD(u,v,w,ustar,vstar,wstar,lapu,gradp,rhomid,
     $                       uadv,vadv,wadv,uhalfx,uhalfy,uhalfz,
     $                       force,dt,DIMS,dx)

      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       v(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   ustar(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T   vstar(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T   wstar(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   gradp(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,3)
      REAL_T  rhomid(lo_1-1:hi_1+1,lo_2-1:hi_2+1,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  uhalfx(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,3)
      REAL_T  uhalfy(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1,3)
      REAL_T  uhalfz(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 dt
      REAL_T dx(3)

c     Local variables
      integer i, j, k
      REAL_T ubar, vbar, wbar
      REAL_T ugradu, ugradv, ugradw

      do k = lo_3,hi_3 
       do j = lo_2,hi_2 
        do i = lo_1,hi_1 

          ubar = half*(uadv(i,j,k) + uadv(i+1,j,k))
          vbar = half*(vadv(i,j,k) + vadv(i,j+1,k))
          wbar = half*(wadv(i,j,k) + wadv(i,j,k+1))

          ugradu = ubar*(uhalfx(i+1,j,k,1) - uhalfx(i,j,k,1))/dx(1) + 
     $             vbar*(uhalfy(i,j+1,k,1) - uhalfy(i,j,k,1))/dx(2) +
     $             wbar*(uhalfz(i,j,k+1,1) - uhalfz(i,j,k,1))/dx(3)

          ugradv = ubar*(uhalfx(i+1,j,k,2) - uhalfx(i,j,k,2))/dx(1) + 
     $             vbar*(uhalfy(i,j+1,k,2) - uhalfy(i,j,k,2))/dx(2) +
     $             wbar*(uhalfz(i,j,k+1,2) - uhalfz(i,j,k,2))/dx(3)

          ugradw = ubar*(uhalfx(i+1,j,k,3) - uhalfx(i,j,k,3))/dx(1) + 
     $             vbar*(uhalfy(i,j+1,k,3) - uhalfy(i,j,k,3))/dx(2) +
     $             wbar*(uhalfz(i,j,k+1,3) - uhalfz(i,j,k,3))/dx(3)

          ustar(i,j,k) = u(i,j,k) + dt * ( half*lapu(i,j,k,1)/rhomid(i,j,k) 
     $                 - gradp(i,j,k,1)/rhomid(i,j,k) - ugradu + force(i,j,k,1) )

          vstar(i,j,k) = v(i,j,k) + dt * ( half*lapu(i,j,k,2)/rhomid(i,j,k) 
     $                 - gradp(i,j,k,2)/rhomid(i,j,k) - ugradv + force(i,j,k,2) )

          wstar(i,j,k) = w(i,j,k) + dt * ( half*lapu(i,j,k,3)/rhomid(i,j,k) 
     $                 - gradp(i,j,k,3)/rhomid(i,j,k) - ugradw + force(i,j,k,3) )

        enddo
       enddo
      enddo

      return
      end
