!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
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 gbl_message
  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 gbl_message
  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 gbl_message
  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 gbl_message
  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 gbl_message
  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,classobs%head%spe%nchan,error)
  if (error)  return
  call mrtcal_chunkset_to_obs_data(set2,classobs%head,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 gbl_message
  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%head%spe%nchan,error)
  if (error)  return
  call mrtcal_chunkset_to_obs_data(set,obs%head,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 gbl_message
  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%head%spe%nchan,error)
  if (error)  return
  !
  call mrtcal_chunkset_to_obs_data(set,obs%head,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 gbl_message
  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
  !
  ! 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
  !
  ! 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
  !
  ! ... 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 gbl_message
  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_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_chunkset_to_obs_data(set,head,data1,dataw,error)
  use gbl_message
  use class_types
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this=>mrtcal_chunkset_to_obs_data
  !---------------------------------------------------------------------
  ! @ 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'
  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%spe%nchan) then
        if (chunk%spe%fres.gt.0.d0) then !  ZZZ Use sign() intrinsic for comparison
           do ichan=1,chunk%spe%nchan
              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%spe%nchan
              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
!
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 gbl_message
  use class_api
  use mrtcal_interfaces, except_this=>mrtcal_toclass_user
  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 gbl_message
  use class_api
  use mrtcal_interfaces, except_this=>mrtcal_fromclass_user
  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
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
