!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module mrtcal_toclass_buffers
  use class_types
  type(observation) :: classobs
  real(kind=4), allocatable :: dataw(:)  ! Weight array for Associated Arrays
end module mrtcal_toclass_buffers
!
subroutine mrtcal_toclass_init(error)
  use mrtcal_messaging
  use mrtcal_dependencies_interfaces
  use mrtcal_toclass_buffers
  use mrtcal_interfaces, except_this=>mrtcal_toclass_init
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  !  Initialize the 'toclass' buffers. This should be done only once in
  ! a session.
  !---------------------------------------------------------------------
  logical, intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='TOCLASS>INIT'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  call class_obs_init(classobs,error)
  if (error)  return
  !
  ! Support for User Section
  call class_user_owner         ('30M','MRTCAL')              ! Owner
  call class_user_toclass       (mrtcal_toclass_user)         ! Transfer subroutine
  call class_user_dump          (mrtcal_user_dump)            ! Hook to LAS\DUMP /SECTION USER
  call class_user_setvar        (mrtcal_user_setvar)          ! Hook to LAS\SET VARIABLE USER
  call class_user_find          (mrtcal_user_find)            ! Hook to LAS\FIND /USER (command line parsing)
  call class_user_fix           (mrtcal_user_fix)             ! Hook to LAS\FIND /USER (selection)
  call class_user_varidx_fill   (mrtcal_user_varidx_fill)     ! Hook to EXP\VARIABLE /INDEX (array filling)
  call class_user_varidx_defvar (mrtcal_user_varidx_defvar)   ! Hook to EXP\VARIABLE /INDEX (vars definition)
  call class_user_varidx_realloc(mrtcal_user_varidx_realloc)  ! Hook to EXP\VARIABLE /INDEX (re/deallocation)
  !
end subroutine mrtcal_toclass_init
!
subroutine mrtcal_toclass_exit(error)
  use mrtcal_messaging
  use mrtcal_dependencies_interfaces
  use mrtcal_toclass_buffers
  use mrtcal_interfaces, except_this=>mrtcal_toclass_exit
  !---------------------------------------------------------------------
  ! @ private
  !  Finalize the 'toclass' buffers. This should be done only once in
  ! a session.
  !---------------------------------------------------------------------
  logical, intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='TOCLASS>EXIT'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  call class_obs_clean(classobs,error)
  if (error)  return
  !
  if (allocated(dataw))  deallocate(dataw)
  !
end subroutine mrtcal_toclass_exit
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine mrtcal_chunkset0d_to_obs(set,error)
  use mrtcal_messaging
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_chunkset0d_to_obs
  use mrtcal_calib_types
  use mrtcal_toclass_buffers
  !---------------------------------------------------------------------
  ! @ private-generic mrtcal_chunkset_to_obs
  ! Stitch the spectra in the set and write them as a Class observation
  ! into the Class output file
  !---------------------------------------------------------------------
  type(chunkset_t), intent(in)    :: set
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CHUNKSET0D>TO>OBS'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  call mrtcal_chunkset_to_obs_ry(set,classobs,error)
  if (error)  return
  !
  call mrtcal_obs_to_class(classobs,error)
  if (error)  return
  !
end subroutine mrtcal_chunkset0d_to_obs
!
subroutine mrtcal_chunkset1d_to_obs(set,error)
  use mrtcal_messaging
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_chunkset1d_to_obs
  use mrtcal_calib_types
  use mrtcal_toclass_buffers
  !---------------------------------------------------------------------
  ! @ private-generic mrtcal_chunkset_to_obs
  ! Convert an array of chunksets to one Class observation with
  ! Associated Arrays
  !---------------------------------------------------------------------
  type(chunkset_t), intent(in)    :: set(:)
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CHUNKSET1D>TO>OBS'
  integer(kind=4) :: iobs
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  ! Reset the observation. In particular, clean out the Associated Arrays
  ! section
  call rzero(classobs,'NULL',mrtcal_user_function)
  !
  call mrtcal_chunkset_to_obs_ry(set(1),classobs,error)
  if (error)  return
  !
  do iobs=2,size(set)
    call mrtcal_chunkset_to_obs_assoc(set(iobs),classobs,error)
    if (error)  return
  enddo
  !
  call mrtcal_obs_to_class(classobs,error)
  if (error)  return
  !
end subroutine mrtcal_chunkset1d_to_obs
!
subroutine mrtcal_chunkset_fsw_to_obs(out,set1,set2,error)
  use mrtcal_messaging
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_chunkset_fsw_to_obs
  use mrtcal_calib_types
  use mrtcal_setup_types
  use mrtcal_toclass_buffers
  !---------------------------------------------------------------------
  ! @ private
  !  Specific to FSW data
  !  Fold the pair of chunksets and produce a single class spectrum
  !---------------------------------------------------------------------
  type(mrtcal_setup_output_t), intent(in)    :: out
  type(chunkset_t),            intent(in)    :: set1
  type(chunkset_t),            intent(in)    :: set2
  logical,                     intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CHUNKSET>FSW>TO>OBS'
  real(kind=4), pointer :: data2(:)
  !
  call mrtcal_message(seve%d,rname,'Welcome')
  !
  ! Reset the observation. In particular, clean out the Associated Arrays
  ! section
  call rzero(classobs,'NULL',mrtcal_user_function)
  !
  ! Build one observation from set #1
  call mrtcal_chunkset_to_obs_ry(set1,classobs,error)
  if (error)  return
  !
  ! Attach 'data2' as an Associated Array named "Y"
  call class_assoc_add(classobs,'Y',data2,error)
  if (error)  return
  ! In return 'data2' is a pointer to be filled, pointing to the
  ! associated array data.
  call mrtcal_reallocate_r4(dataw,obs_nchan(classobs%head),error)
  if (error)  return
  call mrtcal_chunkset_to_obs_data(set2,classobs%head,classobs%datav,data2,dataw,error)
  if (error)  return
  !
  ! At this stage the observation contains one spectrum in RY and
  ! the other in Y associated array. This is acceptable for transfering
  ! data to Class folding code which recognizes this structure, but this
  ! should be improved at the data format level before making it public.
  !
  if (out%fold) then
    classobs%cbad = classobs%head%spe%bad
    call class_fold_obs(classobs,.true.,error)
    if (error)  return
  endif
  !
  call mrtcal_obs_to_class(classobs,error)
  if (error)  return
  !
