!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine mrtcal_pointing_create(chunkset_3d,drifts,error)
  use gbl_message
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this=>mrtcal_pointing_create
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(chunkset_3d_t), intent(in)    :: chunkset_3d  !
  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='SOLVE>AND>WRITE>POINTING'
  !
  ! Sanity
  if (chunkset_3d%kind.ne.ckind_onoff) then
    call mrtcal_message(seve%e,rname,'Unexpected chunkset kind')
    error = .true.
    return
  endif
  if (chunkset_3d%ntime.ne.1) then
    call mrtcal_message(seve%e,rname,'Unexpected time dimension')
    error = .true.
    return
  endif
  !
  do ipix=1,chunkset_3d%npix
    do iset=1,chunkset_3d%nset
      call mrtcal_pointing_create_from_chunkset(  &
        chunkset_3d%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 obs_list_new(drifts,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 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=4) :: idrift
  !
  do idrift=1,drifts%n
    call mrtcal_solve_pointing_observation(drifts%obs(idrift),0,error)
    if (error)  return
    call mrtcal_pointing_associate_array(drifts%obs(idrift),error)
    if (error)  return
    if (out%toclass) then
      call mrtcal_obs_to_class(drifts%obs(idrift),error)
      if (error)  return
    endif
    ndrift = ndrift+1
  enddo
end subroutine mrtcal_solve_and_write_obslist
!
subroutine mrtcal_solve_pointing_observation(obs,debug,error)
  use phys_const
  use gbl_message
  use fit_definitions
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_solve_pointing_observation
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs
  integer(kind=4),   intent(in)    :: debug  ! 0=no, 1=histo, 2=points
  logical,           intent(inout) :: error
  !
  logical, parameter :: quiet = .false.
  type(fit_fun) :: fun
  type(simple_1d) :: dat,sol
  integer(kind=4) :: ier
  character(len=16) :: str
  character(len=message_length) :: mess
  real(kind=4) :: vpeak,epeak
  character(len=*), parameter :: rname='SOLVE>POINTING>OBSERVATION'
  !
  dat%n = obs%head%dri%npoin
  allocate(dat%x(dat%n),dat%y(dat%n),dat%w(dat%n),stat=ier)
  if (failed_allocate(rname,'data buffers',ier,error)) return
  dat%x(:) = obs%datav(1:dat%n)*sec_per_rad  !
  dat%y(:) = obs%data1(1:dat%n)              ! R4 to R8
  dat%w(:) = obs%dataw(1:dat%n)
  !
  ! Initialization
  nullify(fun%par)
  call null_function(fun)
  ! Fitting method
  fun%method = 'SLATEC'
  fun%name = 'GAUSSIAN+BASE'
  fun%npar = 5
  allocate(fun%par(fun%npar),stat=ier)
  if (failed_allocate(rname,"function",ier,error))  goto 100
  !
  ! Names
  call null_parameter(fun%par(1))
  fun%par(1)%name = 'AREA1'
  call null_parameter(fun%par(2))
  fun%par(2)%name = 'POSITION1'
  call null_parameter(fun%par(3))
  fun%par(3)%name = 'WIDTH1'
  call null_parameter(fun%par(4))
  fun%par(4)%name = 'OFFSET'
  call null_parameter(fun%par(5))
  fun%par(5)%name = 'SLOPE'
  !
  ! Try not-so-clever guesses
  fun%par(1)%guess = 10.0                       ! [arcsec.K] Area: guess 30m beam size * 1K
  fun%par(2)%guess = 0.0                        ! [arcsec]   Position: guess is centered at 0
  fun%par(3)%guess = 10.0                       ! [arcsec]   Width: guess 30m beam size
  fun%par(4)%guess = (dat%y(dat%n)+dat%y(1))/2  ! [K]        Offset: guess from boundaries
  fun%par(5)%guess = 0.0                        ! [K/arcsec] Slope: guess is flat
  !
  ! All parameters are free
  fun%par(1:fun%npar)%fixed = .false.
  !
  ! Fitting
  call fit_1d(dat,fun,quiet)
  !
  ! Transfer to observation
  call mrtcal_fit_to_obs_poi(fun,obs,error)
  if (error)  return
  !
  ! --- Debugging ------------------------------------------------------
  if (debug.gt.0) then
    ! Allocate the solution structure
    sol%n = dat%n
    allocate(sol%x(sol%n),sol%y(sol%n),stat=ier)
    if (failed_allocate(rname,"solution",ier,error)) goto 100
    ! Compute the solution profile
    sol%x(:) = dat%x(:)
    call get_profile(fun,sol)
    !
    ! Feedback
    print *,"Values:   Area   Position   FWHM   Offset   Slope   Peak"  ! Order in fun%par(:)
    write(mess,'(a,5(1pg10.3))')  "Guesses: ",fun%par(1:5)%guess
    print *,trim(mess)
    call mrtcal_pointing_peak(obs%head%poi,vpeak,epeak,error)
    if (error)  return
    write(mess,'(a,6(1pg10.3))')  "Results: ",fun%par(1:5)%value,vpeak
    print *,trim(mess)
    write(mess,'(a,6(1pg10.3))')  "Errors:  ",fun%par(1:5)%error,epeak
    print *,trim(mess)
    write(mess,'(a,1(1pg10.3))')  "RMS:  ",fun%rms
    print *,trim(mess)
    !
    ! Plot
    call gr_execl('CLEAR')
    call gr_exec1('SET PLOT LANDSCAPE')
    write(mess,'(a,f0.3,a)') 'SET BLANKING ',obs%head%dri%bad,' 0.0'
    call gr_exec1(mess)
    call gr8_give('X',dat%n,dat%x)
    call gr8_give('Y',dat%n,dat%y)
    call gr_exec1('LIMITS')
    call gr_exec1('BOX')
    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
    call gr_exec1('PEN /COL RED')
    call gr8_give('X',sol%n,sol%x)
    call gr8_give('Y',sol%n,sol%y)
    if (debug.eq.1) then
      call gr_exec1('HISTOGRAM')
    elseif (debug.eq.2) then
      call gr_exec1('POINTS')
    endif
    call gr_exec1('PEN /COL FOREGROUND')
    call sic_wpr('Type C to continue ',str)
  endif
  !---------------------------------------------------------------------
  !
100 continue
  call null_function(fun)
  call null_simple_1d(dat)
  if (debug.gt.0)  call null_simple_1d(sol)
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 gbl_message
  use toc_types
  use class_toc_parameters
  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 obs_list_to_selection(idrifts,toc_keys(1:nkeys),select,error)
  if (error)  return
  !
  call free_obs_list(sdrifts,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 obs_list_new(sdrifts,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 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
  !
  ! 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 copy_obs(drifts%obs(list(1)),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 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 gbl_message
  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,idrift,ref
  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.
  ref = list(1)
  cbad = drifts%obs(ref)%head%dri%bad
  axis%nchan = drifts%obs(ref)%head%dri%npoin
  axis%ref   = drifts%obs(ref)%head%dri%rpoin
  axis%val   = drifts%obs(ref)%head%dri%aref
  axis%inc   = drifts%obs(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(drifts%obs(ref)%head,obs%head)
  stele_c(:) = .true.
  ! obs%head%dri%apos  = drifts%obs(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)
    ! --- Header update ---
    if (drifts%obs(idrift)%head%gen%subscan.ne.obs%head%gen%subscan)  &
      obs%head%gen%subscan = 0
    call sumlin_header_telescope(drifts%obs(idrift)%head%gen%teles,stele_c,obs%head%gen%teles)
    ! --- Data update ---
    call copy_obs(drifts%obs(idrift),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 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,idrift
  integer(kind=4) :: ndata,first,last,npoin,ref,ier
  real(kind=4), allocatable :: buf(:)
  integer(kind=4), allocatable :: key(:)
  !
  ref = list(1)  ! Select 1st obs in its class as reference
  !
  ! Precompute the number of points for this class
  ndata = 0
  do ilist=1,size(list)
    idrift = list(ilist)
    ndata = ndata+drifts%obs(idrift)%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(drifts%obs(ref)%head,obs%head)
  ! obs%head%gen%teles = drifts%obs(ref)%head%gen%teles  ZZZ need specific mixing function
  ! obs%head%dri%apos  = drifts%obs(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)
    npoin = drifts%obs(idrift)%head%dri%npoin
    last = first+npoin-1
    obs%datav(first:last) = drifts%obs(idrift)%datav(1:npoin)
    obs%data1(first:last) = drifts%obs(idrift)%data1(1:npoin)
    obs%dataw(first:last) = drifts%obs(idrift)%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 gbl_message
  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) :: mfreq,mangle,mhpbw
    real(kind=8) :: varea,vposi,vfwhm,voffs,vslop ! Values
    real(kind=8) :: earea,eposi,efwhm,eoffs,eslop ! 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
       !
       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]
       !
       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]
       !
       vfwhm = vfwhm/mhpbw
       efwhm = efwhm/mhpbw
       call user_feedback_oneline(&
            mfrontend,&
            mbackend,&
            mfreq,&
            mangle,&
            varea,earea,&
            vposi,eposi,&
            vfwhm,efwhm,&
            voffs,eoffs,&
            vslop,eslop,&
            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,varea,earea,&
       vposi,eposi,vfwhm,efwhm,voffs,eoffs,vslop,eslop,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)  :: 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
    character(len=*), intent(out) :: oneline
    integer(kind=4),  intent(out) :: color        ! Colorization code
    !
    real(kind=8) :: bad,snr
    !
    !    bad = ???
    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',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,t7,a5,t13,a3,t18,a6,t25,a6,t31,a6,t39,a6,t45,a6,&
    t54,i4,t58,a6,t64,a6,t73,i6,t79,i6,t86,a6,t93,a6)
  end subroutine user_feedback_oneline
  !
  subroutine user_feedback_head(error)
    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,t26,a12,t40,a12,t54,a18,t75,a12,t88,a12)') &
         'idFe','freq','idBe','Angle','  Position  ', '    FWHM    ','       Area       ','   Offset   ','   Slope    '
    call mrtcal_message(seve%r,rname,mess)
    write(mess,'(t7,a5,t19,a5,t26,a12,t40,a12,t54,a18,t74,a12,t88,a12)') &
         '[GHz]','[deg]','--[arcsec]--','-[fraction]-','-[SNR]-[K.arcsec]-','----[mK]----','[ mK/arcsec]'
    call mrtcal_message(seve%r,rname,mess)
    write(mess,'(t1,a99)') &
         '---------------------------------------------------------------------------------------------------'
    call mrtcal_message(seve%r,rname,mess)
  end subroutine user_feedback_head
end subroutine mrtcal_solve_pointing_user_feedback
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
