module ncnhconest2 

! non-causal non-stationary convolution, adjoint is the filter.
  use adj_mod1
  use nhelix
  implicit none
  real ,private,  dimension(:), pointer         :: w 
  type( nfilter), private :: bb 
  integer, private :: nhmax 
  integer,   private                             :: np 

  contains

  subroutine ncnhconest2_init ( w_in,bb_in,nhmax_in )
    real ,   dimension(:), pointer                 :: w_in 
    type( nfilter)    :: bb_in 
    integer    :: nhmax_in 
    w => w_in 
    bb = bb_in 
    nhmax = nhmax_in 
    np = size( bb%hlx)
  end subroutine

  function ncnhconest2_lop ( adj, add, a, y) result(stat)
    integer            :: stat 
    logical,intent(in) :: adj,add 
    real,dimension(:)  :: a,y 
    call adjnull1 (adj,add,a,y )
    call ncnhconest2_lop2(adj,a,y )
    stat=0
  end function 

  subroutine ncnhconest2_lop2(adj,a,y)
    logical,intent(in) :: adj 
    real, dimension ( nhmax, np)  :: a 
    real, dimension (:)  :: y 
    integer                        :: ia, ix, iy, ip, nx
    integer, dimension(:), pointer :: lag
    nx=size(w)
    do iy = 1, size( y)
       if (associated(bb%mis)) then
          if ( bb%mis( iy)) then
             cycle
          end if
       end if
       ip = bb%pch( iy)
       lag => bb%hlx( ip)%lag
       do ia = 1, size( lag)
          ix = iy - lag( ia)
          if ((ix<1).or.(ix>nx)) then
             cycle
          end if
          if ( adj) then
             a( ia, ip) =    a( ia, ip) +  y( iy) * w( ix)
          else
             y( iy) =         y( iy) +  a( ia, ip) * w( ix)
          end if
       end do
    end do
  end subroutine ncnhconest2_lop2

  subroutine ncnhconest2_close()
  end subroutine ncnhconest2_close

end module ncnhconest2
