!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_interpolate_spectrum_tool
  use cubetools_array_types
  use cubemain_messaging
  !
  public :: interpolate_spectrum_prog_t
  private
  !
  type interpolate_spectrum_prog_t
     logical :: equal = .false.
     type(long_1d_t) :: ic     ! [---] Input axis channel number that corresponds to the output axis one
     type(dble_1d_t) :: xratio ! [---]
   contains
     procedure, public :: init     => cubemain_interpolate_spectrum_prog_init
     procedure, public :: spectrum => cubemain_interpolate_spectrum_prog_compute
  end type interpolate_spectrum_prog_t
  !
contains
  !
  subroutine cubemain_interpolate_spectrum_prog_init(interp,in,ou,error)
    use cubeadm_spectrum_types
    !----------------------------------------------------------------------
    ! 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
    !----------------------------------------------------------------------
    class(interpolate_spectrum_prog_t), intent(inout) :: interp
    type(spectrum_t),                   intent(in)    :: in
    type(spectrum_t),                   intent(in)    :: ou
    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='INTERPOLATE>SPECTRUM>PROG>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
    ! 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 interp%ic%reallocate('interpolate ic',ou%n,error)
    if (error) return
    call interp%xratio%reallocate('interpolate xratio',ou%n,error)
    if (error) return
    inc_ratio = ou%inc/in%inc
    ref_distance = (in%ref-ou%ref*inc_ratio) + (ou%val-in%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%val(oc) = 1
          interp%xratio%val(oc) = 0
       else if (ic.gt.in%n) then
          ! Upper end => extrapolation
          interp%ic%val(oc) = in%n
          interp%xratio%val(oc) = 0          
       else
          ! Interpolation
          interp%ic%val(oc) = floor(ic)
          interp%xratio%val(oc) = (ic-floor(ic))
       endif
    enddo ! oc
  end subroutine cubemain_interpolate_spectrum_prog_init
  !
  subroutine cubemain_interpolate_spectrum_prog_compute(interp,in,ou,error)
    use cubeadm_spectrum_types
    !----------------------------------------------------------------------
    ! 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
    !----------------------------------------------------------------------
    class(interpolate_spectrum_prog_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='INTERPOLATE>SPECTRUM>PROG>COMPUTE'
    !
    if (interp%equal) then
       ou%y%val(:) = in%y%val(:)
    else
       yin => in%y%val(:)
       you => ou%y%val(:)
       do oc=1,ou%n
          ic => interp%ic%val(oc)
          xratio => interp%xratio%val(oc)
          if (ic+1.le.in%n) then
             ! Interpolation
             you(oc) = yin(ic) + xratio*(yin(ic+1)-yin(ic))
          else
             ! Extrapolation
             you(oc) = yin(ic)
          endif
       enddo ! oc
    endif
  end subroutine cubemain_interpolate_spectrum_prog_compute
end module cubemain_interpolate_spectrum_tool
! 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
