!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! (re)allocation routines
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine reallocate_chunk(ndata,chunk,error)
  use gbl_message
  use gkernel_interfaces
  use mrtcal_interfaces, except_this=>reallocate_chunk
  use mrtcal_calib_types
  !-------------------------------------------------------------------
  ! @ private
  ! (Re)allocate a chunk so that it can describe n channels.
  !-------------------------------------------------------------------
  integer(kind=4),  intent(in)    :: ndata
  type(chunk_t),    intent(inout) :: chunk
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='REALLOCATE>CHUNK'
  logical :: alloc
  character(len=message_length) :: mess
  integer(kind=4) :: ier
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (ndata.le.0) then
    write(mess,'(A,I0,A)')  'Array size can not be zero nor negative (got ',ndata,')'
    call mrtcal_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  alloc = .true.
  if (chunk%allocated.eq.code_pointer_associated) then
    call mrtcal_message(seve%e,rname,  &
      'Internal error: attempt to allocate an associated pointer')
    error = .true.
    return
  elseif (chunk%allocated.eq.code_pointer_allocated) then
     if (.not.associated(chunk%data1)) then
       ! How come!?!? chunk has code 'allocated' but its pointer is not
       ! associated? Something wrong, need fix.
       call mrtcal_message(seve%e,rname,  &
         'Internal error: CHUNK is expected to be associated but is not')
       error = .true.
       return
     endif
     if (chunk%ndata.eq.ndata) then
        write(mess,'(a,i0)')  &
          'CHUNK arrays already associated at the right size: ',ndata
        call mrtcal_message(seve%d,rname,mess)
        alloc = .false.
     else
        call mrtcal_message(seve%d,rname,  &
          'CHUNKSET arrays already associated but with a different size => Freeing it first')
        call free_chunk(chunk,error)
        if (error)  return
     endif
  endif
  !
  if (alloc) then
     allocate(chunk%data1(ndata),chunk%dataw(ndata),stat=ier)
     if (failed_allocate(rname,'CHUNK',ier,error)) then
        call free_chunk(chunk,error)
        return
     endif
     chunk%allocated = code_pointer_allocated
     write(mess,'(a,i0)') 'Allocated CHUNK arrays of size: ',ndata
     call mrtcal_message(seve%d,rname,mess)
  endif
  !
  ! Allocation success => Initialize
  chunk%ndata = ndata
  !
end subroutine reallocate_chunk
!
subroutine reallocate_chunkset(n,chunkset,error)
  use gbl_message
  use gkernel_interfaces
  use mrtcal_interfaces, except_this=>reallocate_chunkset
  use mrtcal_calib_types
  !-------------------------------------------------------------------
  ! @ private
  ! (Re)allocate a chunkset so that it can store n chunks.
  !
  ! Nothing is done for the chunks in the chunkset. The caller is free
  ! to allocate them or associate them depending on its need.
  !-------------------------------------------------------------------
  integer(kind=4),  intent(in)    :: n
  type(chunkset_t), intent(inout) :: chunkset
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='REALLOCATE>CHUNKSET'
  logical :: alloc
  character(len=message_length) :: mess
  integer(kind=4) :: ier
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (n.le.0) then
    write(mess,'(A,I0,A)')  'Array size can not be zero nor negative (got ',n,')'
    call mrtcal_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  alloc = .true.
  if (chunkset%allocated.eq.code_pointer_associated) then
    call mrtcal_message(seve%e,rname,  &
      'Internal error: attempt to allocate an associated pointer')
    error = .true.
    return
  elseif (chunkset%allocated.eq.code_pointer_allocated) then
     if (.not.associated(chunkset%chunks)) then
       ! How come!?!? chunkset has code 'allocated' but its pointer is not
       ! associated? Something wrong, need fix.
       call mrtcal_message(seve%e,rname,  &
         'Internal error: CHUNKSET is expected to be associated but is not')
       error = .true.
       return
     endif
     if (chunkset%n.eq.n) then
        write(mess,'(a,i0)')  &
          'CHUNKSET already associated at the right size: ',n
        call mrtcal_message(seve%d,rname,mess)
        alloc = .false.
     else
        call mrtcal_message(seve%d,rname,  &
          'CHUNKSET pointer already associated but with a different size => Freeing it first')
        call free_chunkset(chunkset,error)
        if (error)  return
     endif
  endif
  !
  if (alloc) then
     allocate(chunkset%chunks(n),stat=ier)
     if (failed_allocate(rname,'CHUNKSET',ier,error)) then
        call free_chunkset(chunkset,error)
        return
     endif
     chunkset%allocated = code_pointer_allocated
     write(mess,'(a,i0)') 'Allocated CHUNKSET of size: ',n
     call mrtcal_message(seve%d,rname,mess)
  endif
  !
  ! Allocation success => Initialize
  chunkset%n = n
  !