end subroutine mrtcal_chunkset_fsw_to_obs
!
subroutine mrtcal_chunkset_to_obs_ry(set,obs,error)
  use mrtcal_messaging
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_chunkset_to_obs_ry
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  ! Stitch the spectra in the set and save them as the RY spectrum
  ! in the observation.
  !---------------------------------------------------------------------
  type(chunkset_t),  intent(in)    :: set
  type(observation), intent(inout) :: obs
  logical,           intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CHUNKSET>TO>OBS>RY'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  call mrtcal_chunkset_check(set,error)
  if (error)  return
  call mrtcal_chunkset_to_obs_head(set,obs,error)
  if (error)  return
  call reallocate_obs(obs,obs_nchan(obs%head),error)
  if (error)  return
  call mrtcal_chunkset_to_obs_data(set,obs%head,obs%datav,obs%data1,obs%dataw,error)
  if (error)  return
  !
end subroutine mrtcal_chunkset_to_obs_ry
!
subroutine mrtcal_chunkset_to_obs_assoc(set,obs,error)
  use gbl_format
  use mrtcal_messaging
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_chunkset_to_obs_assoc
  use mrtcal_calib_types
  use mrtcal_toclass_buffers
  !---------------------------------------------------------------------
  ! @ private
  !  Stitch the spectra in the set and save them as a new associated
  ! array in the observation.
  !---------------------------------------------------------------------
  type(chunkset_t),  intent(in)    :: set
  type(observation), intent(inout) :: obs
  logical,           intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CHUNKSET>TO>OBS>ASSOC'
  real(kind=4), pointer :: data1(:)
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  call mrtcal_chunkset_check(set,error)
  if (error)  return
  !
  if (set%chunks(1)%pos%sourc.eq.'W') then
    ! A reserved array
    call class_assoc_add(obs,set%chunks(1)%pos%sourc,data1,error)
  else
    ! A free array
    call class_assoc_add(obs,set%chunks(1)%pos%sourc,'',fmt_r4,0,class_bad,data1,error)
  endif
  if (error)  return
  !
  call mrtcal_reallocate_r4(dataw,obs_nchan(obs%head),error)
  if (error)  return
  !
  call mrtcal_chunkset_to_obs_data(set,obs%head,obs%datav,data1,dataw,error)
  if (error)  return
  !
end subroutine mrtcal_chunkset_to_obs_assoc
!
subroutine mrtcal_reallocate_r4(r4,n,error)
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  real(kind=4), allocatable, intent(inout) :: r4(:)
  integer(kind=4),           intent(in)    :: n
  logical,                   intent(inout) :: error
  ! Local
  logical :: realloc
  !
  if (allocated(r4)) then
    realloc = size(r4).ne.n
    if (realloc)  deallocate(r4)
  else
    realloc = .true.
  endif
  if (realloc)  allocate(r4(n))
end subroutine mrtcal_reallocate_r4
!
subroutine mrtcal_chunkset_to_obs_head(set,obs,error)
  use mrtcal_messaging
  use class_api
  use mrtcal_dependencies_interfaces
  use class_types
  use mrtcal_buffers
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this=>mrtcal_chunkset_to_obs_head
  !---------------------------------------------------------------------
  ! @ private
  !   This subroutine fills a Class header from a chunkset (collection
  ! of several chunks).
  !   General and position sections are assumed to be common between all
  ! the chunks of the chunkset. Should it be checked? *** JP
  !---------------------------------------------------------------------
  type(chunkset_t),  intent(in)    :: set
  type(observation), intent(inout) :: obs
  logical,           intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CHUNKSET>TO>OBS>HEAD'
  integer(kind=4) :: version,iuser
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  obs%head%presec(:) = .false.
  !
  ! General
  obs%head%presec(class_sec_gen_id) = .true.
  call mrtcal_chunkset_to_obs_gen(set,obs%head%gen,error)
  if (error)  return
  !
  ! Position
  obs%head%presec(class_sec_pos_id) = .true.
  obs%head%pos = set%chunks(1)%pos
  !
  if (obs%head%gen%kind.eq.kind_cont) then
    ! Continuum drift
    obs%head%presec(class_sec_dri_id) = .true.
    call mrtcal_chunkset_to_obs_con(set,obs%head%dri,obs%head%gen%time,error)
    if (error)  return
    ! X coordinate section
    obs%head%presec(class_sec_xcoo_id) = .true.
    obs%head%gen%xunit = a_angl
    ! The spectroscopic section is also filled but not activated. Only
    ! useful for the line name which is saved in the index (out of the
    ! unactive section).
    call mrtcal_chunkset_to_obs_spe(set,obs%head%spe,error)
    if (error)  return
    ! Switching
    if (set%chunks(1)%swi%swmod.ne.mod_unk) then
      obs%head%presec(class_sec_swi_id) = .true.
      obs%head%swi = set%chunks(1)%swi ! *** JP poor man's solution
    endif
  else
    ! Spectro
    obs%head%presec(class_sec_spe_id) = .true.
    call mrtcal_chunkset_to_obs_spe(set,obs%head%spe,error)
    if (error)  return
    !
    ! Switching
    if (set%chunks(1)%swi%swmod.ne.mod_unk) then
      obs%head%presec(class_sec_swi_id) = .true.
      obs%head%swi = set%chunks(1)%swi ! *** JP poor man's solution
    endif
  endif
  !
  ! Calibrate
  obs%head%presec(class_sec_cal_id) = .true.
  call mrtcal_chunkset_to_obs_cal(set,obs%head%cal,error)
  if (error)  return
  !
  ! Resolution (in agreement with obs%head%spe%restf)
  obs%head%presec(class_sec_res_id) = .true.
  obs%head%res = set%chunks(1)%res ! *** JP poor man's solution
  !
  ! User section
  if (rsetup%out%user) then
    version = 1
    obs%head%presec(class_sec_user_id) = .true.
    call class_user_exists(obs,iuser)
    if (iuser.eq.0) then
      call class_user_add(obs,version,set%chunks(1)%user,error)
      if (error)  return
    else
      call class_user_update(obs,version,set%chunks(1)%user,error)
      if (error) return
    endif
  endif
  !
