subroutine polyno_obs(set,obs,last,cont,flux,z,error)
  use gildas_def
  use gbl_constant
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>polyno_obs
  use class_types
  !---------------------------------------------------------------------
  ! @ private (?)
  ! Support routine for command BASE.
  ! This version for a single observation.
  ! Computes and remove a polynomial baseline. This version uses
  ! singular value decomposition, with fall back to Gauss Jordan if not
  ! possible.
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set    !
  type(observation),   intent(inout) :: obs    ! The input observation to work on
  logical,             intent(inout) :: last   ! Use last baseline determination
  logical,             intent(in)    :: cont   ! Divide rather than subtract baseline
  real(kind=4),        intent(inout) :: flux   ! Flux value (if 0, average of base channels)
  real(kind=4),        intent(inout) :: z(*)   ! Working array
  logical,             intent(out)   :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='POLYNO'
  real(kind=4) :: m0,m1,m2
  real(kind=8) :: x_inc,x_off
  real(kind=4) :: s0,s1,s2,alim,s12,rd,s11,resid
  integer(kind=4) :: i,j,mmm,np,w2,status
  real(kind=4) :: a_coef(mdeg),pp(mdeg),chisq,xi,xx,yy
  real(kind=4) :: xmin,xmax,ymin,ymax
  real(kind=8) :: xoff,dxoff
  real(kind=4), allocatable, save :: x(:)
  integer(kind=4), allocatable, save :: w1(:)
  real(kind=4), allocatable, save :: weight(:),y(:)
  real(kind=4), allocatable :: ipu(:,:), ipv(:,:), ipw(:)
  character(len=80) :: chain
  !
  ! Don't like this, but it is for BASE LAST ... Warning: can not work
  ! for parallel processing
  save a_coef,mmm,xmin,xmax,xoff
  !
  if (allocated(x)) then
     if (ubound(x,1).ne.obs%cnchan) then
        if (last) then
           call class_message(seve%w,rname,'Number of channels changed, LAST mode ignored')
           last = .false.
        endif
        deallocate(x,y,weight,w1)
     endif
  endif
  if (.not.allocated(x)) then
     allocate(x(obs%cnchan),y(obs%cnchan))
     allocate(weight(obs%cnchan),w1(obs%cnchan))
  endif
  !
  ! Set up the arrays to be minimized
  if (obs%head%gen%kind.ne.kind_onoff) then
    call polyno_obs_arrays_spec(obs,last,x,y,weight,w1,np,error)
    if (error)  return
  else
    call polyno_obs_arrays_cont(obs,x,y,weight,w1,np,error)
    if (error)  return
  endif
  !
  ! Check that we have enough points: #(points) > polynom degree
  ! Note: np = sum(weight) NOT sum(w1)
  ! Note: polynom degree>=0 implies np>0
  if (np.le.obs%head%bas%deg.and..not.last) then
     error = .true.
     write(chain,*) 'Not enough channels to fit baseline: ',np,obs%head%bas%deg
     call class_message(seve%e,rname,chain)
     return
  endif
  !
  !  Determine the baseline
  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
     mmm = min(obs%head%bas%deg+1,mdeg)
     xmin = x(1)
     xmax = x(np)
     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
     !
     !  Normalize range to [-1,1]
     do i=1,np
        x(i) = (2*x(i)-xmin-xmax)/(xmax-xmin)
     enddo
     !  Allocate work space for both methods
     allocate (ipv(mmm,mmm),stat=status)
     if (status.ne.0) then
        call class_message(seve%f,rname,'Insufficient memory for work space')
        error = .true.
        return
     endif
     allocate(ipu(np,mmm),ipw(mmm),stat=status)
     if (status.eq.0) then
        ! If possible, use singular value decomposition
        ! The 'mmm' coefficients are in array 'a_coef'
        call svdfit(x,y,weight,np,a_coef,mmm,ipu,ipv,ipw,np,mmm,chisq,fcheb,error)
        if (error) then
           call class_message(seve%e,rname,'Error in singular value decomposition')
        else
           !  Check for too high a degree
           call mindeg (ipw,mmm)
        endif
        deallocate(ipu,ipw)
        deallocate(ipv)
        if (error) return
     else
        !  Fall back on gauss-jordan inversion of the normal
        !  Equations when there is not enough memory
        call lfit(x,y,weight,np,a_coef,mmm,ipv,mmm,chisq,fcheb,error)
        deallocate(ipv)
        if (error) then
           call class_message(seve%e,rname,'Error during least square fit.')
           return
        endif
     endif
  endif
  !
  !  Compute baseline value for edges
  xx = -1.0
  call fcheb(xx,pp,mmm)
  yy = 0
  do j=1,mmm
     yy = yy+a_coef(j)*pp(j)
  enddo
  ymin = yy
  !
  xx = 1.0
  call fcheb(xx,pp,mmm)
  yy = 0
  do j=1,mmm
     yy = yy+a_coef(j)*pp(j)
  enddo
  ymax = yy
  !
  if (mmm.gt.2) then
     !  Degree > 1 => mmm.gt.2
     ! Compute polynomial in fitting range, constant value outside
     ! this range
     do i=1, obs%cnchan
        xi = obs%datax(i)+dxoff
        xx = ((xi-xmin)-(xmax-xi))/(xmax-xmin)
        if (xx.le.-1.0) then
           yy = ymin
        elseif (xx.ge.1.0) then
           yy = ymax
        else
           call fcheb(xx,pp,mmm)
           yy = 0
           do j=1,mmm
              yy = yy+a_coef(j)*pp(j)
           enddo
        endif
        z(i) = yy
     enddo
  else
     ! Degree 0 or 1 : compute polynomial everywhere (including
     ! extrapolation beyond edges)
     do i=1, obs%cnchan
        xi = obs%datax(i)+dxoff
        xx = ((xi-xmin)-(xmax-xi))/(xmax-xmin)
        yy = ymin + (xx+1.0)*(ymax-ymin)/2.0
        z(i) = yy
     enddo
  endif
  !
  !  Subtract the baseline and find the sigma
  s0 = 0.
  s1 = 0.
  s2 = 0.
  s11 = 0
  do i = 1, obs%cnchan
     !  Avoid bad channels
     if (obs%spectre(i).ne.obs%head%spe%bad) then
        resid = obs%spectre(i)-z(i)
        !  Continuum or spectral data
        if (.not.cont) then
           obs%spectre(i) = resid
        else
           obs%spectre(i) = obs%spectre(i)/z(i)
        endif
        if (w1(i).ne.0) then
           s0 = s0 + w1(i)
           s1 = s1 + w1(i)*resid
           s2 = s2 + w1(i)*resid**2
           if (cont) s11 = s11+w1(i)*z(i)
        endif
     endif
  enddo
  if (cont) then
     if (flux.eq.0 .and. s0.gt.0) then
        flux = s11/s0
        s11 = 1
     else
        s11 = flux/s11*s0
     endif
     write(chain,'(A,F0.3)') 'Average flux value: ',flux
     call class_message(seve%i,rname,chain)
     do i = 1, obs%cnchan
        if (obs%spectre(i).ne.obs%cbad) then
           obs%spectre(i) = obs%spectre(i)*flux
        endif
     enddo
     obs%head%gen%tsys = obs%head%gen%tsys*abs(s11)
     s1 = s1 * s11
     s2 = s2 * s11**2
  endif
  if (s0.ne.0) then
     s1 = s1 / s0          ! 1st order moment
     s2 = s2 / s0          ! 2bd order moment
     obs%head%bas%sigfi = sqrt(s2-s1**2)
  else
     obs%head%bas%sigfi = 0.
  endif
  !
  !  Area, velocity, width
  obs%head%bas%aire = 0.
  m0 = 0.  ! area
  m1 = 0.  ! 1st order moment
  m2 = 0.  ! 2nd order moment
  alim = obs%head%bas%sigfi * 3.0
  s0 = 0.
  s1 = 0.
  s2 = 0.
  do i = obs%cimin, obs%cimax
     !  Avoid bad channels
     w2 = 1-w1(i)       ! w2=1 means channel in window(s)
     if (w2.ne.0) then
        rd = obs_good(obs,i)  ! if channel is bad, repair it
        if (cont) then
           resid = rd-flux
        else
           resid = rd
        endif
        obs%head%bas%aire = obs%head%bas%aire + resid * w2
        if (abs(resid).ge.alim) then
           s0 = s0 + resid * w2
           s1 = s1 + resid * i * w2
           s2 = s2 + resid * float(i)**2 * w2
        endif
     endif
  enddo
  !
  ! Type out result according to kind
  ! - units of outputs (area,width,position) depend on X axis unit
  ! - obs%head%bas%area is stored with X unit in km/s
  if (obs%head%gen%kind.eq.kind_spec) then
     if (set%unitx(1).eq."V") then
        x_inc = obs%head%spe%vres
        x_off = obs%head%spe%voff
     else if (set%unitx(1).eq."F" .or. set%unitx(1).eq."I") then
        x_inc = obs%head%spe%fres
        x_off = 0.d0
     else if (set%unitx(1).eq."C") then
        x_inc = 1.d0
        x_off = obs%head%spe%rchan
     endif
     m0 = obs%head%bas%aire*abs(x_inc)
     obs%head%bas%aire = obs%head%bas%aire * abs(obs%head%spe%vres)
     if (s0.ne.0) then
        s1 = s1 / s0
        m1 = (s1-obs%head%spe%rchan)*x_inc+x_off
        s2 = s2 / s0
        s12 = s1**2
        if (s2.le.s12) s2 = s12
        m2 = abs(x_inc)*sqrt((s2-s12)*8.*alog(2.))
     endif
  else
     obs%head%bas%aire = obs%head%bas%aire * abs (obs%head%dri%ares)
     m0 = obs%head%bas%aire
     if (s0.ne.0) then
        s1 = s1 / s0
        m1 = (s1-obs%head%dri%rpoin) * obs%head%dri%ares + obs%head%dri%aref
        s2 = s2 / s0
        s12 = s1**2
        if (s2.le.s12) s2 = s12
        m2  =  abs (obs%head%dri%ares) * sqrt((s2-s12)*8.*alog(2.))
     endif
  endif
  !
  ! Output
  if (obs%head%bas%sigfi.ne.0.) then
     write(chain,'(a,i3,a,1pg10.3,a,1pg10.3,a,1pg11.4,a,1pg10.4)')  &
          'degree: ',obs%head%bas%deg,    &
          ' rms:',   obs%head%bas%sigfi,  &
          ' area:',  m0,                  &
          ' v0:',    m1,                  &
          ' width:', m2
  else
     write(chain,'(a,i3,a,a,1pg10.3,a,1pg11.4,a,1pg10.4)')  &
          'degree: ',obs%head%bas%deg,  &
          ' rms: not measured',         &
          ' area:',  m0,                &
          ' v0:',    m1,                &
          ' width:', m2
  endif
  call class_message(seve%i,rname,chain)
