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(img%xm%n,nz),owrk

if (imagem) then
   nv = floor((img%xm%o-v%xm%o)/v%xm%d)+1
   vel=0
   do k=nzmin,nzmax
   do j=nv,nv+img%xm%n-1
!      if (velint((k-1)*v%xm%n+j) == 0) then
!         vel((k-1)*img%xm%n+j-nv+1)=0
!      else
!         vel((k-1)*img%xm%n+j-nv+1)=velint((k-1)*v%xm%n+j)
!      end if
      if (velint((k-1)*v%xm%n+j) == 0) then
         vel(j-nv+1,k-nzmin+1)=0
      else
         vel(j-nv+1,k-nzmin+1)=velint((k-1)*v%xm%n+j)
      end if
   end do
   end do
   if (exist_file("xxx")) then
      call to_history("n1",img%xm%n,"xxx"); call to_history("d1",img%xm%d,"xxx"); call to_history("o1",img%xm%o,"xxx")  
      call to_history("n2",1,"xxx") ; call to_history("d2",1.,"xxx") ; call to_history("o2",0.,"xxx")
      call to_history("n3",nz,"xxx") ; call to_history("d3",img%z%d,"xxx") ; call to_history("o3",img%z%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 k=1,nz
   do j=ni,ni+kxm%n-1
!      vel((k-1)*kxm%n+j-ni+1)=velint((k-1)*img%xm%n+j)
      vel(j-nv+1,k)=velint((k-1)*img%xm%n+j)
   end do
   end do
   if (exist_file("zzz")) then
      call to_history("n1",kxm%n,"zzz"); call to_history("d1",img%xm%d,"zzz"); call to_history("o1",owrk,"zzz")  
      call to_history("n2",1,"zzz") ; call to_history("d2",1.,"zzz") ; call to_history("o2",0.,"zzz")
      call to_history("n3",nz,"zzz") ; call to_history("d3",img%z%d,"zzz") ; call to_history("o3",img%z%o,"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(img%xm%n,img%z%n)
double precision		:: vel(img%xm%n,nz)
integer			:: j,k,nx_min,nx_max

write(0,*) img%xm%n
if (present(vel0)) then
  do j=1,img%xm%n
     write(0,*) j,nzmin,nzmax,size(vel0,1),size(vel0,2),img%z%n
     do k=nzmin,nzmax
        if (k <= int(pick1(j))) vel(j,k-nzmin+1)=vel0(j,k)
        if (k >  int(pick1(j))) vel0(j,k)=vel(j,k-nzmin+1)
     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
  write(0,*) nx_min,nx_max
  do j=1,img%xm%n
     do k=nzmin,nzmax
        if (k < int(pick1(j))) vel(j,k-nzmin+1)=0.
        if (j < nx_min) vel(j,k-nzmin+1)=vel(nx_min+1,k-nzmin+1)
        if (j > nx_max) vel(j,k-nzmin+1)=vel(nx_max-1,k-nzmin+1)
     end do
  end do
!  do j=1,img%xm%n
!     do k=1,img%z%n
!     vel((k-1)*img%xm%n+1:(k-1)*img%xm%n+nx_min-1)=vel((k-1)*img%xm%n+nx_min)
!     vel((k-1)*img%xm%n+nx_max+1:k*img%xm%n)=vel((k-1)*img%xm%n+nx_max)
!        xx=(j-1)*img%xm%d+img%xm%o
!        if (xx < xv_min) then
!           vel((k-1)*img%xm%n+j)=vel((k-1)*img%xm%n+nx_min)
!           write(0,*) xx,xv_min,nx_min,vel((k-1)*img%xm%n+nx_min)
!        end if
!        if (xx > xv_max) then
!           vel((k-1)*img%xm%n+j)=vel((k-1)*img%xm%n+nx_max)
!           write(0,*) xx,xv_max,nx_max,vel((k-1)*img%xm%n+nx_max)
!        end if
!     end do
!  end do
end if
end subroutine
!=======================================================
subroutine oweditvel_sngl(pick1,vel,vel0)


real			:: pick1(:)
real, optional                :: vel0(img%xm%n,img%z%n)
real     			:: vel(img%xm%n,nz)
integer			:: j,k,nx_min,nx_max

if (present(vel0)) then
  do j=1,img%xm%n
     do k=nzmin,nzmax
        if (k <= int(pick1(j))) vel(j,k-nzmin+1)=vel0(j,k)
        if (k > int(pick1(j))) vel0(j,k)=vel(j,k-nzmin+1)
     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
  write(0,*) nx_min,nx_max
  do j=1,img%xm%n
     do k=nzmin,nzmax
        if (k < int(pick1(j))) vel(j,k-nzmin+1)=0.
        if (j < nx_min) vel(j,k-nzmin+1)=vel(nx_min+1,k-nzmin+1)
        if (j > nx_max) vel(j,k-nzmin+1)=vel(nx_max-1,k-nzmin+1)
     end do
  end do
!  do j=1,img%xm%n
!     do k=1,img%z%n
!     vel((k-1)*img%xm%n+1:(k-1)*img%xm%n+nx_min-1)=vel((k-1)*img%xm%n+nx_min)
!     vel((k-1)*img%xm%n+nx_max+1:k*img%xm%n)=vel((k-1)*img%xm%n+nx_max)
!        xx=(j-1)*img%xm%d+img%xm%o
!        if (xx < xv_min) then
!           vel((k-1)*img%xm%n+j)=vel((k-1)*img%xm%n+nx_min)
!           write(0,*) xx,xv_min,nx_min,vel((k-1)*img%xm%n+nx_min)
!        end if
!        if (xx > xv_max) then
!           vel((k-1)*img%xm%n+j)=vel((k-1)*img%xm%n+nx_max)
!           write(0,*) xx,xv_max,nx_max,vel((k-1)*img%xm%n+nx_max)
!        end if
!     end do
!  end do
end if
end subroutine
!=========================
end module