end subroutine mrtcal_chunkset_to_obs_head
!
subroutine mrtcal_chunkset_to_obs_gen(set,gen,error)
  use gildas_def
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_chunkset_to_obs_gen
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  ! Define the general section suited for the stitched chunks
  !---------------------------------------------------------------------
  type(chunkset_t),      intent(in)    :: set
  type(class_general_t), intent(out)   :: gen
  logical,               intent(inout) :: error
  ! Local
  integer(kind=4) :: ichunk
  integer(kind=size_length) :: nchunk
  real(kind=4) :: r4(set%n)  ! Automatic array
  !
  ! Duplicate everything from the 1st chunk...
  gen = set%chunks(1)%gen
  !
  ! ZZZ If continuum, gen%xunit should be set to a_angle
  ! ZZZ Have to introduce a_angle code in gbl_format
  !
  ! ... except Tsys which varies from one chunk to another. Take
  ! the median of all chunks instead
  do ichunk=1,set%n
    r4(ichunk) = set%chunks(ichunk)%gen%tsys
  enddo
  nchunk = set%n
  call gr4_median(r4,nchunk,class_bad,0.,gen%tsys,error)
  if (error)  return
  !
  ! ... and Tau which may have blanks in several chunks.
  do ichunk=1,set%n
    r4(ichunk) = set%chunks(ichunk)%gen%tau
  enddo
  nchunk = set%n
  call gr4_median(r4,nchunk,class_bad,0.,gen%tau,error)
  if (error)  return
  !
end subroutine mrtcal_chunkset_to_obs_gen
!
subroutine mrtcal_chunkset_to_obs_spe(set,spe,error)
  use mrtcal_messaging
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_chunkset_to_obs_spe
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  ! Define the spectroscopic section suited for the stitched chunks
  !---------------------------------------------------------------------
  type(chunkset_t),      intent(in)    :: set
  type(class_spectro_t), intent(out)   :: spe
  logical,               intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CHUNKSET>TO>OBS>SPE'
  integer(kind=4) :: ichunk
  type(chunk_t), pointer :: chunk
  real(kind=8) :: fleft,fright,fmin,fmax,cmin,cmax,dnu
  character(len=message_length) :: mess
  !
  ! NB: beware if you are willing to change restf here the resolution
  !     section must also be changed!
  !
  ! Initialize everything e.g. line name
  spe = set%chunks(1)%spe
  !
  ! Ensure that the stitched spectrum will be increasing in frequency
  if (spe%fres.lt.0.d0) then
     spe%fres = -spe%fres
     spe%vres = -spe%vres
  endif
  !
  chunk => set%chunks(1)
  call abscissa_sigabs_left(chunk%spe,fleft)
  call abscissa_sigabs_right(chunk%spe,fright)
  fmin = min(fleft,fright)
  fmax = max(fleft,fright)
  do ichunk=2,set%n
    chunk => set%chunks(ichunk)
    call abscissa_sigabs_left(chunk%spe,fleft)
    call abscissa_sigabs_right(chunk%spe,fright)
    fmin = min(fmin,min(fleft,fright))
    fmax = max(fmax,max(fleft,fright))
  enddo
  call abscissa_sigabs2chan(spe,fmin,cmin)
  call abscissa_sigabs2chan(spe,fmax,cmax)
  !
  dnu = spe%fres/(1.d0+spe%doppler)
  spe%nchan = nint(abs((fmax-fmin)/dnu))
  spe%rchan = 0.5d0-cmin+spe%rchan
!print *,fmin,fmax,cmin,cmax,abs(cmax-cmin),spe%nchan,spe%rchan
  !
  ! User feedback
  ! write(mess,'(2x,a,a)') 'Stitched frequency/velocity definition for ',gen%teles
  ! call mrtcal_message(seve%d,rname,mess)
  write(mess,'(4x,a,i0)')   'Number of channels   ',spe%nchan
  call mrtcal_message(seve%d,rname,mess)
  write(mess,'(4x,a,f0.8)') 'Reference channel    ',spe%rchan
  call mrtcal_message(seve%d,rname,mess)
  write(mess,'(4x,a,f0.8)') 'Rest  frequency      ',spe%restf
  call mrtcal_message(seve%d,rname,mess)
  write(mess,'(4x,a,f0.8)') 'Image frequency      ',spe%image
  call mrtcal_message(seve%d,rname,mess)
  write(mess,'(4x,a,f0.8)') 'Velocity             ',spe%voff
  call mrtcal_message(seve%d,rname,mess)
  write(mess,'(4x,a,f0.8)') 'Frequency resolution ',spe%fres
  call mrtcal_message(seve%d,rname,mess)
  write(mess,'(4x,a,f0.8)') 'Velocity  resolution ',spe%vres
  call mrtcal_message(seve%d,rname,mess)
  !
end subroutine mrtcal_chunkset_to_obs_spe
!
subroutine mrtcal_chunkset_to_obs_con(set,con,time,error)
  use phys_const
  use mrtcal_messaging
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_chunkset_to_obs_con
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  ! Define the continuum drift section suited for the stitched chunks
  !---------------------------------------------------------------------
  type(chunkset_t),    intent(in)    :: set    !
  type(class_drift_t), intent(out)   :: con    !
  real(kind=4),        intent(out)   :: time   ! [s] Integration time
  logical,             intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='CHUNKSET>TO>OBS>CON'
  character(len=message_length) :: mess
  logical :: alongx,alongy
  !
  ! Initialize everything e.g. line name
  con = set%chunks(1)%con
  !
  if (set%n.gt.1) then
    call drift_sanity1(set,error)
    if (error)  return
    call drift_sanity2(set,error)
    if (error)  return
    !
    ! Number of points
    con%npoin = set%n
    ! Position angle
    con%apos = position_angle(set,1,set%n)  ! [rad]
    !
    call drift_sanity3(con%apos,error)
    if (error)  return
    !
    ! Angular and time resolution: indicative, as the drift is irregular and
    ! we also write an X coordinate array
    call drift_resolution(set,con%ares,con%tres,error)
    if (error)  return
    if (con%apos.gt.3.d0*pi/4.d0 .or. con%apos.lt.-pi/4.d0)  &
      con%ares = -con%ares
    ! Reference point: indicative from 1st chunk
    con%rpoin = 1.0
    ! Angular offset at reference point
    alongx = set%chunks(1)%offset(2).eq.set%chunks(set%n)%offset(2)
    alongy = set%chunks(1)%offset(1).eq.set%chunks(set%n)%offset(1)
    if (alongx) then
      con%aref = set%chunks(1)%offset(1)
    elseif (alongy) then
      con%aref = set%chunks(1)%offset(2)
    else
      ! ZZZ: rejected by drift_sanity3
    endif
    ! Time value at reference point: first chunk, consistently to con%aref.
    ! Note: this assumes this tref is relative to gen%dobs (no midnight issue).
    con%tref = set%chunks(1)%con%tref
  endif
  !
  ! Total integration time of the drift
  time = sum(set%chunks(1:set%n)%gen%time)
  !
  ! User feedback
  write(mess,'(4x,a,i0)')           'Number of points     ',con%npoin
  call mrtcal_message(seve%d,rname,mess)
  write(mess,'(4x,a,f0.8)')         'Reference point      ',con%rpoin
  call mrtcal_message(seve%d,rname,mess)
  write(mess,'(4x,a,f0.8)')         'Time at reference    ',con%tref
  call mrtcal_message(seve%d,rname,mess)
  write(mess,'(4x,a,f0.8)')         'Angle at reference   ',con%aref
  call mrtcal_message(seve%d,rname,mess)
  write(mess,'(4x,a,f0.8)')         'Time resolution      ',con%tres
  call mrtcal_message(seve%d,rname,mess)
  write(mess,'(4x,a,f0.8)')         'Angular resolution   ',con%ares
  call mrtcal_message(seve%d,rname,mess)
  write(mess,'(4x,a,f0.8,2x,f0.8)') 'Collimation errors   ',con%colla,con%colle
  call mrtcal_message(seve%d,rname,mess)
  !
