!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine mrtcal_pointing_create(backsci,drifts,error)
  use mrtcal_messaging
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this=>mrtcal_pointing_create
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(science_backend_t), intent(in)    :: backsci  !
  type(obs_list_t),        intent(inout) :: drifts   ! Output collection of drifts
  logical,                 intent(inout) :: error    !
  ! Local
  integer(kind=4) :: ipix,iset
  character(len=*), parameter :: rname='POINTING>CREATE'
  !
  ! Sanity
  if (backsci%cumulinit) then
    ! No data accumulated, or remnants from a previous accumulation
    ! which should be ignored. Can happen if tables are zero-sized
    ! (no data or no good data), but should be trapped earlier.
    call mrtcal_message(seve%e,rname,'No data accumulated to be written')
    error = .true.
    return
  endif
  if (backsci%cumul%kind.ne.ckind_onoff) then
    call mrtcal_message(seve%e,rname,'Unexpected chunkset kind')
    error = .true.
    return
  endif
  if (backsci%cumul%ntime.ne.1) then
    call mrtcal_message(seve%e,rname,'Unexpected time dimension')
    error = .true.
    return
  endif
  !
  do ipix=1,backsci%cumul%npix
    do iset=1,backsci%cumul%nset
      call mrtcal_pointing_create_from_chunkset(  &
        backsci%cumul%chunkset(iset,ipix,1),drifts,error)
      if (error)  return
    enddo
  enddo
  !
end subroutine mrtcal_pointing_create
!
subroutine mrtcal_pointing_create_from_chunkset(chunkset,drifts,error)
  use class_types
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this=>mrtcal_pointing_create_from_chunkset
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(chunkset_t), intent(in)    :: chunkset  !
  type(obs_list_t), intent(inout) :: drifts    ! Output collection of drifts
  logical,          intent(inout) :: error     !
  ! Local
  type(drift_book_t), pointer :: book  ! Unused
  type(observation), pointer :: obs
  !
  call drifts%new(book,obs,error)
  if (error)  return
  call mrtcal_chunkset_to_obs_ry(chunkset,obs,error)
  if (error)  return
end subroutine mrtcal_pointing_create_from_chunkset
!
subroutine mrtcal_solve_and_write_obslist(drifts,out,ndrift,error)
  use class_types
  use mrtcal_calib_types
  use mrtcal_setup_types
  use mrtcal_interfaces, except_this=>mrtcal_solve_and_write_obslist
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(obs_list_t),            intent(inout) :: drifts  ! Collection of drifts
  type(mrtcal_setup_output_t), intent(in)    :: out     ! Output configuration
  integer(kind=4),             intent(inout) :: ndrift  ! Cumulative sum of drifts written
  logical,                     intent(inout) :: error   !
  !
  integer(kind=list_k) :: idrift
  type(observation), pointer :: obs
  !
  do idrift=1,drifts%n
    call drifts%get(idrift,obs,error)
    if (error)  return
    call mrtcal_solve_pointing_observation(obs,error)
    if (error)  return
    call mrtcal_pointing_associate_array(obs,error)
    if (error)  return
    if (out%toclass) then
      call mrtcal_obs_to_class(obs,error)
      if (error)  return
    endif
    ndrift = ndrift+1
  enddo
end subroutine mrtcal_solve_and_write_obslist
!
subroutine mrtcal_solve_pointing_observation(obs,error)
  use phys_const
  use point_definitions
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_messaging
  use mrtcal_interfaces, except_this=>mrtcal_solve_pointing_observation
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs
  logical,           intent(inout) :: error
  !
  type(pointing_t) :: point
  type(point_guess_t) :: guess
  logical, parameter :: quiet = .false.
  integer(kind=4) :: ndat
  character(len=16) :: str
  character(len=*), parameter :: rname='SOLVE>POINTING>OBSERVATION'
  !
  ndat = obs%head%dri%npoin
  call init_pointing(ndat,      &  ! Number of data points
                     ndat,      &  ! Number of solution points
                     0,         &  ! ??? Pointing coordinate system
                     ' ',       &  ! ??? Pointing direction in above system
                     'SINGLE',  &  ! i.e. GAUSSIAN+BASE
                     point,error)
  if (error)  goto 100
  !
  point%dat%x(:) = obs%datav(1:ndat)*sec_per_rad  !
  point%dat%y(:) = obs%data1(1:ndat)              ! R4 to R8
  point%dat%w(:) = obs%dataw(1:ndat)
  !
  call default_pointing_guess(guess)
  ! Override the gaussian width with the telescope beam. Note the width
  ! is also used by solve_pointing to sample the gaussian position on
  ! the X axis.
  guess%width%value = iram_30m_beam(obs%head%dri%freq/1.d3)
  !
  ! All parameters are free
  guess%area%fixed     = .false.
  guess%position%fixed = .false.
  guess%width%fixed    = .false.
  guess%offset%fixed   = .false.
  guess%slope%fixed    = .false.
  !
  point%fun%flag = 2  ! Needed so that 'solve_pointing' actually works
  call solve_pointing(point,guess,quiet,error)
  if (error)  goto 100
  !
  ! Transfer to observation
  call mrtcal_fit_to_obs_poi(point%fun,obs,error)
  if (error)  goto 100
  !
  call mrtcal_solve_pointing_debug()
  !
