!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
!                                                                              |
!              ||===\\                                                         | 
!              ||    \\                                                        |
!              ||     ||   //==\\   ||  ||   //==||  ||/==\\                   |
!              ||     ||  ||    ||  ||  ||  ||   ||  ||    ||                  |
!              ||    //   ||    ||  ||  ||  ||   ||  ||                        |
!              ||===//     \\==//    \\==\\  \\==\\  ||                        |
!                                                                              |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
!                                                                              |
!              DEFINE_BC_2Dpunch    Apr. 2007                                  |
!                                                                              |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|

subroutine define_bc_2Dpunch (nnode,kfix,kfixt,x,y,z,u,v,w,temp,vo) 

!------------------------------------------------------------------------------|
!(((((((((((((((( Purpose of the routine  ))))))))))))))))))))))))))))))))))))))
!------------------------------------------------------------------------------|
! this routine assigns the boundary condition in the case of a square, 
! rectangular, or circular punch

!------------------------------------------------------------------------------|
!((((((((((((((((  declaration of the subroutine arguments  ))))))))))))))))))))
!------------------------------------------------------------------------------|

use definitions

implicit none

integer nnode
integer kfix(nnode*3)
integer kfixt(nnode)
double precision x(nnode),y(nnode),z(nnode)
double precision u(nnode),v(nnode),w(nnode)
double precision temp(nnode)
type (void) vo

!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine internal variables )))))))))))))
!------------------------------------------------------------------------------|

integer i
double precision eps,punch_width,truncate_length
double precision imposed_velocity
logical impose_2d_velocity
logical rough

!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|

rough=.true.
punch_width=0.08d0
!truncate_length=0.4012334d0
truncate_length=1.512345d0

eps=1.d-10
imposed_velocity=1.123456789d0
impose_2D_velocity=.false.

if (impose_2D_velocity) then
   do i=1,nnode
      kfix((i-1)*3+2)=1
      v(i)=0.d0
   end do
endif 

do i=1,nnode
   if (x(i).lt.eps) then
      kfix((i-1)*3+1)=1 ; u(i)=0.d0
      kfix((i-1)*3+2)=1 ; v(i)=0.d0
      kfix((i-1)*3+3)=1 ; w(i)=0.d0
   endif
   if (x(i).gt.1.d0-eps) then
      kfix((i-1)*3+1)=1 ; u(i)=0.d0
      kfix((i-1)*3+2)=1 ; v(i)=0.d0
      kfix((i-1)*3+3)=1 ; w(i)=0.d0
   endif
   if (y(i).lt.eps) then
      kfix((i-1)*3+2)=1 ; v(i)=0.d0
   endif
   if (y(i).gt.1.d0-eps) then
      kfix((i-1)*3+2)=1 ; v(i)=0.d0
   endif
   if (z(i).lt.eps) then
      if ((x(i)-(.5d0-.5d0*punch_width))*(x(i)-(.5d0+.5d0*punch_width)).le.0.d0 .and. y(i).lt. truncate_length  ) then 
         if (rough) then
            kfix((i-1)*3+1)=1 ; u(i)=0.d0
            kfix((i-1)*3+2)=1 ; v(i)=0.d0
         end if
         kfix((i-1)*3+3)=1 ; w(i)=imposed_velocity
      endif
      kfixt(i)=1
      temp(i)=1.d0
   endif
   if (z(i).gt.1.d0-eps) then
      kfix((i-1)*3+1)=1 ; u(i)=0.d0
      kfix((i-1)*3+2)=1 ; v(i)=0.d0
      kfix((i-1)*3+3)=1 ; w(i)=0.d0
      kfixt(i)=1
      temp(i)=0.d0
   endif
   if (.not.vo%influid(i)) then
      kfixt(i)=1
      temp(i)=0.d0
   endif
enddo

return
end

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------