subroutine sinus_obs(set,obs,sinuspar,last,work,error)
  use gildas_def
  use phys_const
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>sinus_obs
  use class_types
  use sinus_parameter
  !---------------------------------------------------------------------
  ! @ private
  ! This version for a single observation.
  ! Subtract a sinusoidal baseline to the input observation
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set          !
  type(observation),   intent(inout) :: obs          ! The observation to work on
  real(kind=4),        intent(in)    :: sinuspar(3)  ! Amplitude Period Phase
  logical,             intent(in)    :: last         ! Subtract last fitted baseline
  real(kind=4),        intent(inout) :: work(*)      ! Working array
  logical,             intent(inout) :: error        ! Error flag
  ! Local
  integer(kind=4) :: ier,nchan
  real(kind=4) :: result(5)
  real(kind=8) :: xoff,dxoff
  !
  save result,xoff  ! Save for BASE LAST
  !
  nchan = obs%cnchan
  ! Remark: obs%cnchan can be different from e.g. size(obs%datax) since
  ! reallocate_obs does not shrink the arrays when loading a smaller
  ! observation.
  !
  ! Initialization
  if (mxcan.lt.nchan) then
     if (allocated(wfit)) deallocate(wfit)
  endif
  if (.not.allocated(wfit)) then
     mxcan = nchan
     allocate(wfit(mxcan),stat=ier)
     if (failed_allocate('SINUS','WFIT',ier,error))  return
  endif
  !
  if (last) then
    ! Compute Delta-X-offset, i.e. the difference of offsets between
    ! the LAST and the current X values, since these offsets are not
    ! in obs%datax
    if (set%unitx(1).eq.'F') then
      dxoff = obs%head%spe%restf - xoff
    elseif (set%unitx(1).eq.'I') then
      dxoff = obs%head%spe%image - xoff
    else
      dxoff = 0.d0
    endif
  else
     if (set%unitx(1).eq.'F') then
       xoff = obs%head%spe%restf
     elseif (set%unitx(1).eq.'I') then
       xoff = obs%head%spe%image
     else
       xoff = 0.d0
     endif
     dxoff = 0.d0
     !
     result(:) = 0.
     par(1:3) = sinuspar(:)
     call fitsinus(set,obs,minsinus,.false.,error)
     result(:) = par(:)
  endif
  !
  work(1:nchan) = result(5) + result(4)*(obs%datax(1:nchan)+dxoff) +  &
    result(1)*sin(2.0*pis*(obs%datax(1:nchan)+dxoff-result(3))/result(2))
  !
  ! Subtract the baseline
  where (obs%spectre(1:nchan).ne.obs%cbad)
    obs%spectre(1:nchan) = obs%spectre(1:nchan) - work(1:nchan)
  end where
  !
  ! Store the fitted values in the header
  obs%head%bas%sigfi = sigbas
  obs%head%bas%sinus(1:2) = result(1:2)
  obs%head%bas%sinus(3) = result(3)-dxoff
  !