100 continue
  call free_pointing(point)
  !
contains
  !
  subroutine mrtcal_solve_pointing_debug()
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    integer(kind=4) :: debug,ier
    character(len=message_length) :: mess
    real(kind=4) :: vpeak,epeak
    real(kind=8) :: xmin,xmax,ymin,ymax,bval,eval,y1,y2
    integer(kind=size_length) :: ndat8,imin,imax
    logical :: altplot
    !
    debug = 0  ! Default (0=no, 1=histo, 2=points)
    ier = sic_getlog('MRTCAL_SOLVE_POINTING_DEBUG',debug)
    if (debug.le.0)  return
    !
    ! Feedback
    print *,"Values:   Area   Position    FWHM    Offset    Slope    Peak"  ! Order in fun%par(:)
    write(mess,'(a,5(1pg10.3))')  "Guesses: ",guess%area%value,      &
                                              guess%position%value,  &
                                              guess%width%value,     &
                                              guess%offset%value,    &
                                              guess%slope%value
    print *,trim(mess)
    call mrtcal_pointing_peak(obs%head%poi,vpeak,epeak,error)
    if (error)  return
    write(mess,'(a,6(1pg10.3))')  "Results: ",point%fun%par(1:5)%value,vpeak
    print *,trim(mess)
    write(mess,'(a,6(1pg10.3))')  "Errors:  ",point%fun%par(1:5)%error,epeak
    print *,trim(mess)
    write(mess,'(a,1(1pg10.3))')  "RMS:  ",point%fun%rms
    print *,trim(mess)
    !
    ! Plot
    call gr_execl('CLEAR')
    call gr_exec1('SET PLOT LANDSCAPE')
    !
    ! Limits (suited for the drift)
    ndat8 = ndat
    bval = 0.d0
    eval = -1.d0
    call gr8_minmax(ndat8,point%dat%x,bval,eval,xmin,xmax,imin,imax)
    ! Y
    bval = obs%head%dri%bad
    eval = 0.d0
    call gr8_minmax(ndat8,point%dat%y,bval,eval,ymin,ymax,imin,imax)
    !
    call mrtcal_solve_pointing_plot(debug,xmin,xmax,ymin,ymax,vpeak)
    !
    ! Limits (suited for the drift and the gaussian)
    altplot = .false.
    ! X: ensure we see the gaussian and its wings if outside the data range
    if      (point%fun%par(2)%value-2*point%fun%par(3)%value.lt.xmin) then
      xmin = point%fun%par(2)%value-2*point%fun%par(3)%value
      altplot = .true.
    endif
    if  (point%fun%par(2)%value+2*point%fun%par(3)%value.gt.xmax) then
      xmax = point%fun%par(2)%value+2*point%fun%par(3)%value
      altplot = .true.
    endif
    ! Y: ensure we see the baseline at both edges
    y1 = point%fun%par(4)%value+xmin*point%fun%par(5)%value
    y2 = point%fun%par(4)%value+xmax*point%fun%par(5)%value
    if (ymin.gt.min(y1,y2)) then
      ymin = min(y1,y2)
      altplot = .true.
    endif
    if (ymax.lt.max(y1,y2)) then
      ymax = max(y1,y2)
      altplot = .true.
    endif
    ! Y: Ensure we see the gaussian peak
    if (vpeak.gt.ymax) then
      ymax = vpeak
      altplot = .true.
    endif
    if (altplot) then
      if (.not.gtexist('<GAUSSFIT'))  &
        call gr_execl('CREATE DIRECTORY <GAUSSFIT')
      call gr_execl('CHANGE DIRECTORY <GAUSSFIT')
      call mrtcal_solve_pointing_plot(debug,xmin,xmax,ymin,ymax,vpeak)
      call gr_execl('CHANGE DIRECTORY <GREG')
    endif
    !
    call sic_wpr('Type C to continue ',str)
  end subroutine mrtcal_solve_pointing_debug
  !
  subroutine mrtcal_solve_pointing_plot(debug,xmin,xmax,ymin,ymax,vpeak)
    !-------------------------------------------------------------------
    ! Plot the drift and its fitted model in the currently selected
    ! window, with the given limits
    !-------------------------------------------------------------------
    integer(kind=4), intent(in) :: debug
    real(kind=8),    intent(in) :: xmin,xmax
    real(kind=8),    intent(in) :: ymin,ymax
    real(kind=4),    intent(in) :: vpeak
    !
    type(simple_1d) :: mysol
    integer(kind=4) :: isol
    character(len=message_length) :: mess
    real(kind=8) :: x1,x2,y1,y2
    !
    ! Apply
    write(mess,'(4(a,1pg15.7),a)') 'LIMITS ',xmin,' ',xmax,' ',ymin,' ',ymax,' /MARGIN'
    call gr_exec1(mess)
    call sic_get_dble('USER_XMIN',xmin,error)
    if (error)  return
    call sic_get_dble('USER_XMAX',xmax,error)
    if (error)  return
    call sic_get_dble('USER_YMIN',ymin,error)
    if (error)  return
    call sic_get_dble('USER_YMAX',ymax,error)
    if (error)  return
    call gr_exec1('BOX')
    !
    ! Data
    write(mess,'(a,f0.3,a)') 'SET BLANKING ',obs%head%dri%bad,' 0.0'
    call gr_exec1(mess)
    call gr8_give('X',ndat,point%dat%x)
    call gr8_give('Y',ndat,point%dat%y)
    if (debug.eq.1) then
      call gr_exec1('HISTOGRAM')
    elseif (debug.eq.2) then
      call gr_exec1('SET MARKER 4 1 0.2 45')
      call gr_exec1('POINTS')
    endif
    !
    ! Gaussian+baseline fit
    call gr_exec1('PEN /COL WEB_GREEN')
    if (.false.) then
      call gr8_give('X',point%sol%n,point%sol%x)
      call gr8_give('Y',point%sol%n,point%sol%y)
    else
      mysol%n = 512
      allocate(mysol%x(mysol%n),mysol%y(mysol%n))
      do isol=1,mysol%n
        mysol%x(isol) = xmin + (isol-1.)/(mysol%n-1)*(xmax-xmin)
      enddo
      call get_profile(point%fun,mysol)
      call gr8_give('X',mysol%n,mysol%x)
      call gr8_give('Y',mysol%n,mysol%y)
    endif
    call gr_exec1('CONNECT')
    !
    ! Some typical gaussian points
    mysol%n = 3
    mysol%x(1) = point%fun%par(2)%value-point%fun%par(3)%value/2  ! Half-maximum (left)
    mysol%x(2) = point%fun%par(2)%value                           ! Center
    mysol%x(3) = point%fun%par(2)%value+point%fun%par(3)%value/2  ! Half-maximum (right)
    call get_profile(point%fun,mysol)
    !
    ! Gaussian position (from baseline to peak)
    x1 = mysol%x(2)
    y1 = point%fun%par(4)%value+x1*point%fun%par(5)%value
    write(mess,'(a,1pg15.7,a,1pg15.7,a)') 'DRAW RELOCATE ',x1,' ',y1,' /USER'
    call gr_exec1(mess)
    write(mess,'(a,1pg15.7,a,1pg15.7,a)') 'DRAW LINE ',x1,' ',mysol%y(2),' /USER /CLIP'
    call gr_exec1(mess)
    !
    ! Gaussian FWHM
    write(mess,'(a,1pg15.7,a,1pg15.7,a)') 'DRAW RELOCATE ',mysol%x(1),' ',mysol%y(1),' /USER'
    call gr_exec1(mess)
    write(mess,'(a,1pg15.7,a,1pg15.7,a)') 'DRAW LINE ',mysol%x(3),' ',mysol%y(3),' /USER /CLIP'
    call gr_exec1(mess)
    !
    ! Baseline fit only
    call gr_exec1('PEN /COL BLUE')
    x1 = xmin
    y1 = point%fun%par(4)%value+x1*point%fun%par(5)%value
    write(mess,'(a,1pg15.7,a,1pg15.7,a)') 'DRAW RELOCATE ',x1,' ',y1,' /USER'
    call gr_exec1(mess)
    x2 = xmax
    y2 = point%fun%par(4)%value+x2*point%fun%par(5)%value
    write(mess,'(a,1pg15.7,a,1pg15.7,a)') 'DRAW LINE ',x2,' ',y2,' /USER /CLIP'
    call gr_exec1(mess)
    !
    ! Sanity check
    call gr_exec1('PEN /COL RED')
    if (point%fun%par(2)%value.lt.min(x1,x2).or.point%fun%par(2)%value.gt.max(x1,x2)) then
      write(mess,'(a,1pg0.3,a)') 'DRAW TEXT 0 3 "WARNING: Gaussian peak @ ',point%fun%par(2)%value,'" 5 /BOX 2'
      call gr_exec1(mess)
      write(mess,'(a,1pg0.3,a)') 'DRAW TEXT 0 2 "(the minimization used the edge of the gaussian)" 5 /BOX 2'
      call gr_exec1(mess)
    endif
    if ((y1.gt.ymax.and.y2.gt.ymax).or.(y1.lt.ymin.and.y2.lt.ymin)) then
      write(mess,'(a,1pg0.3,a)') 'DRAW TEXT 0 1 "WARNING: baseline out of plot (',point%fun%par(4)%value,' @ x=0)" 5 /BOX 2'
      call gr_exec1(mess)
    endif
    !
    ! Legend
    call gr_exec1('PEN /COL WEB_GREEN')
    write(mess,'(a,1pg10.3,a)') 'DRAW TEXT 1 -1 "Area: ',point%fun%par(1)%value,' [K.sec]" 6 /CHAR 7'
    call gr_exec1(mess)
    write(mess,'(a,1pg10.3,a)') 'DRAW TEXT 1 -2 "Position: ',point%fun%par(2)%value,' [sec]" 6 /CHAR 7'
    call gr_exec1(mess)
    write(mess,'(a,1pg10.3,a)') 'DRAW TEXT 1 -3 "FWHM: ',point%fun%par(3)%value,' [sec]" 6 /CHAR 7'
    call gr_exec1(mess)
    write(mess,'(a,1pg10.3,a)') 'DRAW TEXT 1 -4 "Peak: ',vpeak,' [K]" 6 /CHAR 7'
    call gr_exec1(mess)
    call gr_exec1('PEN /COL BLUE')
    write(mess,'(a,1pg10.3,a)') 'DRAW TEXT 1 -5 "Offset: ',point%fun%par(4)%value,' [K]" 6 /CHAR 7'
    call gr_exec1(mess)
    write(mess,'(a,1pg10.3,a)') 'DRAW TEXT 1 -6 "Slope: ',point%fun%par(5)%value,' [K/sec]" 6 /CHAR 7'
    call gr_exec1(mess)
    call gr_exec1('PEN /COL FOREGROUND')
    write(mess,'(3a)') 'DRAW TEXT 0 0.5 ',trim(obs%head%gen%teles),' /BOX 8'
    call gr_exec1(mess)
    !
    call null_simple_1d(mysol)
  end subroutine mrtcal_solve_pointing_plot
