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

c *************************************************************************
c ** SETVELBC **
c ** Impose the physical boundary conditions on the velocity (u,v)
c *************************************************************************

      subroutine setvelbc(u,v,w,DIMS,bcx_lo,bcx_hi,bcy_lo,bcy_hi,bcz_lo,bcz_hi,
     $                    visc_coef,dx,time)

      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)
      integer bcx_lo,bcx_hi
      integer bcy_lo,bcy_hi
      integer bcz_lo,bcz_hi
      REAL_T visc_coef
      REAL_T dx(3)
      REAL_T time

c     Local variables
      integer is,ie,js,je,ks,ke,i,j,k

      is = lo_1
      ie = hi_1
      js = lo_2
      je = hi_2
      ks = lo_3
      ke = hi_3

      if (bcz_lo .eq. PERIODIC) then

        do j = js,je 
        do i = is,ie 
          u(i,j,ks-1) = u(i,j,ke)
          v(i,j,ks-1) = v(i,j,ke)
          w(i,j,ks-1) = w(i,j,ke)
        enddo
        enddo

      elseif (bcz_lo .eq. WALL) then

c ::: REMEMBER -  THESE VALUES NOW LIVE ON CELL EDGES

        do j = js,je 
        do i = is,ie 
          w(i,j,ks-1) = zero
          u(i,j,ks-1) = (fifteen*u(i,j,ks  ) - ten*u(i,j,ks+1) + 
     $                     three*u(i,j,ks+2)) / eight
          v(i,j,ks-1) = (fifteen*v(i,j,ks  ) - ten*v(i,j,ks+1) + 
     $                     three*v(i,j,ks+2)) / eight
        enddo
        enddo

        if (visc_coef .gt. zero) then
          do j = js,je 
          do i = is,ie 
            u(i,j,ks-1) = zero
            v(i,j,ks-1) = zero
          enddo
          enddo
        endif

      elseif (bcz_lo .eq. INLET) then

        call velinflow(w,DIMS,time,2,0)

        do j = js,je
        do i = is,ie 
          u(i,j,ks-1) = zero
          v(i,j,ks-1) = zero
        enddo
        enddo

      elseif (bcz_lo .eq. OUTLET) then

        do j = js,je
        do i = is,ie 
          u(i,j,ks-1) = u(i,j,ks)
          v(i,j,ks-1) = v(i,j,ks)
          w(i,j,ks-1) = w(i,j,ks)
        enddo
        enddo

      else

        print *,'bogus bcz_lo in setvelbc ',bcz_lo
        stop

      endif

      if (bcz_hi .eq. PERIODIC) then

        do j = js,je 
        do i = is,ie 
          u(i,j,ke+1) = u(i,j,ks)
          v(i,j,ke+1) = v(i,j,ks)
          w(i,j,ke+1) = w(i,j,ks)
        enddo
        enddo

      elseif (bcz_hi .eq. WALL) then

c ::: REMEMBER -  THESE VALUES NOW LIVE ON CELL EDGES

        do j = js,je 
        do i = is,ie 
          w(i,j,ke+1) = zero
          u(i,j,ke+1) = (fifteen*u(i,j,ke  ) - ten*u(i,j,ke-1) + 
     $                     three*u(i,j,ke-2)) / eight
          v(i,j,ke+1) = (fifteen*v(i,j,ke  ) - ten*v(i,j,ke-1) + 
     $                     three*v(i,j,ke-2)) / eight
        enddo
        enddo

        if (visc_coef .gt. zero) then
          do j = js,je 
          do i = is,ie 
            u(i,j,ke+1) = zero
            v(i,j,ke+1) = zero
          enddo
          enddo
        endif

      elseif (bcz_hi .eq. INLET) then

        call velinflow(w,DIMS,time,2,1)

        do j = js,je
        do i = is,ie 
          u(i,j,ke+1) = zero
          v(i,j,ke+1) = zero
        enddo
        enddo

      elseif (bcz_hi .eq. OUTLET) then

        do j = js,je
        do i = is,ie 
          u(i,j,ke+1) = u(i,j,ke)
          v(i,j,ke+1) = v(i,j,ke)
          w(i,j,ke+1) = w(i,j,ke)
        enddo
        enddo

      else

        print *,'bogus bcz_hi in setvelbc ',bcz_hi
        stop

      endif

      if (bcy_lo .eq. PERIODIC) then

        do k = ks-1,ke+1 
        do i = is,ie 
          u(i,js-1,k) = u(i,je,k)
          v(i,js-1,k) = v(i,je,k)
          w(i,js-1,k) = w(i,je,k)
        enddo
        enddo

      elseif (bcy_lo .eq. WALL) then