end subroutine reallocate_chunkset
!
subroutine reallocate_chunkset_2d(nset,npix,ou2d,error)
  use gbl_message
  use gkernel_interfaces
  use mrtcal_interfaces, except_this=>reallocate_chunkset_2d
  use mrtcal_calib_types
  !-------------------------------------------------------------------
  ! @ private
  ! (re)allocate a 2D array of chunksets of same dimension as another
  ! 2D array of chunksets
  !
  ! Nothing is done for the chunksets and for the chunks in the
  ! chunksets. The caller is free to allocate them or associate them
  ! depending on its need.
  !-------------------------------------------------------------------
  integer(kind=4),     intent(in)    :: nset
  integer(kind=4),     intent(in)    :: npix
  type(chunkset_2d_t), intent(inout) :: ou2d
  logical,             intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='REALLOCATE>CHUNKSET>2D'
  logical :: alloc
  integer(kind=4) :: ier
  character(len=message_length) :: mess
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  ! Sanity check
  if (nset.lt.0) then
     write(mess,'(a,i0)') 'Chunkset nset is lower than 0: ',nset
     call mrtcal_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  if (npix.lt.0) then
     write(mess,'(a,i0)') 'Chunkset npix is lower than 0: ',npix
     call mrtcal_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  !
  ! First the ou2d array
  alloc = nset.gt.0 .and. npix.gt.0
  if (ou2d%allocated.eq.code_pointer_associated) then
    ! Implicit nullification of previous association
    call nullify_chunkset_2d(ou2d,error)
    if (error)  return
  elseif (ou2d%nset.eq.nset .and. ou2d%npix.eq.npix) then
     write(mess,'(a,i0,a,i0)')  &
          'CHUNKSET 2D array already associated at an appropriate size: ',nset,' x ',npix
     call mrtcal_message(seve%d,rname,mess)
     alloc = .false.
  elseif (ou2d%nset.ne.0 .and. ou2d%npix.ne.0) then
     write(mess,'(a)')  &
          'CHUNKSET 2D array already associated but with a different size => Freeing it first'
     call mrtcal_message(seve%d,rname,mess)
     call free_chunkset_2d(ou2d,error)
     if (error)  return
  else
     call mrtcal_message(seve%d,rname,'CHUNKSET 2D first allocation')
  endif
  if (alloc) then
     allocate(ou2d%chunkset(nset,npix),stat=ier)
     if (failed_allocate(rname,'CHUNKSET 2D ARRAY',ier,error)) then
        call free_chunkset_2d(ou2d,error)
        return
     endif
     ou2d%allocated = code_pointer_allocated
     write(mess,'(a,i0,a,i0)')  &
          'Allocated chunkset array of size: ',nset,' x ',npix
     call mrtcal_message(seve%d,rname,mess)
  endif
  ou2d%nset = nset
  ou2d%npix = npix
  !
end subroutine reallocate_chunkset_2d
!
subroutine reallocate_chunkset_3d(nset,npix,ntime,ck3d,error)
  use gbl_message
  use gkernel_interfaces
  use mrtcal_interfaces, except_this=>reallocate_chunkset_3d
  use mrtcal_calib_types
  !-------------------------------------------------------------------
  ! @ private
  ! (re)allocate a 3D array of chunksets.
  !
  ! Nothing is done for the chunksets and for the chunks in the
  ! chunksets. The caller is free to allocate them or associate them
  ! depending on its need.
  !-------------------------------------------------------------------
  integer(kind=4),     intent(in)    :: nset
  integer(kind=4),     intent(in)    :: npix
  integer(kind=4),     intent(in)    :: ntime
  type(chunkset_3d_t), intent(inout) :: ck3d
  logical,             intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='REALLOCATE>CHUNKSET>3D'
  logical :: alloc
  character(len=message_length) :: mess
  integer(kind=4) :: ier
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (nset.lt.0 .or. npix.lt.0 .or. ntime.lt.0) then
    write(mess,'(A,3(I0,A))')  &
      'Array size can not be negative (got ',nset,'x',npix,'x',ntime,')'
    call mrtcal_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  alloc = nset.gt.0 .and. npix.gt.0 .and. ntime.gt.0
  if (associated(ck3d%chunkset)) then
     if (ubound(ck3d%chunkset,1).eq.nset .and.  &  ! Strict equality
         ubound(ck3d%chunkset,2).eq.npix .and.  &  ! Strict equality
         ubound(ck3d%chunkset,3).ge.ntime) then    ! Greater or equal
        write(mess,'(a,i0,a,i0,a,i0)')  &
          'CHUNKSET array already associated at an appropriate size: ',nset,' x ',npix,' x ',ntime
        call mrtcal_message(seve%d,rname,mess)
        alloc = .false.
     else
        write(mess,'(a)')  &
          'CHUNKSET array already associated but with a different size => Freeing it first'
        call mrtcal_message(seve%d,rname,mess)
        call free_chunkset_3d(ck3d,error)
        if (error)  return
     endif
  endif
  !
  if (alloc) then
    allocate(ck3d%chunkset(nset,npix,ntime),stat=ier)
    if (failed_allocate(rname,'CHUNKSET ARRAY',ier,error)) then
      call free_chunkset_3d(ck3d,error)
      return
    endif
    write(mess,'(a,i0,a,i0,a,i0)')  &
      'Allocated chunkset array of size: ',nset,' x ',npix,' x ',ntime
    call mrtcal_message(seve%d,rname,mess)
  endif
  !
  ck3d%nset  = nset
  ck3d%npix  = npix
  ck3d%ntime = ntime
  !