end subroutine mrtcal_solve_pointing_observation
!
subroutine mrtcal_pointing_peak(poi,vpeak,epeak,error)
  use phys_const
  use class_types
  use mrtindex_sec_pointing
  !---------------------------------------------------------------------
  ! @ private
  ! From a CLASS pointing section, return the peak value and its error.
  ! This information is redundant with the (area,position,fwhm) stored
  ! in the section.
  !---------------------------------------------------------------------
  type(class_pointing_t), intent(in)    :: poi
  real(kind=4),           intent(out)   :: vpeak  ! Peak value
  real(kind=4),           intent(out)   :: epeak  ! Peak error
  logical,                intent(inout) :: error
  !
  real(kind=4) :: fac
  real(kind=4) :: voffs,vslop,varea,vposi,vfwhm
  real(kind=4) :: eoffs,eslop,earea,eposi,efwhm
  !
  fac = 2*sqrt(log(2.)/pis)
  !
  voffs = poi%nfit(pointing_fit_offset)
  vslop = poi%nfit(pointing_fit_slope)
  varea = poi%nfit(pointing_fit_area1)
  vposi = poi%nfit(pointing_fit_posi1)
  vfwhm = poi%nfit(pointing_fit_fwhm1)
  vpeak = voffs+vslop*vposi + fac*varea/vfwhm
  !
  eoffs = poi%nerr(pointing_fit_offset)
  eslop = poi%nerr(pointing_fit_slope)
  earea = poi%nerr(pointing_fit_area1)
  eposi = poi%nerr(pointing_fit_posi1)
  efwhm = poi%nerr(pointing_fit_fwhm1)
  epeak = fac/vfwhm * sqrt(earea**2  + (varea*efwhm/vfwhm)**2)  ! ZZZ Missing the eoffs and eslope contribution