contains
  !
  subroutine drift_sanity1(set,error)
    use mrtcal_messaging
    !-------------------------------------------------------------------
    ! Sanity check #1: is the drift straight? Obviously this should not
    ! happen, but we encountered cases where the on-track range was too
    ! including dumps where the antenna was not where it should. We also
    ! had drifts going back and forth at the beginning...
    !-------------------------------------------------------------------
    type(chunkset_t), intent(in)    :: set
    logical,          intent(inout) :: error
    !
    integer(kind=4) :: iset
    real(kind=4) :: refapos,apos
    real(kind=4), parameter :: tolapos=1.*rad_per_deg  ! [rad] 1 degree tolerance
    !
    refapos = position_angle(set,1,2)
    do iset=3,set%n
      apos = position_angle(set,iset-1,iset)
      if (abs(apos-refapos).gt.tolapos) then
        write(mess,'(a,i0,a,2(a,f0.2,a,f0.2,a))')  &
          'Subcan ',set%chunks(1)%gen%subscan,     &
          ': drift does not go straight from ',    &
          'its first point at (',set%chunks(1)%offset(1)*sec_per_rad,              &
          ',',                   set%chunks(1)%offset(2)*sec_per_rad,    ') to ',  &
          'its last point at (', set%chunks(set%n)%offset(1)*sec_per_rad,          &
          ',',                   set%chunks(set%n)%offset(2)*sec_per_rad,') [arcsec]'
        call mrtcal_message(seve%e,rname,mess)
        error = .true.
        return
      endif
    enddo
  end subroutine drift_sanity1
  !
  subroutine drift_sanity2(set,error)
    use mrtcal_messaging
    !-------------------------------------------------------------------
    ! Sanity check #2: does the drift go through (0,0)? If not, we could
    ! support this by adding the drift main offset to
    ! (pos%lamof,pos%betof), but this requires reprojecting this
    ! horizontalTrue offset to a radio offset. This might (or not)
    ! happen in subroutine mrtcal_chunksets_from_data_1time1pix_1chunk
    !-------------------------------------------------------------------
    type(chunkset_t), intent(in)    :: set
    logical,          intent(inout) :: error
    !
    logical :: found
    integer(kind=4) :: iset
    real(kind=4) :: x0,y0,x1,y1,x2,y2,slope
    real(kind=4), parameter :: postol=0.1*rad_per_sec  ! [rad] 1 seconde tolerance
    !
    ! Do not assume this is a full straight line, but a collection of
    ! segments instead
    found = .false.
    x0 = 0.
    y0 = 0.
    do iset=2,set%n
      x1 = set%chunks(iset-1)%offset(1)
      y1 = set%chunks(iset-1)%offset(2)
      x2 = set%chunks(iset)%offset(1)
      y2 = set%chunks(iset)%offset(2)
      ! print *,"(",x1*sec_per_rad,",",y1*sec_per_rad,") to (",x2*sec_per_rad,",",y2*sec_per_rad,")"
      ! Search if this segment crosses (0,0)
      if (abs(x1-x2).le.postol) then
        ! Nearly vertical line: x = slope*y+x0
        if (y1.lt.0. .and. y2.lt.0.)  cycle
        if (y1.gt.0. .and. y2.gt.0.)  cycle
        found = .true.
        slope = (x2-x1)/(y2-y1)
        x0 = x1-slope*y1
        y0 = 0.
      else
        ! Non-vertical line: y = slope*x+y0
        if (x1.lt.0. .and. x2.lt.0.)  cycle
        if (x1.gt.0. .and. x2.gt.0.)  cycle
        found = .true.
        slope = (y2-y1)/(x2-x1)
        x0 = 0.
        y0 = y1-slope*x1
      endif
    enddo
    !
    if (.not.found) then
      ! The varying coordinate do not even get close to 0
      write(mess,'(a,i0,a)')  &
        'Subcan ',set%chunks(1)%gen%subscan,     &
        ': drift does not go through (0,0) offset. Positions are:'
      call mrtcal_message(seve%e,rname,mess)
      do iset=1,set%n
        x1 = set%chunks(iset)%offset(1)
        y1 = set%chunks(iset)%offset(2)
        write(mess,'(i3,a,2(1pg15.7,a))') iset,"  (",x1*sec_per_rad,",",y1*sec_per_rad,") [arcsec]"
        call mrtcal_message(seve%e,rname,mess)
      enddo
      error = .true.
      return
    else
      if (abs(x0).gt.postol .or. abs(y0).gt.postol) then
        write(mess,'(a,i0,a,f0.2,a,f0.2,a)')  &
          'Subcan ',set%chunks(1)%gen%subscan,     &
          ': drift does not go through (0,0) offset but (',  &
          x0*sec_per_rad,',',y0*sec_per_rad,') [arcsec] instead (not implemented)'
        call mrtcal_message(seve%e,rname,mess)
        error = .true.
        return
      endif
    endif
  end subroutine drift_sanity2
  !
  subroutine drift_sanity3(apos,error)
    use mrtcal_messaging
    !-------------------------------------------------------------------
    ! Sanity check #3: is the drift along azimuth or elevation, or not?
    ! Check how MIRA supports rotated drifts. But in this case MIRA does
    ! not use the projected angles, which is non-sense because it uses
    ! them when along X or Y.
    !-------------------------------------------------------------------
    real(kind=4), intent(in)    :: apos
    logical,      intent(inout) :: error
    !
    real(kind=4) :: ang
    real(kind=4), parameter :: pis2=pis/2.
    real(kind=4), parameter :: pis4=pis/4.
    real(kind=4), parameter :: tolapos=1.*rad_per_deg  ! [rad] 1 degree tolerance
    !
    ! We support +- azimuth and +- elevation. Check if it is a pi/2 multiple
    ! (modulo pi/2 until angle is in range [-pi/4,+pi/4]).
    ang = apos
    do
      if (ang.lt.pis4)  exit
      ang = ang-pis2
    enddo
    do
      if (ang.gt.-pis4)  exit
      ang = ang+pis2
    enddo
    !
    if (abs(ang).gt.tolapos) then
      write(mess,'(a,i0,a,f0.2,a)')  &
        'Subcan ',set%chunks(1)%gen%subscan,     &
        ': drift is rotated with angle ',apos*deg_per_rad,' deg (not implemented)'
      call mrtcal_message(seve%e,rname,mess)
      error = .true.
      return
    endif
  end subroutine drift_sanity3
  !
  function position_angle(set,first,last)
    !-------------------------------------------------------------------
    ! Return the position angle on sky between 2 points of the drift.
    ! First/last order matters for proper (oriented) drift angle (i.e.
    ! angle +- pi).
    !-------------------------------------------------------------------
    real(kind=4) :: position_angle
    type(chunkset_t), intent(in) :: set
    integer(kind=4),  intent(in) :: first
    integer(kind=4),  intent(in) :: last
    !
    real(kind=4) :: dlam,dbet
    !
    dlam = set%chunks(last)%offset(1) - set%chunks(first)%offset(1)
    dbet = set%chunks(last)%offset(2) - set%chunks(first)%offset(2)
    position_angle = atan2(dbet,dlam)  ! [rad]
  end function position_angle
  !
  subroutine drift_resolution(set,ares,tres,error)
    !-------------------------------------------------------------------
    ! Return the median resolution on sky between the boundary points of
    ! the drift.
    !
    ! This resolution is indicative because the drift is irregular and
    ! we also write an X coordinate array, but it is used afterwards
    ! when resampling-averaging several drifts onto a common grid which
    ! reuses this resolution. In practive the drifts are almost regular
    ! so sticking to the best resolution is desirable to avoid the
    ! resampling to modify the data more than necessary.
    !
    ! We return the median and not the average because there are cases
    ! where the boundary positions are outliers (e.g. due to antenna
    ! slews at the beginning or end of the drift). See e.g.
    ! iram30m-nbc-20250124s44-imb.fits drift 30ME0HLI-N01
    !-------------------------------------------------------------------
    type(chunkset_t), intent(in)    :: set
    real(kind=4),     intent(out)   :: ares
    real(kind=4),     intent(out)   :: tres
    logical,          intent(inout) :: error
    !
    real(kind=4) :: dlam,dbet
    real(kind=4) :: areso(set%n)  ! Automatic array
    real(kind=4) :: treso(set%n)  ! Automatic array
    integer(kind=size_length) :: ichunk,nchunk
    !
    nchunk = set%n
    do ichunk=1,set%n-1
      dlam = set%chunks(ichunk+1)%offset(1) - set%chunks(ichunk)%offset(1)
      dbet = set%chunks(ichunk+1)%offset(2) - set%chunks(ichunk)%offset(2)
      areso(ichunk) = sqrt(dbet**2+dlam**2)  ! [rad]
      treso(ichunk) = (set%chunks(ichunk+1)%mjd-set%chunks(ichunk)%mjd)*twopi  ! [s]
    enddo
    call gr4_median(areso,nchunk,0.,-1.,ares,error)
    if (error)  return
    call gr4_median(treso,nchunk,0.,-1.,tres,error)
    if (error)  return
  end subroutine drift_resolution
  !
