!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_interpolate
  use cubemain_messaging
  !
  public :: interpolate_t
  public :: cubemain_interpolate_reallocate,cubemain_interpolate_free
  private
  !
  type interpolate_t
     integer(kind=chan_k) :: n = 0
     integer(kind=chan_k), pointer :: ic(:) => null()
     real(kind=coor_k), pointer :: xratio(:) => null()
     logical :: equal = .false.
  end type interpolate_t
  !
contains
  !
  subroutine cubemain_interpolate_reallocate(nchan,interp,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    integer(kind=chan_k), intent(in)    :: nchan
    type(interpolate_t),  intent(inout) :: interp
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='REALLOCATE>INTERPOLATE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nchan.le.0) then
       call cubemain_message(seve%e,rname,'Negative or zero number of channels')
       error = .true.
       return
    endif
    alloc = .true.
    if (associated(interp%ic)) then
       if (interp%n.eq.nchan) then
          write(mess,'(a,i0)')  &
               'Interpolate pointers already associated at the right size: ',nchan
          call cubemain_message(mainseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a)') 'Interpolate pointers ',&
               'already associated but with a different size => Freeing it first'
          call cubemain_message(mainseve%alloc,rname,mess)
          call cubemain_interpolate_free(interp,error)
          if (error)  return
       endif
    endif
    if (alloc) then
       allocate(interp%ic(nchan),interp%xratio(nchan),stat=ier)
       if (failed_allocate(rname,'interpolate pointers',ier,error)) return
    endif
    ! Allocation success => interp%n may be updated
    interp%n = nchan
  end subroutine cubemain_interpolate_reallocate
  !
  subroutine cubemain_interpolate_free(interp,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(interpolate_t), intent(inout) :: interp
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='FREE>INTERPOLATE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    interp%n = 0
    interp%equal = .false.
    if (associated(interp%ic))     deallocate(interp%ic)
    if (associated(interp%xratio)) deallocate(interp%xratio)
  end subroutine cubemain_interpolate_free
end module cubemain_interpolate
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_spectrum_interpolate
  use cubemain_messaging
  use cubemain_spectrum_real
  use cubemain_interpolate
  !
  public :: cubemain_spectrum_interpolate_init
  public :: cubemain_spectrum_interpolate_compute
  private
  !
contains
  !
  subroutine cubemain_spectrum_interpolate_init(in,ou,interp,error)
    !----------------------------------------------------------------------
    ! Initialize linear interpolation using the following formula
    !     you(oc) = yin(ic) + xratio*(yin(ic+1)-yin(ic))
    ! We compute xratio in double precision to avoid rounding errors as the
    ! other computations are done in single precision
    !----------------------------------------------------------------------
    type(spectrum_t),    intent(in)    :: in
    type(spectrum_t),    intent(in)    :: ou
    type(interpolate_t), intent(inout) :: interp
    logical,             intent(inout) :: error
    !
    integer(kind=chan_k) :: oc ! Output channel number
    real(kind=coor_k)    :: ic ! Corresponding channel number in input axis 
    real(kind=coor_k) :: inc_ratio,ref_distance
    character(len=*), parameter :: rname='SPECTRUM>INTERPOLATE>INIT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Special case: output axis = input axis
    if ((ou%n.eq.in%n).and.(ou%ref.eq.in%ref).and.(ou%val.eq.in%val).and.(ou%inc.eq.in%inc)) then
       interp%equal = .true.
    else
       interp%equal = .false.
    endif
    ! *** JP
    ! Sanity check
    if ((in%inc.eq.0.d0).or.(ou%inc.eq.0.d0)) then
       call cubemain_message(seve%e,rname,'Zero valued input or output increment')
       error = .true.
       return
    endif
    ! Initialization
    call cubemain_interpolate_reallocate(ou%n,interp,error)
    if (error) return
    inc_ratio = ou%inc/in%inc
    ref_distance = (in%ref-ou%ref) + (in%val-ou%val)/in%inc
    ! Loop on out channels
    do oc=1,ou%n
       ic = oc*inc_ratio + ref_distance
       if (ic.lt.1) then
          ! Lower end => extrapolation
          interp%ic(oc) = 1
          interp%xratio = 0
       else if (ic.gt.in%n) then
          ! Upper end => extrapolation
          interp%ic(oc) = in%n
          interp%xratio = 0          
       else
          ! Interpolation
          interp%ic(oc) = floor(ic)
          interp%xratio = (ic-floor(ic))
       endif
    enddo ! oc
  end subroutine cubemain_spectrum_interpolate_init
  !
  subroutine cubemain_spectrum_interpolate_compute(interp,in,ou,error)
    !----------------------------------------------------------------------
    ! Apply the linear interpolation using the following formula
    !     you(oc) = yin(ic) + xratio*(yin(ic+1)-yin(ic))
    ! We compute xratio in double precision to avoid rounding errors as the
    ! other computations are done in single precision
    !----------------------------------------------------------------------
    type(interpolate_t), target, intent(in)    :: interp
    type(spectrum_t),    target, intent(in)    :: in
    type(spectrum_t),    target, intent(inout) :: ou
    logical,                     intent(inout) :: error
    !
    integer(kind=chan_k) :: oc
    integer(kind=chan_k), pointer :: ic
    real(kind=coor_k), pointer :: xratio
    real(kind=sign_k), pointer :: yin(:),you(:)
    character(len=*), parameter :: rname='SPECTRUM>INTERPOLATE>COMPUTE'
    !
    yin => in%t(:)
    you => ou%t(:)
    do oc=1,ou%n
       ic => interp%ic(oc)
       xratio => interp%xratio(oc)
       you(oc) = yin(ic) + xratio*(yin(ic+1)-yin(ic))
    enddo ! oc
  end subroutine cubemain_spectrum_interpolate_compute
end module cubemain_spectrum_interpolate
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