end subroutine sinus_obs
!
subroutine fitsinus(set,obs,fcn,liter,error)
  use gildas_def
  use gbl_message
  use fit_minuit
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>fitsinus
  use class_types
  use sinus_parameter
  !---------------------------------------------------------------------
  ! @ private
  ! Setup and starts a gauss fit minimisation using minuit
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in) :: set  !
  type(observation),   intent(in) :: obs  ! The observation to work on
  interface
    subroutine fcn(npar,g,f,x,iflag,obs)  ! Function to be mininized
    use class_types
    integer(kind=4),   intent(in)  :: npar
    real(kind=8),      intent(out) :: g(npar)
    real(kind=8),      intent(out) :: f
    real(kind=8),      intent(in)  :: x(npar)
    integer(kind=4),   intent(in)  :: iflag
    type(observation), intent(in)  :: obs
    end subroutine fcn
  end interface
  logical,           intent(in)  :: liter  ! Iterate fit
  logical,           intent(out) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='BASE SINUS'
  integer(kind=4) :: i,l,ier
  real(kind=8) :: dx,al,ba,du1,du2
  character(len=100) :: mess
  type(fit_minuit_t) :: fit
  !
  ! Added error patch for initialisation
  error = .false.
  ier = 0
  if (set%slev.le.1) then
     fit%verbose = .true.
  else
     fit%verbose = .false.
  endif
  fit%owner = gpack_get_id('class',.true.,error)
  if (error)  return
  fit%maxext=ntot
  fit%maxint=nvar
  !
  ! Initialize values for 1st order polynom component
  call init_sinus(set,obs)
  !
  deltav = abs(obs%datax(obs%cimin+1)-obs%datax(obs%cimin))
  call midsinus(obs,fit,ier,liter)
  if (ier.ne.0) then
     error = .true.
     return
  endif
  call intoex(fit,fit%x)
  fit%up      = sigbas**2
  fit%nfcnmx  = 1000
  fit%epsi    = 0.1d0 * fit%up
  fit%newmin  = 0
  fit%itaur   = 0
  fit%isw(1)  = 0
  fit%isw(3)  = 1
  fit%nfcn    = 1
  fit%vtest   = 0.04
  call fcn(fit%npar,fit%g,fit%amin,fit%u,1,obs)
  !
  ! Simplex minimization
  if (.not.liter) then
     ier = 0
     call simplx(fit,fcn,ier)
     if (ier.ne.0) then
        error = .true.
        return
     endif
  endif
  !
  ! Gradient minimization
  call intoex(fit,fit%x)
  call fcn(fit%npar,fit%g,fit%amin,fit%u,3,obs)
  fit%up = sigbas**2
  fit%epsi  = 0.1d0 * fit%up
  fit%apsi  = fit%epsi
  call hesse(fit,fcn)
  call migrad(fit,fcn,ier)
  if (ier.eq.1) then
     call hesse(fit,fcn)
     ier = 0
  elseif (ier.eq.3) then
     ier = 0
     call migrad(fit,fcn,ier)
     if (ier.eq.1) then
        call hesse(fit,fcn)
     else if (ier.eq.3) then
        call class_message(seve%w,rname,'Sinus did not converged')
     endif
  endif
  if (ier.eq.4) then
     call class_message(seve%e,rname,'Sinus did not converged')
     error =.true.
     return
  endif
  !
  ! Save results for printing
  par(1) = fit%u(1)
  par(2) = fit%u(2)
  par(3) = fit%u(3)
  par(4) = fit%u(4)
  par(5) = fit%u(5)
  fit%nu = 5
  call intoex(fit,fit%x)
  call fcn(fit%npar,fit%g,fit%amin,fit%u,3,obs)
  fit%up = sigbas**2
  !
  ! calculate external errors
  do i=1,fit%nu
     l  = fit%lcorsp(i)
     if (l.eq.0)  then
        fit%werr(i)=0.
     else
        if (fit%isw(2).ge.1)  then
           dx = sqrt(abs(fit%v(l,l)*fit%up))
           if (fit%lcode(i) .gt. 1) then
              al = fit%alim(i)
              ba = fit%blim(i) - al
              du1 = al + 0.5d0 *(sin(fit%x(l)+dx) +1.0d0) * ba - fit%u(i)
              du2 = al + 0.5d0 *(sin(fit%x(l)-dx) +1.0d0) * ba - fit%u(i)
              if (dx.gt.1.0d0)  du1 = ba
              dx = 0.5d0 * (abs(du1) + abs(du2))
           endif
           fit%werr(i) = dx
        endif
     endif
  enddo
  !
  write(mess,1000) sigbas,  &
                   par(1),fit%werr(1),  &
                   par(2),fit%werr(2),  &
                   par(3),fit%werr(3)
  call class_message(seve%i,rname,mess)
  !
1000 format(1x,'bas: ',f7.3,               &
            3x,'I0: ', f8.3,'(',f7.3,')',  &
            4x,'PER: ',f8.3,'(',f7.3,')',  &
            4x,'PHI: ',f8.3,'(',f7.3,')')
