!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! The following routines are independent of the kind of wavelets.
! 
subroutine gwavelet_subtract(iorder,wavelets,vec,error)
  use gmath_interfaces, except_this=>gwavelet_subtract
  use gmath_messaging
  !---------------------------------------------------------------------
  ! @ public
  ! Subtract the ith order when asked
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: iorder 
  real(kind=4),    intent(in)    :: wavelets(:,:)
  real(kind=4),    intent(inout) :: vec(:)
  logical,         intent(inout) :: error
  ! Local
  integer(kind=4) :: nvec,nwav
  character(len=message_length) :: mess
  character(len=*), parameter :: rname='GWAVELET/SUBTRACT'
  !
  nvec = size(wavelets,1)
  nwav = size(wavelets,2)
  if (iorder.gt.nwav) then
    write(mess,'(A,I0,A)') 'Order ',iorder,' is not available for option /BASE'
    call gmath_message(seve%e,rname,mess)
    error = .true.
    return
  elseif (iorder.gt.0) then
     if (size(vec).ne.nvec) then
        write(mess,'(A,I0,A,I0)') 'Size mismatch: ',nvec,',',size(vec)
        call gmath_message(seve%e,rname,mess)
        error = .true.
        return
     endif
     vec(:) = vec(:)-wavelets(:,iorder)
  else
     ! Do not modify input spectrum
  endif
  !
end subroutine gwavelet_subtract
!
subroutine gwavelet_mirror(nvec,vec1,vec2,error)
  use gmath_dependencies_interfaces
  use gmath_interfaces, except_this=>gwavelet_mirror
  !---------------------------------------------------------------------
  ! @ private
  ! Double the size of a vector, fill the central part with the initial
  ! vector and fill the left and right part with mirror versions of the
  ! initial vector.
  ! On return the vec2 array has been allocated and filled
  !---------------------------------------------------------------------
  integer(kind=4),           intent(in)    :: nvec       ! Data size
  real(kind=4),              intent(in)    :: vec1(nvec) ! Data
  real(kind=4), allocatable, intent(inout) :: vec2(:)    ! Results
  logical,                   intent(inout) :: error      ! Logical error flag
  ! Local
  integer(kind=4) :: ivec,nhalf,ier
  character(len=*), parameter :: rname='GWAVELET/MIRROR'
  !
  allocate(vec2(2*nvec),stat=ier)
  if (failed_allocate(rname,'vec2',ier,error)) return
  nhalf = nvec/2   ! Remember nvec may be odd
  do ivec=1,nhalf  ! First half of the input spectrum (mirrored)
    vec2(nhalf+1-ivec) = vec1(ivec)
  enddo
  do ivec=1,nvec  ! Full input spectrum
    vec2(nhalf+ivec) = vec1(ivec)
  enddo
  do ivec=nhalf+1,nvec  ! 2nd half of the input spectrum (mirrored)
    vec2(2*nvec+nhalf+1-ivec) = vec1(ivec)
  enddo
end subroutine gwavelet_mirror
!
subroutine gwavelet_extract(nvec,nwav,wavelets2,wavelets1,error)
  use gmath_dependencies_interfaces
  use gmath_interfaces, except_this=>gwavelet_extract
  !---------------------------------------------------------------------
  ! @ private
  ! Extract the central part of a wavelet array
  ! On return the wavelet1 array has been allocated and filled
  !---------------------------------------------------------------------
  integer(kind=4),           intent(in)    :: nvec                   ! Data size
  integer(kind=4),           intent(in)    :: nwav                   ! Number of wavelets
  real(kind=4),              intent(in)    :: wavelets2(2*nvec,nwav) ! Data
  real(kind=4), allocatable, intent(inout) :: wavelets1(:,:)         ! Results
  logical,                   intent(inout) :: error                  ! Logical error flag
  ! Local
  logical :: alloc
  integer(kind=4) :: nhalf,iwav,ier
  character(len=*), parameter :: rname='GWAVELET/EXTRACT'
  !
  nhalf = nvec/2 ! Remember nvec may be odd
  if (.not.allocated(wavelets1)) then
    alloc = .true.
  elseif (size(wavelets1,1).ne.nvec .or. size(wavelets1,2).ne.nwav) then
    deallocate(wavelets1)
    alloc = .true.
  else
    alloc = .false.
  endif
  if (alloc) then
    allocate(wavelets1(nvec,nwav),stat=ier)
    if (failed_allocate(rname,'wavelets',ier,error))  return
  endif
  ! Fill the values
  do iwav=1,nwav
    wavelets1(:,iwav) = wavelets2(nhalf+1:nhalf+nvec,iwav)
  enddo
