module mrtindex_sec_pointing
  use gbl_message
  use gkernel_interfaces
  use classcore_interfaces_public
  use class_types
  use mrtindex_parameters
  !---------------------------------------------------------------------
  ! Support module for pointing section in MRTCAL index
  !---------------------------------------------------------------------

  public :: drift_book_t

  public :: sec_pointing_id
  public :: sec_pointing_nsol_def,sec_pointing_nkey_def
  public :: sec_pointing_t
  public :: sec_pointing_array_t
  !
  public :: pointing_fit_offset,pointing_fit_slope
  public :: pointing_fit_area1,pointing_fit_posi1,pointing_fit_fwhm1
  public :: pointing_fit_area2,pointing_fit_posi2,pointing_fit_fwhm2
  !
  ! Extra utilities
  public :: code_pointing_azimuth,code_pointing_elevation,code_pointing_unknown
  public :: pointing_direction
  public :: pointing_collimation
  !
  private
  !
  integer(kind=4), parameter :: code_pointing_unknown=0
  integer(kind=4), parameter :: code_pointing_azimuth=1
  integer(kind=4), parameter :: code_pointing_elevation=2
  !
  ! Write/read the MRTCAL section as a collection of CLASS sections
  ! with format V2:
  integer(kind=4), parameter :: obs_version=2

  ! Fitted parameter positions as per the CLASS Data Format in section
  ! class_pointing_t, arrays nfit(:) and nerr(:)
  integer(kind=4), parameter :: pointing_fit_offset=1
  integer(kind=4), parameter :: pointing_fit_slope=2
  integer(kind=4), parameter :: pointing_fit_area1=3
  integer(kind=4), parameter :: pointing_fit_posi1=4
  integer(kind=4), parameter :: pointing_fit_fwhm1=5
  integer(kind=4), parameter :: pointing_fit_area2=6
  integer(kind=4), parameter :: pointing_fit_posi2=7
  integer(kind=4), parameter :: pointing_fit_fwhm2=8

  ! Section Pointing: only for pointing scans.
  integer(kind=4), parameter :: sec_pointing_id=4
  integer(kind=4), parameter :: sec_pointing_nkey_def=2   ! Default for pre-allocations, can be changed
  integer(kind=4), parameter :: sec_pointing_nsol_def=16  ! Default for pre-allocations, can be changed
  !
  ! Variable buffers: the problem is that the Fortran section is an
  ! array of structures. We need to convert it to a structure of arrays.
  type sec_pointing_var_t
    integer(kind=4), allocatable :: poinline(:)
    real(kind=4),    allocatable :: poisigba(:)
    real(kind=4),    allocatable :: poisigra(:)
    real(kind=4),    allocatable :: poinfit(:,:)
    real(kind=4),    allocatable :: poinerr(:,:)
    !
    real(kind=8),    allocatable :: drifreq(:)
    real(kind=4),    allocatable :: driwidth(:)
    integer(kind=4), allocatable :: drinpoin(:)
    real(kind=4),    allocatable :: drirpoin(:)
    real(kind=4),    allocatable :: dritref(:)
    real(kind=4),    allocatable :: driaref(:)
    real(kind=4),    allocatable :: driapos(:)
    real(kind=4),    allocatable :: dritres(:)
    real(kind=4),    allocatable :: driares(:)
    integer(kind=4), allocatable :: drictype(:)
  end type sec_pointing_var_t
  !
  type sec_pointing_array_t
    integer(kind=4)              :: msol            ! Strict size of allocation on 'sol' dimension
    integer(kind=4)              :: nent            ! Used size of 'ent' dimension (allocation may be larger)
    integer(kind=4), allocatable :: nsol(:)         ! [nent]
    !
    integer(kind=4), allocatable :: poinline(:,:)   ! [msol,nent]
    real(kind=4),    allocatable :: poisigba(:,:)   ! [msol,nent]
    real(kind=4),    allocatable :: poisigra(:,:)   ! [msol,nent]
    real(kind=4),    allocatable :: poinfit(:,:,:)  ! [nfit,msol,nent]
    real(kind=4),    allocatable :: poinerr(:,:,:)  ! [nfit,msol,nent]
    !
    real(kind=8),    allocatable :: drifreq(:,:)    ! [msol,nent]
    real(kind=4),    allocatable :: driwidth(:,:)   ! [msol,nent]
    integer(kind=4), allocatable :: drinpoin(:,:)   ! [msol,nent]
    real(kind=4),    allocatable :: drirpoin(:,:)   ! [msol,nent]
    real(kind=4),    allocatable :: dritref(:,:)    ! [msol,nent]
    real(kind=4),    allocatable :: driaref(:,:)    ! [msol,nent]
    real(kind=4),    allocatable :: driapos(:,:)    ! [msol,nent]
    real(kind=4),    allocatable :: dritres(:,:)    ! [msol,nent]
    real(kind=4),    allocatable :: driares(:,:)    ! [msol,nent]
    integer(kind=4), allocatable :: drictype(:,:)   ! [msol,nent]
  contains
    procedure, public :: reallocate => pointing_array_reallocate
    procedure, public :: set        => pointing_array_set
    procedure, public :: variable   => pointing_array_variable
  end type sec_pointing_array_t
  !
  ! Type which describes how drift were equivalenced and combined.
  ! Note this is generic enough to be used in more cases.
  integer(kind=4), parameter :: mkeys=4  ! Could be more
  integer(kind=4), parameter :: drift_book_len_max=2+(4+8)*mkeys
  type drift_book_t
    integer(kind=4)   :: nkey=0         ! Number of keys-values used for this equivalence class
    integer(kind=4)   :: nobs=0         ! Number of observations mixed in this class
    integer(kind=4)   :: keys(mkeys)    ! List of key identifiers
    character(len=32) :: values(mkeys)  ! Values of each key for this class
  end type drift_book_t
  !
  type sec_pointing_sub_t
    type(drift_book_t)     :: book  ! Bookkeeping of each solution
    type(class_general_t)  :: gen   ! General description
    type(class_position_t) :: pos   ! Position description
    type(class_res_t)      :: res   ! Resolution description
    type(class_calib_t)    :: cal   ! Calibration description
    type(class_drift_t)    :: dri   ! Drift description
    type(class_pointing_t) :: poi   ! Pointing solutions
  end type sec_pointing_sub_t
  !
  type sec_pointing_t
    ! How the pointings were grouped before minimization. This follows CLASS
    ! LIST /TOC nomenclature.
    ! - Example 1 (individual fit):
    !     nkey=1, key(:) = ['NUMBER'],
    ! - Example 2 (grouped by unique telescope and unique angle):
    !     nkey=2, key(:) = ['TELESCOPE','DRIFT']
   !integer(kind=4)                       :: nkey    ! [---] Number of pair of key-value describing each pointing
    integer(kind=4)                       :: nsol    ! [---] Number of solutions
    type(sec_pointing_sub_t), allocatable :: sol(:)  ! [---] Solutions
    type(sec_pointing_var_t), private     :: var     ! Support for SIC variables
  contains
    generic,   public  :: reallocate  => reallocate4,reallocate8
    procedure, private :: reallocate4 => pointing_reallocate4
    procedure, private :: reallocate8 => pointing_reallocate8
    procedure, public  :: free        => pointing_free
    procedure, public  :: size        => pointing_size
    procedure, public  :: zero        => pointing_zero
    procedure, public  :: copy        => pointing_copy
    procedure, public  :: debug       => pointing_debug
    procedure, public  :: fromobs     => pointing_from_obs
    procedure, public  :: read        => pointing_read
    procedure, public  :: write       => pointing_write
    procedure, public  :: variable    => pointing_variable
    procedure, public  :: list_register_columns => pointing_list_register_columns
    procedure, public  :: list        => pointing_list
  end type sec_pointing_t

