!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_spectrum_operations
  use cubetools_parameters
  use cubeobsolete_messaging
  use cubemain_spectrum_real
  !
  public :: cubemain_spectrum_base_noise
  public :: cubemain_spectrum_extract
  public :: cubemain_spectrum_smooth
  public :: cubemain_spectrum_average
  public :: cubemain_spectrum_sort
  public :: cubemain_spectrum_wind
  private
  !
contains
  !
  subroutine cubemain_spectrum_base_noise(base,error)
    use cubetools_nan
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(spectrum_t), intent(inout) :: base
    logical,          intent(inout) :: error
    !
    integer(kind=chan_k) :: idat
    real(kind=8) :: mean,var
    character(len=*), parameter :: rname='SPECTRUM>BASE>NOISE'
    !
    call cubeobsolete_message(obsoleteseve%trace,rname,'Welcome')
    !
    ! 0. Sanity check
    if (base%n.lt.5) then
       ! At least five points needed to compute an rms...
       base%noi = gr4nan
       return
    endif
    ! 1. Mean computation
    mean = 0
    do idat=1,base%n
       ! VVV this does not take into account the presence of NaNs or blanks...
       mean = mean+base%t(idat)
    enddo
    mean = mean/dble(base%n)
    ! 2. Variance computation
    var = 0
    do idat=1,base%n
       ! VVV this does not take into account the presence of NaNs or blanks...
       var = var+(base%t(idat)-mean)**2
    enddo
    var = var/dble(base%n)
    ! 3. RMS computation
    base%noi = sqrt(var)
  end subroutine cubemain_spectrum_base_noise
  !
  subroutine cubemain_spectrum_extract(ifirst,ilast,specin,specout,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    integer(kind=chan_k), intent(in)    :: ifirst
    integer(kind=chan_k), intent(in)    :: ilast
    type(spectrum_t),     intent(in)    :: specin
    type(spectrum_t),     intent(inout) :: specout
    logical,              intent(inout) :: error
    !
    integer(kind=chan_k) :: nchan,ochan,ichan
    character(len=*), parameter :: rname='SPECTRUM>EXTRACT'
    !
    call cubeobsolete_message(obsoleteseve%trace,rname,'Welcome')
    !
    nchan = ilast-ifirst+1
    ! VVV This routine does not do any check, hence it may segfault,
    ! should it be left this way for the sake of efficiency?
    do ochan=1,nchan
       ichan = ochan+ifirst-1
       specout%c(ochan) = specin%c(ichan)
       specout%v(ochan) = specin%v(ichan)
       specout%f(ochan) = specin%f(ichan)
       specout%w(ochan) = specin%w(ichan)
       specout%t(ochan) = specin%t(ichan)
    enddo
    specout%n = nchan
  end subroutine cubemain_spectrum_extract
  !
  subroutine cubemain_spectrum_smooth(specin,specout,error)
    use cubetools_nan
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(spectrum_t), intent(in)    :: specin
    type(spectrum_t), intent(inout) :: specout
    logical,          intent(inout) :: error
    !
    integer(kind=chan_k) :: nc,ic,icmin,icmax,idc
    integer(kind=chan_k) :: jc,ldc
    real(kind=8) :: sum
    character(len=*), parameter :: rname='SPECTRUM>SMOOTH'
    !
    call cubeobsolete_message(obsoleteseve%trace,rname,'Welcome')
    !
    specout%n = specin%n
    specout%c = specin%c
    specout%v = specin%v
    specout%f = specin%f
    !
    idc = 5 ! should be user defined *** JP
    ldc = 2*idc+1
    nc = specin%n
    if ((ldc).gt.nc) then
       idc = (nc-1)/2
       ldc = 2*idc+1
    endif
    do ic=1,nc
       icmin = max(ic-idc,1)
       icmax = min(ic+idc,nc)
       if (icmin.eq.1) then
          icmax = icmin+ldc-1
       else if (icmax.eq.nc) then
          icmin = icmax-ldc+1
       endif
       sum = 0.
       ! VVV Here we should decide wether we want the nans to contamine
       ! or not, the old code does not take care of this.
       ! Maybe it assumes blank2zero has been called beforehand?
       do jc=icmin,icmax
          sum = sum+specin%t(jc)
       enddo ! jc
       specout%t(ic) = sum/dble(ldc)
    enddo ! ic
    if (ieee_is_nan(specin%noi)) then
       specout%noi = gr4nan
    else
       specout%noi = sqrt(real(ldc))*specin%noi
    endif
  end subroutine cubemain_spectrum_smooth
  !
  subroutine cubemain_spectrum_average(spec1,spec2,nois1,nois2,aver,error)
    use cubetools_nan
    !----------------------------------------------------------------------
    ! The consistency of the different spectrum is assumed to have been
    ! done outside this routine
    !----------------------------------------------------------------------
    type(spectrum_t), intent(in)    :: spec1
    type(spectrum_t), intent(in)    :: spec2
    type(spectrum_t), intent(in)    :: nois1
    type(spectrum_t), intent(in)    :: nois2
    type(spectrum_t), intent(inout) :: aver
    logical,          intent(inout) :: error
    !
    integer(kind=chan_k) :: nc,ic
    real(kind=sign_k) :: wei1,wei2
    character(len=*), parameter :: rname='SPECTRUM>AVERAGE'
    !
    call cubeobsolete_message(obsoleteseve%trace,rname,'Welcome')
    !
    nc = aver%n
    do ic=1,nc
       ! VVV Previous Behaviour is contamination hence there is no
       ! longer a test on blanking values
       if ((nois1%t(ic).ne.0).and.(nois2%t(ic).ne.0)) then
          wei1 = 1.0/nois1%t(ic)**2
          wei2 = 1.0/nois2%t(ic)**2
          aver%t(ic) = (wei1*spec1%t(ic)+wei2*spec2%t(ic)) / (wei1+wei2)
       else
          aver%t(ic) = gr4nan
       endif
    enddo ! ic
  end subroutine cubemain_spectrum_average
  !
  subroutine cubemain_spectrum_sort(ipeak,specin,specout,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    integer(kind=chan_k),   intent(in)    :: ipeak
    type(spectrum_t),       intent(in)    :: specin
    type(spectrum_t),       intent(inout) :: specout
    logical,                intent(inout) :: error
    !
    integer(kind=chan_k) :: ileft,iright
    integer(kind=chan_k) :: jchan,nchan
    character(len=*), parameter :: rname='SPECTRUM>SORT'
    !
    call cubeobsolete_message(obsoleteseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (ipeak.eq.code_null) then
       call cubeobsolete_message(seve%e,rname,'Inexistent peak channel')
       error = .true.
       return
    endif
    if (specin%n.lt.1) then
       call cubeobsolete_message(seve%e,rname,'Zero channel')
       error = .true.
       return
    endif
    specout%n = specin%n
    specout%noi = specin%noi
    ! Order data
    specout%c(1) = specin%c(ipeak)
    specout%v(1) = specin%v(ipeak)
    specout%f(1) = specin%f(ipeak)
    specout%w(1) = specin%w(ipeak)
    specout%t(1) = specin%t(ipeak)
    nchan = specin%n
    jchan = 2
    ileft = ipeak-1
    iright = ipeak+1
    do while (jchan.le.nchan)
       if (ileft.eq.0) then
          specout%c(jchan) = specin%c(iright)
          specout%v(jchan) = specin%v(iright)
          specout%f(jchan) = specin%f(iright)
          specout%w(jchan) = specin%w(iright)
          specout%t(jchan) = specin%t(iright)
          iright = iright+1
       else if (iright.eq.(nchan+1)) then
          specout%c(jchan) = specin%c(ileft)
          specout%v(jchan) = specin%v(ileft)
          specout%f(jchan) = specin%f(ileft)
          specout%w(jchan) = specin%w(ileft)
          specout%t(jchan) = specin%t(ileft)
          ileft = ileft-1
       else if (specin%t(ileft).gt.specin%t(iright)) then
          specout%c(jchan) = specin%c(ileft)
          specout%v(jchan) = specin%v(ileft)
          specout%f(jchan) = specin%f(ileft)
          specout%w(jchan) = specin%w(ileft)
          specout%t(jchan) = specin%t(ileft)
          ileft = ileft-1
       else
          specout%c(jchan) = specin%c(iright)
          specout%v(jchan) = specin%v(iright)
          specout%f(jchan) = specin%f(iright)
          specout%w(jchan) = specin%w(iright)
          specout%t(jchan) = specin%t(iright)
          iright = iright+1
       endif
       jchan = jchan+1
    enddo
  end subroutine cubemain_spectrum_sort
  !
  subroutine cubemain_spectrum_wind(sorted,wfound,error)
    use cube_types
    use cubemain_windowing
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(spectrum_t),      intent(in)    :: sorted
    type(window_scalar_t), intent(out)   :: wfound
    logical,               intent(inout) :: error
    !
    integer(kind=chan_k) :: ichan,imin,imax,cmin,cmax
    character(len=*), parameter :: rname='SPECTRUM>WIND'
    !
    call cubeobsolete_message(obsoleteseve%trace,rname,'Welcome')
    !
    imin = 1
    imax = 1
    cmin = sorted%c(1)
    cmax = sorted%c(1)
    do ichan=2,sorted%n
       if (cmin.gt.sorted%c(ichan)) then
          cmin = sorted%c(ichan)
          imin = ichan
       endif
       if (cmax.lt.sorted%c(ichan)) then
          cmax = sorted%c(ichan)
          imax = ichan
       endif
       if (sorted%t(ichan).le.0.0) then
          exit
       endif
    enddo ! ichan
    ! Transfer result in original spectrum channels
    wfound%nc = imax-imin+1
    wfound%o = (/ imin,imax /)
    wfound%p = (/ imin,imax /)
  end subroutine cubemain_spectrum_wind
end module cubemain_spectrum_operations
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