end subroutine gwavelet_extract
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! The following routines assume gaps wavelets.
!
subroutine gwavelet_gaps(vec1,wavelets1,error)
  use gmath_interfaces, except_this=>gwavelet_gaps
  !---------------------------------------------------------------------
  ! @ public
  ! Compute the wavelets for an input 1D data
  ! Take care of edge effects by mirroring the vector at each edge
  ! On return the input 'wavelets' array has been allocated and filled
  !---------------------------------------------------------------------
  real(kind=4),              intent(in)    :: vec1(:)        ! Data
  real(kind=4), allocatable, intent(inout) :: wavelets1(:,:) ! Results
  logical,                   intent(inout) :: error          ! Logical error flag
  ! Local
  integer(kind=4) :: nvec,nwav
  real(kind=4), allocatable :: vec2(:),wavelets2(:,:)
  character(len=*), parameter :: rname='GWAVELET/GAPS'
  !
  nvec = size(vec1)
  call gwavelet_mirror(nvec,vec1,vec2,error)
  if (error) goto 10
  call gwavelet_gaps_sub(vec2,2*nvec,wavelets2,nwav,error)
  if (error)  goto 10
  call gwavelet_extract(nvec,nwav,wavelets2,wavelets1,error)
  if (error) goto 10
  !
10 continue
  if (allocated(vec2))  deallocate(vec2)
  if (allocated(wavelets2))  deallocate(wavelets2)
  !
end subroutine gwavelet_gaps
!
subroutine gwavelet_gaps_sub(vec,vsize,wavelets,nwav,error)
  use gmath_dependencies_interfaces
  use gmath_interfaces, except_this=>gwavelet_gaps_sub
  use gmath_messaging
  !---------------------------------------------------------------------
  ! @ private
  ! Compute and modify inplace the wavelets for input 1D data
  ! On return the input wavelets array has been allocated and filled
  !---------------------------------------------------------------------
  integer(kind=4),           intent(in)    :: vsize          ! Vector size
  real(kind=4),              intent(inout) :: vec(vsize)     ! Data / working buffer
  real(kind=4), allocatable, intent(inout) :: wavelets(:,:)  ! Results
  integer(kind=4),           intent(out)   :: nwav           ! Number of wavelets in working buffer
  logical,                   intent(inout) :: error          ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='GWAVELET/GAPS/SUB'
  integer(kind=4), parameter :: fwidth=5  ! Filter width
  real(kind=4), parameter :: filter(fwidth) =  &
    (/ 1./16., 1./4., 3./8., 1./4., 1./16. /)
  integer(kind=4) :: ier
  !
  call gwavelet_gaps_prepare(vsize,fwidth,nwav)
  if (nwav.le.0) then
    call gmath_message(seve%e,rname,'Number of wavelets lower or equal to 0')
    error = .true.
    return
  endif
  !
  allocate(wavelets(vsize,nwav),stat=ier)
  if (failed_allocate(rname,'wavelets',ier,error))  return
  !
  ! Compute
  call gwavelet_gaps_compute(vec,vsize,filter,fwidth,nwav,wavelets,error)
  if (error)  return
  !
end subroutine gwavelet_gaps_sub
!
subroutine gwavelet_gaps_prepare(vsize,fw,nwav)
  !---------------------------------------------------------------------
  ! @ private
  ! Compute the number of wavelets which will be needed
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)  :: vsize  ! Data size
  integer(kind=4), intent(in)  :: fw     ! Filter width
  integer(kind=4), intent(out) :: nwav   ! Number of wavelets
  !
  nwav = int(log(real(vsize,kind=4)/real(fw,kind=4))/log(2.))
  !