end subroutine polyno_obs
!
subroutine polyno_obs_arrays_spec(obs,last,x,y,weight,w1,np,error)
  use gbl_message
  use classcore_interfaces, except_this=>polyno_obs_arrays_spec
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Fill the X, Y, WEIGHT arrays with the valid points to be used for
  ! baselining. A valid point is not in a signal window and is not
  ! bad. The number of valid points is set in NP.
  !  Also fill the W1 array with 0 (in a signal window) or 1 (out a
  ! signal window), i.e. W1 is the representation of the signal windows
  ! as an array of channels.
  !  X, Y, WEIGHT and W1 must have been preallocated to the size
  ! obs%cnchan (i.e. the number of channels currently covered by SET
  ! MODE X), even if they are not entirely used in return.
  !---------------------------------------------------------------------
  type(observation), intent(in)    :: obs        !
  logical,           intent(in)    :: last       ! Do we reuse the last fitting results?
  real(kind=4),      intent(out)   :: x(:)       ! X positions, in current DATAX units
  real(kind=4),      intent(out)   :: y(:)       ! Y intensities
  real(kind=4),      intent(out)   :: weight(:)  !
  integer(kind=4),   intent(out)   :: w1(:)      ! In or out the signal windows
  integer(kind=4),   intent(out)   :: np         !
  logical,           intent(inout) :: error      !
  ! Local
  character(len=*), parameter :: rname='POLYNO'
  integer(kind=4) :: i,i1,i2,i3,iw
  real(kind=4) :: vv
  integer(kind=4), pointer :: line(:)
  !
  ! Velocity increases or decreases with channel number, increment I3 = +/- 1
  if (obs%datax(obs%cnchan).gt.obs%datax(1)) then
    i1 = 1
    i2 = obs%cnchan
    i3 = 1
  else
    i1 = obs%cnchan
    i2 = 1
    i3 = -1
  endif
  !
  ! Loop on channels
  ! w1(i)=1 if channel i not in window
  ! weight(i)=1 if w1(i)=1 AND channel i not bad
  ! np = sum(weight)
  np = 0
  !
  if (obs%head%bas%nwind.eq.basnwind_assoc) then
    ! Automatic mode: no spectral windows; use Associated Array named "LINE"
    ! which provides, for each channel, 0 (out of a line) or 1 (in a line).
    if (.not.class_assoc_exists(obs,'LINE',line)) then
      call class_message(seve%e,rname,'Associated Array LINE does not exists')
      error = .true.
      return
    endif
    do i=i1, i2, i3
      w1(i) = 0
      if (i.lt.obs%cimin .or. i.gt.obs%cimax)  cycle
      if (line(i).eq.1)  cycle
      if (obs%spectre(i).ne.obs%head%spe%bad) then  !  Avoid bad channels
        np = np + 1
        weight(np)= +1.0
        x(np) = obs%datax(i)
        y(np) = obs%spectre(i)
      endif
      w1(i) = 1
    enddo
    !
  else
    ! Spectral windows are found in obs%head%bas%w1 and w2, which have been
    ! preset.
