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

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

!------------------------------------------------------------------------------|
!(((((((((((((((( Purpose of the routine  ))))))))))))))))))))))))))))))))))))))
!------------------------------------------------------------------------------|
! this routine assigns the boundary condition for the Stokes sphere experiment 

!------------------------------------------------------------------------------|
!((((((((((((((((  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

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

eps=1.d-10

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+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).gt.1.d0-eps) then
      if (x(i)<0.55d0 .and. x(i)>0.45d0) then
         kfix((i-1)*3+1)=1 ; u(i)=0.d0
         kfix((i-1)*3+2)=1 ; v(i)=-1.d0
         kfix((i-1)*3+3)=1 ; w(i)=0.d0
      end if
   endif
   if (z(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
      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
end do

return
end

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