end subroutine fitsinus
!
subroutine init_sinus(set,obs)
  use gildas_def
  use sinus_parameter
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  ! Initializes parameters for 1st order polynom component of sine fit
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in) :: set  !
  type(observation),   intent(in) :: obs  ! The observation to work on
  ! Local
  real(kind=4) :: ainf,asup,xinf,xsup,vv
  integer(kind=4) :: i,kbas,kinf,ksup,iw,imed
  !
  ! Set the weights in wfit
  ! mask window part of the spectrum
  do i=1, obs%cnchan
     wfit(i) = 0
     if (i.lt.obs%cimin.or.i.gt.obs%cimax) goto 30
     if (set%nwind.gt.0) then
        vv = obs%datax(i)
        do iw = 1,set%nwind
           if ((vv-set%wind1(iw))*(vv-set%wind2(iw)).le.0) goto 30
        enddo
     endif
     ! avoid bad channels
     if (obs%spectre(i).eq.obs%cbad) then
        wfit(i)=0
     else
        wfit(i)=1
     endif
30   continue
  enddo
  !
  ! Compute the sigma
  kinf=0
  ksup=0
  ainf = 0.0
  asup = 0.0
  xinf = 0.0
  xsup = 0.0
  imed = (obs%cimax+obs%cimin)/2
  do i=obs%cimin,imed
     if (wfit(i).ne.0) then
        kinf = kinf+1
        ainf = ainf+obs%spectre(i)
        xinf = xinf+obs%datax(i)
     endif
  enddo
  do i=imed,obs%cimax
     if (wfit(i).ne.0) then
        ksup = ksup+1
        asup = asup+obs%spectre(i)
        xsup = xsup+obs%datax(i)
     endif
  enddo
  !
  ! par(4): slope
  ! par(5): ordinate
  if (kinf.ne.0 .and. ksup.ne.0) then
     par(4) = (asup/ksup-ainf/kinf)/(xsup/ksup-xinf/kinf)
     par(5) = (ksup*asup+kinf*ainf)/(ksup+kinf)
  elseif (kinf.ne.0 .or. ksup.ne.0) then
     par(4) = 0.0
     par(5) = (ksup*asup+kinf*ainf)/(ksup+kinf)
  else
     par(4) = 0.0
     par(5) = 0.0
  endif
  !
  ! Compute rms of (spectrum-1st order polynom)
  kbas = 0
  sigbas = 0.0
  do i=obs%cimin,obs%cimax
     if (wfit(i).ne.0) then
        kbas = kbas+1
        sigbas = sigbas + (obs%spectre(i)-par(4)*obs%datax(i)-par(5))**2
     endif
  enddo
  if (kbas.ne.0) then
     sigbas=sqrt(sigbas/kbas)
  else
     sigbas=1.0
  endif
end subroutine init_sinus
!
subroutine sinus_obs_new(set,obs,dosinus,sinuspar,work,error)
  use gbl_message
  use phys_const
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>sinus_obs_new
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  ! This version for a single observation.
  ! Subtract a sinusoidal baseline to the input observation, knowing
  ! its period.
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set          !
  type(observation),   intent(inout) :: obs          ! The observation to work on
  logical,             intent(in)    :: dosinus(3)   ! Which parameters are to be fitted?
  real(kind=4),        intent(in)    :: sinuspar(3)  ! Ampli Period Phase
  real(kind=4),        intent(inout) :: work(*)      ! The fitted model
  logical,             intent(inout) :: error        ! Error flag
  ! Local
  character(len=*), parameter :: rname='BASE'
  real(kind=4) :: conti,ampli,period,pulsa,phase
  real(kind=8) :: co,si,sigbas
  real(kind=8) :: A(3,3),B(3,3),V(3),W(3)
  integer(kind=4) :: iw,ichan,nchan
  character(len=message_length) :: mess
  !
  if (dosinus(1) .and. .not.dosinus(2) .and. dosinus(3)) then
    ! Period is fixed, amplitude and phase are free. Compute analytic solution
    ! for formula:
    !   Y[i] = ampli * sin(2*pi*X[i] + phase)
    period = sinuspar(2)
    pulsa = 2.*pis/period
    A(:,:) = 0.d0
    V(:) = 0.d0