chanloop: do i=i1, i2, i3
      w1(i) = 0
      if (i.lt.obs%cimin .or. i.gt.obs%cimax)  cycle
      vv = obs%datax(i)
      !  Loop on spectral window(s)
      do iw = 1, obs%head%bas%nwind  ! Nwind can be zero
        ! Dichotomy-like test to check whether in or out of the signal window
        if ( (vv-obs%head%bas%w1(iw))*(vv-obs%head%bas%w2(iw)).lt.0.) then
          ! In a signal window. Skip this channel, but warn for
          ! extrapolation.
          if (i.ne.obs%cimin .and. i.ne.obs%cimax) then
            cycle chanloop
          elseif (.not.last .and. obs%head%bas%deg.gt.1) then
            ! This means a window overlaps a boundary of the SET MODE X
            ! range. What happens to the baselining in this boundary window?
            !  - degrees 0, 1 or sinus are extrapolated
            !  - degrees >=2 are not extrapolated, i.e. a constant value
            !    is used.
            ! In other words, when a window overlaps a SET MODE X boundary,
            ! the fitting range is not SET MODE X, but SET MODE X less the
            ! window. Out of the fitting range, the usual extrapolation rules
            ! apply.
            call class_message(seve%w,rname,'Baseline extrapolation is hazardous')
            cycle chanloop
          else
            cycle chanloop
          endif
        endif
      enddo
      if (obs%spectre(i).ne.obs%head%spe%bad) then  !  Avoid bad channels
        np = np + 1
        weight(np)= +1.0
        x(np) = obs%datax(i)
        y(np) = obs%spectre(i)
      endif
      w1(i) = 1
    enddo chanloop
  endif
  !
