!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_spectrum_resampling
  use cubetools_axis_types
  use cubetools_nan
  use cubemain_spectrum_real
  use cubemain_messaging
  !
  public :: cubemain_spectrum_resample
  private
  !
contains
  !
  subroutine cubemain_spectrum_resample(old,new,in,out,error)
    !----------------------------------------------------------------------
    ! Calls the proper resampling routines depending on the case.  This
    ! code and is subroutines have been ported almost ipsis literis from
    ! Class. It has been however stripped of the comments, and slightly
    ! modified to fit the different data structures present here. Check
    ! gildas/class/lib/resample.f90 if more information is needed
    !----------------------------------------------------------------------
    type(axis_t),     intent(in)    :: old
    type(axis_t),     intent(in)    :: new
    type(spectrum_t), intent(in)    :: in
    type(spectrum_t), intent(inout) :: out
    logical,          intent(inout) :: error
    !
    real(kind=coor_k) :: xr1,xr2,is1,is2
    integer(kind=chan_k) :: ochanmin,ochanmax 
    character(len=*), parameter :: rname='SPECTRUM>RESAMPLE>CLASS'
    !
    xr1 = (   1.-old%ref)*old%inc+old%val
    xr2 = (old%n-old%ref)*old%inc+old%val
    is1 = (xr1-new%val)/new%inc+new%ref  
    is2 = (xr2-new%val)/new%inc+new%ref
    if (is1.lt.is2) then
       ochanmin = nint(is1)
       ochanmax = nint(is2)
    else
       ochanmin = nint(is2)
       ochanmax = nint(is1)
    endif
    if (ochanmin.gt.new%n .or. ochanmax.lt.1) then
      call cubemain_message(seve%e,rname, 'New spectral axis does not intersect the original one')
      error = .true.
      return
    endif
    ochanmin = max(ochanmin,1)
    ochanmax = min(ochanmax,new%n)
    !
    ! ZZZ For the moment plugged to 2 channel interpolation
    ! ZZZ There needs to be a proper trigger for FTS data
    if (abs(new%inc).le.abs(old%inc)) then
       call cubemain_spectrum_resample_2over(old,new,in,out,ochanmin,ochanmax,error)
       if (error)  return
    else
       call cubemain_spectrum_resample_2under(old,new,in,out,ochanmin,ochanmax,error)
       if (error)  return
    endif
    ! ZZZ The trilinear interpolation is bugged. Waiting for debug and
    ! proper trigger.
    !
    ! if (abs(new%inc).le.abs(old%inc)) then
    !    call cubemain_spectrum_resample_3over(old,new,in,out,ochanmin,ochanmax,error)
    !    if (error)  return
    ! else
    !    call cubemain_spectrum_resample_3under(old,new,in,out,ochanmin,ochanmax,error)
    !    if (error)  return
    ! endif
  end subroutine cubemain_spectrum_resample
  !
  subroutine cubemain_spectrum_resample_2under(old,new,in,out,ochanmin,ochanmax,error)
    !----------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    type(axis_t),         intent(in)    :: old
    type(axis_t),         intent(in)    :: new
    type(spectrum_t),     intent(in)    :: in
    type(spectrum_t),     intent(inout) :: out
    integer(kind=chan_k), intent(in)    :: ochanmin
    integer(kind=chan_k), intent(in)    :: ochanmax
    logical,              intent(inout) :: error
    !
    logical :: contaminate,equal
    real(kind=4) :: nch
    real(kind=sign_k) :: weiout,valout,wei,weisum
    real(kind=coor_k) :: inval0,outval0,outcentre,incentre
    real(kind=coor_k) :: wr1,wr2,wr3,rdistmax,rdistmin,dist
    integer(kind=chan_k) :: ichan,ochan,inmin,inmax
    !ieee_is_nan(x)
    contaminate = .true.
    equal = .true.
    !
    ! Initialize the output (resampled) observation
    out%t(:) = gr4nan
    out%w(:) = 0.  ! No data available yet in the spectrum
    !
    ! The algorithm below works with the 0-th channels as references (simpler
    ! equations and faster computations). Compute the X value at these channels:
    inval0 = (0.d0-old%ref)*old%inc+old%val
    outval0 = (0.d0-new%ref)*new%inc+new%val
    !
    rdistmax = (abs(new%inc)+abs(old%inc))*0.5
    rdistmin = (abs(new%inc)-abs(old%inc))*0.5
    wr1 = -sign(1.d0,old%inc)*rdistmin-inval0  ! Take care of the resolution sign
    wr2 =  sign(1.d0,old%inc)*rdistmax-inval0  ! Idem
    wr3 = 1./(rdistmax-rdistmin)             ! = 1/abs(old%inc)
    !
    do ochan = ochanmin,ochanmax  ! Loop on output channels
       outcentre = new%inc*ochan+outval0
       !
       ! Local resample for input observation
       inmin = max(1     ,int((outcentre+wr1)/old%inc))
       inmax = min(old%n,int((outcentre+wr2)/old%inc))
       nch = 0.  ! Number of channels which contribute
       weisum = 0.   ! Fraction sum
       weiout = 0.   ! Weight of (possibly resampled) channel from R
       valout = 0.   ! Value of (possibly resampled) channel from R
       do ichan = inmin,inmax
          incentre = old%inc*ichan + inval0
          dist = abs(incentre-outcentre)
          if (dist.lt.rdistmax) then
             ! This channel in R is at least partially overlapped by the
             ! one in S
             if (ieee_is_nan(in%t(ichan))) then
                ! Bad channels
                if (contaminate) then
                   out%t(ochan) = gr4nan
                   out%w(ochan) = 0.0
                   goto 30  ! Next output channel
                endif
                wei = 0.
             elseif (dist.le.rdistmin) then
                ! This channel in R is fully overlapped by the one in S. It
                ! has a full contribution:
                wei = 1.
             else
                ! This channel in R is partially overlapped by the one in S
                ! It contributes, but less. wr3 normalizes dist-rdistmin such as
                ! 0<wei<1 . wei is proportional to the overlapping.
                wei = 1.-(dist-rdistmin)*wr3
             endif
             nch = nch+wei
             weisum  = weisum+wei*wei*in%w(ichan)
             weiout  = weiout + wei*in%w(ichan)  ! beta
             valout  = valout + in%t(ichan)*wei*in%w(ichan)
          endif
       enddo
       !
       if (weiout.ne.0.0) then
          valout = valout/weiout       ! Value of resampled channel
          if (equal) then
             weiout = weiout/nch    ! Normalize the weight of the resampled channel
          else
             weiout = weiout*weiout/weisum  ! Weight of resampled channel
          endif
       else
          valout = gr4nan ! Blank value is now NaN
       endif
       !
       ! Store new value
       out%t(ochan) = valout
       out%w(ochan) = weiout  ! Possibly 0.0
       !