end subroutine mrtcal_chunkset_to_obs_con
!
subroutine mrtcal_chunkset_to_obs_cal(set,cal,error)
  use gildas_def
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_chunkset_to_obs_cal
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  ! Define the calibration section suited for the stitched chunks
  !---------------------------------------------------------------------
  type(chunkset_t),    intent(in)    :: set
  type(class_calib_t), intent(out)   :: cal
  logical,             intent(inout) :: error
  ! Local
  integer(kind=4) :: ichunk
  integer(kind=size_length) :: nchunk
  real(kind=4) :: r4(set%n)  ! Automatic array
  logical :: found
  !
  ! Duplicate everything from the first chunk where chopper did not
  ! fail.
  found = .false.
  do ichunk=1,set%n
    if (set%chunks(ichunk)%cal%h2omm.ne.class_bad) then
      found = .true.
      cal = set%chunks(ichunk)%cal
      exit
    endif
  enddo
  if (.not.found) then
    cal = set%chunks(1)%cal
    return
  endif
  !
  ! ... except for the parameters which vary and which are also displayed
  ! in the "calibration table". Must use the same strategy i.e. median of
  ! all valid chunks.
  !
  ! Trec
  do ichunk=1,set%n
    r4(ichunk) = set%chunks(ichunk)%cal%trec
  enddo
  nchunk = set%n
  call gr4_median(r4,nchunk,class_bad,0.,cal%trec,error)
  if (error)  return
  !
  ! atfac (Tcal)
  do ichunk=1,set%n
    r4(ichunk) = set%chunks(ichunk)%cal%atfac
    ! NB: if bad, set%chunks(ichunk)%cal%atfac is set to class_bad in
    ! mrtcal_calibrate_chopperset2loadheader
  enddo
  nchunk = set%n
  call gr4_median(r4,nchunk,class_bad,0.,cal%atfac,error)
  if (error)  return
  !
  ! h2omm
  do ichunk=1,set%n
    r4(ichunk) = set%chunks(ichunk)%cal%h2omm
  enddo
  nchunk = set%n
  call gr4_median(r4,nchunk,class_bad,0.,cal%h2omm,error)
  if (error)  return
  !