c ::: REMEMBER -  THESE VALUES NOW LIVE ON CELL EDGES

        do k = ks-1,ke+1 
        do i = is,ie 
          v(i,js-1,k) = zero
          u(i,js-1,k) = (fifteen*u(i,js  ,k) - ten*u(i,js+1,k) + 
     $                     three*u(i,js+2,k)) / eight
          w(i,js-1,k) = (fifteen*w(i,js  ,k) - ten*w(i,js+1,k) + 
     $                     three*w(i,js+2,k)) / eight
        enddo
        enddo

        if (visc_coef .gt. zero) then
          do k = ks-1,ke+1 
          do i = is,ie 
            u(i,js-1,k) = zero
            w(i,js-1,k) = zero
          enddo
          enddo
        endif

      elseif (bcy_lo .eq. INLET) then

        call velinflow(v,DIMS,time,1,0)

        do k = ks-1,ke+1
        do i = is,ie 
          u(i,js-1,k) = zero
          w(i,js-1,k) = zero
        enddo
        enddo

      elseif (bcy_lo .eq. OUTLET) then

        do k = ks-1,ke+1
        do i = is,ie 
          u(i,js-1,k) = u(i,js,k)
          v(i,js-1,k) = v(i,js,k)
          w(i,js-1,k) = w(i,js,k)
        enddo
        enddo

      else

        print *,'bogus bcy_lo in setvelbc ', bcy_lo
        stop

      endif

      if (bcy_hi .eq. PERIODIC) then

        do k = ks-1,ke+1 
        do i = is,ie 
          u(i,je+1,k) = u(i,js,k)
          v(i,je+1,k) = v(i,js,k)
          w(i,je+1,k) = w(i,js,k)
        enddo
        enddo

      elseif (bcy_hi .eq. WALL) then


c ::: REMEMBER -  THESE VALUES NOW LIVE ON CELL EDGES

        do k = ks-1,ke+1 
        do i = is,ie 
          v(i,je+1,k) = zero
          u(i,je+1,k) = (fifteen*u(i,je  ,k) - ten*u(i,je-1,k) + 
     $                     three*u(i,je-2,k)) / eight
          w(i,je+1,k) = (fifteen*w(i,je  ,k) - ten*w(i,je-1,k) + 
     $                     three*w(i,je-2,k)) / eight
        enddo
        enddo

        if (visc_coef .gt. zero) then
          do k = ks-1,ke+1 
          do i = is,ie 
            u(i,je+1,k) = zero
            w(i,je+1,k) = zero
          enddo
          enddo
        endif

      elseif (bcy_hi .eq. INLET) then

        call velinflow(v,DIMS,time,1,1)

        do k = ks-1,ke+1
        do i = is,ie 
          u(i,je+1,k) = zero
          w(i,je+1,k) = zero
        enddo
        enddo

      elseif (bcy_hi .eq. OUTLET) then

        do k = ks-1,ke+1
        do i = is,ie 
          u(i,je+1,k) = u(i,je,k)
          v(i,je+1,k) = v(i,je,k)
          w(i,je+1,k) = w(i,je,k)
        enddo
        enddo

      else

        print *,'bogus bcy_hi in setvelbc ',bcy_hi
        stop

      endif

      if (bcx_lo .eq. PERIODIC) then

        do k = ks-1,ke+1 
        do j = js-1,je+1 
             u(is-1,j,k) =    u(ie,j,k)
             v(is-1,j,k) =    v(ie,j,k)
             w(is-1,j,k) =    w(ie,j,k)
        enddo
        enddo

      elseif (bcx_lo .eq. WALL) then