end subroutine reallocate_chunkset_3d
!
subroutine reallocate_chopperset(chunkset_2d,chopperset,error)
  use gbl_message
  use gkernel_interfaces
  use chopper_definitions
  use mrtcal_interfaces, except_this=>reallocate_chopperset
  use mrtcal_calib_types
  !-------------------------------------------------------------------
  ! @ private
  ! (re)allocate chopperset with a size deduced from chunkset
  !-------------------------------------------------------------------
  type(chunkset_2d_t), intent(in)    :: chunkset_2d
  type(chopper_t),     pointer       :: chopperset(:,:) ! inout
  logical,             intent(inout) :: error
  ! Local
  logical :: alloc
  integer(kind=4) :: ier
  integer(kind=4) :: iset,nset
  integer(kind=4) :: ipix,npix
  character(len=message_length) :: mess
  character(len=*), parameter :: rname='REALLOCATE>CHOPPERSET'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  ! Sanity checks
  nset = chunkset_2d%nset
  npix = chunkset_2d%npix
  if (nset.lt.0) then
    ! NB: zero-sized arrays are legal Fortran
     write(mess,'(a,i0)') 'NSET size is lower than 0: ',nset
     call mrtcal_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  if (npix.lt.0) then
    ! NB: zero-sized arrays are legal Fortran
     write(mess,'(a,i0)') 'NPIX size is lower than 0: ',npix
     call mrtcal_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  ! First the chopperset array
  alloc = .true.
  if (associated(chopperset)) then
     if (ubound(chopperset,1).eq.nset .and. &
         ubound(chopperset,2).eq.npix) then
        write(mess,'(a,i0,a,i0)') 'CHOPPERSET already associated with the appropriate size: ',nset,' x ',npix
        call mrtcal_message(seve%d,rname,mess)
        alloc = .false.
     else
        write(mess,'(a)')  &
          'CHOPPERSET already associated but with a different size => Freeing it first'
        call mrtcal_message(seve%d,rname,mess)
        call free_chopperset(chopperset,error)
        if (error)  return
     endif
  endif
  if (alloc) then
    allocate(chopperset(nset,npix),stat=ier)
    if (failed_allocate(rname,'CHOPPERSET',ier,error)) then
      call free_chopperset(chopperset,error)
      return
   endif
    write(mess,'(a,i0,a,i0)') 'Allocated CHOPPERSET of size: ',nset,' x ',npix
    call mrtcal_message(seve%d,rname,mess)
  endif
  ! Second the arrays inside each chopperset member
  do ipix=1,npix
     do iset=1,nset
        call telcal_reallocate_chopper(chunkset_2d%chunkset(iset,ipix)%n,chopperset(iset,ipix),error)
        if (error) return
     enddo ! iset
  enddo ! ipix
  !
end subroutine reallocate_chopperset
!
subroutine reallocate_calib_scan(n,calarray,error)
  use gbl_message
  use mrtcal_calib_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>reallocate_calib_scan
  !-------------------------------------------------------------------
  ! @ private
  ! (re)allocate calibration arrays
  !-------------------------------------------------------------------
  integer(kind=4),    intent(in)    :: n
  type(calib_scan_t), intent(inout) :: calarray
  logical,            intent(inout) :: error
  ! Local
  logical :: alloc
  integer(kind=4) :: ier,iarray
  character(len=message_length) :: mess
  character(len=*), parameter :: rname='REALLOCATE>CALIB>SCAN'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (n.lt.0) then
     write(mess,'(a,i0,a)') 'Array size can not negative (got ',n,')'
     call mrtcal_message(seve%e,rname,mess)
     error = .true.
     return
  else if (n.eq.0) then
     write(mess,'(a)') 'Array size is zero'
     call mrtcal_message(seve%d,rname,mess)
     call free_calib_scan(calarray,error)
     if (error)  return
  else
     alloc = .true.
     if (associated(calarray%val)) then
        if (calarray%n.eq.n) then
           write(mess,'(a,i0)')  &
             'Calibration arrays already associated at the right size: ',n
           call mrtcal_message(seve%d,rname,mess)
           alloc = .false.
        else
           write(mess,'(a)') 'Calibration pointers already associated but with a different size => Freeing it first'
           call mrtcal_message(seve%d,rname,mess)
           call free_calib_scan(calarray,error)
           if (error)  return
        endif
     endif
     !
     if (alloc) then
        allocate(calarray%val(n),stat=ier)
        if (failed_allocate(rname,'calibration arrays',ier,error)) then
           call free_calib_scan(calarray,error)
           return
        endif
        ! Also initialize its contents
        do iarray=1,n
          call mrtindex_entry_zheader(calarray%val(iarray)%head,error)
          if (error)  return
        enddo
        write(mess,'(a,i0)') 'Allocated calibration arrays of size: ',n
        call mrtcal_message(seve%d,rname,mess)
     endif
  endif
  !
  ! Allocation success => Initialize
  calarray%n = n
  !
end subroutine reallocate_calib_scan
!
subroutine reallocate_science_scan(n,sciarray,error)
  use gbl_message
  use mrtcal_calib_types
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>reallocate_science_scan
  !-------------------------------------------------------------------
  ! @ private
  ! (re)allocate science arrays
  !-------------------------------------------------------------------
  integer(kind=4),              intent(in)    :: n
  type(science_scan_t), target, intent(inout) :: sciarray
  logical,                      intent(inout) :: error
  ! Local
  logical :: alloc
  integer(kind=4) :: ier,iarray
  character(len=message_length) :: mess
  character(len=*), parameter :: rname='REALLOCATE>SCIENCE>SCAN'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (n.lt.0) then
     write(mess,'(a,i0,a)') 'Array size can not negative (got ',n,')'
     call mrtcal_message(seve%e,rname,mess)
     error = .true.
     return
  else if (n.eq.0) then
     write(mess,'(a)') 'Array size is zero'
     call mrtcal_message(seve%d,rname,mess)
     call free_science_scan(sciarray,error)
     if (error)  return
  else
     alloc = .true.
     if (associated(sciarray%val)) then
        if (sciarray%n.eq.n) then
           write(mess,'(a,i0)')  &
             'Science arrays already associated at the right size: ',n
           call mrtcal_message(seve%d,rname,mess)
           alloc = .false.
        else
           write(mess,'(a)') 'Science pointers already associated but with a different size => Freeing it first'
           call mrtcal_message(seve%d,rname,mess)
           call free_science_scan(sciarray,error)
           if (error)  return
        endif
     endif
     !
     if (alloc) then
        allocate(sciarray%val(n),stat=ier)
        if (failed_allocate(rname,'science arrays',ier,error)) then
           call free_science_scan(sciarray,error)
           return
        endif
        ! Important initialization here!...
        do iarray=1,n
           call mrtindex_entry_zheader(sciarray%val(iarray)%head,error)
           if (error)  return
           sciarray%val(iarray)%off%prev => sciarray%val(iarray)%off%stack(1)
           sciarray%val(iarray)%off%next => sciarray%val(iarray)%off%stack(2)
        enddo ! iarray
        write(mess,'(a,i0)') 'Allocated science arrays of size: ',n
        call mrtcal_message(seve%d,rname,mess)
     endif
  endif
  !
  ! Allocation success => Initialize
  sciarray%n = n
  !
