module cubefit_spectral_obs
  ! Kernel imports
  use fit_minuit
  ! CUBE imports
  use cubemain_spectrum_real
  use cubefit_messaging
  use cubefit_parameters
  use cubefit_spectral_parameters
  use cubefit_hfs
  !
  public :: spectral_obs_t
  private
  !
  type spectral_obs_t
     real(kind=sign_k)              :: sigbase
     real(kind=sign_k)              :: sigline
     real(kind=coor_k)              :: deltav
     real(kind=coor_k)              :: deltaf
     integer(kind=chan_k)           :: ifirst
     integer(kind=chan_k)           :: ilast
     type(spectrum_t),      pointer :: spec
     type(spectral_pars_t), pointer :: par
     type(hfs_prog_t),      pointer :: hfs
     integer(kind=4), allocatable   :: wfit(:)
   contains
     procedure                      :: init      => cubefit_spectral_obs_init
     procedure                      :: point     => cubefit_spectral_obs_point
     procedure                      :: sigma     => cubefit_spectral_obs_sigma
     procedure                      :: est_gauss => cubefit_spectral_obs_estimate_gauss
     procedure                      :: est_shell => cubefit_spectral_obs_estimate_shell
  end type spectral_obs_t
  !
contains
  !
  subroutine cubefit_spectral_obs_init(obs,hfs,par,spec,wind,error)
    use gkernel_interfaces
    use cubetools_nan
    use cubemain_windowing   
    !----------------------------------------------------------------------
    ! Initializes spectral observation type
    !----------------------------------------------------------------------
    class(spectral_obs_t),         intent(out)   :: obs
    type(hfs_prog_t),      target, intent(in)    :: hfs
    type(spectral_pars_t), target, intent(in)    :: par
    type(spectrum_t),      target, intent(in)    :: spec
    type(window_array_t),          intent(in)    :: wind
    logical,                       intent(inout) :: error
    !
    integer(kind=chan_k) :: nbase,ninfunc,ichan
    real(kind=sign_k) :: ainf,asup,aega
    integer(kind=4) :: ier,iw
    character(len=*), parameter :: rname="SPECTRAL>OBS>INIT"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call obs%point(hfs,par,spec,error)
    if (error) return
    !
    allocate(obs%wfit(spec%n),stat=ier)
    if (failed_allocate(rname,'fit weights',ier,error)) return
    !
    obs%ifirst  = wind%val(1)%o(1)     
    obs%ilast   = wind%val(wind%n)%o(2)
    obs%wfit(:) = 0
    do iw=1,wind%n
       do ichan=wind%val(iw)%o(1),wind%val(iw)%o(2)
          if (ieee_is_nan(spec%t(ichan))) then
             obs%wfit(ichan) = 0
          else
             obs%wfit(ichan) = 1
          endif
       enddo
    enddo
    !
    ! Compute first Sigma
    nbase   = 0
    ninfunc   = 0
    obs%sigbase = 0.
    obs%sigline = 0.
    aega   = obs%spec%t(obs%ifirst)*obs%wfit(obs%ifirst)
    asup   = aega
    do ichan=obs%ifirst+1,obs%ilast
       ainf=aega
       aega=asup
       asup=obs%spec%t(ichan)*obs%wfit(ichan)
       ! Check wether in/out of the line
       ! In the line: at least 2 consecutive points have the same sign
       if ( ainf*aega.lt.0. .and. aega*asup.lt.0. ) then
          obs%sigbase=obs%sigbase+aega**2
          nbase=nbase+1
       else
          obs%sigline=obs%sigline+aega**2
          ninfunc=ninfunc+obs%wfit(ichan-1)
       endif
    enddo
    !
    ! Try to avoid zero sigmas
    if (nbase.ne.0) obs%sigbase=sqrt(obs%sigbase/nbase)
    if (ninfunc.ne.0) then
       obs%sigline=sqrt(obs%sigline/ninfunc)
       if (obs%sigbase.eq.0.) obs%sigbase=obs%sigline
    else
       obs%sigline=obs%sigbase
    endif
  end subroutine cubefit_spectral_obs_init
  !
  subroutine cubefit_spectral_obs_point(obs,hfs,par,spec,error)
    !----------------------------------------------------------------------
    ! Do only pointings
    !----------------------------------------------------------------------
    class(spectral_obs_t),         intent(out)   :: obs
    type(hfs_prog_t),      target, intent(in)    :: hfs
    type(spectral_pars_t), target, intent(in)    :: par
    type(spectrum_t),      target, intent(in)    :: spec
    logical,                       intent(inout) :: error
    !
    character(len=*), parameter :: rname="SPECTRAL>OBS>POINT"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    obs%spec => spec
    obs%par  => par
    obs%hfs  => hfs
    !
    obs%deltav = abs(obs%spec%v(1)-obs%spec%v(2))
    obs%deltaf = abs(obs%spec%f(1)-obs%spec%f(2))
  end subroutine cubefit_spectral_obs_point
  !
  subroutine cubefit_spectral_obs_sigma(obs,fcn,dofreq)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(spectral_obs_t), intent(inout) :: obs
    interface
       function fcn(obs,xval,jfunc) result (yval)
         import 
         type(spectral_obs_t), intent(in) :: obs
         real(kind=coor_k),    intent(in) :: xval
         integer(kind=func_k), intent(in) :: jfunc
         real(kind=sign_k)                :: yval
       end function fcn
    end interface
    logical,               intent(in)    :: dofreq
    !
    integer(kind=chan_k) :: ichan,nfunc,nbase
    real(kind=sign_k) :: threshold,pred,sumfunc,sumbase
    real(kind=coor_k), pointer :: xaxis(:)
    character(len=*), parameter :: rname="SPECTRAL>OBS>SIGMA"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    nbase     = 0
    sumbase   = 0.
    nfunc     = 0
    sumfunc   = 0.
    threshold = obs%sigbase/3.
    if (dofreq) then
       xaxis => obs%spec%f
    else
       xaxis => obs%spec%v
    endif
    !
    do ichan=obs%ifirst,obs%ilast
       if (obs%wfit(ichan).ne.0) then
          pred = fcn(obs,xaxis(ichan),0)
          if (abs(pred).lt.threshold) then
             nbase=nbase+1
             sumbase=sumbase+obs%spec%t(ichan)**2
          else
             nfunc=nfunc+1
             sumfunc=sumfunc+(pred-obs%spec%t(ichan))**2
          endif
       endif
    enddo
    !
    if (nfunc.ne.0) then
       obs%sigline=sqrt(sumfunc/nfunc)
    else
       obs%sigline=0.
    endif
    if (nbase.gt.5) then
       obs%sigbase=sqrt(sumbase/nbase)
    else
       obs%sigbase=obs%sigline
    endif
  end subroutine cubefit_spectral_obs_sigma
  !
  subroutine cubefit_spectral_obs_estimate_gauss(obs,first,last,inte,velo,fwhm,error)
    !----------------------------------------------------------------------
    ! Compute first guesses for intensity, velocity and width in the range
    ! between first and last. Useful for methods GAUSS, HFS and ABSORPTION
    !----------------------------------------------------------------------
    class(spectral_obs_t), intent(in)    :: obs
    integer(kind=chan_k),  intent(in)    :: first
    integer(kind=chan_k),  intent(in)    :: last
    real(kind=para_k),     intent(out)   :: inte
    real(kind=para_k),     intent(out)   :: velo
    real(kind=para_k),     intent(out)   :: fwhm
    logical,               intent(inout) :: error
    !
    real(kind=sign_k) :: area,ymin,ymax,yval
    real(kind=coor_k) :: vinf,vsup
    integer(kind=chan_k) :: ichan
    character(len=*), parameter :: rname='SPECTRAL>OBS>ESTIMATE>GAUSS'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ymax=0.
    ymin=0.
    area=0.
    vinf = minval(obs%spec%v)
    vsup = maxval(obs%spec%v)
    do ichan=first+1,last-1
       yval = obs%spec%t(ichan)
       if (obs%wfit(ichan).ne.0) then
          if (yval.ge.ymax) then
             ymax = yval
             vsup = obs%spec%v(ichan)
          elseif (yval.le.ymin) then
             ymin = yval
             vinf = obs%spec%v(ichan)
          endif
          area = area+yval*abs(obs%spec%v(ichan+1)-obs%spec%v(ichan-1))
       endif
    enddo
    area = area*0.5
    if (area.lt.0.) then
       fwhm = abs(area/ymin)
       velo = vinf
       inte = ymin
    elseif (area.gt.0) then
       fwhm = abs(area/ymax)
       velo = vsup
       inte = ymax
    endif
  end subroutine cubefit_spectral_obs_estimate_gauss
  !
  subroutine cubefit_spectral_obs_estimate_shell(obs,first,last,area,freq,fwzl,error)
    !----------------------------------------------------------------------
    ! Compute first guesses for area, frequency and FWZL in the range
    ! between first and last. Useful for method SHELL
    !----------------------------------------------------------------------
    class(spectral_obs_t), intent(in)    :: obs
    integer(kind=chan_k),  intent(in)    :: first
    integer(kind=chan_k),  intent(in)    :: last
    real(kind=para_k),     intent(out)   :: area
    real(kind=para_k),     intent(out)   :: freq
    real(kind=para_k),     intent(out)   :: fwzl
    logical,               intent(inout) :: error
    !
    real(kind=sign_k) :: yval
    real(kind=8) :: mom0,mom1,mom2
    integer(kind=chan_k) :: ichan
    character(len=*), parameter :: rname='SPECTRAL>OBS>ESTIMATE>SHELL'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    mom0=0.
    mom1=0.
    mom2=0.
    do ichan=first+1,last-1
       yval = obs%spec%t(ichan)       
       if (obs%wfit(ichan).ne.0) then
          mom0 = mom0 + yval
          mom1 = mom1 + yval * obs%spec%f(ichan)
          mom2 = mom2 + yval * obs%spec%f(ichan)**2
       endif
    enddo
    if (mom0.ne.0) then
       mom1 = mom1 / mom0
       mom2 = mom2 / mom0
       yval  = abs ((obs%spec%f(first)-obs%spec%f(last)) / (first-last))
       fwzl = yval * sqrt (abs(mom2-mom1**2)*8.*alog(2.))
       freq = mom1
       area = mom0 * yval
       error = .false.
    else
       call cubefit_message(seve%e,rname,'Null area found, use manual mode')
       error = .true.
    endif
  end subroutine cubefit_spectral_obs_estimate_shell
end module cubefit_spectral_obs