end subroutine mrtcal_pointing_peak
!
subroutine mrtcal_pointing_associate_array(obs,error)
  use class_types
  use mrtindex_sec_pointing
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_pointing_associate_array
  !---------------------------------------------------------------------
  ! @ private
  ! If the observation provides a pointing drift fit, it is modified so
  ! that:
  ! 1) RY provides the baselined pointing drift,
  ! 2) an associated array named XX provides the (original)
  !    non-baselined pointing drifts
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs
  logical,           intent(inout) :: error
  !
  real(kind=4), pointer :: data1(:)
  integer(kind=4) :: ichan
  real(kind=4) :: y
  !
  if (.not.obs%head%presec(class_sec_poi_id))  return
  !
  ! Declare the reserved associated array and fetch a pointer to its
  ! data
  call class_assoc_add(obs,'POINTING',data1,error)
  if (error)  return
  data1(:) = obs%data1(:)
  !
  ! Replace original RY with its baselined version
  do ichan=1,obs%head%dri%npoin
    if (obs%data1(ichan).ne.obs%head%dri%bad) then
      y = obs%head%poi%nfit(pointing_fit_offset) +  &
          obs%head%poi%nfit(pointing_fit_slope) * obs%datav(ichan)
      obs%data1(ichan) = obs%data1(ichan) - y
    endif
  enddo