end subroutine reallocate_science_scan
!
subroutine reallocate_backend_list(n,backarray,error)
  use gbl_message
  use gkernel_interfaces
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this=>reallocate_backend_list
  !-------------------------------------------------------------------
  ! @ private
  ! (re)allocate backend list arrays
  !-------------------------------------------------------------------
  integer(kind=4),      intent(in)    :: n
  type(backend_list_t), intent(inout) :: backarray
  logical,              intent(inout) :: error
  ! Local
  logical :: alloc
  integer(kind=4) :: ier
  character(len=message_length) :: mess
  character(len=*), parameter :: rname='REALLOCATE>BACKEND>LIST'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (n.lt.0) then
    write(mess,'(a,i0,a)') 'Array size can not be negative (got ',n,')'
    call mrtcal_message(seve%e,rname,mess)
    error = .true.
    return
  else if (n.eq.0) then
     write(mess,'(a)') 'Array size is zero'
     call mrtcal_message(seve%d,rname,mess)
     call free_backend_list(backarray,error)
     if (error) return
  else
     alloc = .true.
     if (associated(backarray%backcode)) then
        if (backarray%n.eq.n) then
           write(mess,'(a,i0)')  &
             'Backend list arrays already associated at the right size: ',n
           call mrtcal_message(seve%d,rname,mess)
           alloc = .false.
        else
           write(mess,'(a)') 'Backend list pointers already associated but with a different size => Freeing it first'
           call mrtcal_message(seve%d,rname,mess)
           call free_backend_list(backarray,error)
           if (error)  return
        endif
     endif
     !
     if (alloc) then
        allocate(backarray%backcode(n),backarray%file(n),stat=ier)
        if (failed_allocate(rname,'calibration arrays',ier,error)) then
           call free_backend_list(backarray,error)
           return
        endif
        write(mess,'(a,i0)') 'Allocated backend list arrays of size: ',n
        call mrtcal_message(seve%d,rname,mess)
     endif
  endif
  !
  ! Allocation success => Initialize
  backarray%n = n
  !
end subroutine reallocate_backend_list
!
subroutine reallocate_subscan_list(n,list,error)
  use gbl_message
  use gkernel_interfaces
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this=>reallocate_subscan_list
  !-------------------------------------------------------------------
  ! @ private
  ! (re)allocate subscan list arrays
  !-------------------------------------------------------------------
  integer(kind=4),      intent(in)    :: n
  type(subscan_list_t), intent(inout) :: list
  logical,              intent(inout) :: error
  ! Local
  logical :: alloc
  integer(kind=4) :: ier
  character(len=message_length) :: mess
  character(len=*), parameter :: rname='REALLOCATE>SUBSCAN>LIST'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (n.le.0) then
     write(mess,'(a,i0,a)') 'Array size can not be zero nor negative (got ',n,')'
     call mrtcal_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  !
  alloc = .true.
  if (associated(list%mjd)) then
     if (list%nsub.eq.n) then
        write(mess,'(a,i0)')  &
             'SUBSCAN LIST arrays already associated at the right size: ',n
        call mrtcal_message(seve%d,rname,mess)
        alloc = .false.
     else
        write(mess,'(a)') 'SUBSCAN LIST pointers already associated but with a different size => Freeing it first'
        call mrtcal_message(seve%d,rname,mess)
        call free_subscan_list(list,error)
        if (error)  return
     endif
  endif
  !
  if (alloc) then
     allocate(list%isub(n),list%mjd(n),list%time(n),list%empty(n),stat=ier)
     if (failed_allocate(rname,'SUBSCAN LIST arrays',ier,error)) then
        call free_subscan_list(list,error)
        return
     endif
     call reallocate_eclass_char(list%scanning,n,error)
     if (error)  return
     call reallocate_eclass_2dble1char(list%onoff,n,error)
     if (error)  return
     write(mess,'(a,i0)') 'Allocated SUBSCAN LIST arrays of size: ',n
     call mrtcal_message(seve%d,rname,mess)
  endif
  !
  ! Allocation success => Initialize
  list%nsub = n
  list%tracked = 0
  list%otf = 0
  list%on  = 0
  list%off = 0
  list%scanning%cnt(:) = 1 ! *** JP This default should be factorized in the reallocate_eclass routines
  list%onoff%cnt(:) = 1 ! *** JP This default should be factorized in the reallocate_eclass routines
  !
