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

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

#if BL_USE_FLOAT
#define twentyfive 25.e0
#define fifth 0.2
#else
#define twentyfive 25.d0
#define fifth 0.2d0
#endif

c *************************************************************************
c ** LAPLAC **
c ** Compute the viscous/diffusive terms for the momentum and scalar update
c ** equations
c ********************************************************************

      subroutine laplac(u,lapu,areax,areay,areaz,vol,DIMS,dx,diff_coef,bc)

      implicit none

      integer DIMS
      REAL_T      u(lo_1-3:hi_1+3,lo_2-3:hi_2+3,lo_3-3:hi_3+3)
      REAL_T   lapu(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T  areax(lo_1  :hi_1+1,lo_2  :hi_2  ,lo_3  :hi_3  )
      REAL_T  areay(lo_1  :hi_1  ,lo_2  :hi_2+1,lo_3  :hi_3  )
      REAL_T  areaz(lo_1  :hi_1  ,lo_2  :hi_2  ,lo_3  :hi_3+1)
      REAL_T    vol(lo_1-1:hi_1+1,lo_2-1:hi_2+1,lo_3-1:hi_3+1)
      REAL_T  dx(3)
      REAL_T  diff_coef
      integer bc(2,3)

c     Local variables
      REAL_T facx,facy,facz
      REAL_T ux_left,ux_left_wall
      REAL_T ux_rght,ux_rght_wall
      REAL_T uy_bot,uy_bot_wall
      REAL_T uy_top,uy_top_wall
      REAL_T uz_bot,uz_bot_wall
      REAL_T uz_top,uz_top_wall
      integer is, ie, js, je, ks, ke
      integer i,j,k

      is = lo_1
      ie = hi_1
      js = lo_2
      je = hi_2
      ks = lo_3
      ke = hi_3
      facx = one / (dx(1)*dx(1))
      facy = one / (dx(2)*dx(2))
      facz = one / (dx(3)*dx(3))

      if (diff_coef .gt. zero) then

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

            ux_left = (u(i,j,k) - u(i-1,j,k)) 
            ux_left_wall = (-sixteen * u(is-1,j,k) + twenty * u(is,j,k) 
     $                         -five * u(is+1,j,k) + u(is+2,j,k) ) * fifth
            ux_left = cvmgt(ux_left_wall, ux_left, i .eq. is .and.
     $                      (BCX_LO .eq. WALL .or. BCX_LO .eq. INLET) )
            ux_left = areax(i,j,k) * ux_left / dx(1)

            ux_rght = (u(i+1,j,k) - u(i,j,k)) 
            ux_rght_wall = -(-sixteen * u(ie+1,j,k) + twenty * u(ie,j,k)
     $                          -five * u(ie-1,j,k) + u(ie-2,j,k) ) * fifth
            ux_rght = cvmgt(ux_rght_wall, ux_rght, i .eq. ie .and.
     $                      (BCX_HI .eq. WALL .or. BCX_HI .eq. INLET) )
            ux_rght = areax(i+1,j,k) * ux_rght / dx(1)

            uy_bot = (u(i,j,k) - u(i,j-1,k)) 
            uy_bot_wall = (-sixteen * u(i,js-1,k) + twenty * u(i,js,k)
     $                        -five * u(i,js+1,k) + u(i,js+2,k) ) * fifth
            uy_bot = cvmgt(uy_bot_wall, uy_bot, j .eq. js .and.
     $                      (BCY_LO .eq. WALL .or. BCY_LO .eq. INLET) )
            uy_bot = areay(i,j,k) * uy_bot / dx(2)

            uy_top = (u(i,j+1,k) - u(i,j,k)) 
            uy_top_wall = -(-sixteen * u(i,je+1,k) + twenty * u(i,je,k)
     $                         -five * u(i,je-1,k) + u(i,je-2,k) ) * fifth
            uy_top = cvmgt(uy_top_wall, uy_top, j .eq. je .and.
     $                      (BCY_HI .eq. WALL .or. BCY_HI .eq. INLET) )
            uy_top = areay(i,j+1,k) * uy_top / dx(2)

            uz_bot = (u(i,j,k) - u(i,j,k-1)) 
            uz_bot_wall = (-sixteen * u(i,j,ks-1) + twenty * u(i,j,ks)
     $                        -five * u(i,j,ks+1) + u(i,j,ks+2) ) * fifth
            uz_bot = cvmgt(uz_bot_wall, uz_bot, k .eq. ks .and.
     $                      (BCZ_LO .eq. WALL .or. BCZ_LO .eq. INLET) )
            uz_bot = areaz(i,j,k) * uz_bot / dx(3)

            uz_top = (u(i,j,k+1) - u(i,j,k)) 
            uz_top_wall = -(-sixteen * u(i,j,ke+1) + twenty * u(i,j,ke)
     $                         -five * u(i,j,ke-1) + u(i,j,ke-2) ) * fifth
            uz_top = cvmgt(uz_top_wall, uz_top, k .eq. ke .and.
     $                      (BCZ_HI .eq. WALL .or. BCZ_HI .eq. INLET) )
            uz_top = areaz(i,j,k+1) * uz_top / dx(3)

            lapu(i,j,k) = diff_coef * 
     $          (ux_rght-ux_left+uy_top-uy_bot+uz_top-uz_bot) / vol(i,j,k)

        enddo
        enddo
        enddo

      else

        do k = ks, ke 
        do j = js, je 
        do i = is, ie 
            lapu(i,j,k) = zero
        enddo
        enddo
        enddo

      endif

      return
      end
