/*
** (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(vel,DIMS,bc,visc_coef,dx,time)

      implicit none

      integer DIMS
      REAL_T  vel(lo_1-3:hi_1+3,lo_2-3:hi_2+3,lo_3-3:hi_3+3,3)
      integer bc(2,3)
      REAL_T visc_coef
      REAL_T dx(3)
      REAL_T time

c     Local variables
      integer is,ie,js,je,ks,ke,i,j,k
      integer ilo,ihi,jlo,jhi
      integer ng

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

      ilo = cvmgt(lo_1-3,lo_1,BCX_LO .eq. INTERIOR .or. BCX_LO .eq. PERIODIC)
      ihi = cvmgt(hi_1+3,hi_1,BCX_HI .eq. INTERIOR .or. BCX_HI .eq. PERIODIC)
      jlo = cvmgt(lo_2-3,lo_2,BCY_LO .eq. INTERIOR .or. BCY_LO .eq. PERIODIC)
      jhi = cvmgt(hi_2+3,hi_2,BCY_HI .eq. INTERIOR .or. BCY_HI .eq. PERIODIC)

c     NOTE: IF BC == WALL, THESE VALUES ARE DEFINED ON THE EDGE OF THE PHYSICAL
c           BOUNDARY, NOT IN THE GHOST CELL

      if (BCZ_LO .eq. WALL) then

        do ng = 1,3
        do j = js-3,je+3
        do i = is-3,ie+3
          vel(i,j,ks-ng,3) = zero
        enddo
        enddo
        enddo

        do j = jlo,jhi
        do i = ilo,ihi
          vel(i,j,ks-1,1) = (fifteen*vel(i,j,ks  ,1) - ten*vel(i,j,ks+1,1) + 
     $                         three*vel(i,j,ks+2,1)) / eight
          vel(i,j,ks-1,2) = (fifteen*vel(i,j,ks  ,2) - ten*vel(i,j,ks+1,2) + 
     $                         three*vel(i,j,ks+2,2)) / eight
          vel(i,j,ks-2,1) = vel(i,j,ks-1,1)
          vel(i,j,ks-3,1) = vel(i,j,ks-1,1)
          vel(i,j,ks-2,2) = vel(i,j,ks-1,2)
          vel(i,j,ks-3,2) = vel(i,j,ks-1,2)
        enddo
        enddo

        if (visc_coef .gt. zero) then
          do ng = 1,3
          do j = js-3,je+3
          do i = is-3,ie+3
            vel(i,j,ks-ng,1) = zero
            vel(i,j,ks-ng,2) = zero
          enddo
          enddo
          enddo
        endif

      elseif (BCZ_LO .eq. INLET) then

        call velinflow(vel(lo_1-3,lo_2-3,lo_3-3,3),DIMS,time,dx,2,0)

        do ng = 1,3
        do j = js-3,je+3
        do i = is-3,ie+3
          vel(i,j,ks-ng,1) = zero
          vel(i,j,ks-ng,2) = zero
        enddo
        enddo
        enddo

      elseif (BCZ_LO .eq. OUTLET) then

        do ng = 1,3
        do j = js-3,je+3
        do i = is-3,ie+3
          vel(i,j,ks-ng,1) = vel(i,j,ks,1)
          vel(i,j,ks-ng,2) = vel(i,j,ks,2)
          vel(i,j,ks-ng,3) = vel(i,j,ks,3)
        enddo
        enddo
        enddo

      endif

      if (BCZ_HI .eq. WALL) then

        do ng = 1,3
        do j = js-3,je+3
        do i = is-3,ie+3
          vel(i,j,ke+ng,3) = zero
        enddo
        enddo
        enddo

        do j = jlo,jhi
        do i = ilo,ihi
          vel(i,j,ke+1,1) = (fifteen*vel(i,j,ke  ,1) - ten*vel(i,j,ke-1,1) + 
     $                         three*vel(i,j,ke-2,1)) / eight
          vel(i,j,ke+1,2) = (fifteen*vel(i,j,ke  ,2) - ten*vel(i,j,ke-1,2) + 
     $                         three*vel(i,j,ke-2,2)) / eight
          vel(i,j,ke+2,1) = vel(i,j,ke+1,1)
          vel(i,j,ke+3,1) = vel(i,j,ke+1,1)
          vel(i,j,ke+2,2) = vel(i,j,ke+1,2)
          vel(i,j,ke+3,2) = vel(i,j,ke+1,2)
        enddo
        enddo

        if (visc_coef .gt. zero) then
          do ng = 1,3
          do j = js-3,je+3
          do i = is-3,ie+3
            vel(i,j,ke+ng,1) = zero
            vel(i,j,ke+ng,2) = zero
          enddo
          enddo
          enddo
        endif

      elseif (BCZ_HI .eq. INLET) then

        call velinflow(vel(lo_1-3,lo_2-3,lo_3-3,3),DIMS,time,dx,2,1)

        do ng = 1,3
        do j = js-3,je+3
        do i = is-3,ie+3
          vel(i,j,ke+ng,1) = zero
          vel(i,j,ke+ng,2) = zero
        enddo
        enddo
        enddo

      elseif (BCZ_HI .eq. OUTLET) then

        do ng = 1,3
        do j = js-3,je+3
        do i = is-3,ie+3
          vel(i,j,ke+ng,1) = vel(i,j,ke,1)
          vel(i,j,ke+ng,2) = vel(i,j,ke,2)
          vel(i,j,ke+ng,3) = vel(i,j,ke,3)
        enddo
        enddo
        enddo

      endif

      if (BCY_LO .eq. WALL) then

        do ng = 1,3
        do k = ks-3,ke+3
        do i = is-3,ie+3 
          vel(i,js-ng,k,2) = zero
        enddo
        enddo
        enddo

        do k = ks-3,ke+3
        do i = ilo,ihi
          vel(i,js-1,k,1) = (fifteen*vel(i,js  ,k,1) - ten*vel(i,js+1,k,1) + 
     $                         three*vel(i,js+2,k,1)) / eight
          vel(i,js-1,k,3) = (fifteen*vel(i,js  ,k,3) - ten*vel(i,js+1,k,3) + 
     $                         three*vel(i,js+2,k,3)) / eight
          vel(i,js-2,k,1) = vel(i,js-1,k,1)
          vel(i,js-3,k,1) = vel(i,js-1,k,1)
          vel(i,js-2,k,3) = vel(i,js-1,k,3)
          vel(i,js-3,k,3) = vel(i,js-1,k,3)
        enddo
        enddo

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

      elseif (BCY_LO .eq. INLET) then

        call velinflow(vel(lo_1-3,lo_2-3,lo_3-3,2),DIMS,time,dx,1,0)

        do ng = 1,3
        do k = ks-3,ke+3
        do i = is-3,ie+3
          vel(i,js-ng,k,1) = zero
          vel(i,js-ng,k,3) = zero
        enddo
        enddo
        enddo

      elseif (BCY_LO .eq. OUTLET) then

        do ng = 1,3
        do k = ks-3,ke+3
        do i = is-3,ie+3
          vel(i,js-ng,k,1) = vel(i,js,k,1)
          vel(i,js-ng,k,2) = vel(i,js,k,2)
          vel(i,js-ng,k,3) = vel(i,js,k,3)
        enddo
        enddo
        enddo

      else

      endif

      if (BCY_HI .eq. WALL) then

        do ng = 1,3
        do k = ks-3,ke+3 
        do i = is-3,ie+3 
          vel(i,je+ng,k,2) = zero
        enddo
        enddo
        enddo

        do k = ks-3,ke+3 
        do i = ilo,ihi
          vel(i,je+1,k,1) = (fifteen*vel(i,je  ,k,1) - ten*vel(i,je-1,k,1) + 
     $                     three*vel(i,je-2,k,1)) / eight
          vel(i,je+1,k,3) = (fifteen*vel(i,je  ,k,3) - ten*vel(i,je-1,k,3) + 
     $                     three*vel(i,je-2,k,3)) / eight
          vel(i,je+2,k,1) = vel(i,je+1,k,1)
          vel(i,je+3,k,1) = vel(i,je+1,k,1)
          vel(i,je+2,k,3) = vel(i,je+1,k,3)
          vel(i,je+3,k,3) = vel(i,je+1,k,3)
        enddo
        enddo

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

      elseif (BCY_HI .eq. INLET) then

        call velinflow(vel(lo_1-3,lo_2-3,lo_3-3,2),DIMS,time,dx,1,1)

        do ng = 1,3
        do k = ks-3,ke+3
        do i = is-3,ie+3 
          vel(i,je+ng,k,1) = zero
          vel(i,je+ng,k,3) = zero
        enddo
        enddo
        enddo

      elseif (BCY_HI .eq. OUTLET) then

        do ng = 1,3
        do k = ks-3,ke+3
        do i = is-3,ie+3
          vel(i,je+ng,k,1) = vel(i,je,k,1)
          vel(i,je+ng,k,2) = vel(i,je,k,2)
          vel(i,je+ng,k,3) = vel(i,je,k,3)
        enddo
        enddo
        enddo

      endif

      if (BCX_LO .eq. WALL) then

        do ng = 1,3
        do k = ks-3,ke+3 
        do j = js-3,je+3
          vel(is-ng,j,k,1) = zero
        enddo
        enddo
        enddo

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

        if (visc_coef .gt. zero) then
          do ng = 1,3
          do k = ks-3,ke+3
          do j = js-3,je+3 
            vel(is-ng,j,k,2) = zero
            vel(is-ng,j,k,3) = zero
          enddo
          enddo
          enddo
        endif

      elseif (BCX_LO .eq. INLET) then

        call velinflow(vel(lo_1-3,lo_2-3,lo_3-3,1),DIMS,time,dx,0,0)

        do ng = 1,3
        do k = ks-3,ke+3 
        do j = js-3,je+3
          vel(is-ng,j,k,2) = zero
          vel(is-ng,j,k,3) = zero
        enddo
        enddo
        enddo

      elseif (BCX_LO .eq. OUTLET) then

        do ng = 1,3
        do k = ks-3,ke+3 
        do j = js-3,je+3
          vel(is-ng,j,k,1) = vel(is,j,k,1)
          vel(is-ng,j,k,2) = vel(is,j,k,2)
          vel(is-ng,j,k,3) = vel(is,j,k,3)
        enddo
        enddo
        enddo

      endif

      if (BCX_HI .eq. WALL) then

        do ng = 1,3
        do k = ks-3,ke+3
        do j = js-3,je+3
          vel(ie+ng,j,k,1) = zero
        enddo
        enddo
        enddo

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

        if (visc_coef .gt. zero) then
          do ng = 1,3
          do k = ks-3,ke+3
          do j = js-3,je+3
            vel(ie+ng,j,k,2) = zero
            vel(ie+ng,j,k,3) = zero
          enddo
          enddo
          enddo
        endif

      elseif (BCX_HI .eq. INLET) then

        call velinflow(vel(lo_1-3,lo_2-3,lo_3-3,1),DIMS,time,dx,0,1)

        do ng = 1,3
        do k = ks-3,ke+3
        do j = js-3,je+3
          vel(ie+ng,j,k,2) = zero
          vel(ie+ng,j,k,3) = zero
        enddo
        enddo
        enddo

      elseif (BCX_HI .eq. OUTLET) then

        do ng = 1,3
        do k = ks-3,ke+3
        do j = js-3,je+3
          vel(ie+ng,j,k,1) = vel(ie,j,k,1)
          vel(ie+ng,j,k,2) = vel(ie,j,k,2)
          vel(ie+ng,j,k,3) = vel(ie,j,k,3)
        enddo
        enddo
        enddo

      endif

      return
      end