end subroutine reallocate_subscan_list
!
subroutine reallocate_switch_desc(noffset,nfront,desc,error)
  use gbl_message
  use gkernel_interfaces
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this=>reallocate_switch_desc
  !-------------------------------------------------------------------
  ! @ private
  ! (re)allocate switch desc arrays
  !-------------------------------------------------------------------
  integer(kind=4),     intent(in)    :: noffset
  integer(kind=4),     intent(in)    :: nfront
  type(switch_desc_t), intent(inout) :: desc
  logical,             intent(inout) :: error
  ! Local
  logical :: alloc
  integer(kind=4) :: ier
  character(len=message_length) :: mess
  character(len=*), parameter :: rname='REALLOCATE>SWITCH>DESC'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if ((noffset.le.0).or.(nfront.le.0)) then
     write(mess,'(a,i0,a,i0,a)') 'Array size can not be zero nor negative (got ',noffset,'x',nfront,')'
     call mrtcal_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  !
  alloc = .true.
  if (associated(desc%off)) then
     if ((desc%noffset.eq.noffset).and.(desc%nfront.eq.nfront)) then
        write(mess,'(a,i0,a,i0)')  &
             'switch desc arrays already associated at the right size: ',noffset,'x',nfront
        call mrtcal_message(seve%d,rname,mess)
        alloc = .false.
     else
        write(mess,'(a)') 'switch desc pointers already associated but with a different size => Freeing it first'
        call mrtcal_message(seve%d,rname,mess)
        call free_switch_desc(desc,error)
        if (error)  return
     endif
  endif
  !
  if (alloc) then
     allocate(desc%off(noffset,nfront),desc%wei(nfront),stat=ier)
     if (failed_allocate(rname,'switch desc arrays',ier,error)) then
        call free_switch_desc(desc,error)
        return
     endif
     write(mess,'(a,i0,a,i0)') 'Allocated switch desc arrays of size: ',noffset,'x',nfront
     call mrtcal_message(seve%d,rname,mess)
  endif
  !
  ! Allocation success => Initialize
  desc%nfront = nfront
  desc%noffset = noffset
  !
end subroutine reallocate_switch_desc
!
subroutine reallocate_switch_on_or_off_index(n,idx,error)
  use gbl_message
  use gkernel_interfaces
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this=>reallocate_switch_on_or_off_index
  !-------------------------------------------------------------------
  ! @ private
  ! (re)allocate switch on or off index arrays
  !-------------------------------------------------------------------
  integer(kind=4),                intent(in)    :: n
  type(switch_on_or_off_index_t), intent(inout) :: idx
  logical,                        intent(inout) :: error
  ! Local
  logical :: alloc
  integer(kind=4) :: ier
  character(len=message_length) :: mess
  character(len=*), parameter :: rname='REALLOCATE>SWITCH>ON>OR>OFF>INDEX'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (n.le.0) then
     write(mess,'(a,i0,a)') 'Array size can not be zero nor negative (got ',n,')'
     call mrtcal_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  !
  if (idx%n.eq.n) then
     write(mess,'(a,i0)')  &
          'switch on or off index arrays already associated at the right size: ',n
     call mrtcal_message(seve%d,rname,mess)
     alloc = .false.
  else
     write(mess,'(a)') 'switch on or off index arrays already allocated but with a different size => Freeing it first'
     call mrtcal_message(seve%d,rname,mess)
     call free_switch_on_or_off_index(idx,error)
     if (error)  return
     alloc = .true.
  endif
  !
  if (alloc) then
     allocate(idx%i(n),stat=ier)
     if (failed_allocate(rname,'switch on or off index arrays',ier,error)) then
        return
     endif
     write(mess,'(a,i0)') 'Allocated switch on or off index arrays of size: ',n
     call mrtcal_message(seve%d,rname,mess)
  endif
  !
  ! Allocation success => Initialize
  idx%n = n
  !
end subroutine reallocate_switch_on_or_off_index
!
subroutine reallocate_switch_cycle(ndump,npha,non,noff,nfront,cycle,error)
  use gbl_message
  use gkernel_interfaces
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this=>reallocate_switch_cycle
  !-------------------------------------------------------------------
  ! @ private
  ! (re)allocate cycle arrays
  !-------------------------------------------------------------------
  integer(kind=4),      intent(in)    :: ndump
  integer(kind=4),      intent(in)    :: npha
  integer(kind=4),      intent(in)    :: non
  integer(kind=4),      intent(in)    :: noff
  integer(kind=4),      intent(in)    :: nfront
  type(switch_cycle_t), intent(inout) :: cycle
  logical,              intent(inout) :: error
  ! Local
  logical :: alloc
  integer(kind=4) :: ier,ipha
  character(len=message_length) :: mess
  character(len=*), parameter :: rname='REALLOCATE>SWITCH>CYCLE'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (npha.le.0) then
     write(mess,'(a,i0,a)') 'Array size can not be zero nor negative (got ',npha,')'
     call mrtcal_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  if (npha.lt.ndump) then
     write(mess,'(a,i0,a,i0,a)')  &
       'Number of dumps (',ndump,') in cycle can not be lower than number of phases (',npha,')'
     call mrtcal_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  if (npha.ne.non+noff) then
     write(mess,'(a,i0,a,i0,a,i0,a)')  &
       'Number of ON (',non,') + OFF (',noff,') in cycle must be equal to the number of phases (',npha,')'
     call mrtcal_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  !
  alloc = .true.
  if (associated(cycle%data)) then
     if (cycle%npha.eq.npha) then
        write(mess,'(a,i0)')  &
             'CYCLE arrays already associated at the right size: ',npha
        call mrtcal_message(seve%d,rname,mess)
        alloc = .false.
     else
        write(mess,'(a)') 'CYCLE pointers already associated but with a different size => Freeing it first'
        call mrtcal_message(seve%d,rname,mess)
        call free_switch_cycle(cycle,error)
        if (error)  return
     endif
  endif
  !
  if (alloc) then
     allocate(cycle%data(npha),cycle%desc(npha),stat=ier)
     if (failed_allocate(rname,'CYCLE arrays',ier,error)) then
        call free_switch_cycle(cycle,error)
        return
     endif
     write(mess,'(a,i0)') 'Allocated CYCLE arrays of size: ',npha
     call mrtcal_message(seve%d,rname,mess)
  endif
  !
  do ipha=1,npha
     call reallocate_switch_desc(npha,nfront,cycle%desc(ipha),error)
     if (error) return
  enddo ! ipha
  call reallocate_switch_on_or_off_index(non,cycle%on,error)
  if (error) return
  call reallocate_switch_on_or_off_index(noff,cycle%off,error)
  if (error) return
  !
  ! Allocation success => Initialize
  cycle%ndump = ndump
  cycle%npha  = npha
  !
