module OW_grabvel_areal

use OW_type
use OW_parms_areal

implicit none

contains

subroutine owgrab_vel(velint,vel,imagem,ni,ixs)
logical				:: imagem
integer,optional			:: ixs,ni
integer				:: nv,j,k
real				:: velint(:), vel(:),owrk

if (imagem) then
   nv = floor((img%xm%o-v%xm%o)/v%xm%d)+1
   vel=0
   do j=nv,nv+img%xm%n-1
   do k=1,img%z%n
      vel((j-nv)*img%z%n+k)=1/velint((j-1)*v%z%n+k)
   end do
   end do
   if (exist_file("xxx")) then
      call to_history("n1",img%z%n,"xxx") ; call to_history("d1",img%z%d,"xxx") ; call to_history("o1",img%z%o,"xxx")
      call to_history("n2",1,"xxx") ; call to_history("d2",1.,"xxx") ; call to_history("o2",0.,"xxx")
      call to_history("n3",img%xm%n,"xxx"); call to_history("d3",img%xm%d,"xxx"); call to_history("o3",img%xm%o,"xxx")  
      call to_history("n4",1,"xxx"); call to_history("d4",1,"xxx"); call to_history("o4",0,"xxx")
      call to_history("n5",1,"xxx"); call to_history("d5",1,"xxx"); call to_history("o5",0,"xxx")  
      call to_history("esize",4,"xxx")
      call srite("xxx",1/vel,4*img%z%n*img%xm%n)
   end if
else
   owrk=(ixs-1)*rec%xd%d+rec%xd%o+rec%h%o-(padtraces+tapertr)*rec%h%d
   ni = (owrk-img%xm%o)/img%xm%d+1.5
   write(0,*) owrk,ni
   vel=0
   do j=ni,ni+kxm%n-1
   do k=1,img%z%n
      vel((j-ni)*img%z%n+k)=velint((j-1)*img%z%n+k)
   end do
   end do
   if (exist_file("zzz")) then
      call to_history("n1",img%z%n,"zzz") ; call to_history("d1",img%z%d,"zzz") ; call to_history("o1",img%z%o,"zzz")
      call to_history("n2",1,"zzz") ; call to_history("d2",1.,"zzz") ; call to_history("o2",0.,"zzz")
      call to_history("n3",kxm%n,"zzz"); call to_history("d3",img%xm%d,"zzz"); call to_history("o3",owrk,"zzz")  
      call to_history("n4",1,"zzz"); call to_history("d4",1,"zzz"); call to_history("o4",0,"zzz")
      call to_history("n5",1,"zzz"); call to_history("d5",1,"zzz"); call to_history("o5",0,"zzz")  
      call to_history("esize",4,"zzz")
      call srite("zzz",1/vel,4*img%z%n*kxm%n)
   end if
end if

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

real			:: pick1(:)
real, optional                :: vel0(:)
double precision		:: vel(:)
integer			:: j,k

if (present(vel0)) then
  do j=1,img%xm%n
     do k=1,img%z%n
!        if ((j-1)*img%xm%d+img%xm%o >= xmin .and. &
!            (j-1)*img%xm%d+img%xm%o <= xmax .and. &
!                                k <= int(pick1(j))) then
!            vel((j-1)*img%z%n+k)=vel0((j-1)*img%z%n+k)
!        else if ((j-1)*img%xm%d+img%xm%o < xmin .and. &
!                                k <= int(pick1(1))) then
!            vel((j-1)*img%z%n+k)=vel0((j-1)*img%z%n+k)
!        else if ((j-1)*img%xm%d+img%xm%o > xmax .and. &
!                      k <= int(pick1(size(pick1)))) then
!            vel((j-1)*img%z%n+k)=vel0((j-1)*img%z%n+k)
        if (k <= int(pick1(j))) then
            vel((j-1)*img%z%n+k)=vel0((j-1)*img%z%n+k)
        end if
     end do
  end do
else
  do j=1,img%xm%n
     do k=1,img%z%n
        if (k < pick1(j)) then
            vel((j-1)*img%z%n+k)=0.
        end if
     end do
  end do
end if
end subroutine
end module
