module OW_shaper

 use OW_type
 use OW_parms_areal

implicit none
integer,private                 :: ihor,ireal,igapx,igapy
contains

!===============================================
subroutine owshaper(source,GGS,sign)
 integer			:: i,j,sign,k
 complex			:: source(:),GGS(:,:,:),temp(sou%w%n)

temp=0
do j=1,sou%w%n
   do k=1,kym%n-2*(padtracesy+tapertry)
      do i=1,kxm%n-2*(padtracesx+tapertrx)
         temp(j)=temp(j)+sum(abs(GGS(i,k,max(1,j-10):min(j+10,sou%w%n))))/(min(j+10,sou%w%n)-max(1,j-10)+1)
      end do
   end do
end do
temp=temp/(kxm%n-2*(padtracesx+tapertrx))/(kym%n-2*(padtracesy+tapertry))
do k=1,kym%n-2*(padtracesy+tapertry)
   do i=1,kxm%n-2*(padtracesx+tapertrx)
      if (sum(abs(temp)**2+.01*maxval(abs(temp))) > 0) then
         GGS(i,k,:)=GGS(i,k,:)*abs(source)*abs(temp)/(abs(temp)**2+.01*maxval(abs(temp)))
      end if
   end do
end do
end subroutine

!temp=0
!do j=1,sou%w%n
!   do k=padtracesy+tapertry+1,kym%n-(padtracesy+tapertry)
!      do i=padtracesx+tapertrx+1,kxm%n-(padtracesx+tapertrx)
!         temp(j)=temp(j)+sum(abs(GGS(i,k,max(1,j-10):min(j+10,sou%w%n))))/(min(j+10,sou%w%n)-max(1,j-10)+1)
!      end do
!   end do
!end do
!temp=temp/kxm%n/kym%n
!do k=padtracesy+tapertry+1,kym%n-(padtracesy+tapertry)
!   do i=padtracesx+tapertrx+1,kxm%n-(padtracesx+tapertrx)
!      if (sum(abs(temp)**2+.1*maxval(abs(temp))) > 0) then
!         GGS(i,k,:)=GGS(i,k,:)*abs(source)*abs(temp)/(abs(temp)**2+.01*maxval(abs(temp)))
!      end if
!   end do
!end do
!end subroutine
!--------------------------------------------------------------------
subroutine gathers_init(ihor_in,ireal_in,igapx_in,igapy_in)

integer                                                     :: ihor_in,ireal_in,igapx_in,igapy_in

ihor=ihor_in
ireal=ireal_in
igapx=igapx_in
igapy=igapy_in

end subroutine
!========================================
subroutine gathers_io(GG,tag,op)
complex              :: GG(:,:,:)
character*7          :: tag
character*4          :: op
integer              :: nnx,nny,ninx,nfnx,niny,nfny,nrxy,irxy


nnx=nx-2*(padtracesx+tapertrx)
nny=ny-2*(padtracesy+tapertry)
ninx=padtracesx+tapertrx+1
nfnx=kxm%n-(padtracesx+tapertrx)
niny=padtracesy+tapertry+1
nfny=kym%n-(padtracesy+tapertry)
nrxy=ngapx*ngapy
irxy=(igapx-1)*ngapy+igapy-1

if(op.eq."reed") then
  call sreed_window(tag,7,(/nnx,nny, sou%w%n,  ngapx*ngapy,  nreal,1,1/),&
                          (/nnx,nny, sou%w%n,            1,      1,1,1/),&
                          (/  0,  0,       0,         irxy,ireal-1,0,0/),&
                          (/  1,  1,       1,            1,      1,1,1/),&
                          8,GG) 
else
  call srite_window(tag,7,(/nnx,nny, sou%w%n,  ngapx*ngapy,  nreal,1,1/),&
                          (/nnx,nny, sou%w%n,            1,      1,1,1/),&
                          (/  0,  0,       0,         irxy,ireal-1,0,0/),&
                          (/  1,  1,       1,            1,      1,1,1/),&
                          8,GG) 
end if
end subroutine
!========================================
end module
