module OW_grabvel2_areal

use OW_type
use OW_parms_areal

implicit none

contains

subroutine owgrab_velim(velint,vel,ni)
integer   			:: ni
integer				:: nvx,nvy,i,j,k
real				:: velint(:), vel(kxm%n,kym%n,nz),owrkx,owrky

   nvx = floor((xmin-v%xm%o)/v%xm%d)+1
   nvy = floor((ymin-v%ym%o)/v%ym%d)+1
   vel=0
   do k=nzmin,nzmax
   do j=nvy,nvy+kym%n-1
   do i=nvx,nvx+kxm%n-1
      if (velint((k-1)*v%xm%n*v%ym%n+(j-1)*v%ym%n+i) == 0) then
         vel(i-nvx+1,j-nvy+1,k-nzmin+1)=0
      else
         vel(i-nvx+1,j-nvy+1,k-nzmin+1)=velint((k-1)*v%xm%n*v%ym%n+(j-1)*v%ym%n+i)
      end if
   end do
   end do
   end do


end subroutine
!-------------------------------------------------
subroutine oweditvel(pick1,vel,vel0)

real			:: pick1(img%xm%n,img%ym%n),xx,yy
real, optional                :: vel0(img%xm%n,img%ym%n,img%z%n)
double precision		:: vel(img%xm%n,img%ym%n,img%z%n)
integer			:: i,j,k,nx_min,nx_max,ny_min,ny_max

if (present(vel0)) then
  do j=1,img%xm%n
    do i=1,img%ym%n
      do k=1,img%z%n
        if (k < int(pick1(j,i))) then
            vel(j,i,k)=vel0(j,i,k)
        end if
      end do
    end do
  end do
else
  nx_max=(xv_max-img%xm%o)/img%xm%d+1.5
  nx_min=(xv_min-img%xm%o)/img%xm%d+1.5
  ny_max=(yv_max-img%ym%o)/img%ym%d+1.5
  ny_min=(yv_min-img%ym%o)/img%ym%d+1.5
  do j=1,img%xm%n
     do i=1,img%ym%n
        do k=1,img%z%n
!           if (k < int(pick1(j,i))) then
!              vel(j,i,k)=0.
!           else
!              if (j < nx_min) then
!                 vel(j,i,k)=vel(nx_min+1,i,k)
!              end if
!              if (j > nx_max) then
!                 vel(j,i,k)=vel(nx_max-1,i,k)
!              end if
!              if (i < ny_min) then
!                 vel(j,i,k)=vel(j,ny_min+1,k)
!              end if
!              if (i > ny_max) then
!                 vel(j,i,k)=vel(j,ny_max-1,k)
!              end if
!           end if

           if (k < int(pick1(j,i))) vel(j,i,k)=0.
           if (j < nx_min) vel(j,i,k)=vel(nx_min+1,i,k)
           if (j > nx_max) vel(j,i,k)=vel(nx_max-1,i,k)
           if (i < ny_min) vel(j,i,k)=vel(j,ny_min+1,k)
           if (i > ny_max) vel(j,i,k)=vel(j,ny_max-1,k)
        end do 
     end do
  end do
end if
end subroutine
!=======================================================
subroutine oweditvel_sngl(pick1,vel,vel0)

real			:: pick1(:,:),xx,yy
real, optional                :: vel0(img%xm%n,img%ym%n,img%z%n)
real			:: vel(img%xm%n,img%ym%n,img%z%n)
integer			:: i,j,k,nx_min,nx_max,ny_min,ny_max

if (present(vel0)) then
  do j=1,img%xm%n
    do i=1,img%ym%n
      do k=1,img%z%n
        if (k < int(pick1(j,i))) then
            vel(j,i,k)=vel0(j,i,k)
        end if
      end do
    end do
  end do
else
  nx_max=(xv_max-img%xm%o)/img%xm%d+1.5
  nx_min=(xv_min-img%xm%o)/img%xm%d+1.5
  ny_max=(yv_max-img%ym%o)/img%ym%d+1.5
  ny_min=(yv_min-img%ym%o)/img%ym%d+1.5
  do j=1,img%xm%n
     do i=1,img%ym%n
        do k=1,img%z%n
!           if (k < int(pick1(j,i))) then
!              vel(j,i,k)=0.
!           else
!              if (j < nx_min) then
!                 vel(j,i,k)=vel(nx_min+1,i,k)
!              end if
!              if (j > nx_max) then
!                 vel(j,i,k)=vel(nx_max-1,i,k)
!              end if
!              if (i < ny_min) then
!                 vel(j,i,k)=vel(j,ny_min+1,k)
!              end if
!              if (i > ny_max) then
!                 vel(j,i,k)=vel(j,ny_max-1,k)
!              end if
!           end if

           if (k < int(pick1(j,i))) vel(j,i,k)=0.
           if (j < nx_min) vel(j,i,k)=vel(nx_min+1,i,k)
           if (j > nx_max) vel(j,i,k)=vel(nx_max-1,i,k)
           if (i < ny_min) vel(j,i,k)=vel(j,ny_min+1,k)
           if (i > ny_max) vel(j,i,k)=vel(j,ny_max-1,k)
        end do 
     end do
  end do
end if
end subroutine
!=========================
end module