end subroutine mrtcal_pointing_associate_array
!
subroutine mrtcal_pointing_classify(mrtset,idrifts,sdrifts,error)
  use phys_const
  use mrtcal_messaging
  use toc_types
  use class_toc_parameters
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_calib_types
  use mrtcal_setup_types
  use mrtcal_interfaces, except_this=>mrtcal_pointing_classify
  !---------------------------------------------------------------------
  ! @ private
  ! Gtaher drifts by equivalence class and solve each class.
  !---------------------------------------------------------------------
  type(mrtcal_setup_t), intent(in)    :: mrtset   !
  type(obs_list_t),     intent(in)    :: idrifts  ! Collection of individual drifts
  type(obs_list_t),     intent(inout) :: sdrifts  ! Collection of averaged and solved drifts
  logical,              intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='SOLVE>POINTING>AVERAGE'
  integer(kind=4) :: toc_keys(2)
  type(toc_selection_t) :: select
  integer(kind=entry_length) :: iequ
  type(drift_book_t), pointer :: book
  type(observation), pointer :: obs
  integer(kind=4) :: nkeys,ikey
  !
  select case (mrtset%sol%poimix)
  case (mixmode_entry)     ! Unique entry
                           ! i.e. no mixing
    nkeys = 1
    toc_keys(1) = class_toc_key_entry
  case (mixmode_drift)     ! Unique telescope and unique drift
                           ! i.e. mixed directions (e.g. 0+180)
    nkeys = 2
    toc_keys(1) = class_toc_key_telescope
    toc_keys(2) = class_toc_key_drift
  case (mixmode_fesbdrift) ! Unique frontend, unique sideband and unique drift
                           ! i.e. mixed polarizations and mixed directions
    nkeys = 2
    toc_keys(1) = class_toc_key_fesb
    toc_keys(2) = class_toc_key_drift
  case (mixmode_fesbdirec) ! Unique frontend, unique sideband and unique direction
                           ! i.e. mixed polarizations
    nkeys = 2
    toc_keys(1) = class_toc_key_fesb
    toc_keys(2) = class_toc_key_direction
  case (mixmode_fedrift)   ! Unique frontend and unique drift
                           ! i.e. mixed polarizations, sidebands, and directions
    nkeys = 2
    toc_keys(1) = class_toc_key_frontend
    toc_keys(2) = class_toc_key_drift
  case (mixmode_fedirec)   ! Unique frontend and unique direction
                           ! i.e. mixed polarizations and sidebands
    nkeys = 2
    toc_keys(1) = class_toc_key_frontend
    toc_keys(2) = class_toc_key_direction
  case default
    call mrtcal_message(seve%e,rname,'MSET SOLVE POINTING mode not implemented')
    error = .true.
    return
  end select
  !
  call idrifts%to_selection(toc_keys(1:nkeys),select,error)
  if (error)  return
  !
  call sdrifts%final(error)
  if (error)  return
  !
  ! Fill pseudo observations (only the relevant parts needed by
  ! mrtcal_solve_pointing_observation) and perform the minimizations
  do iequ=1,select%nequ
    ! Fetch a new observation from list
    call sdrifts%new(book,obs,error)
    if (error)  return
    ! Bookkeeping for this class
    book%nkey = nkeys
    book%nobs = select%cnt(iequ)
    do ikey=1,nkeys
      book%keys(ikey)   = select%ids(ikey)
      book%values(ikey) = select%nam(iequ,ikey)
    enddo
    ! Gather this class in a single observation
    call mrtcal_solve_pointing_oneclass(idrifts,iequ,select%cnt(iequ),select%bak,obs,error)
    if (error)  return
  enddo
end subroutine mrtcal_pointing_classify
!
subroutine mrtcal_solve_pointing_oneclass(drifts,iequ,cnt,bak,obs,error)
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_solve_pointing_oneclass
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  ! Produce the drift for one equivalence class
  !---------------------------------------------------------------------
  type(obs_list_t),           intent(in)    :: drifts  ! Collection of drifts
  integer(kind=entry_length), intent(in)    :: iequ    ! Eq. class identifier
  integer(kind=entry_length), intent(in)    :: cnt     ! Number of elements in this eq. class
  integer(kind=entry_length), intent(in)    :: bak(:)  ! Back pointer to original elements
  type(observation),          intent(inout) :: obs     !
  logical,                    intent(inout) :: error   !
  ! Local
  character(len=*), parameter :: rname='SOLVE>POINTING>ONECLASS'
  integer(kind=entry_length) :: idrift,ilist,list(cnt)  ! Automatic array
  type(observation), pointer :: drift
  !
  ! Get the drift numbers which go in this eq. class
  ilist = 0
  do idrift=1,drifts%n
    if (bak(idrift).eq.iequ) then
      ilist = ilist+1
      list(ilist) = idrift
    endif
  enddo
  !
  if (cnt.eq.1) then
    ! Direct export (as is), i.e. leave it irregular
    call drifts%get(list(1),drift,error)
    if (error)  return
    call copy_obs(drift,obs,error)
    if (error)  return
  else
    ! Resample and average in a single regular drift
    call mrtcal_solve_pointing_gather(drifts,list,obs,error)
    if (error)  return
  endif
  !
end subroutine mrtcal_solve_pointing_oneclass
!
subroutine mrtcal_solve_pointing_gather(drifts,list,obs,error)
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_solve_pointing_gather
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  ! Gather the drifts indentfies in the list and produce a single drift
  ! observation
  !---------------------------------------------------------------------
  type(obs_list_t),           intent(in)    :: drifts   ! Collection of drifts
  integer(kind=entry_length), intent(in)    :: list(:)  !
  type(observation),          intent(inout) :: obs      !
  logical,                    intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='SOLVE>POINTING>GATHER'
  logical, parameter :: doregular=.true.
  !
  if (doregular) then
    ! Resample and average the drifts
    call mrtcal_solve_pointing_gather_regular(drifts,list,obs,error)
    if (error)  return
  else
    ! Concatenate and sort the data points
    call mrtcal_solve_pointing_gather_irregular(drifts,list,obs,error)
    if (error)  return
  endif
