!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! (re)allocation routines
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine reallocate_calib_scan(n,calarray,error)
  use mrtcal_messaging
  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 calarray%free(error)
     if (error)  return
  else
     alloc = .true.
     if (allocated(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 calarray%free(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 calarray%free(error)
           return
        endif
        ! Also initialize its contents
        do iarray=1,n
          call calarray%val(iarray)%init(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 mrtcal_messaging
  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 sciarray%free(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 sciarray%free(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 sciarray%free(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 mrtcal_messaging
  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 mrtcal_messaging
  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 list%free(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 list%free(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 mrtcal_messaging
  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 desc%free(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 desc%free(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 mrtcal_messaging
  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 idx%free(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 mrtcal_messaging
  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 cycle%free(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 cycle%free(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_backend_list(backarray,error)
  use mrtcal_messaging
  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 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
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
