module OW_picksh

use sep
use OW_type
use OW_parms_areal

implicit none


integer, public, save, allocatable				:: picks(:,:,:)
integer, public, save					:: wavz,nhorz,npick

contains

subroutine owpick()

character(len=128) 						:: hor1, hor2, hor3, hor4
integer, allocatable						:: tempick(:,:,:)
integer,pointer,dimension(:,:)					:: pick1,pick2,pick3,pick4
integer							:: i,m,n,j,minm,maxm,k
integer,allocatable						:: minx(:),maxx(:)

 nhorz=0
 if (exist_file("hor1")) then
    nhorz=1
    call from_param('hor1',hor1)
    open(51,file=hor1,status='old')
    allocate(pick1(sog%xm%n*sog%sh%n,3));pick1=0
    read(51,*,end=1) ((pick1(n,m), m=1,3), n=1,sog%xm%n*sog%sh%n)
1   close(51)
 end if	

!write(2,33) (pick1(n,:), n=1,sog%xm%n*sog%sh%n)
!33 format(3I6)

11 continue
 if (exist_file("hor2")) then
    nhorz=nhorz+1
    call from_param('hor2',hor2)
    open(51,file=hor2,status='old')
    allocate(pick2(sog%xm%n*sog%sh%n,3));pick2=0
    read(51,*,end=2) ((pick2(n,m), m=1,3), n=1,sog%xm%n*sog%sh%n)
2   close(51)
 end if	

 if (exist_file("hor3")) then
    nhorz=nhorz+1
    call from_param('hor3',hor3)
    open(51,file=hor3,status='old')
    allocate(pick3(sog%xm%n*sog%sh%n,3));pick3=0
    read(51,*,end=3) ((pick3(n,m), m=1,3), n=1,sog%xm%n*sog%sh%n)
3   close(51)
 end if	

 if (exist_file("hor4")) then
    nhorz=nhorz+1
    call from_param('hor4',hor4)
    open(51,file=hor4,status='old')
    allocate(pick4(sog%xm%n*sog%sh%n,3));pick4=0
    read(51,*,end=4) ((pick4(n,m), m=1,3), n=1,sog%xm%n*sog%sh%n)
4   close(51)
 end if	

!--------------------------------------------------
!
! "Arranging picks"
!
if (nhorz .ne. 0) then
call from_param("wavz",wavz,7)
allocate(tempick(nhorz,sog%xm%n,sog%sh%n))
tempick=0
do i=1,nhorz
   k=1
   if (i .eq. 1) then
   do j=1,sog%sh%n
      minm=minval(pick1(:,2), mask=(pick1(:,1).ne.0.and.pick1(:,3).eq.j-1))
      maxm=maxval(pick1(:,2), mask=pick1(:,3).eq.j-1)
      write(0,*) minm,maxm
      if (minm.ge.0.and.maxm.ge.0) then
      do m=minm,maxm
         write(2,*) m,k+m-minval(pick1(:,2), mask=(pick1(:,1).ne.0.and.pick1(:,3).eq.j-1)),j,pick1(k+m-minval(pick1(:,2), mask=(pick1(:,1).ne.0.and.pick1(:,3).eq.j-1)),1)
         tempick(1,m+1,j)=pick1(k+m-minval(pick1(:,2), mask=(pick1(:,1).ne.0.and.pick1(:,3).eq.j-1)),1)
      end do
      k=k+maxm-minm+1
      end if
   end do
   deallocate(pick1)
   end if
   k=1
   if (i .eq. 2) then
   do j=1,sog%sh%n
      minm=minval(pick2(:,2), mask=(pick2(:,1).ne.0.and.pick2(:,3).eq.j-1))
      maxm=maxval(pick2(:,2), mask=pick2(:,3).eq.j-1)
      write(0,*) minm,maxm
      if (minm.ge.0.and.maxm.ge.0) then
      do m=minm,maxm
         write(2,*) m,k+m-minval(pick2(:,2), mask=(pick2(:,1).ne.0.and.pick2(:,3).eq.j-1)),j,pick2(k+m-minval(pick2(:,2), mask=(pick2(:,1).ne.0.and.pick2(:,3).eq.j-1)),1)
         tempick(2,m+1,j)=pick2(k+m-minval(pick2(:,2), mask=(pick2(:,1).ne.0.and.pick2(:,3).eq.j-1)),1)
      end do
      k=k+maxm-minm+1
      end if
   end do
   deallocate(pick2)
   end if
   k=1
   if (i .eq. 3) then
   do j=1,sog%sh%n
      do m=minval(pick3(:,2), mask=(pick3(:,2).ne.0.and.pick3(:,3).eq.j-1)),maxval(pick3(:,2), mask=pick3(:,3).eq.j-1)
         tempick(3,m,j)=pick3(m-minval(pick3(:,2), mask=(pick3(:,2).ne.0.and.pick3(:,3).eq.j-1))+1,1)
      end do
   end do
   deallocate(pick3)
   end if
   k=1
   if (i .eq. 4) then
   do j=1,sog%sh%n
      do m=minval(pick4(:,2), mask=(pick4(:,2).ne.0.and.pick4(:,3).eq.j-1)),maxval(pick4(:,2), mask=pick4(:,3).eq.j-1)
         tempick(4,m,j)=pick4(m-minval(pick4(:,2), mask=(pick4(:,2).ne.0.and.pick4(:,3).eq.j-1))+1,1)
      end do
   end do
   deallocate(pick4)
   end if
end do
allocate(picks(nhorz,sog%xm%n,sog%sh%n))
picks=tempick

do i=1,nhorz
do m=1,sog%xm%n
do j=1,sog%sh%n
write(2,*) i,m,j,picks(i,m,j)
end do
end do
end do

deallocate(tempick)

end if
end subroutine
end module