c ::: REMEMBER -  THESE VALUES NOW LIVE ON CELL EDGES

        do k = ks-1,ke+1 
        do j = js-1,je+1 
          u(is-1,j,k) = zero
          v(is-1,j,k) = (fifteen*v(is  ,j,k) - ten*v(is+1,j,k) + 
     $                     three*v(is+2,j,k)) / eight
          w(is-1,j,k) = (fifteen*w(is  ,j,k) - ten*w(is+1,j,k) + 
     $                     three*w(is+2,j,k)) / eight
       enddo
       enddo

        if (visc_coef .gt. zero) then
          do k = ks-1,ke+1 
          do j = js-1,je+1 
            v(is-1,j,k) = zero
            w(is-1,j,k) = zero
          enddo
          enddo
        endif

      elseif (bcx_lo .eq. INLET) then

        call velinflow(u,DIMS,time,0,0)

        do k = ks-1,ke+1 
        do j = js-1,je+1 
          v(is-1,j,k) = zero
          w(is-1,j,k) = zero
        enddo
        enddo

      elseif (bcx_lo .eq. OUTLET) then

        do k = ks-1,ke+1 
        do j = js-1,je+1 
          u(is-1,j,k) = u(is,j,k)
          v(is-1,j,k) = v(is,j,k)
          w(is-1,j,k) = w(is,j,k)
        enddo
        enddo

      else

        print *,'bogus bcx_lo in setvelbc ',bcx_lo
        stop

      endif

      if (bcx_hi .eq. PERIODIC) then

        do k = ks-1,ke+1 
        do j = js-1,je+1 
             u(ie+1,j,k) =    u(is,j,k)
             v(ie+1,j,k) =    v(is,j,k)
             w(ie+1,j,k) =    w(is,j,k)
        enddo
        enddo

      elseif (bcx_hi .eq. WALL) then

c ::: REMEMBER -  THESE VALUES NOW LIVE ON CELL EDGES

        do k = ks-1,ke+1 
        do j = js-1,je+1 
          u(ie+1,j,k) = zero
          v(ie+1,j,k) = (fifteen*v(ie  ,j,k) - ten*v(ie-1,j,k) + 
     $                     three*v(ie-2,j,k)) / eight
          w(ie+1,j,k) = (fifteen*w(ie  ,j,k) - ten*w(ie-1,j,k) + 
     $                     three*w(ie-2,j,k)) / eight
       enddo
       enddo

        if (visc_coef .gt. zero) then
          do k = ks-1,ke+1 
          do j = js-1,je+1 
            v(ie+1,j,k) = zero
            w(ie+1,j,k) = zero
          enddo
          enddo
        endif

      elseif (bcx_hi .eq. INLET) then

        call velinflow(u,DIMS,time,0,1)

        do k = ks-1,ke+1 
        do j = js-1,je+1 
          v(ie+1,j,k) = zero
          w(ie+1,j,k) = zero
        enddo
        enddo

      elseif (bcx_hi .eq. OUTLET) then

        do k = ks-1,ke+1 
        do j = js-1,je+1 
          u(ie+1,j,k) = u(ie,j,k)
          v(ie+1,j,k) = v(ie,j,k)
          w(ie+1,j,k) = w(ie,j,k)
        enddo
        enddo

      else

        print *,'bogus bcx_hi in setvelbc ', bcx_hi
        stop

      endif

      return
      end