30     continue
    enddo
  end subroutine cubemain_spectrum_resample_2under
  ! 
  subroutine cubemain_spectrum_resample_2over(old,new,in,out,ochanmin,ochanmax,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(axis_t),         intent(in)    :: old
    type(axis_t),         intent(in)    :: new
    type(spectrum_t),     intent(in)    :: in
    type(spectrum_t),     intent(inout) :: out
    integer(kind=chan_k), intent(in)    :: ochanmin
    integer(kind=chan_k), intent(in)    :: ochanmax
    logical,              intent(inout) :: error
    !
    logical :: contaminate,equal
    real(kind=4) :: nch
    real(kind=sign_k) :: weiout,valout,wei,weisum
    real(kind=coor_k) :: ichanf,inval0,outval0,outcentre
    integer(kind=chan_k) :: ichan,ochan
    !
    contaminate = .true.
    equal = .true.
    !
    ! Initialize the output (resampled) observation
    out%t(:) = gr4nan
    out%w(:) = 0.  ! No data available yet in the spectrum
    !
    ! The algorithm below works with the 0-th channels as references (simpler
    ! equations and faster computations). Compute the X value at these channels:
    inval0 = (0.d0-old%ref)*old%inc+old%val
    outval0 = (0.d0-new%ref)*new%inc+new%val
    !
    do ochan = ochanmin,ochanmax  ! Loop on output channels
       outcentre = new%inc*ochan+outval0  ! X position
       ichanf = (outcentre-inval0)/old%inc  ! Channel position in input spectrum
       !
       nch = 0.
       weisum = 0.
       valout = 0.
       weiout = 0.
       !
       ichan = int(ichanf)  ! Left channel contribution
       if (ichan.ge.1 .and. ichan.le.old%n) then
          if (ieee_is_nan(in%t(ichan))) then
             ! Bad channels
             if (contaminate) then
                out%t(ochan) = gr4nan
                out%w(ochan) = 0.0
                cycle  ! Next output channel
             endif
             wei = 0.
          else
             wei = real(ichan+1)-ichanf
          endif
          nch = nch+            wei
          weisum  = weisum +          wei*wei*in%w(ichan)
          weiout  = weiout +            wei*in%w(ichan)  ! beta
          valout  = valout + in%t(ichan)*wei*in%w(ichan)
          !
       endif
       !
       ichan = ichan+1  ! Right channel contribution
       if (ichan.ge.1 .and. ichan.le.old%n) then
          if (ieee_is_nan(in%t(ichan))) then
             ! Bad channels
             if (contaminate) then
                out%t(ochan) = gr4nan
                out%w(ochan) = 0.0
                cycle  ! Next output channel
             endif
             wei = 0.
          else
             wei = ichanf-real(ichan-1)
          endif
          nch = nch+ wei
          weisum  = weisum + wei*wei*in%w(ichan)
          weiout  = weiout + wei*in%w(ichan)  ! beta
          valout  = valout + in%t(ichan)*wei*in%w(ichan)
          !
       endif
       !
       if (weiout.ne.0.0) then
          valout = valout/weiout       ! Value of resampled channel
          if (equal) then
             weiout = weiout/nch    ! Normalize the weight of the resampled channel
          else
             weiout = weiout*weiout/weisum  ! Weight of resampled channel
          endif
       else
          valout = gr4nan
       endif
       !
       ! Store new value
       out%t(ochan) = valout
       out%w(ochan) = weiout  ! Possibly 0.0
    enddo
  end subroutine cubemain_spectrum_resample_2over
!!$  !
!!$  subroutine cubemain_spectrum_resample_3under(old,new,in,out,ochanmin,ochanmax,error)
!!$    !----------------------------------------------------------------------
!!$    !
!!$    !---------------------------------------------------------------------
!!$    type(axis_t),     intent(in)    :: old
!!$    type(axis_t),     intent(in)    :: new
!!$    type(spectrum_t),      intent(in)    :: in
!!$    type(spectrum_t),      intent(inout) :: out
!!$    integer(kind=chan_k),  intent(out)   :: ochanmin
!!$    integer(kind=chan_k),  intent(out)   :: ochanmax
!!$    logical,               intent(inout) :: error
!!$    !
!!$    logical :: contaminate
!!$    real(kind=sign_k) :: weiout,valout,ymax,ymin
!!$    real(kind=coor_k) :: ichanf,inval0,outval0,expand
!!$    real(kind=coor_k) :: maxpix,minpix,scale,outcentre
!!$    integer(kind=chan_k) :: ichan,ochan,ichanmax,ichanmin
!!$    !
!!$    contaminate = .true.  ! Bad channels contaminate output or not?
!!$    !
!!$    ! Initialize the output (resampled) observation
!!$    out%t(:) = gr4nan
!!$    out%w(:) = 0.  ! No data available yet in the spectrum
!!$    !
!!$    ! The algorithm below works with the 0-th channels as references (simpler
!!$    ! equations and faster computations). Compute the X value at these channels:
!!$    inval0 = (0.d0-old%ref)*old%inc+old%val
!!$    outval0 = (0.d0-new%ref)*new%inc+new%val
!!$    !
!!$    expand = abs(new%inc/old%inc)  ! Undersampling: expand>=1
!!$    scale = 1.0d0/(2.0d0*expand)
!!$    !
!!$    do ochan = ochanmin,ochanmax
!!$       ! Compute interval
!!$       outcentre = new%inc*ochan+outval0  ! X position
!!$       ichanf = (outcentre-inval0)/old%inc  ! Channel position in input spectrum
!!$       !
!!$       maxpix = ichanf + 0.5d0*expand
!!$       minpix = ichanf - 0.5d0*expand
!!$       ichanmin = int(minpix+1.0d0)
!!$       ichanmax = int(maxpix)
!!$       ! Undersampling: ichanmin<=ichanmax
!!$       valout = 0.
!!$       weiout = 0.
!!$       !
!!$       ! Left part
!!$       ymin = 0.
!!$       ! Protect from access to channel #0. if contaminate blank first
!!$       ! channel if it needs info from channel #0
!!$       if (ichanmin.eq.1) then
!!$          if (contaminate) then
!!$             out%t(ochan) = gr4nan
!!$             out%w(ochan) = 0.0
!!$             cycle  ! N
!!$          else
!!$             ymin = 0.
!!$          endif
!!$       else
!!$          if (ieee_is_nan(in%t(ichanmin-1))) then  ! Bad channels
!!$             if (contaminate) then
!!$                out%t(ochan) = gr4nan
!!$                out%w(ochan) = 0.0
!!$                cycle  ! Next output channel
!!$             endif
!!$          else
!!$             ymin = in%t(ichanmin-1)*(ichanmin-minpix)
!!$          endif
!!$       endif
!!$       if (ieee_is_nan(in%t(ichanmin))) then
!!$          if (contaminate) then
!!$             out%t(ochan) = gr4nan
!!$             out%w(ochan) = 0.0
!!$             cycle  ! Next output channel
!!$          endif
!!$          if (ymin.ne.0.) then
!!$             valout = (ichanmin-minpix) * ymin
!!$             weiout = (ichanmin-minpix)
!!$          endif
!!$       else
!!$          ymin = ymin + in%t(ichanmin)*(minpix-ichanmin+1)
!!$          valout = (ichanmin-minpix) * (ymin+in%t(ichanmin))
!!$          weiout = (ichanmin-minpix)
!!$       endif
!!$       !
!!$       ! Central part (if any)
!!$       do ichan=ichanmin, ichanmax-1  ! Maybe 0 loop
!!$          if (ieee_is_nan(in%t(ichan))) then
!!$             if (contaminate) then
!!$                out%t(ochan) = gr4nan
!!$                out%w(ochan) = 0.0
!!$                cycle  ! Next output channel
!!$             endif
!!$          else
!!$             valout = valout + in%w(ichan)*in%t(ichan)
!!$             weiout = weiout + in%w(ichan)
!!$          endif
!!$          if (ieee_is_nan(in%t(ichan+1))) then
!!$             if (contaminate) then
!!$                out%t(ochan) = gr4nan
!!$                out%w(ochan) = 0.0
!!$                cycle  ! Next output channel
!!$             endif
!!$          else
!!$             valout = valout + in%w(ichan+1)*in%t(ichan+1)
!!$             weiout = weiout + in%w(ichan+1)
!!$          endif
!!$       enddo
!!$       !
!!$       ! Right part
!!$       ymax = 0.
!!$       ! Protect from access to channel nchan+1. if contaminate blank first
!!$       ! channel if it needs info from channel nchan+1
!!$       if (ichanmax.eq.old%n) then
!!$          if (contaminate) then
!!$             out%t(ochan) = gr4nan
!!$             out%w(ochan) = 0.0
!!$             cycle  ! N
!!$          else
!!$             ymax = 0.
!!$          endif
!!$       else
!!$          if (ieee_is_nan(in%t(ichanmax+1))) then
!!$             if (contaminate) then
!!$                out%t(ochan) = gr4nan
!!$                out%w(ochan) = 0.0
!!$                cycle  ! Next output channel
!!$             endif
!!$          else
!!$             ymax = ymax + in%t(ichanmax+1)*(maxpix-ichanmax)
!!$          endif
!!$       endif
!!$       if (ieee_is_nan(in%t(ichanmax))) then
!!$          if (contaminate) then
!!$             out%t(ochan) = gr4nan
!!$             out%w(ochan) = 0.0
!!$             cycle  ! Next output channel
!!$          endif
!!$          if (ymax.ne.0.) then
!!$             valout = valout + (maxpix-ichanmax)*ymax
!!$             weiout = weiout + (maxpix-ichanmax)
!!$          endif
!!$       else
!!$          ymax = ymax + in%t(ichanmax)*(ichanmax+1-maxpix)
!!$          valout = valout + (maxpix-ichanmax)*(ymax+in%t(ichanmax))
!!$          weiout = weiout + (maxpix-ichanmax)
!!$       endif
!!$       !
!!$       if (weiout.ne.0.) then
!!$          out%t(ochan) = valout/weiout
!!$          out%w(ochan) = weiout
!!$       else
!!$          out%t(ochan) = gr4nan
!!$       endif
!!$    enddo
!!$  end subroutine cubemain_spectrum_resample_3under
!!$  !
!!$  subroutine cubemain_spectrum_resample_3over(old,new,in,out,ochanmin,ochanmax,error)
!!$    !----------------------------------------------------------------------
!!$    ! This routine is a cube translation of resample_interpolate3_over
!!$    !---------------------------------------------------------------------
!!$    type(axis_t),    intent(in)    :: old
!!$    type(axis_t),    intent(in)    :: new
!!$    type(spectrum_t),     intent(in)    :: in
!!$    type(spectrum_t),     intent(inout) :: out
!!$    integer(kind=chan_k), intent(out)   :: ochanmin
!!$    integer(kind=chan_k), intent(out)   :: ochanmax
!!$    logical,              intent(inout) :: error
!!$    !
!!$    logical :: contaminate
!!$    real(kind=sign_k) :: weiout,valout,ymax,ymin
!!$    real(kind=coor_k) :: ichanf,inval0,outval0,expand
!!$    real(kind=coor_k) :: maxpix,minpix,scale,outcentre
!!$    integer(kind=chan_k) :: ochan,ichanmax,ichanmin
!!$    !
!!$    contaminate = .true.  ! Bad channels contaminate output or not?
!!$    !
!!$    ! Initialize the output (resampled) observation
!!$    out%t(:) = gr4nan  ! Avoid NaN
!!$    out%w(:) = 0.  ! No data available yet in the spectrum
!!$    !
!!$    ! The algorithm below works with the 0-th channels as references (simpler
!!$    ! equations and faster computations). Compute the X value at these channels:
!!$    inval0 = (0.d0-old%ref)*old%inc+old%val
!!$    outval0 = (0.d0-new%ref)*new%inc+new%val
!!$    !
!!$    expand = abs(new%inc/old%inc)  ! Oversampling: expand<=1
!!$    scale = 1.0d0/(2.0d0*expand)
!!$    !
!!$    do ochan = ochanmin,ochanmax
!!$      ! Compute interval
!!$      outcentre = new%inc*ochan+outval0  ! X position
!!$      ichanf = (outcentre-inval0)/old%inc  ! Channel position in input spectrum
!!$      !
!!$      maxpix = ichanf + 0.5d0*expand
!!$      minpix = ichanf - 0.5d0*expand
!!$      ichanmin = int(minpix+1.0d0)
!!$      ichanmax = int(maxpix)
!!$      ! Oversampling: ichanmin>=ichanmax
!!$      valout = 0.
!!$      weiout = 0.
!!$      if (ichanmin.gt.ichanmax) ichanmin=ichanmax
!!$      !
!!$      if (ichanmax.eq.ichanmin) then
!!$         ! New channel overlap the center of an old one
!!$         ! Left part
!!$         ymin = 0.
!!$         if (ichanmin.eq.1) then
!!$            if (contaminate) then
!!$               out%t(ochan) = gr4nan
!!$               out%w(ochan) = 0.0
!!$               cycle  ! N
!!$            else
!!$               ymin = 0.
!!$            endif
!!$         else
!!$            if (ieee_is_nan(in%t(ichanmin-1))) then  ! Bad channels
!!$               if (contaminate) then
!!$                  out%t(ochan) = gr4nan
!!$                  out%w(ochan) = 0.0
!!$                  cycle  ! Next output channel
!!$               endif
!!$            else
!!$               ymin = in%t(ichanmin-1)*(ichanmin-minpix)
!!$            endif
!!$         endif
!!$         if (ieee_is_nan(in%t(ichanmin))) then
!!$            if (contaminate) then
!!$               out%t(ochan) = gr4nan
!!$               out%w(ochan) = 0.0
!!$               cycle  ! Next output channel
!!$            endif
!!$            if (ymin.ne.0.) then
!!$               valout = (ichanmin-minpix) * ymin
!!$               weiout = (ichanmin-minpix)
!!$            endif
!!$         else
!!$            ymin = ymin + in%t(ichanmin)*(minpix-ichanmin+1)
!!$            valout = (ichanmin-minpix) * (ymin+in%t(ichanmin))
!!$            weiout = (ichanmin-minpix)
!!$         endif
!!$         !
!!$         ! Right part
!!$         ymax = 0.
!!$         if (ichanmax.eq.old%n) then
!!$            if (contaminate) then
!!$               out%t(ochan) = gr4nan
!!$               out%w(ochan) = 0.0
!!$               cycle  ! N
!!$            else
!!$               ymax = 0.
!!$            endif
!!$         else
!!$            if (ieee_is_nan(in%t(ichanmax+1))) then
!!$               if (contaminate) then
!!$                  out%t(ochan) = gr4nan
!!$                  out%w(ochan) = 0.0
!!$                  cycle  ! Next output channel
!!$               endif
!!$            else
!!$               ymax = ymax + in%t(ichanmax+1)*(maxpix-ichanmax)
!!$            endif
!!$         endif
!!$         if (ieee_is_nan(in%t(ichanmax))) then
!!$            if (contaminate) then
!!$               out%t(ochan) = gr4nan
!!$               out%w(ochan) = 0.0
!!$               cycle  ! Next output channel
!!$            endif
!!$            if (ymax.ne.0.) then
!!$               valout = valout + (maxpix-ichanmax)*ymax
!!$               weiout = weiout + (maxpix-ichanmax)
!!$            endif
!!$         else
!!$            ymax = ymax + in%t(ichanmax)*(ichanmax+1-maxpix)
!!$            valout = valout + (maxpix-ichanmax)*(ymax+in%t(ichanmax))
!!$            weiout = weiout + (maxpix-ichanmax)
!!$         endif
!!$         !
!!$      else
!!$         ! New channel does not overlap the center of an old one:
!!$         !   2 points interpolation between the 2 channels
!!$         if (ichanmin.eq.1) then
!!$            if (contaminate) then
!!$               out%t(ochan) = gr4nan
!!$               out%w(ochan) = 0.0
!!$               cycle  ! N
!!$            else
!!$               ymin = 0.
!!$            endif
!!$         else
!!$            if (ieee_is_nan(in%t(ichanmin-1))) then  ! Bad channels
!!$               if (contaminate) then
!!$                  out%t(ochan) = gr4nan
!!$                  out%w(ochan) = 0.0
!!$                  cycle  ! Next output channel
!!$               endif
!!$            else
!!$               valout = in%t(ichanmin-1)*(ichanmin-ichanf)
!!$               weiout = ichanmin-ichanf
!!$            endif
!!$         endif
!!$         !
!!$         if (ieee_is_nan(in%t(ichanmin))) then
!!$            ! Bad channels
!!$            if (contaminate) then
!!$               out%t(ochan) = gr4nan
!!$               out%w(ochan) = 0.0
!!$               cycle  ! Next output channel
!!$            endif
!!$         else
!!$            valout = valout + in%t(ichanmin)*(ichanf-ichanmin+1)
!!$            weiout = weiout + ichanf-ichanmin+1.
!!$         endif
!!$      endif
!!$      !
!!$      if (weiout.ne.0.) then
!!$         out%t(ochan) = valout/weiout
!!$         out%w(ochan) = weiout
!!$      else
!!$         out%t(ochan) = gr4nan
!!$      endif
!!$    enddo
!!$  end subroutine cubemain_spectrum_resample_3over
end module cubemain_spectrum_resampling
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