end subroutine polyno_obs_arrays_spec
!
subroutine polyno_obs_arrays_cont(obs,x,y,weight,w1,np,error)
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Handle the special case of continuum on/off
  !---------------------------------------------------------------------
  type(observation), intent(in)    :: obs        !
  real(kind=4),      intent(out)   :: x(:)       ! X positions, in current DATAX units
  real(kind=4),      intent(out)   :: y(:)       ! Y intensities
  real(kind=4),      intent(out)   :: weight(:)  !
  integer(kind=4),   intent(out)   :: w1(:)      ! In or out the signal windows
  integer(kind=4),   intent(out)   :: np         !
  logical,           intent(inout) :: error      !
  ! Global
  include 'gbl_pi.inc'  ! For epsr4
  ! Local
  integer(kind=4) :: i
  !
  ! Group the data points in pairs, and ignore windows.
  np = 1
  x(1) = obs%datax(1)
  y(1) = (obs%spectre(1)+obs%spectre(2))/2
  weight(1) = epsr4
  do i=1,obs%cnchan/2
    if (obs%spectre(2*i-1).ne.obs%cbad .and. obs%spectre(2*i).ne.obs%cbad) then
      np = np + 1
      weight(np)= +1.0
      x(np) = (obs%datax(2*i-1)+obs%datax(2*i))/2
      y(np) = (obs%spectre(2*i-1)+obs%spectre(2*i))/2
    endif
    w1(2*i)   = 1
    w1(2*i-1) = 1
  enddo
  np = np+1
  x(np) = obs%datax(obs%cnchan)
  y(np) = (obs%spectre(obs%cnchan)+obs%spectre(obs%cnchan-1))/2
  weight(np) = epsr4
  !
end subroutine polyno_obs_arrays_cont
!
subroutine mindeg(a,n)
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! CLASS  Internal routine
  !    Warn if the polynomial degree is too high
  !---------------------------------------------------------------------
  integer, intent(in) :: n     ! Polynom degree + 1
  real,    intent(in) :: a(n)  ! RMS for each degree
  !
  ! Local variables
  integer :: imin
  character(len=32) :: chain
  !
  imin = minloc(a,1)
  if (imin.lt.n) then
     write(chain,'(A,I2,A)') 'Degree ',imin-1,' would be even better'
     call class_message(seve%i,'POLYNO',chain)
  endif
end subroutine mindeg