end subroutine gwavelet_gaps_prepare
!
subroutine gwavelet_gaps_compute(vec,vsize,f1,fw1,nwav,wav,error)
  use gmath_dependencies_interfaces
  use gmath_interfaces, except_this=>gwavelet_gaps_compute
  !---------------------------------------------------------------------
  ! @ private
  ! Compute the wavelets
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: vsize            ! Data size
  real(kind=4),    intent(inout) :: vec(vsize)       ! Data / working buffer
  integer(kind=4), intent(in)    :: fw1              ! Original filter width
  real(kind=4),    intent(in)    :: f1(fw1)          ! Original filter
  integer(kind=4), intent(in)    :: nwav             ! Number of wavelets
  real(kind=4),    intent(out)   :: wav(vsize,nwav)  ! Wavelets on return
  logical,         intent(inout) :: error            ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='GWAVELET'
  integer(kind=4) :: fwn,fwmax,ier,ifv,iwav
  real(kind=4), allocatable :: fn(:)
  !
  ! Filter width grows iteratively for each wavelet order:
  !   fw(n) = 2*fw(n-1)-1
  ! We compute the maximum size we will have to work with and allocate
  ! it once. We can prove that:
  !   fw(n) = 2**(n-1) * (fw(1)-1) + 1
  fwmax = 2**(nwav-1) * (fw1-1) + 1
  allocate(fn(fwmax),stat=ier)
  if (failed_allocate(rname,'fn',ier,error))  return
  !
  ! 1st order
  fwn = fw1
  fn(1:fwn) = f1(:)
  call gwavelet_convolve(vec,wav(1,nwav),vsize,fn,fwn)
  vec(:) = vec(:)-wav(:,1)
  !
  ! Higher orders
  do iwav=2,nwav
    !
    ! Compute next filter by interleaving 0 values. Start from the end
    ! to allow working in the same array.
    fn(2*fwn-1) = fn(fwn)
    do ifv=fwn-1,1,-1
      fn(2*ifv) = 0.
      fn(2*ifv-1) = fn(ifv)
    enddo
    fwn = 2*fwn-1
    !
    ! Convolve
    call gwavelet_convolve(wav(1,nwav-iwav+2),wav(1,nwav-iwav+1),vsize,fn,fwn)
    ! Subtract
    vec(:) = vec(:)-wav(:,nwav-iwav+1)
    !
  enddo
  !
  if (allocated(fn)) deallocate(fn)
  !
end subroutine gwavelet_gaps_compute
!
subroutine gwavelet_convolve(din,dout,dsize,kern,ksize)
  !---------------------------------------------------------------------
  ! @ private
  ! 1D convolution
  ! This version is optimized for convolution kernels which have
  ! 0-valued elements.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)  :: dsize        ! Data size
  real(kind=4),    intent(in)  :: din(dsize)   ! Data in
  real(kind=4),    intent(out) :: dout(dsize)  ! Data out
  integer(kind=4), intent(in)  :: ksize        ! Kernel size
  real(kind=4),    intent(in)  :: kern(ksize)  ! Kernel
  ! Local
  integer(kind=4) :: i,k,koff
  !
  ! There are many zeros in 'kern' in the wavelet context: loops are
  ! inverted (possible because they are independant) and ignored when
  ! the kernel value is 0.
  koff = (ksize+1)/2
  dout(:) = 0.
  do k=1,ksize
    if (kern(k).eq.0.)  cycle
    do i=1,dsize
      if (i+k-koff.le.0 .or. i+k-koff.gt.dsize)  cycle
      dout(i) = dout(i) + din(i+k-koff)*kern(k)
    enddo
  enddo
  !
  ! Should we ensure that the convolution kernel is normalized?
  ! norm = 1./sum(kern)
  !
end subroutine gwavelet_convolve
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