end subroutine mrtcal_solve_pointing_gather
!
subroutine mrtcal_solve_pointing_gather_regular(drifts,list,obs,error)
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_solve_pointing_gather_regular
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  ! Resample each irregular drift to a common axis and average them.
  !---------------------------------------------------------------------
  type(obs_list_t),           intent(in)    :: drifts   ! Collection of drifts
  integer(kind=entry_length), intent(in)    :: list(:)  !
  type(observation),          intent(inout) :: obs      !
  logical,                    intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='SOLVE>POINTING>GATHER>REGULAR'
  integer(kind=entry_length) :: ilist
  integer(kind=list_k) :: iref,idrift
  type(observation), pointer :: ref,drift
  type(resampling) :: axis
  type(observation) :: tmp
  real(kind=4) :: cbad,weight
  logical :: stele_c(12)
  logical, parameter :: contaminate=.true.
  logical, parameter :: weight_update=.true.
  !
  ! Use the first drift as reference. All drifts have a regular axis
  ! declared which is a good approximation of the irregular axis.
  iref = list(1)
  call drifts%get(iref,ref,error)
  if (error)  return
  cbad = ref%head%dri%bad
  axis%nchan = ref%head%dri%npoin
  axis%ref   = ref%head%dri%rpoin
  axis%val   = ref%head%dri%aref
  axis%inc   = ref%head%dri%ares
  axis%unit  = 'A'
  axis%shape = ''   ! Only for FFT resampling
  axis%width = 1.0  ! Only for FFT resampling
  !
  ! Initialize output sum
  ! - Minimalist header (more to be done for a real drift in CLASS)
  call copy_header(ref%head,obs%head)
  obs%head%presec(class_sec_xcoo_id) = .false.
  stele_c(:) = .true.
  ! obs%head%dri%apos  = ref%head%dri%apos   ZZZ need specific mixing function i.e. 0,180 give 0
  ! - Data area
  call reallocate_obs(obs,axis%nchan,error)  ! Is this useful?
  if (error)  return
  obs%spectre(:) = 0.
  obs%dataw(:) = 0.
  !
  ! Initialize temporary observation
  call class_obs_init(tmp,error)
  if (error)  return
  !
  do ilist=1,size(list)
    idrift = list(ilist)
    call drifts%get(idrift,drift,error)
    if (error)  return
    ! --- Header update ---
    if (drift%head%gen%subscan.ne.obs%head%gen%subscan)  &
      obs%head%gen%subscan = 0
    call sumlin_header_telescope(drift%head%gen%teles,stele_c,obs%head%gen%teles)
    ! --- Data update ---
    call copy_obs(drift,tmp,error)
    if (error)  exit
    call obs_weight_time(rname,tmp,weight,error,verbose=.true.)
    if (error)  exit
    ! From irregular axis to regular: use CLASS RESAMPLE
    tmp%cbad = cbad
    tmp%datax = tmp%datav
    call class_resample_obs(tmp,axis,.false.,error)
    if (error)  exit
    ! Average in running sum
    tmp%dataw(:) = weight
    call simple_waverage(tmp%spectre,tmp%dataw,cbad,  &
                         obs%spectre,obs%dataw,cbad,  &
                         1,axis%nchan,contaminate,weight_update)
  enddo
  ! Recompute regularized X axis in DATAV (used for minimization)
  call abscissa_angl_r8(obs%head,obs%datav,1,obs%head%dri%npoin)
  !
  call class_obs_clean(tmp,error)
  if (error)  return
end subroutine mrtcal_solve_pointing_gather_regular
!
subroutine mrtcal_solve_pointing_gather_irregular(drifts,list,obs,error)
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_solve_pointing_gather_irregular
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  ! Gather the drifts identifies in the list and produce a single drift
  ! observation. Just concatenate and sort the (X,Y) data point, leave
  ! the observation irregular.
  ! This solution is well suited for minimization of the point cloud,
  ! but can not be extensively used in CLASS. In particular, such an
  ! irregular axis does not behave well with the RESAMPLE command.
  !---------------------------------------------------------------------
  type(obs_list_t),           intent(in)    :: drifts   ! Collection of drifts
  integer(kind=entry_length), intent(in)    :: list(:)  !
  type(observation),          intent(inout) :: obs      !
  logical,                    intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='SOLVE>POINTING>GATHER'
  integer(kind=entry_length) :: ilist
  type(observation), pointer :: ref,drift
  integer(kind=list_k) :: iref,idrift
  integer(kind=4) :: ndata,first,last,npoin,ier
  real(kind=4), allocatable :: buf(:)
  integer(kind=4), allocatable :: key(:)
  !
  iref = list(1)  ! Select 1st obs in its class as reference
  call drifts%get(iref,ref,error)
  if (error)  return
  !
  ! Precompute the number of points for this class
  ndata = 0
  do ilist=1,size(list)
    idrift = list(ilist)
    call drifts%get(idrift,drift,error)
    if (error)  return
    ndata = ndata+drift%head%dri%npoin
  enddo
  call reallocate_obs(obs,ndata,error)
  if (error)  return
  !
  ! Minimalist header (more to be done for a real drift in CLASS)
  call copy_header(ref%head,obs%head)
  ! obs%head%gen%teles = ref%head%gen%teles  ZZZ need specific mixing function
  ! obs%head%dri%apos  = ref%head%dri%apos   ZZZ need specific mixing function i.e. 0,180 give 0
  !
  ! Collect points
  first = 1
  do ilist=1,size(list)
    idrift = list(ilist)
    call drifts%get(idrift,drift,error)
    if (error)  return
    npoin = drift%head%dri%npoin
    last = first+npoin-1
    obs%datav(first:last) = drift%datav(1:npoin)
    obs%data1(first:last) = drift%data1(1:npoin)
    obs%dataw(first:last) = drift%dataw(1:npoin)
    first = last+1
  enddo
  obs%head%dri%npoin = ndata  ! = last
  !
  ! Sort the points
  allocate(buf(ndata),key(ndata),stat=ier)
  if (failed_allocate(rname,"sorting buffers",ier,error))  return
  call gr8_trie(obs%datav,key,ndata,error)
  if (error)  return
  call gr4_sort(obs%data1,buf,key,ndata)
  if (error)  return
  call gr4_sort(obs%dataw,buf,key,ndata)
  if (error)  return