end subroutine reallocate_switch_cycle
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Deallocation routines
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine free_chunk(chunk,error)
  use gbl_message
  use mrtcal_interfaces, except_this => free_chunk
  use mrtcal_calib_types
  !-------------------------------------------------------------------
  ! @ private
  ! Free a chunk
  !-------------------------------------------------------------------
  type(chunk_t), intent(inout) :: chunk
  logical,       intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='FREE>CHUNK'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (chunk%allocated.eq.code_pointer_associated) then
    call nullify_chunk(chunk,error)
    if (error)  return
    !
  elseif (chunk%allocated.eq.code_pointer_allocated) then
     chunk%ndata = 0
     if (associated(chunk%data1)) deallocate(chunk%data1)
     if (associated(chunk%dataw)) deallocate(chunk%dataw)
     chunk%allocated = code_pointer_null
  endif
  !
  ! Here we should nullify the gen, pos and spe sections *** JP
  !
end subroutine free_chunk
!
subroutine free_chunkset(chunkset,error)
  use gbl_message
  use mrtcal_interfaces, except_this => free_chunkset
  use mrtcal_calib_types
  !-------------------------------------------------------------------
  ! @ private
  ! Free a chunkset
  !-------------------------------------------------------------------
  type(chunkset_t), intent(inout) :: chunkset
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='FREE>CHUNKSET'
  integer(kind=4) :: ichunk
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (chunkset%allocated.eq.code_pointer_associated) then
    call nullify_chunkset(chunkset,error)
    if (error)  return
    !
  elseif (chunkset%allocated.eq.code_pointer_allocated) then
    do ichunk=1,ubound(chunkset%chunks,1)
      call free_chunk(chunkset%chunks(ichunk),error)
      ! if (error) continue
    enddo ! ichunk
    chunkset%n = 0
    if (associated(chunkset%chunks))  deallocate(chunkset%chunks)
    chunkset%allocated = code_pointer_null
  endif
  !
end subroutine free_chunkset
!
subroutine free_chunkset_2d(ck2d,error)
  use gbl_message
  use mrtcal_interfaces, except_this=>free_chunkset_2d
  use mrtcal_calib_types
  !-------------------------------------------------------------------
  ! @ private
  !  Free a chunkset_2d type:
  !   1) free all the elements in its 2D array of chunksets,
  !   2) free the array itself
  !-------------------------------------------------------------------
  type(chunkset_2d_t), intent(inout) :: ck2d
  logical,             intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='FREE>CHUNKSET>2D'
  integer(kind=4) :: i1,i2,ier
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (ck2d%allocated.eq.code_pointer_allocated) then
    if (.not.associated(ck2d%chunkset)) then
      ! This is unexpected, since ck2d%allocated tells us the array is in use!
      call mrtcal_message(seve%e,rname,'Chunkset 2D array is not associated!')
      error = .true.
      return
    endif
    !
    do i1=1,ubound(ck2d%chunkset,1)
      do i2=1,ubound(ck2d%chunkset,2)
        call free_chunkset(ck2d%chunkset(i1,i2),error)
        ! if (error)  continue
      enddo
    enddo
    !
    deallocate(ck2d%chunkset,stat=ier)
    if (ier.ne.0) then
      call mrtcal_message(seve%e,rname,'Failed to deallocate ')
      error = .true.
      return
    endif
    !
    ck2d%npix = 0
    ck2d%nset = 0
    ck2d%allocated = code_pointer_null
    !
  elseif (ck2d%allocated.eq.code_pointer_associated) then
    call nullify_chunkset_2d(ck2d,error)
    if (error)  return
    !
  else  ! ck2d%allocated.eq.code_pointer_null
    if (associated(ck2d%chunkset)) then
      ! This is unexpected, since ck2d%allocated tells us the array is NOT in use!
      call mrtcal_message(seve%e,rname,  &
        'Internal error: unexpected association status')
      error = .true.
      return
    endif
    !
  endif
  !
end subroutine free_chunkset_2d
!
subroutine free_chunkset_3d(ck3d,error)
  use gbl_message
  use mrtcal_interfaces, except_this => free_chunkset_3d
  use mrtcal_calib_types
  !-------------------------------------------------------------------
  ! @ private
  !  Free a chunkset_3d type:
  !   1) free all the elements in its 3D array of chunksets,
  !   2) free the array itself
  !-------------------------------------------------------------------
  type(chunkset_3d_t), intent(inout) :: ck3d
  logical,             intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='FREE>CHUNKSET>3D'
  integer(kind=4) :: i1,i2,i3,ier
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (associated(ck3d%chunkset)) then
    do i1=1,ubound(ck3d%chunkset,1)
      do i2=1,ubound(ck3d%chunkset,2)
        do i3=1,ubound(ck3d%chunkset,3)
          call free_chunkset(ck3d%chunkset(i1,i2,i3),error)
          ! if (error)  continue
        enddo
      enddo
    enddo
    deallocate(ck3d%chunkset,stat=ier)
    if (ier.ne.0) then
      call mrtcal_message(seve%e,rname,'Failed to deallocate ck3d%chunkset')
      error = .true.
      return
    endif
  endif
   !