contains

  subroutine pointing_reallocate4(poi,msol,error)
    !-------------------------------------------------------------------
    ! Reallocate the section to hold at most 'msol' solutions
    !-------------------------------------------------------------------
    class(sec_pointing_t), intent(inout) :: poi
    integer(kind=4),       intent(in)    :: msol
    logical,               intent(inout) :: error
    !
    call pointing_reallocate8(poi,int(msol,kind=8),error)
    if (error)  return
  end subroutine pointing_reallocate4
  !
  subroutine pointing_reallocate8(poi,msol,error)
    !-------------------------------------------------------------------
    ! Reallocate the section to hold at most 'msol' solutions
    !-------------------------------------------------------------------
    class(sec_pointing_t), intent(inout) :: poi
    integer(kind=8),       intent(in)    :: msol
    logical,               intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='REALLOCATE>POINTING'
    logical :: dealloc,alloc
    integer(kind=4) :: ier
    !
    dealloc = .false.
    alloc = .false.
    if (allocated(poi%sol)) then
      if (size(poi%sol).ne.msol)  dealloc = .true.
    else
      alloc = .true.
    endif
    !
    if (dealloc) then
      call poi%free(error)
      if (error)  return
      alloc = .true.
    endif
    !
    if (alloc) then
      allocate(poi%sol(msol),stat=ier)
      if (failed_allocate(rname,'sol',ier,error))  return
    endif
  end subroutine pointing_reallocate8
  !
  subroutine pointing_free(poi,error)
    !-------------------------------------------------------------------
    ! Free properly the section and subsections
    !-------------------------------------------------------------------
    class(sec_pointing_t), intent(inout) :: poi
    logical,               intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='FREE>POINTING'
   !integer(kind=4) :: isol
    !
   !if (allocated(poi%key)) deallocate(poi%key)
    if (allocated(poi%sol)) then
   !  do isol=1,size(poi%sol)
   !    if (allocated(poi%sol(isol)%val))  deallocate(poi%sol(isol)%val)
   !  enddo
      deallocate(poi%sol)
    endif
  end subroutine pointing_free
  !
  function pointing_size(poi)
    !-------------------------------------------------------------------
    ! Return the max size (in 4 bytes words) of the section
    !-------------------------------------------------------------------
    integer(kind=4) :: pointing_size
    class(sec_pointing_t), intent(in) :: poi
    pointing_size = 0
    pointing_size = pointing_size + drift_book_len_max      ! Max size
    pointing_size = pointing_size + class_sec_gen_len_full  ! General subsection
    pointing_size = pointing_size + class_sec_pos_len_v2    ! Position subsection
    pointing_size = pointing_size + class_sec_res_len       ! Resolution subsection
    pointing_size = pointing_size + class_sec_cal_len       ! Calibration subsection
    pointing_size = pointing_size + class_sec_dri_len       ! Drift subsection
    pointing_size = pointing_size + class_sec_poi_len       ! Pointing subsection
    pointing_size = 1 + poi%nsol * pointing_size            ! For all solutions
  end function pointing_size
  !
  subroutine pointing_zero(poi,error)
    !---------------------------------------------------------------------
    !  Zero-ify a 'sec_pointing_t' structure
    !---------------------------------------------------------------------
    class(sec_pointing_t), intent(inout) :: poi
    logical,               intent(inout) :: error
    !
    poi%nsol = 0
  end subroutine pointing_zero
  !
  subroutine pointing_copy(i,o,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(sec_pointing_t), intent(in)    :: i
    type(sec_pointing_t),  intent(inout) :: o
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: isol
    !
    call o%reallocate(i%nsol,error)
    if (error)  return
    o%nsol = i%nsol
    do isol=1,i%nsol
      o%sol(isol) = i%sol(isol)  ! Section to section
    enddo
  end subroutine pointing_copy
  !
  subroutine pointing_from_obs(poi,isol,book,obs,error)
    use class_types
    !---------------------------------------------------------------------
    ! Add a new solution to the pointing section
    !---------------------------------------------------------------------
    class(sec_pointing_t), intent(inout) :: poi
    integer(kind=4),       intent(in)    :: isol
    type(drift_book_t),    intent(in)    :: book
    type(observation),     intent(in)    :: obs
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='POINTING>FROM>OBS'
    !
    if (isol.gt.size(poi%sol)) then
      ! See pre-allocation of this section in mrtcal_calib_or_solve_init
      call mrtindex_message(seve%e,rname,'Not enough room to store all the pointing results')
      error = .true.
      return
    endif
    !
    poi%sol(isol)%book = book
    poi%sol(isol)%gen  = obs%head%gen
    poi%sol(isol)%pos  = obs%head%pos
    poi%sol(isol)%res  = obs%head%res
    poi%sol(isol)%cal  = obs%head%cal
    poi%sol(isol)%dri  = obs%head%dri
    poi%sol(isol)%poi  = obs%head%poi
    ! call poi%debug()
  end subroutine pointing_from_obs
  !
  subroutine pointing_debug(p)
    !-------------------------------------------------------------------
    ! List the section contents (debug mode)
    !-------------------------------------------------------------------
    class(sec_pointing_t), intent(in) :: p
    !
    integer(kind=4) :: isol,ikey,nc
    character(len=256) :: c
    !
    print *,''
    print *,"nsol = ",p%nsol
    do isol=1,p%nsol
      print *,"solution #",isol
      print *,"nkey, nobs = ",p%sol(isol)%book%nkey,p%sol(isol)%book%nobs
      c = "keys:values ="
      nc = len_trim(c)
      do ikey=1,p%sol(isol)%book%nkey
        write(c(nc+2:),'(i0,a,a)')  &
          p%sol(isol)%book%keys(ikey),  &
          ':',  &
          trim(p%sol(isol)%book%values(ikey))
        nc = len_trim(c)
      enddo
      print *,c(1:nc)
      ! General subsection
      print *,"teles = ",p%sol(isol)%gen%teles
      ! Drift subsection
      print *,"freq = ",p%sol(isol)%dri%freq
      print *,"apos = ",p%sol(isol)%dri%apos
      ! Pointing subsection
      print *,"fit = ",p%sol(isol)%poi%nfit(:)
      print *,"error = ",p%sol(isol)%poi%nerr(:)
    enddo
  end subroutine pointing_debug
  !
  subroutine pointing_read(poi,filein,iwork,error)
    !-------------------------------------------------------------------
    ! Read the MRTCAL pointing section from buffer
    !-------------------------------------------------------------------
    class(sec_pointing_t), intent(inout) :: poi
    type(classic_file_t),  intent(in)    :: filein
    integer(kind=4),       intent(in)    :: iwork(:)
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='POINTING>READ'
    integer(kind=4) :: isol,ikey
    integer(kind=data_length) :: addr,slen
    !
    call filein%conv%read%i4(iwork(1),poi%nsol,1)
    call poi%reallocate(poi%nsol,error)
    if (error)  return
    addr = 2
    do isol=1,poi%nsol
      ! Bookkeeping
      call filein%conv%read%i4(iwork(addr),  poi%sol(isol)%book%nkey,1)
      call filein%conv%read%i4(iwork(addr+1),poi%sol(isol)%book%nobs,1)
      call filein%conv%read%i4(iwork(addr+2),poi%sol(isol)%book%keys,poi%sol(isol)%book%nkey)
      addr = addr+2+poi%sol(isol)%book%nkey
      do ikey=1,poi%sol(isol)%book%nkey
        call filein%conv%read%cc(iwork(addr),poi%sol(isol)%book%values(ikey),8)  ! 32 chars = 8 words
        addr = addr+8
      enddo
      ! General
      slen = class_sec_gen_len_full  ! Ad-hoc format for this section
      call class_read_general_full(poi%sol(isol)%gen,filein%conv,obs_version,iwork(addr:),slen,error)
      if (error)  return
      addr = addr+slen
      ! Position
      slen = class_sec_pos_len_v2    ! For obs_version=2
      call class_read_position(poi%sol(isol)%pos,filein%conv,obs_version,iwork(addr:),slen,error)
      if (error)  return
      addr = addr+slen
      ! Resolution
      slen = class_sec_res_len
      call class_read_resolution(poi%sol(isol)%res,filein%conv,obs_version,iwork(addr:),slen,error)
      if (error)  return
      addr = addr+slen
      ! Calibration
      slen = class_sec_cal_len
      call class_read_calibration(poi%sol(isol)%cal,filein%conv,obs_version,iwork(addr:),slen,error)
      if (error)  return
      addr = addr+slen
      ! Drift
      slen = class_sec_dri_len  ! For obs_version=2
      call class_read_drift(poi%sol(isol)%dri,filein%conv,obs_version,iwork(addr:),slen,error)
      if (error)  return
      addr = addr+slen
      ! Pointing
      slen = class_sec_poi_len  ! For obs_version=2
      call class_read_pointing(poi%sol(isol)%poi,filein%conv,obs_version,iwork(addr:),slen,error)
      if (error)  return
      addr = addr+slen
    enddo
    ! Debug:
    ! call poi%debug()
  end subroutine pointing_read
  !
  subroutine pointing_write(poi,fileout,iwork,seclen,error)
    !-------------------------------------------------------------------
    ! Write the MRTCAL pointing section to buffer
    !-------------------------------------------------------------------
    class(sec_pointing_t),     intent(in)    :: poi
    type(classic_file_t),      intent(in)    :: fileout
    integer(kind=4),           allocatable   :: iwork(:)
    integer(kind=data_length), intent(out)   :: seclen
    logical,                   intent(inout) :: error
    !
    character(len=*), parameter :: rname='POINTING>WRITE'
    integer(kind=4) :: ier,isol,ikey
    integer(kind=data_length) :: addr,slen
    !
    seclen = 0
    !
    allocate(iwork(poi%size()),stat=ier)
    if (failed_allocate(rname,'iwork',ier,error))  return
    !
    call fileout%conv%writ%i4(poi%nsol,iwork(1),1)
    addr = 2
    do isol=1,poi%nsol
      ! Bookkeeping
      call fileout%conv%writ%i4(poi%sol(isol)%book%nkey,iwork(addr),  1)
      call fileout%conv%writ%i4(poi%sol(isol)%book%nobs,iwork(addr+1),1)
      call fileout%conv%writ%i4(poi%sol(isol)%book%keys,iwork(addr+2),poi%sol(isol)%book%nkey)
      addr = addr+2+poi%sol(isol)%book%nkey
      do ikey=1,poi%sol(isol)%book%nkey
        call fileout%conv%writ%cc(poi%sol(isol)%book%values(ikey),iwork(addr),8)  ! 32 chars = 8 words
        addr = addr+8
      enddo
      ! General
      call class_write_general_full(poi%sol(isol)%gen,fileout%conv,obs_version,iwork(addr:),slen,error)
      if (error)  return
      addr = addr+slen
      ! Position
      call class_write_position(poi%sol(isol)%pos,fileout%conv,obs_version,iwork(addr:),slen,error)
      if (error)  return
      addr = addr+slen
      ! Resolution
      call class_write_resolution(poi%sol(isol)%res,fileout%conv,obs_version,iwork(addr:),slen,error)
      if (error)  return
      addr = addr+slen
      ! Calibration
      call class_write_calibration(poi%sol(isol)%cal,fileout%conv,obs_version,iwork(addr:),slen,error)
      if (error)  return
      addr = addr+slen
      ! Drift
      call class_write_drift(poi%sol(isol)%dri,fileout%conv,obs_version,iwork(addr:),slen,error)
      if (error)  return
      addr = addr+slen
      ! Pointing
      call class_write_pointing(poi%sol(isol)%poi,fileout%conv,obs_version,iwork(addr:),slen,error)
      if (error)  return
      addr = addr+slen
    enddo
    seclen = addr-1
  end subroutine pointing_write
  !
  subroutine pointing_variable(sec,struct,ro,error)
    !-------------------------------------------------------------------
    ! Create the SIC variables pointing to the structure
    !-------------------------------------------------------------------
    class(sec_pointing_t), intent(inout) :: sec     !
    character(len=*),      intent(in)    :: struct  ! Structure name
    logical,               intent(in)    :: ro      ! Read-Only?
    logical,               intent(inout) :: error   ! Logical error flag
    !
    logical :: userreq
    character(len=32) :: str,strpoi,strdri
    integer(kind=4) :: isol
    integer(kind=index_length) :: dims(sic_maxdims)
    !
    userreq = .false.
    str = trim(struct)//'%POI'
    !
    call sic_delvariable(str,userreq,error)
    call sic_defstructure(str,.true.,error)
    if (error)  return
    !
    call sic_def_inte(trim(str)//'%N',sec%nsol,0,0,ro,error)
    if (error)  return
    !
    if (sec%nsol.eq.0)  return
    !
    ! ------------------------------------------------------------------
    !
    ! Allocate buffers ZZZ we should have variable_reallocate procedure
    if (allocated(sec%var%poinline))  deallocate(sec%var%poinline)
    if (allocated(sec%var%poisigba))  deallocate(sec%var%poisigba)
    if (allocated(sec%var%poisigra))  deallocate(sec%var%poisigra)
    if (allocated(sec%var%poinfit))   deallocate(sec%var%poinfit)
    if (allocated(sec%var%poinerr))   deallocate(sec%var%poinerr)
    allocate(sec%var%poinline(sec%nsol))
    allocate(sec%var%poisigba(sec%nsol))
    allocate(sec%var%poisigra(sec%nsol))
    allocate(sec%var%poinfit(mpoifit,sec%nsol))
    allocate(sec%var%poinerr(mpoifit,sec%nsol))
    !
    ! Fill buffers
    do isol=1,sec%nsol
      sec%var%poinline(isol)  = sec%sol(isol)%poi%nline
      sec%var%poisigba(isol)  = sec%sol(isol)%poi%sigba
      sec%var%poisigra(isol)  = sec%sol(isol)%poi%sigra
      sec%var%poinfit(:,isol) = sec%sol(isol)%poi%nfit(:)
      sec%var%poinerr(:,isol) = sec%sol(isol)%poi%nerr(:)
    enddo
    !
    ! Map buffers. NB: use same names as CLASS
    strpoi = trim(str)//'%POI'
    call sic_defstructure(strpoi,.true.,error)
    if (error)  return
    !
    dims(1) = sec%nsol
    call sic_def_inte(trim(strpoi)//'%NLINE',   sec%var%poinline,1,dims,ro,error)
    call sic_def_real(trim(strpoi)//'%RMS_BASE',sec%var%poisigba,1,dims,ro,error)
    call sic_def_real(trim(strpoi)//'%RMS_LINE',sec%var%poisigra,1,dims,ro,error)
    if (error)  return
    !
    dims(1) = mpoifit
    dims(2) = sec%nsol
    call sic_def_real(trim(strpoi)//'%RESULT',sec%var%poinfit,2,dims,ro,error)
    call sic_def_real(trim(strpoi)//'%ERROR', sec%var%poinerr,2,dims,ro,error)
    if (error)  return
    !
    ! ------------------------------------------------------------------
    ! Drift buffers
    !
    ! Allocate buffers
    if (allocated(sec%var%drifreq))   deallocate(sec%var%drifreq)
    if (allocated(sec%var%driwidth))  deallocate(sec%var%driwidth)
    if (allocated(sec%var%drinpoin))  deallocate(sec%var%drinpoin)
    if (allocated(sec%var%drirpoin))  deallocate(sec%var%drirpoin)
    if (allocated(sec%var%dritref))   deallocate(sec%var%dritref)
    if (allocated(sec%var%driaref))   deallocate(sec%var%driaref)
    if (allocated(sec%var%driapos))   deallocate(sec%var%driapos)
    if (allocated(sec%var%dritres))   deallocate(sec%var%dritres)
    if (allocated(sec%var%driares))   deallocate(sec%var%driares)
    if (allocated(sec%var%drictype))  deallocate(sec%var%drictype)
    allocate(sec%var%drifreq(sec%nsol))
    allocate(sec%var%driwidth(sec%nsol))
    allocate(sec%var%drinpoin(sec%nsol))
    allocate(sec%var%drirpoin(sec%nsol))
    allocate(sec%var%dritref(sec%nsol))
    allocate(sec%var%driaref(sec%nsol))
    allocate(sec%var%driapos(sec%nsol))
    allocate(sec%var%dritres(sec%nsol))
    allocate(sec%var%driares(sec%nsol))
    allocate(sec%var%drictype(sec%nsol))
    !
    ! Fill buffers
    do isol=1,sec%nsol
      sec%var%drifreq(isol)  = sec%sol(isol)%dri%freq
      sec%var%driwidth(isol) = sec%sol(isol)%dri%width
      sec%var%drinpoin(isol) = sec%sol(isol)%dri%npoin
      sec%var%drirpoin(isol) = sec%sol(isol)%dri%rpoin
      sec%var%dritref(isol)  = sec%sol(isol)%dri%tref
      sec%var%driaref(isol)  = sec%sol(isol)%dri%aref
      sec%var%driapos(isol)  = sec%sol(isol)%dri%apos
      sec%var%dritres(isol)  = sec%sol(isol)%dri%tres
      sec%var%driares(isol)  = sec%sol(isol)%dri%ares
      sec%var%drictype(isol) = sec%sol(isol)%dri%ctype
    enddo
    !
    ! Map buffers. NB: use same names as CLASS
    strdri = trim(str)//'%DRI'
    call sic_defstructure(strdri,.true.,error)
    if (error)  return
    !
    dims(1) = sec%nsol
    call sic_def_dble(trim(strdri)//'%FREQ', sec%var%drifreq, 1,dims,ro,error)
    call sic_def_real(trim(strdri)//'%WIDTH',sec%var%driwidth,1,dims,ro,error)
    call sic_def_inte(trim(strdri)//'%NPOIN',sec%var%drinpoin,1,dims,ro,error)
    call sic_def_real(trim(strdri)//'%RPOIN',sec%var%drirpoin,1,dims,ro,error)
    call sic_def_real(trim(strdri)//'%TREF', sec%var%dritref, 1,dims,ro,error)
    call sic_def_real(trim(strdri)//'%AREF', sec%var%driaref, 1,dims,ro,error)
    call sic_def_real(trim(strdri)//'%APOS', sec%var%driapos, 1,dims,ro,error)
    call sic_def_real(trim(strdri)//'%TRES', sec%var%dritres, 1,dims,ro,error)
    call sic_def_real(trim(strdri)//'%ARES', sec%var%driares, 1,dims,ro,error)
    call sic_def_inte(trim(strdri)//'%CTYPE',sec%var%drictype,1,dims,ro,error)
    if (error)  return
    ! ------------------------------------------------------------------
  end subroutine pointing_variable
  !
  subroutine pointing_array_reallocate(poi,msol,nent,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(sec_pointing_array_t), intent(inout) :: poi
    integer(kind=4),             intent(in)    :: msol
    integer(kind=8),             intent(in)    :: nent
    logical,                     intent(inout) :: error
    !
    character(len=*), parameter :: rname='VARIABLE'
    logical :: realloc
    integer(kind=4) :: ier
    !
    poi%msol = msol
    poi%nent = nent
    !
    if (allocated(poi%poinline)) then
      ! Strict equality on msol dimension, otherwise this means troubles when mapping SIC variables
      ! Lower than is fine for trailing dimension
      realloc = ubound(poi%poinline,1).ne.poi%msol .or.  &
                ubound(poi%poinline,2).lt.poi%nent
      if (poi%nent.le.0 .or. realloc) then
        deallocate(poi%nsol)
        !
        deallocate(poi%poinline,poi%poisigba,poi%poisigra)
        deallocate(poi%poinfit, poi%poinerr)
        !
        deallocate(poi%drifreq, poi%driwidth,poi%drinpoin)
        deallocate(poi%drirpoin,poi%dritref, poi%driaref)
        deallocate(poi%driapos, poi%dritres, poi%driares)
        deallocate(poi%drictype)
      endif
    else
      realloc = poi%nent.gt.0
    endif
    !
    if (realloc) then
      allocate(poi%nsol(poi%nent),stat=ier)
      !
      allocate(poi%poinline(poi%msol,poi%nent),poi%poisigba(poi%msol,poi%nent),stat=ier)
      allocate(poi%poisigra(poi%msol,poi%nent),                                stat=ier)
      allocate(poi%poinfit(mpoifit,poi%msol,poi%nent),                         stat=ier)
      allocate(poi%poinerr(mpoifit,poi%msol,poi%nent),                         stat=ier)
      !
      allocate(poi%drifreq(poi%msol,poi%nent), poi%driwidth(poi%msol,poi%nent),stat=ier)
      allocate(poi%drinpoin(poi%msol,poi%nent),poi%drirpoin(poi%msol,poi%nent),stat=ier)
      allocate(poi%dritref(poi%msol,poi%nent), poi%driaref(poi%msol,poi%nent), stat=ier)
      allocate(poi%driapos(poi%msol,poi%nent), poi%dritres(poi%msol,poi%nent), stat=ier)
      allocate(poi%driares(poi%msol,poi%nent), poi%drictype(poi%msol,poi%nent),stat=ier)
      if (failed_allocate(rname,'MDX%HEAD%POI arrays',ier,error))  return
    endif
  end subroutine pointing_array_reallocate
  !
  subroutine pointing_array_set(varpoi,ient,sec,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(sec_pointing_array_t), intent(inout) :: varpoi
    integer(kind=8),             intent(in)    :: ient
    type(sec_pointing_t),        intent(in)    :: sec
    logical,                     intent(inout) :: error
    !
    integer(kind=4) :: isol
    !
    varpoi%nsol(ient) = sec%nsol
    do isol=1,sec%nsol
      varpoi%poinline(isol,ient)  = sec%sol(isol)%poi%nline
      varpoi%poisigba(isol,ient)  = sec%sol(isol)%poi%sigba
      varpoi%poisigra(isol,ient)  = sec%sol(isol)%poi%sigra
      varpoi%poinfit(:,isol,ient) = sec%sol(isol)%poi%nfit(:)
      varpoi%poinerr(:,isol,ient) = sec%sol(isol)%poi%nerr(:)
      !
      varpoi%drifreq(isol,ient)  = sec%sol(isol)%dri%freq
      varpoi%driwidth(isol,ient) = sec%sol(isol)%dri%width
      varpoi%drinpoin(isol,ient) = sec%sol(isol)%dri%npoin
      varpoi%drirpoin(isol,ient) = sec%sol(isol)%dri%rpoin
      varpoi%dritref(isol,ient)  = sec%sol(isol)%dri%tref
      varpoi%driaref(isol,ient)  = sec%sol(isol)%dri%aref
      varpoi%driapos(isol,ient)  = sec%sol(isol)%dri%apos
      varpoi%dritres(isol,ient)  = sec%sol(isol)%dri%tres
      varpoi%driares(isol,ient)  = sec%sol(isol)%dri%ares
      varpoi%drictype(isol,ient) = sec%sol(isol)%dri%ctype
    enddo
    !
    ! Nullify the unused parts
    do isol=sec%nsol+1,varpoi%msol
      varpoi%poinline(isol,ient)  = 0
      varpoi%poisigba(isol,ient)  = 0.
      varpoi%poisigra(isol,ient)  = 0.
      varpoi%poinfit(:,isol,ient) = 0.
      varpoi%poinerr(:,isol,ient) = 0.
      !
      varpoi%drifreq(isol,ient)  = 0.d0
      varpoi%driwidth(isol,ient) = 0.
      varpoi%drinpoin(isol,ient) = 0
      varpoi%drirpoin(isol,ient) = 0.
      varpoi%dritref(isol,ient)  = 0.
      varpoi%driaref(isol,ient)  = 0.
      varpoi%driapos(isol,ient)  = 0.
      varpoi%dritres(isol,ient)  = 0.
      varpoi%driares(isol,ient)  = 0.
      varpoi%drictype(isol,ient) = 0
    enddo
  end subroutine pointing_array_set
  !
  subroutine pointing_array_variable(poi,str,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(sec_pointing_array_t), intent(in)    :: poi
    character(len=*),            intent(in)    :: str
    logical,                     intent(inout) :: error
    !
    character(len=32) :: topstr,strpoi,strdri
    integer(kind=index_length) :: dims(sic_maxdims)
    !
    topstr = trim(str)//'%POI'
    call sic_defstructure(topstr,.true.,error)
    if (error)  return
    dims(1) = poi%nent
    call sic_def_inte(trim(topstr)//'%N',poi%nsol,1,dims,.true.,error)
    if (error)  return
    !
    ! --- Pointing subsection ------------------------------------------
    !
    strpoi = trim(topstr)//'%POI'
    call sic_defstructure(strpoi,.true.,error)
    if (error)  return
    !
    dims(1) = poi%msol
    dims(2) = poi%nent
    call sic_def_inte(trim(strpoi)//'%NLINE',   poi%poinline,2,dims,.true.,error)
    call sic_def_real(trim(strpoi)//'%RMS_BASE',poi%poisigba,2,dims,.true.,error)
    call sic_def_real(trim(strpoi)//'%RMS_LINE',poi%poisigra,2,dims,.true.,error)
    if (error)  return
    dims(1) = mpoifit
    dims(2) = poi%msol
    dims(3) = poi%nent
    call sic_def_real(trim(strpoi)//'%RESULT',poi%poinfit,3,dims,.true.,error)
    call sic_def_real(trim(strpoi)//'%ERROR', poi%poinerr,3,dims,.true.,error)
    if (error)  return
    !
    ! --- Drift subsection ---------------------------------------------
    !
    strdri = trim(topstr)//'%DRI'
    call sic_defstructure(strdri,.true.,error)
    if (error)  return
    !
    dims(1) = poi%msol
    dims(2) = poi%nent
    call sic_def_dble(trim(strdri)//'%FREQ', poi%drifreq, 2,dims,.true.,error)
    call sic_def_real(trim(strdri)//'%WIDTH',poi%driwidth,2,dims,.true.,error)
    call sic_def_inte(trim(strdri)//'%NPOIN',poi%drinpoin,2,dims,.true.,error)
    call sic_def_real(trim(strdri)//'%RPOIN',poi%drirpoin,2,dims,.true.,error)
    call sic_def_real(trim(strdri)//'%TREF', poi%dritref, 2,dims,.true.,error)
    call sic_def_real(trim(strdri)//'%AREF', poi%driaref, 2,dims,.true.,error)
    call sic_def_real(trim(strdri)//'%APOS', poi%driapos, 2,dims,.true.,error)
    call sic_def_real(trim(strdri)//'%TRES', poi%dritres, 2,dims,.true.,error)
    call sic_def_real(trim(strdri)//'%ARES', poi%driares, 2,dims,.true.,error)
    call sic_def_inte(trim(strdri)//'%CTYPE',poi%drictype,2,dims,.true.,error)
    if (error)  return
  end subroutine pointing_array_variable
  !
  subroutine pointing_list_register_columns(sec,tab,error)
    use mrtindex_table
    !-------------------------------------------------------------------
    ! List the header of the columns displayed by pointing_list
    !-------------------------------------------------------------------
    class(sec_pointing_t), intent(in)    :: sec
    type(table_t),         intent(inout) :: tab
    logical,               intent(inout) :: error
    !
    call tab%register_column('Ndr',       '',           3,'(i3)',error)
    if (error)  return
    call tab%register_column('Subscan',   '',           3,'(i3)',error)
    if (error)  return
    call tab%register_column('Time',      '[day]',     11,'(f11.9)',error)
    if (error)  return
    call tab%register_column('Source',    '',          14,'(a)',error)
    if (error)  return
    call tab%register_column('Azimuth',   '[deg]',      8,'(f8.3)',error)
    if (error)  return
    call tab%register_column('Elevation', '[deg]',      7,'(f7.3)',error)
    if (error)  return
    call tab%register_column('idFe',      '',           5,'(a5)',error)
    if (error)  return
    call tab%register_column('Freq',      '[GHz]',      8,'(f8.4)',error)
    if (error)  return
    call tab%register_column('Angle',     '[deg]',      7,'(f7.2)',error)
    if (error)  return
    call tab%register_column('Modulo',    '[deg]',      7,'(f7.2)',error)
    if (error)  return
    call tab%register_column('Correction','[arcsec]',  12,'(1pg12.5)',error)
    if (error)  return
    call tab%register_column('Position',  '[arcsec]',  12,'(1pg12.5)',error)
    if (error)  return
    call tab%register_column('ErrPos',    '[arcsec]',  11,'(1pg11.5)',error)
    if (error)  return
    call tab%register_column('FWHM',      '[arcsec]',  12,'(1pg12.5)',error)
    if (error)  return
    call tab%register_column('ErrFWHM',   '[arcsec]',  11,'(1pg11.5)',error)
    if (error)  return
    call tab%register_column('Area',      '[K.arcsec]',12,'(1pg12.5)',error)
    if (error)  return
    call tab%register_column('ErrArea',   '[K.arcsec]',11,'(1pg11.5)',error)
    if (error)  return
    call tab%register_column('Offset',    '[K]',       12,'(1pg12.5)',error)
    if (error)  return
    call tab%register_column('ErrOffset', '[K]',       11,'(1pg11.5)',error)
    if (error)  return
    call tab%register_column('Slope',     '[K/arcsec]',12,'(1pg12.5)',error)
    if (error)  return
    call tab%register_column('ErrSlope',  '[K/arcsec]',11,'(1pg11.5)',error)
    if (error)  return
    call tab%register_column('RMS',       '[K]',       12,'(1pg12.5)',error)
    if (error)  return
  end subroutine pointing_list_register_columns
  !
  subroutine pointing_list(sec,tab,line,backid,olun,error)
    use phys_const
    use mrtindex_table
    !-------------------------------------------------------------------
    ! List the pointing section under specific format
    !-------------------------------------------------------------------
    class(sec_pointing_t), intent(in)    :: sec
    type(table_t),         intent(in)    :: tab
    type(line_t),          intent(in)    :: line
    integer(kind=4),       intent(in)    :: backid
    integer(kind=4),       intent(in)    :: olun
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: isol
    type(line_t) :: lline  ! Local line copy
    real(kind=4) :: corr,posi1
    !
    do isol=1,sec%nsol
      lline = line
      !
      call lline%new_value(tab,sec%sol(isol)%book%nobs,error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%gen%subscan,error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%gen%ut/twopi,error)  ! [day] Time in range [0:1] day
      if (error)  return
      call lline%new_value(tab,"'"//trim(sec%sol(isol)%pos%sourc)//"'",error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%gen%az*deg_per_rad,error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%gen%el*deg_per_rad,error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%gen%teles(4:8),error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%dri%freq/1.d3,error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%dri%apos*deg_per_rad,error)
      if (error)  return
      call lline%new_value(tab,class_toc_drift_modulo(  &
                               sec%sol(isol)%book%keys(1:sec%sol(isol)%book%nkey))*deg_per_rad,  &
                               error)
      if (error)  return
      corr = pointing_collimation(sec%sol(isol)%dri)
      posi1 = sec%sol(isol)%poi%nfit(pointing_fit_posi1)*sec_per_rad
      if (corr.ne.sec%sol(isol)%dri%bad)  corr = corr*sec_per_rad+posi1
      call lline%new_value(tab,corr,error)
      if (error)  return
      call lline%new_value(tab,posi1,error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%poi%nerr(pointing_fit_posi1)*sec_per_rad,error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%poi%nfit(pointing_fit_fwhm1)*sec_per_rad,error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%poi%nerr(pointing_fit_fwhm1)*sec_per_rad,error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%poi%nfit(pointing_fit_area1)*sec_per_rad,error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%poi%nerr(pointing_fit_area1)*sec_per_rad,error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%poi%nfit(pointing_fit_offset),error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%poi%nerr(pointing_fit_offset),error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%poi%nfit(pointing_fit_slope)/sec_per_rad,error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%poi%nerr(pointing_fit_slope)/sec_per_rad,error)
      if (error)  return
      call lline%new_value(tab,sec%sol(isol)%poi%sigba,error)
      if (error)  return
      !
      call lline%list(olun,error)
      if (error)  return
    enddo
  end subroutine pointing_list
  !
  ! --- Extra utilities ------------------------------------------------
  !
  function pointing_direction(apos) result(code)
    use phys_const
    !-------------------------------------------------------------------
    ! Return the drift direction (as a code) from the drift angle.
    !-------------------------------------------------------------------
    integer(kind=4) :: code
    real(kind=4), intent(in) :: apos  ! [rad]
    !
    ! Because of the possible 0+-epsilon issues, modulo() is not reliable
    if (nearly_equal(apos,  0.,1.e-3) .or. &
        nearly_equal(apos,+pis,1.e-3) .or. &
        nearly_equal(apos,-pis,1.e-3)) then
      ! An azimuth drift
      code = code_pointing_azimuth
    elseif (nearly_equal(apos,+pis/2.,1.e-3) .or. &
            nearly_equal(apos,-pis/2.,1.e-3)) then
      ! An elevation drift
      code = code_pointing_elevation
    else
      ! Something else, could we derive it from colla/colle and the drift angle?
      code = code_pointing_unknown
    endif
  end function pointing_direction
  !
  function pointing_collimation(dri) result(colla)
    !-------------------------------------------------------------------
    ! Return the collimation angle from the drift section.
    !-------------------------------------------------------------------
    real(kind=4) :: colla  ! [rad]
    type(class_drift_t), intent(in) :: dri
    !
    select case (pointing_direction(dri%apos))
    case (code_pointing_azimuth)
      colla = dri%colla
    case (code_pointing_elevation)
      colla = dri%colle
    case default
      ! Something else, could we derive it from colla/colle and the drift angle?
      colla = dri%bad
    end select
  end function pointing_collimation
end module mrtindex_sec_pointing