end subroutine mrtcal_solve_pointing_gather_irregular
!
!--------------------------------------------------------------------------
!
subroutine mrtcal_solve_pointing_user_feedback(backsci,setout,error)
  use mrtcal_messaging
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this => mrtcal_solve_pointing_user_feedback
  use mrtcal_buffers
  use mrtcal_calib_types
  use mrtcal_setup_types
  use mrtcal_user_feedback_tool
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(science_backend_t),     intent(in)    :: backsci
  type(mrtcal_setup_output_t), intent(in)    :: setout
  logical,                     intent(inout) :: error
  !
  type(user_feedback_t) :: user
  character(len=*), parameter :: rname='SOLVE>POINTING>USER>FEEDBACK'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  call user_feedback_head(error)
  if (error) return
  call user%allocate_and_init(backsci%head%poi%nsol,error)
  if (error) return
  call user_feedback_perobs(backsci%head,error)
  if (error) return
  call user%sort_by_freq_direction_idfe(error)
  if (error) return
  call user%list(error)
  if (error) return
  if (setout%restable) then
     call user%tofile(backsci%head,error)
     if (error) return
  endif
  !
contains
  !
  subroutine user_feedback_perobs(head,error)
    use phys_const
    !---------------------------------------------------------------------
    !---------------------------------------------------------------------
    type(mrtindex_header_t), intent(in)    :: head
    logical,                 intent(inout) :: error
    ! Local
    integer(kind=4) :: iobs,color
    real(kind=8) :: bad
    real(kind=8) :: mfreq,mangle,mhpbw
    real(kind=8) :: varea,vposi,vfwhm,voffs,vslop,vcorr ! Values
    real(kind=8) :: earea,eposi,efwhm,eoffs,eslop,ecorr ! Errors
    character(len=8) :: mfrontend,mbackend
    character(len=message_length) :: result
    !
    do iobs=1,head%poi%nsol
