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

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

#define DIMS lo_1,lo_2,hi_1,hi_2

c *************************************************************************
c ** LAPLAC **
c ** Compute the diffusive/viscous terms 
c ********************************************************************

      subroutine laplac(u,lapu,areax,areay,vol,DIMS,dx,
     $                  diff_coef,irz,bc,n)

      implicit none

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

c     Local variables
      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 r
      integer is, ie, js, je
      integer i,j

      is = lo_1
      ie = hi_1
      js = lo_2
      je = hi_2

      if (diff_coef .gt. zero) then

        do j = js, je
        do i = is, ie

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

            ux_rght = (u(i+1,j) - u(i,j)) 
            ux_rght_wall = -(-sixteen * u(ie+1,j) + twenty * u(ie,j) 
     $                          -five * u(ie-1,j) + u(ie-2,j) ) * 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) * ux_rght / dx(1)

            uy_bot = (u(i,j) - u(i,j-1)) 
            uy_bot_wall = (-sixteen * u(i,js-1) + twenty * u(i,js) 
     $                         -five * u(i,js+1) + u(i,js+2) ) * 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) * uy_bot / dx(2)

            uy_top = (u(i,j+1) - u(i,j)) 
            uy_top_wall = -(-sixteen * u(i,je+1) + twenty * u(i,je)
     $                          -five * u(i,je-1) + u(i,je-2) ) * 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) * uy_top / dx(2)

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

        enddo
        enddo

        if (n .eq. 0 .and. irz. eq. 1) then
          do j = js, je 
          do i = is, ie 
            r = (i+half)*dx(1)
            lapu(i,j) = lapu(i,j) - diff_coef*u(i,j)/(r*r)
          enddo
          enddo
        endif

      else

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

      endif

      return
      end
