! Copyright 1999 Stanford University
!All rights reserved
!
!Author:  Sergey Fomel
module nhelicon_patch  
! Nonstationary convolution, inverse to deconvolution.
  use adj_mod
!             Requires the filter be causal with an implicit "1." at the onset.
  use nhelix
  implicit none
  type( nfilter), private :: aa 
  logical, pointer, private,save :: local_bounds(:)
  contains
  subroutine nhelicon_patch_init ( aa_in,bound )
    type( nfilter)    :: aa_in 
  logical,optional,pointer :: bound(:)

    if(present(bound))  then
      local_bounds=>bound
    else
      nullify(local_bounds)
    end if

    aa = aa_in
  end subroutine
  function nhelicon_patch_op ( adj, add, xx, yy,index) result(stat)
    integer            :: stat 
    logical,intent(in) :: adj,add 
    integer :: index(:)
    real,dimension(:)  :: xx,yy 
    call adjnull (adj,add,xx,yy )
    call nhelicon_patch_op2(adj,xx,yy,index )
    stat=0
  end function 
  subroutine nhelicon_patch_op2(adj,xx,yy,index)
    logical,intent(in) :: adj 
    integer, dimension (:)  :: index 
    real, dimension (:)  :: xx 
    real, dimension (:)  :: yy 
    integer                         :: iy, ix, ia, ip
    integer, dimension( :), pointer :: lag
    real,    dimension( :), pointer :: flt
    if ( adj) then
! zero lag
      xx =	xx + yy
    else
      yy =	yy + xx
    end if 
    do iy = 1, size( yy)
      if ( associated( local_bounds)) then
        if ( local_bounds( iy)) then
          cycle
        end if
      end if
      ip = aa%pch( iy)
      if ( associated( aa%mis)) then
        if ( aa%mis( index(iy))) then
          cycle
        end if
      end if
      ip = aa%pch( iy)
      lag => aa%hlx( ip)%lag
      flt => aa%hlx( ip)%flt
      do ia = 1, size( lag)
        ix = iy - lag( ia)
        if ( ix < 1) then
          cycle
        end if
        if ( adj) then
          xx(ix) =                        xx(ix) + yy(iy) * flt( ia)
        else
          yy(iy) =                        yy(iy) + xx(ix) * flt( ia)
        end if
      end do
    end do
  end subroutine 
  subroutine nhelicon_patch_close()
  end subroutine 
end module 