end subroutine mrtcal_chunkset_to_obs_cal
!
subroutine mrtcal_fit_to_obs_poi(fun,obs,error)
  use phys_const
  use mrtcal_messaging
  use fit_definitions
  use class_types
  use mrtcal_interfaces, except_this=>mrtcal_fit_to_obs_poi
  use mrtindex_sec_pointing
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(fit_fun),     intent(in)    :: fun
  type(observation), intent(inout) :: obs
  logical,           intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='SOLVE>POINTING>FIT2OBS'
  !
  if (fun%name.ne.'GAUSSIAN+BASE') then
    call mrtcal_message(seve%e,rname,'Fitted function not supported')
    error = .true.
    return
  endif
  !
  obs%head%presec(class_sec_poi_id) = .true.
  obs%head%poi%nfit(:) = 0.  ! Nullify for unused values
  obs%head%poi%nerr(:) = 0.
  !
  obs%head%poi%nline = 1
  obs%head%poi%sigba = fun%rms  ! Note that CLASS distinguishes RMS on baseline vs RMS on line
  obs%head%poi%sigra = fun%rms
  ! Note: the fit was done in arcsec, need to convert to radians
  ! Offset
  obs%head%poi%nfit(pointing_fit_offset) = fun%par(4)%value              ! [K]
  obs%head%poi%nerr(pointing_fit_offset) = fun%par(4)%error
  ! Slope
  obs%head%poi%nfit(pointing_fit_slope) = fun%par(5)%value/rad_per_sec  ! [K/rad]
  obs%head%poi%nerr(pointing_fit_slope) = fun%par(5)%error/rad_per_sec
  ! Area
  obs%head%poi%nfit(pointing_fit_area1) = fun%par(1)%value*rad_per_sec  ! [K.rad]
  obs%head%poi%nerr(pointing_fit_area1) = fun%par(1)%error*rad_per_sec
  ! Position
  obs%head%poi%nfit(pointing_fit_posi1) = fun%par(2)%value*rad_per_sec  ! [rad]
  obs%head%poi%nerr(pointing_fit_posi1) = fun%par(2)%error*rad_per_sec
  ! Width
  obs%head%poi%nfit(pointing_fit_fwhm1) = fun%par(3)%value*rad_per_sec  ! [rad]
  obs%head%poi%nerr(pointing_fit_fwhm1) = fun%par(3)%error*rad_per_sec
  !
end subroutine mrtcal_fit_to_obs_poi
!
subroutine mrtcal_chunkset_to_obs_data(set,head,datax,data1,dataw,error)
  use mrtcal_messaging
  use class_types
  use mrtcal_calib_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_chunkset_to_obs_data
  !---------------------------------------------------------------------
  ! @ private
  ! Merge the chunks in the chunkset to produce the CLASS observation
  ! data.
  !---------------------------------------------------------------------
  type(chunkset_t), intent(in)    :: set
  type(header),     intent(in)    :: head
  real(kind=8),     intent(out)   :: datax(:)
  real(kind=4),     intent(out)   :: data1(:)
  real(kind=4),     intent(out)   :: dataw(:)
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CHUNKSET>TO>OBS>DATA'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (head%gen%kind.eq.kind_spec) then
    call mrtcal_chunkset_to_obs_data_spe(set,head,data1,dataw,error)
    if (error)  return
  else
    call mrtcal_chunkset_to_obs_data_con(set,datax,data1,dataw,error)
    if (error)  return
  endif
end subroutine mrtcal_chunkset_to_obs_data
!
subroutine mrtcal_chunkset_to_obs_data_con(set,datax,data1,dataw,error)
  use mrtcal_messaging
  use class_types
  use mrtcal_calib_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_chunkset_to_obs_data_con
  !---------------------------------------------------------------------
  ! @ private
  ! Continuum case
  ! Merge the single-point continuum chunks into a N-points drift
  !---------------------------------------------------------------------
  type(chunkset_t), intent(in)    :: set
  real(kind=8),     intent(out)   :: datax(:)
  real(kind=4),     intent(out)   :: data1(:)
  real(kind=4),     intent(out)   :: dataw(:)
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CHUNKSET>TO>OBS>DATA>CON'
  type(chunk_t), pointer :: chunk
  integer(kind=4) :: ichunk,ipoin
  logical :: alongx,alongy
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  alongx = set%chunks(1)%offset(2).eq.set%chunks(set%n)%offset(2)
  alongy = set%chunks(1)%offset(1).eq.set%chunks(set%n)%offset(1)
  if ((.not.alongx) .and. (.not.alongy)) then
    call mrtcal_message(seve%e,rname,'Rotated drifts are not yet supported')
    error = .true.
    return
  endif
  !
  datax(:) = 0.d0
  data1(:) = 0.0
  dataw(:) = 0.0
  !
  do ichunk=1,set%n
    chunk => set%chunks(ichunk)
    if (chunk%ndata.ne.1) then
      call mrtcal_message(seve%e,rname,'Unexpected chunk size')
      error = .true.
      return
    endif
    !
    ! ZZZ Assume no sorting is needed
    if (alongx) then
      datax(ichunk) = chunk%offset(1)
    elseif (alongy) then
      datax(ichunk) = chunk%offset(2)
    else
      ! ZZZ MIRA for not obvious formula
    endif
    data1(ichunk) = chunk%data1(1)
    dataw(ichunk) = 1.0
  enddo ! ichunk
  ! Normalize
  do ipoin=1,set%n
     if ((dataw(ipoin).ne.0.0).and.(data1(ipoin).ne.bad)) then
        data1(ipoin) = data1(ipoin)/dataw(ipoin)
     else
        data1(ipoin) = bad
     endif
  enddo ! ipoin
  !