CHANLOOP: do ichan=obs%cimin,obs%cimax
      if (obs%spectre(ichan).eq.obs%cbad)  cycle
      do iw=1,set%nwind
        ! Ignore channels in windows. NB: upper and lower bounds may not be ordered
        if ( (obs%datax(ichan)-set%wind1(iw)) *     &
             (obs%datax(ichan)-set%wind2(iw)).le.0. )  cycle CHANLOOP
      enddo
      !
      si = sin(pulsa*obs%datax(ichan))
      co = cos(pulsa*obs%datax(ichan))
      !
      A(1,1) = A(1,1) + 1
      A(1,2) = A(1,2) + si
      A(1,3) = A(1,3) + co
      !
      A(2,1) = A(2,1) + si
      A(2,2) = A(2,2) + si*si
      A(2,3) = A(2,3) + si*co
      !
      A(3,1) = A(3,1) + co
      A(3,2) = A(3,2) + si*co
      A(3,3) = A(3,3) + co*co
      !
      V(1) = V(1) + obs%spectre(ichan)
      V(2) = V(2) + obs%spectre(ichan)*si
      V(3) = V(3) + obs%spectre(ichan)*co
    enddo CHANLOOP
    !
    if (A(1,1).le.0.d0) then
      call class_message(seve%e,rname,'No valid data in range')
      error = .true.
      return
    endif
    !
    call matinv3(A,B)
    !
    call matvec(V,B,W)
    !
    conti = W(1)  ! Continuum level
    ampli = sqrt( W(2)*W(2) + W(3)*W(3) )
    phase = atan2(W(3),W(2))
    !
!   elseif (.not.dosinus(1) .and. .not.dosinus(2) .and. .not.dosinus(3)) then
!     ! All parameters are fixed. Just fit a continuum and apply the values
!     conti =  ZZZ
!     ampli = sinuspar(1)
!     period = sinuspar(2)
!     pulsa = 2.*pis/period
!     phase = sinuspar(3)
    !
  else
    write(mess,'(3(A,L1))')  'NEWSINUS does not support fitting Amplitude ',  &
                             dosinus(1),', Period ',dosinus(2),', Phase ',dosinus(3)
    call class_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! Convert to the data format formula (in particular the phase is in the same
  ! unit as the period, usually km/s or MHz), from:
  !  Y[i] = ampli * sin(2*pi*X[i] + phase)
  !     to:
  !  Y[i] = ampli * sin(2*pi* (X[i]-phase)/period)
  phase = -phase/pulsa
  !
  ! Feedback
  write(mess,'(4(A,F0.3))') 'NEWSINUS fitted continuum ',conti,', amplitude ',  &
                            ampli,', period ',period,', phase ',phase
  call class_message(seve%i,rname,mess)
  !
  ! Post-processing
  nchan = 0
  sigbas = 0.d0
  do ichan=1,obs%cnchan
    ! Compute the model for all channels (not only cimin to cimax)
    work(ichan) = conti + ampli*sin(pulsa*(obs%datax(ichan)-phase))
    !
    ! Remove model (only for non-bad data)
    if (obs%spectre(ichan).eq.obs%cbad)  cycle
    obs%spectre(ichan) = obs%spectre(ichan)-work(ichan)
    !
    ! Compute sigma (only from cimin to cimax)
    if (ichan.lt.obs%cimin .or. ichan.gt.obs%cimax)  cycle
    nchan = nchan+1
    sigbas = sigbas + obs%spectre(ichan)**2
  enddo
  if (nchan.gt.0)  sigbas = sqrt(sigbas/nchan)
  !
  ! Store the fitted values in the header
  obs%head%bas%sigfi = sigbas
  obs%head%bas%deg = -1
  obs%head%bas%sinus(1) = ampli
  obs%head%bas%sinus(2) = period
  obs%head%bas%sinus(3) = phase
  !
end subroutine sinus_obs_new