!!$      call calibrate_user_feedback_compute_perpixel(gr8_compute,  &
!!$           backcal,ipix,                                          &
!!$           mfrontend,mfreq,mthot,mtcold,mtrec,mtsys,mtcal,mtau,mh2o,error)
!!$      if (error) return
       !
       bad = head%poi%sol(iobs)%dri%bad
       !
       mfrontend = head%poi%sol(iobs)%gen%teles(4:)
       mbackend = backends_mrtcal(head%key%backend)
       mfreq = head%poi%sol(iobs)%dri%freq/1d3
       mangle = head%poi%sol(iobs)%dri%apos*deg_per_rad
       mhpbw = iram_30m_beam(mfreq)
       !
       voffs = head%poi%sol(iobs)%poi%nfit(pointing_fit_offset)*1d3            ! [mK]
       vslop = head%poi%sol(iobs)%poi%nfit(pointing_fit_slope)/sec_per_rad*1d3 ! [mK/arcsec]
       varea = head%poi%sol(iobs)%poi%nfit(pointing_fit_area1)*sec_per_rad     ! [K.arcsec]
       vposi = head%poi%sol(iobs)%poi%nfit(pointing_fit_posi1)*sec_per_rad     ! [arcsec]
       vfwhm = head%poi%sol(iobs)%poi%nfit(pointing_fit_fwhm1)*sec_per_rad     ! [arcsec]
       vcorr = pointing_collimation(head%poi%sol(iobs)%dri)                    ! [rad]
       if (vcorr.ne.bad)  vcorr = vcorr*sec_per_rad+vposi                      ! [arcsec]
       !
       eoffs = head%poi%sol(iobs)%poi%nerr(pointing_fit_offset)*1d3            ! [mK]
       eslop = head%poi%sol(iobs)%poi%nerr(pointing_fit_slope)/sec_per_rad*1d3 ! [mK/arcsec]
       earea = head%poi%sol(iobs)%poi%nerr(pointing_fit_area1)*sec_per_rad     ! [K.arcsec]
       eposi = head%poi%sol(iobs)%poi%nerr(pointing_fit_posi1)*sec_per_rad     ! [arcsec]
       efwhm = head%poi%sol(iobs)%poi%nerr(pointing_fit_fwhm1)*sec_per_rad     ! [arcsec]
       ecorr = eposi                                                           ! [arcsec]
       !
       vfwhm = vfwhm/mhpbw
       efwhm = efwhm/mhpbw
       call user_feedback_oneline(&
            mfrontend,&
            mbackend,&
            mfreq,&
            mangle,&
            vcorr,ecorr,&
            varea,earea,&
            vposi,eposi,&
            vfwhm,efwhm,&
            voffs,eoffs,&
            vslop,eslop,&
            bad,&
            result,color)
       call user%fill(iobs,mfrontend,mfreq,mangle,result,color)
    enddo ! iobs
  end subroutine user_feedback_perobs
  !
  subroutine user_feedback_oneline(frontend,backend,freq,angle,  &
       vcorr,ecorr,varea,earea, &
       vposi,eposi,vfwhm,efwhm, &
       voffs,eoffs,vslop,eslop,bad,oneline,color)
    !---------------------------------------------------------------------
    !---------------------------------------------------------------------
    character(len=*), intent(in)  :: frontend
    character(len=*), intent(in)  :: backend
    real(kind=8),     intent(in)  :: freq
    real(kind=8),     intent(in)  :: angle
    real(kind=8),     intent(in)  :: vcorr,ecorr
    real(kind=8),     intent(in)  :: varea,earea
    real(kind=8),     intent(in)  :: vposi,eposi
    real(kind=8),     intent(in)  :: vfwhm,efwhm
    real(kind=8),     intent(in)  :: voffs,eoffs
    real(kind=8),     intent(in)  :: vslop,eslop
    real(kind=8),     intent(in)  :: bad
    character(len=*), intent(out) :: oneline
    integer(kind=4),  intent(out) :: color        ! Colorization code
    !
    real(kind=8) :: snr
    !
    snr = abs(varea/earea)
    write(oneline,100)  frontend,&
                        user_feedback_format_onedouble(5,'f5.1',freq,bad),&
                        backend,&
                        user_feedback_format_onedouble(6,'f6.1',angle,bad),&
                        user_feedback_format_onedouble(6,'f6.1',vcorr,bad),&
                        user_feedback_format_onedouble(6,'f6.1',vposi,bad),&
                        user_feedback_format_onedouble(6,'f6.1',eposi,bad),&
                        user_feedback_format_onedouble(6,'f6.2',vfwhm,bad),&
                        user_feedback_format_onedouble(6,'f6.2',efwhm,bad),&
                        nint(snr),&
                        user_feedback_format_onedouble(6,'f6.1',varea,bad),&
                        user_feedback_format_onedouble(6,'f6.1',earea,bad),&
                        nint(voffs),&
                        nint(eoffs),&
                        user_feedback_format_onedouble(6,'f6.1',vslop,bad),&
                        user_feedback_format_onedouble(6,'f6.1',eslop,bad)
    !
    if (snr.lt.10) then
       color = code_color_red
    else if (snr.lt.20) then
       color = code_color_orange
    else
       color = code_color_green
    endif
    !
100 format(t1,a5,   &  ! Frontend
           t7,a5,   &  ! Freq
           t13,a3,  &  ! Backend
           t18,a6,  &  ! Angle
           t25,a6,  &  ! Correction
           t32,a6,  &  ! Position
           t38,a6,  &  ! Position error
           t46,a6,  &  ! FWHM
           t52,a6,  &  ! FWHM error
           t60,i4,  &  ! Area SNR
           t65,a6,  &  ! Area (+1 leading blank)
           t72,a6,  &  ! Area error (+1 leading blank)
           t80,i6,  &  ! Offset
           t87,i6,  &  ! Offset error (+1 leading blank)
           t95,a6,  &  ! Slope
           t102,a6)    ! Slope error (+1 leading blank)
  end subroutine user_feedback_oneline
  !
  subroutine user_feedback_head(error)
    use mrtcal_messaging
    logical, intent(inout) :: error
    !
    character(len=message_length) :: mess
    !
    call mrtcal_separator(seve%r,rname,1,error)
    if (error) return
    write(mess,'(t1,a4,t7,a4,t13,a4,t18,a6,t25,a6,t32,a12,t46,a12,t60,a18,t80,a12,t95,a13)') &
         'idFe','freq','idBe','Angle','Correc','  Position  ', '    FWHM    ','       Area       ','   Offset    ','    Slope    '
    call mrtcal_message(seve%r,rname,mess)
    write(mess,'(t7,a5,t19,a5,t25,a6,t32,a12,t46,a12,t60,a18,t80,a13,t95,a13)') &
         '[GHz]','[deg]','[arcs]','--[arcsec]--','-[fraction]-','-[SNR]-[K.arcsec]-','----[mK]-----','-[mK/arcsec]-'
    call mrtcal_message(seve%r,rname,mess)
    mess = repeat('-',107)
    call mrtcal_message(seve%r,rname,mess)
  end subroutine user_feedback_head
end subroutine mrtcal_solve_pointing_user_feedback
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