end subroutine mrtcal_chunkset_to_obs_data_con
!
subroutine mrtcal_chunkset_to_obs_data_spe(set,head,data1,dataw,error)
  use mrtcal_messaging
  use class_types
  use mrtcal_calib_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_chunkset_to_obs_data_spe
  !---------------------------------------------------------------------
  ! @ private
  ! Simple stitching. No resampling is foreseen.
  ! However, we check that the frequency axes are aligned.
  ! A simple average is performed for channels which are present in more
  ! than one chunk (use the SET BAD OR policy of CLASS).
  !---------------------------------------------------------------------
  type(chunkset_t), intent(in)    :: set
  type(header),     intent(in)    :: head
  real(kind=4),     intent(out)   :: data1(:)
  real(kind=4),     intent(out)   :: dataw(:)
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CHUNKSET>TO>OBS>DATA>SPE'
  type(chunk_t), pointer :: chunk
  real(kind=4) :: cleft,cright
  integer(kind=4) :: ichunk,cmin,cmax,ichan,jchan
  character(len=message_length) :: mess
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  data1(:) = 0.0
  dataw(:) = 0.0
  !
  do ichunk=1,set%n
     chunk => set%chunks(ichunk)
     !
     cleft = head%spe%rchan +  &
          (1.d0-chunk%spe%rchan) * (chunk%spe%fres/head%spe%fres)
     cright = head%spe%rchan + &
          (chunk%spe%nchan-chunk%spe%rchan) * (chunk%spe%fres/head%spe%fres)
     !
     cmin = nint(cleft)
     if (abs(cleft-cmin).gt.spacing(cleft)) then  ! Single precision comparison
        ! Tolerate 1 epsilon, but there is no warranty we do not cumulate
        ! several epsilons in the cleft/cright computations above.
        write(mess,'(a,i0,a,i0,a,f0.10)') &
             'Left edge of chunk #',ichunk,' is not aligned on the stitched frequency axis: ',&
             cmin,' vs ',cleft
        call mrtcal_message(seve%w,rname,mess)
     endif
     !
     cmax = nint(cright)
     if (abs(cright-cmax).gt.spacing(cright)) then  ! Single precision comparison
        ! Tolerate 1 epsilon, but there is no warranty we do not cumulate
        ! several epsilons in the cleft/cright computations above.
        write(mess,'(a,i0,a,i0,a,f0.10)') &
             'Right edge of chunk #',ichunk,' is not aligned on the stitched frequency axis: ',&
             cmax,' vs ',cright
        call mrtcal_message(seve%w,rname,mess)
     endif
     !
     cmin = min(nint(cleft),nint(cright))
     cmax = max(nint(cleft),nint(cright))
     if ((cmin.lt.1).or.(head%spe%nchan.lt.cmin)) then
        write(mess,'(a,i0,a,i0,a,i0,a)') &
             'Left edge of chunk #',ichunk,' (',cmin,&
             ') is outside of authorized range (1-',&
             head%spe%nchan,')'
        call mrtcal_message(seve%e,rname,mess)
        error = .true.
        return
     endif
     if ((cmax.lt.1).or.(head%spe%nchan.lt.cmax)) then
        write(mess,'(a,i0,a,i0,a,i0,a)') &
             'Right edge of chunk #',ichunk,' (',cmax,&
             ') is outside of authorized range (1,',&
             head%spe%nchan,')'
        call mrtcal_message(seve%e,rname,mess)
        error = .true.
        return
     endif
     !
     if ((cmax-cmin+1).eq.chunk%ndata) then
        if (chunk%spe%fres.gt.0.d0) then !  ZZZ Use sign() intrinsic for comparison
           do ichan=1,chunk%ndata
              jchan=cmin+(ichan-1)
              if (chunk%data1(ichan).ne.bad) then
                 data1(jchan) = data1(jchan)+chunk%data1(ichan)
                 dataw(jchan) = dataw(jchan)+1.0
              endif
           enddo ! ichan
        else
           do ichan=1,chunk%ndata
              jchan=cmax-(ichan-1)
              if (chunk%data1(ichan).ne.bad) then
                 data1(jchan) = data1(jchan)+chunk%data1(ichan)
                 dataw(jchan) = dataw(jchan)+1.0
              endif
           enddo ! ichan
        endif
     else
        call mrtcal_message(seve%w,rname,'Incorrect number of channels')
        error = .true.
        return
     endif
  enddo ! ichunk
  ! Normalize
  do ichan=1,head%spe%nchan
     if ((dataw(ichan).ne.0.0).and.(data1(ichan).ne.bad)) then
        data1(ichan) = data1(ichan)/dataw(ichan)
     else
        data1(ichan) = bad
     endif
  enddo ! ichan
  !
