/*
** (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,DIMS,dx,diff_coef,
     $                  bcx_lo,bcx_hi,bcy_lo,bcy_hi,bcz_lo,bcz_hi)

      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   lapu(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 bcx_lo,bcx_hi
      integer bcy_lo,bcy_hi
      integer bcz_lo,bcz_hi

c     Local variables
      REAL_T facx,facy,facz
      REAL_T uxx, uxx_lo, uxx_hi
      REAL_T uyy, uyy_lo, uyy_hi
      REAL_T uzz, uzz_lo, uzz_hi
      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 

            uxx = ( u(i+1,j,k) - two * u(i,j,k) + u(i-1,j,k) )
            uyy = ( u(i,j+1,k) - two * u(i,j,k) + u(i,j-1,k) )
            uzz = ( u(i,j,k+1) - two * u(i,j,k) + u(i,j,k-1) )

            uxx_hi = (sixteen * u(ie+1,j,k) - twentyfive * u(ie,j,k) +
     $                    ten * u(ie-1,j,k) - u(ie-2,j,k) ) * fifth
            uxx_lo = (sixteen * u(is-1,j,k) - twentyfive * u(is,j,k) +
     $                    ten * u(is+1,j,k) - u(is+2,j,k) ) * fifth

            uxx = cvmgt(uxx_hi, uxx, i .eq. ie .and. 
     $                  (bcx_hi .eq. WALL .or. bcx_hi .eq. INLET) )
            uxx = cvmgt(uxx_lo, uxx, i .eq. is .and.
     $                  (bcx_lo .eq. WALL .or. bcx_lo .eq. INLET) )

            uyy_hi = (sixteen * u(i,je+1,k) - twentyfive * u(i,je,k) +
     $                    ten * u(i,je-1,k) - u(i,je-2,k) ) * fifth
            uyy_lo = (sixteen * u(i,js-1,k) - twentyfive * u(i,js,k) +
     $                    ten * u(i,js+1,k) - u(i,js+2,k) ) * fifth

            uyy = cvmgt(uyy_hi, uyy, j .eq. je .and. 
     $                  (bcy_hi .eq. WALL .or. bcy_hi .eq. INLET) )
            uyy = cvmgt(uyy_lo, uyy, j .eq. js .and. 
     $                  (bcy_lo .eq. WALL .or. bcy_lo .eq. INLET) )

            uzz_hi = (sixteen * u(i,j,ke+1) - twentyfive * u(i,j,ke) +
     $                    ten * u(i,j,ke-1) - u(i,j,ke-2) ) * fifth
            uzz_lo = (sixteen * u(i,j,ks-1) - twentyfive * u(i,j,ks) +
     $                    ten * u(i,j,ks+1) - u(i,j,ks+2) ) * fifth

            uzz = cvmgt(uzz_hi, uzz, k .eq. ke .and.
     $                  (bcz_hi .eq. WALL .or. bcz_hi .eq. INLET) )
            uzz = cvmgt(uzz_lo, uzz, k .eq. ks .and.
     $                  (bcz_lo .eq. WALL .or. bcz_lo .eq. INLET) )

            lapu(i,j,k) = (uxx*facx + uyy*facy + uzz*facz) * diff_coef

        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

      if (bcx_lo .eq. PERIODIC) then
        do k = ks,ke
        do j = js,je
          lapu(is-1,j,k) = lapu(ie,j,k)
          lapu(ie+1,j,k) = lapu(is,j,k)
        enddo
        enddo
      endif

      if (bcy_lo .eq. PERIODIC) then
        do k = ks,ke
        do i = is,ie
          lapu(i,js-1,k) = lapu(i,je,k)
          lapu(i,je+1,k) = lapu(i,js,k)
        enddo
        enddo
      endif

      if (bcz_lo .eq. PERIODIC) then
        do j = js,je
        do i = is,ie
          lapu(i,j,ks-1) = lapu(i,j,ke)
          lapu(i,j,ke+1) = lapu(i,j,ks)
        enddo
        enddo
      endif

      if (bcx_lo .eq. PERIODIC .and. bcy_lo .eq. PERIODIC) then
        do k = ks,ke
          lapu(is-1,js-1,k) = lapu(ie,je,k)
          lapu(is-1,je+1,k) = lapu(ie,js,k)
          lapu(ie+1,js-1,k) = lapu(is,je,k)
          lapu(ie+1,je+1,k) = lapu(is,js,k)
        enddo
      endif

      if (bcx_lo .eq. PERIODIC .and. bcz_lo .eq. PERIODIC) then
        do j = js,je
          lapu(is-1,j,ks-1) = lapu(ie,j,ke)
          lapu(is-1,j,ke+1) = lapu(ie,j,ks)
          lapu(ie+1,j,ks-1) = lapu(is,j,ke)
          lapu(ie+1,j,ke+1) = lapu(is,j,ks)
        enddo
      endif

      if (bcy_lo .eq. PERIODIC .and. bcz_lo .eq. PERIODIC) then
        do i = is,ie
          lapu(i,js-1,ks-1) = lapu(i,je,ke)
          lapu(i,js-1,ke+1) = lapu(i,je,ks)
          lapu(i,je+1,ks-1) = lapu(i,js,ke)
          lapu(i,je+1,ke+1) = lapu(i,js,ks)
        enddo
      endif

      if (bcx_lo .eq. PERIODIC .and. bcy_lo .eq. PERIODIC .and. bcz_lo .eq. PERIODIC) then
          lapu(is-1,js-1,ks-1) = lapu(ie,je,ke)
          lapu(ie+1,js-1,ks-1) = lapu(is,je,ke)
          lapu(is-1,je+1,ks-1) = lapu(ie,js,ke)
          lapu(ie+1,je+1,ks-1) = lapu(is,js,ke)
          lapu(is-1,js-1,ke+1) = lapu(ie,je,ks)
          lapu(ie+1,js-1,ke+1) = lapu(is,je,ks)
          lapu(is-1,je+1,ke+1) = lapu(ie,js,ks)
          lapu(ie+1,je+1,ke+1) = lapu(is,js,ks)
      endif


      return
      end