end subroutine free_chunkset_3d
!
subroutine free_chopperset(chopperset,error)
  use gbl_message
  use chopper_definitions
  use mrtcal_interfaces, except_this => free_chopperset
  use mrtcal_calib_types
  !-------------------------------------------------------------------
  ! @ private
  ! Free a 2D array of chopper type
  !-------------------------------------------------------------------
  type(chopper_t), pointer       :: chopperset(:,:)
  logical,         intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='FREE>CHOPPERSET'
  integer(kind=4) :: i1,i2
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (.not.associated(chopperset))  return
  ! First the choppersets inside each chopperset member
  do i1=1,ubound(chopperset,1)
     do i2=1,ubound(chopperset,2)
        call telcal_free_chopper(chopperset(i1,i2),error)
        if (error) return
     enddo !i2
  enddo ! i1
  ! Second the chopperset array
  deallocate(chopperset)
  !
end subroutine free_chopperset
!
subroutine free_calib_scan(calarray,error)
  use gbl_message
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this => free_calib_scan
  !-------------------------------------------------------------------
  ! @ private
  !-------------------------------------------------------------------
  type(calib_scan_t), intent(inout) :: calarray
  logical,            intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='FREE>CALIB>SCAN'
  integer(kind=4) :: iback
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (.not.associated(calarray%val))  return
  !
  ! The array components first
  do iback=1,size(calarray%val)
    call free_calib_backend(calarray%val(iback),error)
    if (error)  continue
  enddo
  !
  ! The array itself
  calarray%n = 0
  deallocate(calarray%val)
  !
end subroutine free_calib_scan
!
subroutine free_calib_backend(backcal,error)
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>free_calib_backend
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(calib_backend_t), intent(inout) :: backcal  !
  logical,               intent(inout) :: error    !
  !
  call mrtindex_entry_fheader(backcal%head,error)
  call free_chunkset_2d(backcal%sky,error)
  call free_chunkset_2d(backcal%hot,error)
  call free_chunkset_2d(backcal%cold,error)
  call free_chunkset_2d(backcal%trec,error)
  call free_chunkset_2d(backcal%tcal,error)
  call free_chunkset_2d(backcal%tsys,error)
  call free_chunkset_2d(backcal%atsys,error)
  call free_chunkset_2d(backcal%water,error)
  call free_chunkset_2d(backcal%ztau,error)
  call free_chunkset_2d(backcal%flag,error)
  call free_chopperset(backcal%chopperset,error)
  call free_chunkset_2d(backcal%grid,error)
  call free_chunkset_2d(backcal%amppha,error)
  call free_chunkset_2d(backcal%sincos,error)
  !
  call imbfits_free_back_chunks(backcal%chunksetlist,error)
  !
  backcal%nset = 0
  backcal%npix = 0
  !
end subroutine free_calib_backend
!
subroutine free_science_scan(sciarray,error)
  use gbl_message
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this => free_science_scan
  !-------------------------------------------------------------------
  ! @ private
  !-------------------------------------------------------------------
  type(science_scan_t), intent(inout) :: sciarray
  logical,              intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='FREE>SCIENCE>SCAN'
  integer(kind=4) :: iback
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  if (.not.associated(sciarray%val))  return
  !
  ! The array components first
  do iback=1,size(sciarray%val)
    call free_science_backend(sciarray%val(iback),error)
    if (error)  continue
  enddo
  !
  ! The array itself
  sciarray%n = 0
  deallocate(sciarray%val)
  !
end subroutine free_science_scan
!
subroutine free_science_backend(backsci,error)
  use mrtcal_dependencies_interfaces
  use mrtcal_interfaces, except_this=>free_science_backend
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(science_backend_t), intent(inout) :: backsci
  logical,                 intent(inout) :: error
  !
  call mrtindex_entry_fheader(backsci%head,error)
  call free_subscan_list(backsci%list,error)
  call free_switch_cycle(backsci%switch%cycle,error)
  call free_on_stack(backsci%on,error)
  call free_off_stack(backsci%off,error)
  call free_chunkset_3d(backsci%diff,error)
  call free_chunkset_3d(backsci%cumul,error)
  call free_chunkset_2d(backsci%tscale,error)
  call free_chunkset_2d(backsci%expatau,error)
  call free_obs_list(backsci%drift%indiv,error)
  call free_obs_list(backsci%drift%solved,error)
  !
  call imbfits_free_back_chunks(backsci%chunksetlist,error)
  !
end subroutine free_science_backend
!
subroutine free_on_stack(on,error)
  use mrtcal_interfaces, except_this=>free_on_stack
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(on_stack_t), intent(inout) :: on
  logical,          intent(inout) :: error
  !
  call free_chunkset_2d(on%curr,error)
  !
end subroutine free_on_stack
!
subroutine free_off_stack(off,error)
  use mrtcal_interfaces, except_this=>free_off_stack
  use mrtcal_calib_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(off_stack_t), intent(inout) :: off
  logical,           intent(inout) :: error
  !
  call free_chunkset_2d(off%stack(1),error)
  call free_chunkset_2d(off%stack(2),error)
  call free_chunkset_2d(off%slope,error)
  call free_chunkset_2d(off%offset,error)
  call free_chunkset_2d(off%computed,error)
  !