end subroutine mrtcal_chunkset_to_obs_data_spe
!
subroutine mrtcal_obs_to_class(obs,error)
  use class_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_obs_to_class
  use mrtcal_buffers
  !---------------------------------------------------------------------
  ! @ private
  !  Write the observation to the current Class file
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs
  logical,           intent(inout) :: error
  !
  if (rsetup%out%vdirection) then
    ! Recompute the Doppler factor at actual position. Depending on
    ! the observing mode (in particular OTF), the Doppler factor
    ! found in the IMB-FITS was computed at the reference position
    ! (not the actual position)
    ! NB: this must come after header (in particular head%gen, head%pos,
    ! and head%spe) and all data are written to the observation ("all
    ! data" means all arrays, including Associated Arrays)
    call class_modify_vdirection(obs%head,error)
    if (error)  return
  endif
  !
  call class_obs_write(obs,error)
  if (error)  return
  !
end subroutine mrtcal_obs_to_class
!
function mrtcal_user_function(action)
  use mrtcal_interfaces, except_this=>mrtcal_user_function
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  logical :: mrtcal_user_function
  character(len=*), intent(in) :: action
  mrtcal_user_function = .false.
end function mrtcal_user_function
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine mrtcal_toclass_user(mydata,version,error)
  use mrtcal_messaging
  use class_api
  use mrtcal_interfaces, except_this=>mrtcal_toclass_user
  use mrtcal_chunk_types
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Transfer and order the input 'mydata' object to the internal Class
  ! data buffer.
  !---------------------------------------------------------------------
  type(mrtcal_classuser_t), intent(in)    :: mydata   !
  integer(kind=4),          intent(in)    :: version  ! The version of the data
  logical,                  intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='TOCLASS>USER'
  character(len=message_length) :: mess
  !
  if (version.ne.1) then
    write(mess,'(A,I0)')  'Unsupported data version ',version
    call mrtcal_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  call class_user_datatoclass(mydata%obstype)
  call class_user_datatoclass(mydata%noise)
  call class_user_datatoclass(mydata%backeff)
  call class_user_datatoclass(mydata%airmass)
  call class_user_datatoclass(mydata%expatau)
  !
end subroutine mrtcal_toclass_user
!
subroutine mrtcal_fromclass_user(mydata,version,error)
  use mrtcal_messaging
  use class_api
  use mrtcal_interfaces, except_this=>mrtcal_fromclass_user
  use mrtcal_chunk_types
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  ! Transfer the data values from the Class data buffer to the 'mydata'
  ! instance.
  !---------------------------------------------------------------------
  type(mrtcal_classuser_t), intent(out)   :: mydata   !
  integer(kind=4),          intent(in)    :: version  ! The version of the data
  logical,                  intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='FROMCLASS>USER'
  character(len=message_length) :: mess
  !
  if (version.ne.1) then
    write(mess,'(A,I0)')  'Unsupported data version ',version
    call mrtcal_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  call class_user_classtodata(mydata%obstype)
  call class_user_classtodata(mydata%noise)
  call class_user_classtodata(mydata%backeff)
  call class_user_classtodata(mydata%airmass)
  call class_user_classtodata(mydata%expatau)
  !
end subroutine mrtcal_fromclass_user
!
subroutine mrtcal_user_dump(version,error)
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_user_dump
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Dump to screen the Mrtcal User Subsection
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: version ! The version of the data
  logical,         intent(inout) :: error    ! Logical error flag
  ! Local
  type(mrtcal_classuser_t) :: mydata
  !
  call mrtcal_fromclass_user(mydata,version,error) ! Read the Class buffer and fill mydata
  if (error) return
  !
  ! Display to screen
  print *,"     obstype = ",mydata%obstype,' (',mrtindex_obstype(mydata%obstype),')'
  print *,"     noise   = ",mydata%noise
  print *,"     backeff = ",mydata%backeff
  print *,"     airmass = ",mydata%airmass
  print *,"     expatau = ",mydata%expatau
  !
end subroutine mrtcal_user_dump
!
subroutine mrtcal_user_setvar(version,error)
  use class_api
  use mrtcal_interfaces, except_this=>mrtcal_user_setvar
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Define SIC variables in the structure R%USER%OWNER% which map the
  ! subsection content.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: version ! The version of the data
  logical,         intent(inout) :: error    ! Logical error flag
  ! Local
  integer(kind=4) :: ndim,dims(4)
  !
  ndim = 0
  dims(:) = 0
  call class_user_def_inte('OBSTYPE',ndim,dims,error)
  call class_user_def_real('NOISE',  ndim,dims,error)
  call class_user_def_real('BACKEFF',ndim,dims,error)
  call class_user_def_real('AIRMASS',ndim,dims,error)
  call class_user_def_real('EXPATAU',ndim,dims,error)
  if (error) return
  !
end subroutine mrtcal_user_setvar
!
subroutine mrtcal_user_fix(version,found,error)
  use mrtcal_interfaces, except_this=>mrtcal_user_fix
  use mrtcal_index_vars
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Hook to command:
  !   LAS\FIND /USER
  !  Find or not according the Mrtcal User Subsection. Called only if
  ! the observation has a user section and it matches the one
  ! declared here.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: version  ! The version of the data
  logical,         intent(out)   :: found    !
  logical,         intent(inout) :: error    ! Logical error flag
  ! Local
  type(mrtcal_classuser_t) :: mydata
  !
  call mrtcal_fromclass_user(mydata,version,error) ! Read the Class buffer and fill mydata
  if (error) return
  !
  found = userfind%ltypes(mydata%obstype)
  !
end subroutine mrtcal_user_fix
!
subroutine mrtcal_user_find(arg,narg,error)
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>mrtcal_user_find
  use mrtcal_index_vars
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Hook to command:
  !   LAS\FIND /USER [Arg1] ... [ArgN]
  ! Command line parsing: retrieve the arguments given to the option.
  !---------------------------------------------------------------------
  integer(kind=4),  intent(in)    :: narg       !
  character(len=*), intent(in)    :: arg(narg)  !
  logical,          intent(inout) :: error      ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='FIND>USER'
  integer(kind=4) :: iarg,ikey
  character(len=32) :: key
  character(len=obstype_length) :: obstype
  character(len=obstype_length) :: obstypes(nobstypes_mrtcal+1)
  !
  ! ZZZ This stupid code duplicates the obstypes from lib-mrtindex!
  do ikey=0,nobstypes_mrtcal
    obstypes(ikey+1) = mrtindex_obstype(ikey)
  enddo
  !
  userfind%ltypes(:) = .false.
  do iarg=1,narg
    obstype = arg(iarg)
    call sic_upper(obstype)
    call sic_ambigs(rname,obstype,key,ikey,obstypes,nobstypes_mrtcal+1,error)
    if (error)  return
    !
    userfind%ltypes(ikey-1) = .true.
  enddo
  !
end subroutine mrtcal_user_find
!
subroutine mrtcal_user_varidx_fill(version,ient,error)
  use classic_api
  use mrtcal_interfaces, except_this=>mrtcal_user_varidx_fill
  use mrtcal_calib_types
  use mrtcal_sicidx
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Hook to command:
  !   EXP\VARIABLE USER /INDEX  (array filling part)
  ! Fill the arrays supporting the structure IDX%USER%
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)    :: version  ! The version of the data
  integer(kind=entry_length), intent(in)    :: ient     !
  logical,                    intent(inout) :: error    ! Logical error flag
  ! Local
  type(mrtcal_classuser_t) :: mydata
  !
  call mrtcal_fromclass_user(mydata,version,error) ! Read the Class buffer and fill mydata
  if (error) return
  !
  idxuser%obstype(ient) = mydata%obstype
  idxuser%noise(ient)   = mydata%noise
  idxuser%backeff(ient) = mydata%backeff
  idxuser%airmass(ient) = mydata%airmass
  idxuser%expatau(ient) = mydata%expatau
  !
end subroutine mrtcal_user_varidx_fill
!
subroutine mrtcal_user_varidx_defvar(error)
  use classic_api
  use mrtcal_dependencies_interfaces
  use mrtcal_sicidx
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Hook to command:
  !   EXP\VARIABLE USER /INDEX  (variables definition)
  ! Define the Sic arrays in IDX%USER%30M%MRTCAL%
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  ! Logical error flag
  !
  call class_user_varidx_def_inte('OBSTYPE',idxuser%obstype,error)
  if (error)  return
  call class_user_varidx_def_real('NOISE',  idxuser%noise,  error)
  if (error)  return
  call class_user_varidx_def_real('BACKEFF',idxuser%backeff,error)
  if (error)  return
  call class_user_varidx_def_real('AIRMASS',idxuser%airmass,error)
  if (error)  return
  call class_user_varidx_def_real('EXPATAU',idxuser%expatau,error)
  if (error)  return
  !
end subroutine mrtcal_user_varidx_defvar
!
subroutine mrtcal_user_varidx_realloc(nent,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  use mrtcal_interfaces, except_this=>mrtcal_user_varidx_realloc
  use mrtcal_sicidx
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Hook to command:
  !   EXP\VARIABLE USER /INDEX  (re/deallocation part)
  ! Re/Deallocate the support arrays. nent <= 0 means deallocation only
  ! (useful at exit time)
  !---------------------------------------------------------------------
  integer(kind=entry_length), intent(in)    :: nent     !
  logical,                    intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='REALLOCATE'
  logical :: realloc
  integer(kind=4) :: ier
  !
  if (allocated(idxuser%obstype)) then
    realloc = size(idxuser%obstype).lt.nent
    if (nent.le.0 .or. realloc) then
      deallocate(idxuser%obstype,idxuser%noise,idxuser%backeff)
      deallocate(idxuser%airmass,idxuser%expatau)
    endif
  else
    realloc = nent.gt.0
  endif
  !
  if (realloc .and. nent.gt.0) then
    allocate(idxuser%obstype(nent),idxuser%noise(nent),  stat=ier)
    allocate(idxuser%backeff(nent),idxuser%airmass(nent),stat=ier)
    allocate(idxuser%expatau(nent),                      stat=ier)
    if (failed_allocate(rname,'IDXUSER arrays',ier,error))  return
  endif
  !
end subroutine mrtcal_user_varidx_realloc
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
