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,img%z%n),owrk

if (imagem) then
   nv = floor((img%xm%o-v%xm%o)/v%xm%d)+1
   vel=0
   do k=1,img%z%n
   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)=0
      else
         vel(j-nv+1,k)=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",img%z%n,"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,img%z%n
   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",img%z%n,"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                          :: xx
real, optional		:: pick1(:)
real, optional                :: vel0(:)
double precision		:: vel(:)
integer			:: j,k,nx_min,nx_max

if (present(vel0)) then
  do j=1,img%xm%n
     do k=1,img%z%n
!        if (k < int(pick1(j))) then
        if ((k-1)*img%z%d+zmin < int(pick1(j))) then
            vel((k-1)*img%xm%n+j)=vel0((k-1)*img%xm%n+j)
        end if
     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
  if(present(pick1)) then
     do j=1,img%xm%n
        do k=1,img%z%n
           if ((k-1)*img%z%d+zmin < int(pick1(j)-img%z%d)) then
              vel((k-1)*img%xm%n+j)=0.
           end if
        end do
     end do
  end if
  do j=1,img%xm%n
     do k=1,img%z%n
        if (j < nx_min) then
           vel((k-1)*img%xm%n+j)=vel((k-1)*img%xm%n+nx_min+1)
        end if
        if (j > nx_max) then
           vel((k-1)*img%xm%n+j)=vel((k-1)*img%xm%n+nx_max-1)
        end if
     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(:),xx
real, optional                :: vel0(:)
real 			:: vel(img%xm%n*img%z%n)
integer			:: j,k,nx_min,nx_max

if (present(vel0)) then
  do j=1,img%xm%n
     do k=1,img%z%n
        if (k < int(pick1(j))) then
            vel((k-1)*img%xm%n+j)=vel0((k-1)*img%xm%n+j)
        end if
     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
  do j=1,img%xm%n
     do k=1,img%z%n
        if ((k-1)*img%z%d+zmin < int(pick1(j))) then
           vel((k-1)*img%xm%n+j)=0.
!        else
!           if (j < nx_min) then
!              vel((k-1)*img%xm%n+j)=vel((k-1)*img%xm%n+nx_min+1)
!           end if
!           if (j > nx_max) then
!              vel((k-1)*img%xm%n+j)=vel((k-1)*img%xm%n+nx_max-1)
!           end if
        end if
     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