end subroutine free_off_stack
!
subroutine free_backend_list(backarray,error)
  use gbl_message
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this => free_backend_list
  !-------------------------------------------------------------------
  ! @ private
  !-------------------------------------------------------------------
  type(backend_list_t), intent(inout) :: backarray
  logical,              intent(inout) :: error
  !
  character(len=*), parameter :: rname='FREE>BACKEND>LIST'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  backarray%n = 0
  if (associated(backarray%backcode)) deallocate(backarray%backcode)
  if (associated(backarray%file))     deallocate(backarray%file)
  ! Nullification is implicit with deallocate
  !
end subroutine free_backend_list
!
subroutine free_subscan_list(list,error)
  use gbl_message
  use gkernel_interfaces
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this => free_subscan_list
  !-------------------------------------------------------------------
  ! @ private
  !-------------------------------------------------------------------
  type(subscan_list_t), intent(inout) :: list
  logical,              intent(inout) :: error
  !
  character(len=*), parameter :: rname='FREE>SUBSCAN>LIST'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  list%nsub = 0
  if (associated(list%isub))   deallocate(list%isub)
  if (associated(list%time))   deallocate(list%time)
  if (associated(list%mjd))    deallocate(list%mjd)
  if (associated(list%empty))  deallocate(list%empty)
  call free_eclass_2dble1char(list%onoff,error)
  if (error) return
  call free_eclass_char(list%scanning,error)
  if (error) return
  ! Nullification is implicit with deallocate
  !
end subroutine free_subscan_list
!
subroutine free_switch_desc(desc,error)
  use gbl_message
  use gkernel_interfaces
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this => free_switch_desc
  !-------------------------------------------------------------------
  ! @ private
  !-------------------------------------------------------------------
  type(switch_desc_t), intent(inout) :: desc
  logical,             intent(inout) :: error
  !
  character(len=*), parameter :: rname='FREE>SWITCH>DESC'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  desc%nfront = 0
  desc%noffset = 0
  if (associated(desc%wei)) deallocate(desc%wei)
  if (associated(desc%off)) deallocate(desc%off)
  ! Nullification is implicit with deallocate
  !
end subroutine free_switch_desc
!
subroutine free_switch_on_or_off_index(idx,error)
  use gbl_message
  use gkernel_interfaces
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this => free_switch_on_or_off_index
  !-------------------------------------------------------------------
  ! @ private
  !-------------------------------------------------------------------
  type(switch_on_or_off_index_t), intent(inout) :: idx
  logical,                        intent(inout) :: error
  !
  character(len=*), parameter :: rname='FREE>SWITCH>ON>OR>OFF>INDEX'
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  idx%n = 0
  if (allocated(idx%i)) deallocate(idx%i)
  !
end subroutine free_switch_on_or_off_index
!
subroutine free_switch_cycle(cycle,error)
  use gbl_message
  use gkernel_interfaces
  use mrtcal_calib_types
  use mrtcal_interfaces, except_this => free_switch_cycle
  !-------------------------------------------------------------------
  ! @ private
  !-------------------------------------------------------------------
  type(switch_cycle_t), intent(inout) :: cycle
  logical,              intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='FREE>SWITCH>CYCLE'
  integer(kind=4) :: i
  !
  call mrtcal_message(seve%t,rname,'Welcome')
  !
  cycle%npha = 0
  cycle%ndump = 0
  cycle%ndata = 0
  if (associated(cycle%data)) then
    do i=1,size(cycle%data)
      call free_chunkset_2d(cycle%data(i),error)
      if (error)  return
    enddo
    deallocate(cycle%data)
  endif
  !
  if (associated(cycle%desc)) then
    do i=1,size(cycle%desc)
      call free_switch_desc(cycle%desc(i),error)
      if (error)  return
    enddo
    deallocate(cycle%desc)
  endif
  !
  call free_switch_on_or_off_index(cycle%on,error)
  if (error)  return
  call free_switch_on_or_off_index(cycle%off,error)
  if (error)  return
  !
end subroutine free_switch_cycle
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine reallocate_dble_1d(r8,newndata,keep,error)
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ private
  ! Reallocate a simple 1D REAL*8 pointer
  !---------------------------------------------------------------------
  real(kind=8),    pointer       :: r8(:)     !
  integer(kind=4), intent(in)    :: newndata  !
  logical,         intent(in)    :: keep      !
  logical,         intent(inout) :: error     !
  ! Local
  character(len=*), parameter :: rname='REALLOCATE>DBLE>1D'
  integer(kind=4) :: oldndata,ier
  real(kind=8), pointer :: tmp(:)
  !
  tmp => null()
  if (associated(r8)) then
    oldndata = size(r8)
    if (oldndata.ge.newndata) then
      ! Enough space, nothing to be done
      return
    endif
    if (keep) then
      allocate(tmp(oldndata),stat=ier)
      if (failed_allocate(rname,'tmp array',ier,error)) then
        error = .true.
        return
      endif
      tmp(:) = r8(:)
    endif
    deallocate(r8,stat=ier)
    if (failed_allocate(rname,'r8 array',ier,error)) then
      error = .true.
      return
    endif
  endif
  !
  allocate(r8(newndata),stat=ier)
  if (failed_allocate(rname,'r8 array',ier,error)) then
    error = .true.
    return
  endif
  if (keep .and. associated(tmp)) then
    r8(1:oldndata) = tmp(1:oldndata)
    deallocate(tmp)
  endif
  !
end subroutine reallocate_dble_1d
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
