!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine imbfits_read_header_init(file,hdu,error)
  use gbl_message
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_read_header_init
  !---------------------------------------------------------------------
  ! @ private
  !  Read the elements in the 'imbfits_header_t' type
  !---------------------------------------------------------------------
  type(imbfits_file_t),   intent(in)    :: file
  type(imbfits_header_t), intent(inout) :: hdu
  logical,                intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='IMBFITS>READ>HEADER>INIT'
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  hdu%status = code_imbfits_started
  call imbfits_read_key(rname,file,'xtension',hdu%xtension,error)
  if (error) return
  call imbfits_read_key(rname,file,'bitpix',hdu%bitpix,error)
  if (error) return
  call imbfits_read_key(rname,file,'naxis',hdu%naxis,error)
  if (error) return
  call imbfits_read_key(rname,file,'naxis1',hdu%naxis1,error)
  if (error) return
  call imbfits_read_key(rname,file,'naxis2',hdu%naxis2,error)
  if (error) return
  call imbfits_read_key(rname,file,'pcount',hdu%pcount,error)
  if (error) return
  call imbfits_read_key(rname,file,'gcount',hdu%gcount,error)
  if (error) return
  call imbfits_read_key(rname,file,'tfields',hdu%tfields,error)
  if (error) return
  call imbfits_read_key(rname,file,'extname',hdu%extname,error)
  if (error) return
  !
end subroutine imbfits_read_header_init
!
subroutine imbfits_free_header_init(hdu,error)
  use gbl_message
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_free_header_init
  !---------------------------------------------------------------------
  ! @ private
  !  Free the elements in the 'imbfits_header_t' type
  !---------------------------------------------------------------------
  type(imbfits_header_t), intent(inout) :: hdu
  logical,                intent(inout) :: error
  !
  ! Scalar elements:
  !  => nothing to be freed.
  ! Nullify elements for safety
  hdu%xtension%val = ''
  hdu%bitpix%val   = 0
  hdu%naxis%val    = 0
  hdu%naxis1%val   = 0
  hdu%naxis2%val   = 0
  hdu%pcount%val   = 0
  hdu%gcount%val   = 0
  hdu%tfields%val  = 0
  hdu%extname%val  = ''
  !
  ! Array elements:
  !  => none
  !
  hdu%status = code_imbfits_init
  !
end subroutine imbfits_free_header_init
!
subroutine imbfits_read_header_done(file,hdu,error)
  use gbl_message
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_read_header_done
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(imbfits_file_t), intent(in)      :: file
  type(imbfits_header_t), intent(inout) :: hdu
  logical,              intent(inout)   :: error
  ! Local
  character(len=*), parameter :: rname='IMBFITS>READ>HEADER>DONE'
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  hdu%status = code_imbfits_done
end subroutine imbfits_read_header_done
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Reading routines (0D)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine imbfits_read_dble_0d(caller,file,key,dble,error,default)
  use gbl_message
  use cfitsio_api
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_read_dble_0d
  !---------------------------------------------------------------------
  ! @ private-generic imbfits_read_key
  !---------------------------------------------------------------------
  character(len=*),     intent(in)           :: caller
  type(imbfits_file_t), intent(in)           :: file
  character(len=*),     intent(in)           :: key
  type(fits_dble_0d_t), intent(out)          :: dble
  logical,              intent(inout)        :: error
  real(kind=8),         intent(in), optional :: default
  ! Local
  character(len=*), parameter :: rname='IMBFITS>READ>DBLE>0D'
  integer(kind=4) :: status
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  if (file%unit.eq.0) then
     call imbfits_message(seve%e,rname,'Input file not opened')
     error = .true.
     return
  endif
  !
  dble%key = key
  status = 0
  call ftgkyd(file%unit,dble%key,dble%val,dble%comment,status)
  if (status.gt.0) then
    if (present(default) .and. status.eq.code_cfitsio_error_missingkey) then
      ! Keyword not found
      dble%val     = default
      dble%comment = 'WARNING! Keyword not found in header'
    else
      call imbfits_message(seve%e,caller,'Error')
      call imbfits_message(seve%e,rname,'Some error reading '''//trim(dble%key)//'''')
      call cfitsio_message(status)
      error = .true.
      return
    endif
  endif
  !
end subroutine imbfits_read_dble_0d
!
subroutine imbfits_read_inte_0d(caller,file,key,inte,error,default)
  use gbl_message
  use cfitsio_api
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_read_inte_0d
  !---------------------------------------------------------------------
  ! @ private-generic imbfits_read_key
  !---------------------------------------------------------------------
  character(len=*),     intent(in)           :: caller
  type(imbfits_file_t), intent(in)           :: file
  character(len=*),     intent(in)           :: key
  type(fits_inte_0d_t), intent(out)          :: inte
  logical,              intent(inout)        :: error
  integer(kind=4),      intent(in), optional :: default
  ! Local
  character(len=*), parameter :: rname='IMBFITS>READ>INTE>0D'
  integer(kind=4) :: status
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  if (file%unit.eq.0) then
     call imbfits_message(seve%e,rname,'Input file not opened')
     error = .true.
     return
  endif
  !
  inte%key = key
  status = 0
  call ftgkyj(file%unit,inte%key,inte%val,inte%comment,status)
  if (status.gt.0) then
    if (present(default) .and. status.eq.code_cfitsio_error_missingkey) then
      ! Keyword not found
      inte%val     = default
      inte%comment = 'WARNING! Keyword not found in header'
    else
      call imbfits_message(seve%e,caller,'Error')
      call imbfits_message(seve%e,rname,'Some error reading '''//trim(inte%key)//'''')
      call cfitsio_message(status)
      error = .true.
      return
    endif
  endif
  !
end subroutine imbfits_read_inte_0d
!
subroutine imbfits_read_logi_0d(caller,file,key,logi,error,default)
  use gbl_message
  use cfitsio_api
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_read_logi_0d
  !---------------------------------------------------------------------
  ! @ private-generic imbfits_read_key
  !---------------------------------------------------------------------
  character(len=*),     intent(in)           :: caller
  type(imbfits_file_t), intent(in)           :: file
  character(len=*),     intent(in)           :: key
  type(fits_logi_0d_t), intent(out)          :: logi
  logical,              intent(inout)        :: error
  logical,              intent(in), optional :: default
  ! Local
  character(len=*), parameter :: rname='IMBFITS>READ>LOGI>0D'
  integer(kind=4) :: status
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  if (file%unit.eq.0) then
     call imbfits_message(seve%e,rname,'Input file not opened')
     error = .true.
     return
  endif
  !
  logi%key = key
  status = 0
  call ftgkyl(file%unit,logi%key,logi%val,logi%comment,status)
  if (status.gt.0) then
    if (present(default) .and. status.eq.code_cfitsio_error_missingkey) then
      ! Keyword not found
      logi%val     = default
      logi%comment = 'WARNING! Keyword not found in header'
    else
      call imbfits_message(seve%e,caller,'Error')
      call imbfits_message(seve%e,rname,'Some error reading '''//trim(logi%key)//'''')
      call cfitsio_message(status)
      error = .true.
      return
    endif
  endif
  !
end subroutine imbfits_read_logi_0d
!
subroutine imbfits_read_char_0d(caller,file,key,char,error,default)
  use gbl_message
  use cfitsio_api
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_read_char_0d
  !---------------------------------------------------------------------
  ! @ private-generic imbfits_read_key
  !---------------------------------------------------------------------
  character(len=*),     intent(in)           :: caller
  type(imbfits_file_t), intent(in)           :: file
  character(len=*),     intent(in)           :: key
  type(fits_char_0d_t), intent(out)          :: char
  logical,              intent(inout)        :: error
  character(len=*),     intent(in), optional :: default
  ! Local
  character(len=*), parameter :: rname='IMBFITS>READ>CHAR>0D'
  integer(kind=4) :: status
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  if (file%unit.eq.0) then
     call imbfits_message(seve%e,rname,'Input file not opened')
     error = .true.
     return
  endif
  !
  char%key = key
  status = 0
  call ftgkys(file%unit,char%key,char%val,char%comment,status)
  if (status.gt.0) then
    if (present(default) .and. status.eq.code_cfitsio_error_missingkey) then
      ! Keyword not found
      char%val     = default
      char%comment = 'WARNING! Keyword not found in header'
    else
      call imbfits_message(seve%e,caller,'Error')
      call imbfits_message(seve%e,rname,'Some error reading '''//trim(char%key)//'''')
      call cfitsio_message(status)
      error = .true.
      return
    endif
  endif
  !
end subroutine imbfits_read_char_0d
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Reading routines (1D)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine imbfits_read_logi_1d(caller,file,key,n,logi,error)
  use gbl_message
  use cfitsio_api
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_read_logi_1d
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_read_column
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: caller
  type(imbfits_file_t), intent(in)    :: file
  character(len=*),     intent(in)    :: key
  integer(kind=4),      intent(in)    :: n
  type(fits_logi_1d_t), intent(inout) :: logi    ! INOUT: keep allocation status
  logical,              intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='IMBFITS>READ>LOGI>1D'
  integer(kind=4) :: colnum,status
  character(len=message_length) :: mess
  character(len=10) :: tkey,tval
  character(len=comment_length) :: tcomm
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  if (file%unit.eq.0) then
     call imbfits_message(seve%e,caller,'Error')
     call imbfits_message(seve%e,rname,'Input file not opened')
     error = .true.
     return
  endif
  !
  ! Allocations
  call reallocate_fits_logi_1d(key,n,logi,error)
  if (error)  return
  !
  ! Get column number
  status = 0
  call ftgcno(file%unit,.false.,logi%key,colnum,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Error while searching for column '''//trim(key)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  ! Get corresponding TFORM
  tkey = 'TFORM'
  write(tkey(6:7),'(I0)')  colnum
  call ftgkys(file%unit,tkey,tval,tcomm,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Some error reading '''//trim(tkey)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  if (tval.ne.'L' .and. tval.ne.'1L') then
    write(mess,'(A,A,A,A,A)')  &
      'Attempt to read column ''',trim(key),''' (type ',trim(tval),') in a logical*4 vector'
    call imbfits_message(seve%w,rname,mess)
  endif
  !
  ! Get corresponding TTYPE so that we get its comment
  tkey = 'TTYPE'
  write(tkey(6:7),'(I0)')  colnum
  call ftgkys(file%unit,tkey,tval,logi%comment,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Some error reading '''//trim(tkey)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  ! Read the column data
  if (n.eq.0)  return  ! No data, nothing more to do
  call ftgcl(file%unit,colnum,1,1,n,logi%val,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    write(mess,'(A,I0,A,A,A,I0)')  &
      'Error while reading column #',colnum,' (',trim(key),'), row #',1
    call imbfits_message(seve%e,rname,mess)
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
end subroutine imbfits_read_logi_1d
!
subroutine imbfits_read_inte_1d(caller,file,key,n,inte,error)
  use gbl_message
  use cfitsio_api
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_read_inte_1d
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_read_column
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: caller
  type(imbfits_file_t), intent(in)    :: file
  character(len=*),     intent(in)    :: key
  integer(kind=4),      intent(in)    :: n
  type(fits_inte_1d_t), intent(inout) :: inte    ! INOUT: keep allocation status
  logical,              intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='IMBFITS>READ>INTE>1D'
  integer(kind=4) :: colnum,status
  logical :: anynull
  character(len=message_length) :: mess
  character(len=10) :: tkey,tval
  character(len=comment_length) :: tcomm
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  if (file%unit.eq.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Input file not opened')
    error = .true.
    return
  endif
  !
  ! Allocations
  call reallocate_fits_inte_1d(key,n,inte,error)
  if (error)  return
  !
  ! Get column number
  status = 0
  call ftgcno(file%unit,.false.,inte%key,colnum,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Error while searching for column '''//trim(key)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  ! Get corresponding TFORM
  tkey = 'TFORM'
  write(tkey(6:7),'(I0)')  colnum
  call ftgkys(file%unit,tkey,tval,tcomm,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Some error reading '''//trim(tkey)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  if (tval.ne.'J' .and. tval.ne.'1J') then
    write(mess,'(A,A,A,A,A)')  &
      'Attempt to read column ',trim(key),' (type ',trim(tval),') in an integer*4 vector'
    call imbfits_message(seve%w,rname,mess)
  endif
  !
  ! Get corresponding TTYPE so that we get its comment
  tkey = 'TTYPE'
  write(tkey(6:7),'(I0)')  colnum
  call ftgkys(file%unit,tkey,tval,inte%comment,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Some error reading '''//trim(tkey)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  ! Read the column data
  if (n.eq.0)  return  ! No data, nothing more to do
  anynull = .false.
  call ftgcvj(file%unit,colnum,1,1,n,-1,inte%val,anynull,status)
  if (anynull .or. status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    write(mess,'(A,I0,A,A,A,I0)')  &
      'Error while reading column #',colnum,' (',trim(key),'), row #',1
    call imbfits_message(seve%e,rname,mess)
    if (anynull) then
      call imbfits_message(seve%e,rname,'Some null values found')
    else
      call cfitsio_message(status)
    endif
    error = .true.
    return
  endif
  !
end subroutine imbfits_read_inte_1d
!
subroutine imbfits_read_real_1d(caller,file,key,n,real,error)
  use gbl_message
  use cfitsio_api
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_read_real_1d
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_read_column
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: caller
  type(imbfits_file_t), intent(in)    :: file
  character(len=*),     intent(in)    :: key
  integer(kind=4),      intent(in)    :: n
  type(fits_real_1d_t), intent(inout) :: real    ! INOUT: keep allocation status
  logical,              intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='IMBFITS>READ>REAL>1D'
  integer(kind=4) :: colnum,status
  logical :: anynull
  character(len=message_length) :: mess
  character(len=10) :: tkey,tval
  character(len=comment_length) :: tcomm
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  if (file%unit.eq.0) then
     call imbfits_message(seve%e,rname,'Input file not opened')
     error = .true.
     return
  endif
  !
  ! Allocations
  call reallocate_fits_real_1d(key,n,real,error)
  if (error)  return
  !
  ! Get column number
  status = 0
  call ftgcno(file%unit,.false.,real%key,colnum,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Error while searching for column '''//trim(key)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  ! Get corresponding TFORM
  tkey = 'TFORM'
  write(tkey(6:7),'(I0)')  colnum
  call ftgkys(file%unit,tkey,tval,tcomm,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Some error reading '''//trim(tkey)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  if (tval.ne.'E' .and. tval.ne.'1E') then
    write(mess,'(A,A,A,A,A)')  &
      'Attempt to read column ',trim(key),' (type ',trim(tval),') in a real*4 vector'
    call imbfits_message(seve%w,rname,mess)
  endif
  !
  ! Get corresponding TTYPE so that we get its comment
  tkey = 'TTYPE'
  write(tkey(6:7),'(I0)')  colnum
  call ftgkys(file%unit,tkey,tval,real%comment,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Some error reading '''//trim(tkey)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  ! Read the column data
  if (n.eq.0)  return  ! No data, nothing more to do
  anynull = .false.
  call ftgcve(file%unit,colnum,1,1,n,-1.e0,real%val,anynull,status)
  if (anynull .or. status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    write(mess,'(A,I0,A,A,A,I0)')  &
      'Error while reading column #',colnum,' (',trim(key),'), row #',1
    call imbfits_message(seve%e,rname,mess)
    if (anynull) then
      call imbfits_message(seve%e,rname,'Some null values found')
    else
      call cfitsio_message(status)
    endif
    error = .true.
    return
  endif
  !
end subroutine imbfits_read_real_1d
!
subroutine imbfits_read_dble_1d(caller,file,key,n,dble,error)
  use gbl_message
  use cfitsio_api
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_read_dble_1d
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_read_column
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: caller
  type(imbfits_file_t), intent(in)    :: file
  character(len=*),     intent(in)    :: key
  integer(kind=4),      intent(in)    :: n
  type(fits_dble_1d_t), intent(inout) :: dble    ! INOUT: keep allocation status
  logical,              intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='IMBFITS>READ>DBLE>1D'
  integer(kind=4) :: colnum,status
  logical :: anynull
  character(len=message_length) :: mess
  character(len=10) :: tkey,tval
  character(len=comment_length) :: tcomm
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  if (file%unit.eq.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Input file not opened')
    error = .true.
    return
  endif
  !
  ! Allocations
  call reallocate_fits_dble_1d(key,n,dble,error)
  if (error)  return
  !
  ! Get column number
  status = 0
  call ftgcno(file%unit,.false.,dble%key,colnum,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Error while searching for column '''//trim(key)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  ! Get corresponding TFORM
  tkey = 'TFORM'
  write(tkey(6:7),'(I0)')  colnum
  call ftgkys(file%unit,tkey,tval,tcomm,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Some error reading '''//trim(tkey)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  if (tval.ne.'D' .and. tval.ne.'1D') then
    write(mess,'(A,A,A,A,A)')  &
      'Attempt to read column ',trim(key),' (type ',trim(tval),') in a real*8 vector'
    call imbfits_message(seve%w,rname,mess)
  endif
  !
  ! Get corresponding TTYPE so that we get its comment
  tkey = 'TTYPE'
  write(tkey(6:7),'(I0)')  colnum
  call ftgkys(file%unit,tkey,tval,dble%comment,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Some error reading '''//trim(tkey)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  ! Read the column data
  if (n.eq.0)  return  ! No data, nothing more to do
  anynull = .false.
  call ftgcvd(file%unit,colnum,1,1,n,-1.d0,dble%val,anynull,status)
  if (anynull .or. status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    write(mess,'(A,I0,A,A,A,I0)')  &
      'Error while reading column #',colnum,' (',trim(key),'), row #',1
    call imbfits_message(seve%e,rname,mess)
    if (anynull) then
      call imbfits_message(seve%e,rname,'Some null values found')
    else
      call cfitsio_message(status)
    endif
    error = .true.
    return
  endif
  !
end subroutine imbfits_read_dble_1d
!
subroutine imbfits_read_char_1d(caller,file,key,n,char,error,default)
  use gbl_message
  use cfitsio_api
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_read_char_1d
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_read_column
  !---------------------------------------------------------------------
  character(len=*),     intent(in)           :: caller
  type(imbfits_file_t), intent(in)           :: file
  character(len=*),     intent(in)           :: key
  integer(kind=4),      intent(in)           :: n
  type(fits_char_1d_t), intent(inout)        :: char    ! INOUT: keep allocation status
  logical,              intent(inout)        :: error
  character(len=*),     intent(in), optional :: default  ! If absent column or NULL values in column
  ! Local
  character(len=*), parameter :: rname='IMBFITS>READ>CHAR>1D'
  integer(kind=4) :: colnum,status,nc
  logical :: anynull
  character(len=message_length) :: mess
  character(len=10) :: tkey,tval
  character(len=comment_length) :: tcomm
  character(len=char1d_length) :: defstring
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  if (file%unit.eq.0) then
     call imbfits_message(seve%e,rname,'Input file not opened')
     error = .true.
     return
  endif
  !
  ! Allocations
  call reallocate_fits_char_1d(key,n,char,error)
  if (error)  return
  !
  ! Get column number
  status = 0
  call ftgcno(file%unit,.false.,char%key,colnum,status)
  if (status.gt.0) then
    ! Error, probably no such column
    if (present(default)) then
      char%val(:) = default
      char%comment = 'WARNING! Column not found in table'
      return
    else
      call imbfits_message(seve%e,caller,'Error')
      call imbfits_message(seve%e,rname,'Error while searching for column '''//trim(key)//'''')
      call cfitsio_message(status)
      error = .true.
      return
    endif
  endif
  !
  ! Get corresponding TFORM
  tkey = 'TFORM'
  write(tkey(6:7),'(I0)')  colnum
  call ftgkys(file%unit,tkey,tval,tcomm,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Some error reading '''//trim(tkey)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  nc = len_trim(tval)
  if (tval(nc:nc).ne.'A') then
    write(mess,'(A,A,A,A,A)')  &
      'Attempt to read column ',trim(key),' (type ',trim(tval),') in a character vector'
    call imbfits_message(seve%w,rname,mess)
  endif
  !
  ! Get corresponding TTYPE so that we get its comment
  tkey = 'TTYPE'
  write(tkey(6:7),'(I0)')  colnum
  call ftgkys(file%unit,tkey,tval,char%comment,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Some error reading '''//trim(tkey)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  ! Read the column data
  if (n.eq.0)  return  ! No data, nothing more to do
  if (present(default)) then
    defstring = default
  else
    defstring = 'NULL'
  endif
  anynull = .false.
  call ftgcvs(file%unit,colnum,1,1,n,defstring,char%val,anynull,status)
  if (anynull .or. status.gt.0) then
    if (status.eq.0 .and. anynull .and. present(default)) then
      ! Caller gave a default in case of undefined values. Not an error
      continue
    else
      call imbfits_message(seve%e,caller,'Error')
      write(mess,'(A,I0,A,A,A,I0)')  &
        'Error while reading column #',colnum,' (',trim(key),'), row #',1
      call imbfits_message(seve%e,rname,mess)
      if (anynull) then
        call imbfits_message(seve%e,rname,'Some null values found')
      else
        call cfitsio_message(status)
      endif
      error = .true.
      return
    endif
  endif
  !
end subroutine imbfits_read_char_1d
!
subroutine imbfits_read_dble_2d_into_1d(caller,file,key,nrow,ncol,dble,error)
  use gbl_message
  use cfitsio_api
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_read_dble_2d_into_1d
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_read_column
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: caller
  type(imbfits_file_t), intent(in)    :: file
  character(len=*),     intent(in)    :: key
  integer(kind=4),      intent(in)    :: nrow
  integer(kind=4),      intent(in)    :: ncol
  type(fits_dble_1d_t), intent(inout) :: dble    ! INOUT: keep allocation status
  logical,              intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='IMBFITS>READ>DBLE>2D>INTO>1D'
  integer(kind=4) :: colnum,status,nelem
  logical :: anynull
  character(len=message_length) :: mess
  character(len=10) :: tkey,tval
  character(len=comment_length) :: tcomm
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  ! *** JP Next block should be factorized
  if (file%unit.eq.0) then
     call imbfits_message(seve%e,rname,'Input file not opened')
     error = .true.
     return
  endif
  !
  ! Allocations
  call reallocate_fits_dble_1d(key,nrow*ncol,dble,error)
  if (error)  return
  !
  ! *** JP Next two blocks should be factorized
  ! Get column number
  status = 0
  call ftgcno(file%unit,.false.,dble%key,colnum,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Error while searching for column '''//trim(key)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  ! Get corresponding TFORM
  tkey = 'TFORM'
  write(tkey(6:7),'(I0)')  colnum
  call ftgkys(file%unit,tkey,tval,tcomm,status)
  if (status.gt.0) then
     call imbfits_message(seve%e,caller,'Error')
     call imbfits_message(seve%e,rname,'Some error reading '''//trim(tkey)//'''')
     call cfitsio_message(status)
     error = .true.
     return
  endif
  ! ZZZ Some clever check here!
  !   if (tval.ne.'E') then
  !     write(mess,'(A,A,A,A,A)')  &
  !       'Attempt to read column ',trim(key),' (type ',trim(tval),') in a real*8 array'
  !     call imbfits_message(seve%w,rname,mess)
  !   endif
  !
  ! Get corresponding TTYPE so that we get its comment
  tkey = 'TTYPE'
  write(tkey(6:7),'(I0)')  colnum
  call ftgkys(file%unit,tkey,tval,dble%comment,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Some error reading '''//trim(tkey)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  nelem = nrow*ncol
  anynull = .false.
  call ftgcvd(file%unit,colnum,1,1,nelem,-1.d0,dble%val,anynull,status)
  ! *** JP Next block could be factorized
  if (anynull .or. status.gt.0) then
     call imbfits_message(seve%e,caller,'Error')
     write(mess,'(A,I0,A,A,A,I0)')  &
          'Error while reading column #',colnum,' (',trim(key),'), row #',1
     call imbfits_message(seve%e,rname,mess)
     if (anynull) then
        call imbfits_message(seve%e,rname,'Some null values found')
     else
        call cfitsio_message(status)
     endif
     error = .true.
     return
  endif
  !
end subroutine imbfits_read_dble_2d_into_1d
!
subroutine imbfits_read_data(caller,file,nchan,npix,ftime,ntime,  &
  imbdata,error)
  use gbl_message
  use cfitsio_api
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_read_data
  !---------------------------------------------------------------------
  ! @ public
  ! Reading subroutine specific to the 'DATA' column
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: caller   ! Name of calling subroutine
  type(imbfits_file_t), intent(in)    :: file     !
  integer(kind=4),      intent(in)    :: nchan    !
  integer(kind=4),      intent(in)    :: npix     !
  integer(kind=4),      intent(in)    :: ftime    ! First 'time' row read
  integer(kind=4),      intent(in)    :: ntime    ! Number of 'time' rows read
  type(imbfits_data_t), intent(inout) :: imbdata  !
  logical,              intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='IMBFITS>READ>DATA'
  integer(kind=4) :: colnum,status,nelem
  logical :: anynull
  character(len=message_length) :: mess
  character(len=10) :: tkey,tval
  character(len=comment_length) :: tcomm
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  if (file%unit.eq.0) then
     call imbfits_message(seve%e,rname,'Input file not opened')
     error = .true.
     return
  endif
  !
  ! Allocations
  call reallocate_imbfits_data_val(nchan,npix,ntime,imbdata,error)
  if (error)  return
  !
  ! Get column number
  status = 0
  call ftgcno(file%unit,.false.,'DATA',colnum,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Error while searching for column ''DATA''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  ! Get corresponding TFORM
  tkey = 'TFORM'
  write(tkey(6:7),'(I0)')  colnum
  call ftgkys(file%unit,tkey,tval,tcomm,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    call imbfits_message(seve%e,rname,'Some error reading '''//trim(tkey)//'''')
    call cfitsio_message(status)
    error = .true.
    return
  endif
! ZZZ Some clever check here!
!   if (tval.ne.'E') then
!     write(mess,'(A,A,A,A,A)')  &
!       'Attempt to read column ',trim(key),' (type ',trim(tval),') in a real*4 array'
!     call imbfits_message(seve%w,rname,mess)
!   endif
  !
  nelem = nchan*npix*ntime
  anynull = .false.
  call ftgcve(file%unit,colnum,ftime,1,nelem,-1.e0,imbdata%val,anynull,status)
  if (anynull .or. status.gt.0) then
    call imbfits_message(seve%e,caller,'Error')
    write(mess,'(A,I0,A,I0)')  &
      'Error while reading column #',colnum,' (DATA), time row #',ftime
    call imbfits_message(seve%e,rname,mess)
    if (anynull) then
      call imbfits_message(seve%e,rname,'Some null values found')
    else
      call cfitsio_message(status)
      call ftrprt('STDOUT',status)  ! Much verbose for debugging
    endif
    error = .true.
    return
  endif
  !
  ! Weight (1D array, shared by all time dumps and pixels)
  imbdata%wei(:) = 1.
  !
end subroutine imbfits_read_data
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Making routines (1D)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine imbfits_make_inte_1d(key,n,comment,inte,error)
  use gbl_message
  use imbfits_interfaces, except_this=>imbfits_make_inte_1d
  use imbfits_types
  !-------------------------------------------------------------------
  ! @ private-generic imbfits_make_column
  ! Allocate and fill a column with continuous numbering.
  !-------------------------------------------------------------------
  character(len=*),     intent(in)    :: key
  integer(kind=4),      intent(in)    :: n
  character(len=*),     intent(in)    :: comment
  type(fits_inte_1d_t), intent(inout) :: inte    ! INOUT: keep allocation status
  logical,              intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='IMBFITS>MAKE>INTE>1D'
  integer(kind=4) :: i
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  call reallocate_fits_inte_1d(key,n,inte,error)
  if (error)  return
  inte%comment = comment
  !
  do i=1,n
    inte%val(i) = i
  enddo
  !
end subroutine imbfits_make_inte_1d
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Compression routines (1D)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine imbfits_compress_inte_1d(inte,flag,nnew,buf,error)
  use imbfits_interfaces, except_this=>imbfits_compress_inte_1d
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ private-generic imbfits_compress_column
  ! Compress the column according to the flag array. Assume the column,
  ! the flag array, and the buffer have a consistent size.
  !---------------------------------------------------------------------
  type(fits_inte_1d_t), intent(inout) :: inte     !
  logical,              intent(in)    :: flag(:)  !
  integer(kind=4),      intent(in)    :: nnew     ! Number of .true. flag values
  integer(kind=4)                     :: buf(:)   ! Working buffer
  logical,              intent(inout) :: error    ! Logical error flag
  ! Local
  integer(kind=4) :: nold,iold,inew
  !
  ! Save previous values
  nold = inte%n
  buf(1:nold) = inte%val(1:nold)
  !
  call reallocate_fits_inte_1d(inte%key,nnew,inte,error)
  if (error)  return
  write(inte%comment,'(A,I0,A)')  &
    'WARNING! ',nold-nnew,' values removed because of ISWITCH'
  !
  inew = 0
  do iold=1,nold
    if (.not.flag(iold))  cycle
    inew = inew+1
    inte%val(inew) = buf(iold)
  enddo
  !
end subroutine imbfits_compress_inte_1d
!
subroutine imbfits_compress_dble_1d(dble,flag,nnew,buf,error)
  use imbfits_interfaces, except_this=>imbfits_compress_dble_1d
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ private-generic imbfits_compress_column
  ! Compress the column according to the flag array. Assume the column,
  ! the flag array, and the buffer have a consistent size.
  !---------------------------------------------------------------------
  type(fits_dble_1d_t), intent(inout) :: dble     !
  logical,              intent(in)    :: flag(:)  !
  integer(kind=4),      intent(in)    :: nnew     ! Number of .true. flag values
  real(kind=8)                        :: buf(:)   ! Working buffer
  logical,              intent(inout) :: error    ! Logical error flag
  ! Local
  integer(kind=4) :: nold,iold,inew
  !
  ! Save previous values
  nold = dble%n
  buf(1:nold) = dble%val(1:nold)
  !
  call reallocate_fits_dble_1d(dble%key,nnew,dble,error)
  if (error)  return
  write(dble%comment,'(A,I0,A)')  &
    'WARNING! ',nold-nnew,' values removed because of ISWITCH'
  !
  inew = 0
  do iold=1,nold
    if (.not.flag(iold))  cycle
    inew = inew+1
    dble%val(inew) = buf(iold)
  enddo
  !
end subroutine imbfits_compress_dble_1d
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Deallocation routines (1D)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine imbfits_free_logi_1d(logi,error)
  use gbl_message
  use imbfits_interfaces, except_this => imbfits_free_logi_1d
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_free_column
  !---------------------------------------------------------------------
  type(fits_logi_1d_t), intent(inout) :: logi    ! INOUT: keep allocation status
  logical,              intent(inout) :: error
  !
  call free_fits_logi_1d(logi,error)
  if (error)  return
  !
end subroutine imbfits_free_logi_1d
!
subroutine imbfits_free_inte_1d(inte,error)
  use gbl_message
  use imbfits_interfaces, except_this => imbfits_free_inte_1d
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_free_column
  !---------------------------------------------------------------------
  type(fits_inte_1d_t), intent(inout) :: inte    ! INOUT: keep allocation status
  logical,              intent(inout) :: error
  !
  call free_fits_inte_1d(inte,error)
  if (error)  return
  !
end subroutine imbfits_free_inte_1d
!
subroutine imbfits_free_real_1d(real,error)
  use gbl_message
  use imbfits_interfaces, except_this => imbfits_free_real_1d
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_free_column
  !---------------------------------------------------------------------
  type(fits_real_1d_t), intent(inout) :: real    ! INOUT: keep allocation status
  logical,              intent(inout) :: error
  !
  call free_fits_real_1d(real,error)
  if (error)  return
  !
end subroutine imbfits_free_real_1d
!
subroutine imbfits_free_dble_1d(dble,error)
  use gbl_message
  use imbfits_interfaces, except_this => imbfits_free_dble_1d
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_free_column
  !---------------------------------------------------------------------
  type(fits_dble_1d_t), intent(inout) :: dble    ! INOUT: keep allocation status
  logical,              intent(inout) :: error
  !
  call free_fits_dble_1d(dble,error)
  if (error)  return
  !
end subroutine imbfits_free_dble_1d
!
subroutine imbfits_free_char_1d(char,error)
  use gbl_message
  use imbfits_interfaces, except_this => imbfits_free_char_1d
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_free_column
  !---------------------------------------------------------------------
  type(fits_char_1d_t), intent(inout) :: char    ! INOUT: keep allocation status
  logical,              intent(inout) :: error
  !
  call free_fits_char_1d(char,error)
  if (error)  return
  !
end subroutine imbfits_free_char_1d
!
subroutine imbfits_free_data(imbdata,error)
  use imbfits_interfaces, except_this=>imbfits_free_data
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ public
  ! Freeing subroutine specific to the 'DATA' column
  !---------------------------------------------------------------------
  type(imbfits_data_t), intent(inout) :: imbdata  !
  logical,              intent(inout) :: error    !
  !
  call free_imbfits_data_val(imbdata,error)
  if (error)  return
  !
end subroutine imbfits_free_data
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Dumping routines (0D)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine imbfits_dump_dble_0d(dble,olun,error)
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_dump_dble_0d
  !---------------------------------------------------------------------
  ! @ private-generic imbfits_dump_key
  !---------------------------------------------------------------------
  type(fits_dble_0d_t), intent(in)    :: dble
  integer(kind=4),      intent(in)    :: olun   ! Output LUN
  logical,              intent(inout) :: error
  ! Local
  character(len=key_length) :: key
  !
  key = dble%key
  call sic_upper(key)
  write(olun,100) key,dble%val,trim(dble%comment)
  !
100 format(A8,' (R8) = ',1PG22.15,' / ',A)
end subroutine imbfits_dump_dble_0d
!
subroutine imbfits_dump_inte_0d(inte,olun,error)
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_dump_inte_0d
  !---------------------------------------------------------------------
  ! @ private-generic imbfits_dump_key
  !---------------------------------------------------------------------
  type(fits_inte_0d_t), intent(in)    :: inte
  integer(kind=4),      intent(in)    :: olun   ! Output LUN
  logical,              intent(inout) :: error
  ! Local
  character(len=key_length) :: key
  !
  key = inte%key
  call sic_upper(key)
  write(olun,100) key,inte%val,trim(inte%comment)
  !
100 format(A8,' (I4) = ',I22,' / ',A)
end subroutine imbfits_dump_inte_0d
!
subroutine imbfits_dump_logi_0d(logi,olun,error)
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_dump_logi_0d
  !---------------------------------------------------------------------
  ! @ private-generic imbfits_dump_key
  !---------------------------------------------------------------------
  type(fits_logi_0d_t), intent(in)    :: logi
  integer(kind=4),      intent(in)    :: olun   ! Output LUN
  logical,              intent(inout) :: error
  ! Local
  character(len=key_length) :: key
  !
  key = logi%key
  call sic_upper(key)
  write(olun,100) key,logi%val,trim(logi%comment)
  !
100 format(A8,' (L)  = ',L22,' / ',A)
end subroutine imbfits_dump_logi_0d
!
subroutine imbfits_dump_char_0d(char,olun,error)
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_dump_char_0d
  !---------------------------------------------------------------------
  ! @ private-generic imbfits_dump_key
  !---------------------------------------------------------------------
  type(fits_char_0d_t), intent(in)    :: char
  integer(kind=4),      intent(in)    :: olun   ! Output LUN
  logical,              intent(inout) :: error
  ! Local
  character(len=key_length) :: key
  !
  key = char%key
  call sic_upper(key)
  write(olun,100) key,char%val,trim(char%comment)
  !
100 format(A8,' (C)  = ',A22,' / ',A)
end subroutine imbfits_dump_char_0d
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Dumping routines (1D)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine imbfits_dump_inte_1d(inte,olun,error,full)
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_dump_inte_1d
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_dump_column
  !---------------------------------------------------------------------
  type(fits_inte_1d_t), intent(in)    :: inte
  integer(kind=4),      intent(in)    :: olun   ! Output LUN
  logical,              intent(inout) :: error
  logical, optional,    intent(in)    :: full   ! Full output (all values)?
  ! Local
  character(len=key_length) :: key
  logical :: dofull
  !
  if (present(full)) then
    dofull = full
  else
    dofull = .false.
  endif
  key = inte%key
  call sic_upper(key)
  if (.not.associated(inte%val)) then
    write(olun,100)  key,trim(inte%comment)
  elseif (dofull) then
    write(olun,'(4A,I0)')  &
      trim(key),' (',trim(inte%comment),') is an integer column of dimensions ',inte%n
    call i4_type(inte%n,inte%val)
  elseif (inte%n.ge.3) then
    write(olun,103)  key,inte%val(1),inte%val(inte%n),trim(inte%comment)
  elseif (inte%n.eq.2) then
    write(olun,102)  key,inte%val(1:2),trim(inte%comment)
  else  ! 1 value
    write(olun,101)  key,inte%val(1),trim(inte%comment)
  endif
  !
100 format(A8,' (I4) = NO DATA ASSOCIATED!',              T64,'/ ',A)
101 format(A8,' (I4) =',1(1X,I14),                        T64,'/ ',A)
102 format(A8,' (I4) =',2(1X,I14),                        T64,'/ ',A)
103 format(A8,' (I4) =',1(1X,I14),'      ...     ',1X,I14,T64,'/ ',A)
end subroutine imbfits_dump_inte_1d
!
subroutine imbfits_dump_real_1d(real,olun,error,full)
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_dump_real_1d
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_dump_column
  !---------------------------------------------------------------------
  type(fits_real_1d_t), intent(in)    :: real
  integer(kind=4),      intent(in)    :: olun   ! Output LUN
  logical,              intent(inout) :: error
  logical, optional,    intent(in)    :: full   ! Full output (all values)?
  ! Local
  character(len=key_length) :: key
  logical :: dofull
  !
  if (present(full)) then
    dofull = full
  else
    dofull = .false.
  endif
  key = real%key
  call sic_upper(key)
  if (.not.associated(real%val)) then
    write(olun,100)  key,trim(real%comment)
  elseif (dofull) then
    write(olun,'(4A,I0)')  &
      trim(key),' (',trim(real%comment),') is a real column of dimensions ',real%n
    call r4_type(real%n,real%val)
  elseif (real%n.ge.3) then
    write(olun,103)  key,real%val(1),real%val(real%n),trim(real%comment)
  elseif (real%n.eq.2) then
    write(olun,102)  key,real%val(1:2),trim(real%comment)
  else
    write(olun,101)  key,real%val(1),trim(real%comment)
  endif
  !
  ! Single precision floats: precision is 7.22 decimal digits
100 format(A8,' (R4) = NO DATA ASSOCIATED!',                         T64,'/ ',A)
101 format(A8,' (R4) =',1(1X,1PG14.7),                               T64,'/ ',A)
102 format(A8,' (R4) =',2(1X,1PG14.7),                               T64,'/ ',A)
103 format(A8,' (R4) =',1(1X,1PG14.7),'      ...     ',1(1X,1PG14.7),T64,'/ ',A)
end subroutine imbfits_dump_real_1d
!
subroutine imbfits_dump_dble_1d(dble,olun,error,full)
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_dump_dble_1d
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_dump_column
  !---------------------------------------------------------------------
  type(fits_dble_1d_t), intent(in)    :: dble
  integer(kind=4),      intent(in)    :: olun   ! Output LUN
  logical,              intent(inout) :: error
  logical, optional,    intent(in)    :: full   ! Full output (all values)?
  ! Local
  character(len=key_length) :: key
  logical :: dofull
  !
  if (present(full)) then
    dofull = full
  else
    dofull = .false.
  endif
  key = dble%key
  call sic_upper(key)
  if (.not.associated(dble%val)) then
    write(olun,100)  key,trim(dble%comment)
  elseif (dofull) then
    write(olun,'(4A,I0)')  &
      trim(key),' (',trim(dble%comment),') is a double column of dimensions ',dble%n
    call r8_type(dble%n,dble%val)
  elseif (dble%n.ge.3) then
    write(olun,103)  key,dble%val(1),dble%val(dble%n),trim(dble%comment)
  elseif (dble%n.eq.2) then
    write(olun,102)  key,dble%val(1:2),trim(dble%comment)
  else
    write(olun,101)  key,dble%val(1),trim(dble%comment)
  endif
  !
  ! Double precision floats: precision is 15.95 decimal digits (using
  ! more than 15 digits can make appear roundoff problems because of
  ! precision is not exactly 16).
100 format(A8,' (R8) = NO DATA ASSOCIATED!',                  T64,'/ ',A)
101 format(A8,' (R8) =',1(1X,1PG22.15),                       T64,'/ ',A)
102 format(A8,' (R8) =',2(1X,1PG22.15),                       T64,'/ ',A)
103 format(A8,' (R8) =',1(1X,1PG22.15),' ... ',1(1X,1PG22.15),T64,'/ ',A)
end subroutine imbfits_dump_dble_1d
!
subroutine imbfits_dump_char_1d(char,olun,error,full)
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_dump_char_1d
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_dump_column
  !---------------------------------------------------------------------
  type(fits_char_1d_t), intent(in)    :: char
  integer(kind=4),      intent(in)    :: olun   ! Output LUN
  logical,              intent(inout) :: error
  logical, optional,    intent(in)    :: full   ! Full output (all values)?
  ! Local
  character(len=key_length) :: key
  logical :: dofull
  !
  if (present(full)) then
    dofull = full
  else
    dofull = .false.
  endif
  key = char%key
  call sic_upper(key)
  if (.not.associated(char%val)) then
    write(olun,100)  key,trim(char%comment)
  elseif (dofull) then
    write(olun,'(4A,I0,A,I0)')  &
      trim(key),' (',trim(char%comment),') is a character*',len(char%val(1)),' column of dimensions ',char%n
    call ch_type(char%n,char%val,len(char%val(1)))
  elseif (char%n.ge.3) then
    write(olun,103)  key,char%val(1),char%val(char%n),trim(char%comment)
  elseif (char%n.eq.2) then
    write(olun,102)  key,char%val(1:2),trim(char%comment)
  else
    write(olun,101)  key,char%val(1),trim(char%comment)
  endif
  !
100 format(A8,' (C)  = NO DATA ASSOCIATED!',                 T64,'/ ',A)
101 format(A8,' (C)  =',1(1X,A14),                           T64,'/ ',A)
102 format(A8,' (C)  =',2(1X,A14),                           T64,'/ ',A)
103 format(A8,' (C)  =',1(1X,A14),'      ...     ',1(1X,A14),T64,'/ ',A)
end subroutine imbfits_dump_char_1d
!
subroutine imbfits_dump_logi_1d(logi,olun,error,full)
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_dump_logi_1d
  !---------------------------------------------------------------------
  ! @ public-generic imbfits_dump_column
  !---------------------------------------------------------------------
  type(fits_logi_1d_t), intent(in)    :: logi
  integer(kind=4),      intent(in)    :: olun   ! Output LUN
  logical,              intent(inout) :: error
  logical, optional,    intent(in)    :: full   ! Full output (all values)?
  ! Local
  character(len=key_length) :: key
  logical :: dofull
  !
  if (present(full)) then
    dofull = full
  else
    dofull = .false.
  endif
  key = logi%key
  call sic_upper(key)
  if (.not.associated(logi%val)) then
    write(olun,100)  key,trim(logi%comment)
  elseif (dofull) then
    write(olun,'(4A,I0)')  &
      trim(key),' (',trim(logi%comment),') is a logical column of dimensions ',logi%n
    call l_type(logi%n,logi%val)
  elseif (logi%n.ge.3) then
    write(olun,103)  key,logi%val(1),logi%val(logi%n),trim(logi%comment)
  elseif (logi%n.eq.2) then
    write(olun,102)  key,logi%val(1:2),trim(logi%comment)
  else
    write(olun,101)  key,logi%val(1),trim(logi%comment)
  endif
  !
100 format(A8,' (L)  = NO DATA ASSOCIATED!',         T64,'/ ',A)
101 format(A8,' (L)  =',1(1X,L8),                    T64,'/ ',A)
102 format(A8,' (L)  =',2(1X,L8),                    T64,'/ ',A)
103 format(A8,' (L)  =',1(1X,L8),'   ...  ',1(1X,L8),T64,'/ ',A)
end subroutine imbfits_dump_logi_1d
!
subroutine imbfits_dump_imbfdata(imbf,olun,error)
  use gbl_message
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_dump_imbfdata
  use ram_sizes
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  type(imbfits_data_t), intent(in)    :: imbf
  integer(kind=4),      intent(in)    :: olun   ! Output LUN
  logical,              intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='IMBFITS>DUMP>IMBFDATA'
  !
  if (.not.associated(imbf%val)) then
    call imbfits_message(seve%e,rname,'No data associated')
    error = .true.
    return
  endif
  !
  write(olun,'(A,I8,A,F0.1,A)')  &
    '   ',imbf%nchan,' channels (',1.d0*imbf%nchan*bytes_per_real/kB,' kB)'
  write(olun,'(A,I8,A)')  &
    ' x ',imbf%npix,' pixel(s)'
  write(olun,'(A,I8,A)')  &
    ' x ',imbf%ntime,' time dumps'
  write(olun,'(A,I8,A,F0.1,A)')  &
    ' = ',size(imbf%val),' values (',1.d0*size(imbf%val)*bytes_per_real/MB,' MB)'
  !
end subroutine imbfits_dump_imbfdata
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine imbfits_hdus(file,hdus,error)
  use gbl_message
  use imbfits_types
  use imbfits_interfaces, except_this=>imbfits_hdus
  !---------------------------------------------------------------------
  ! @ private
  !  Set up the HDUs description which is used later on when we
  ! access the subscan HDUs.
  !---------------------------------------------------------------------
  type(imbfits_file_t), intent(in)    :: file
  type(imbfits_hdus_t), intent(out)   :: hdus
  logical,              intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='HDUS'
  type(fits_dble_0d_t) :: imbftsve
  type(fits_inte_0d_t) :: nsub
  !
  ! Get the IMB-FITS version
  call imbfits_mvhdu_pos(1,file,error)  ! Primary is always #1
  if (error)  return
  call imbfits_read_key(rname,file,'imbftsve',imbftsve,error)
  if (error) then
    call imbfits_message(seve%e,rname,'Not an IMB-FITS file?')
    return
  endif
  call imbfits_read_key(rname,file,'n_obsp',nsub,error)
  if (error)  return
  !
  ! Number of HDUs
  hdus%n = 0
  ! Computing NHDU with FTTHDU is highly unefficient => not available.
  ! call ftthdu(file%unit,hdus%n,status)
  ! if (status.gt.0) then
  !   call imbfits_message(seve%e,rname,'Could not find number of HDUs')
  !   call cfitsio_message(status)
  !   error = .true.
  !   return
  ! endif
  !
  if (imbftsve%val.gt.2.2099999d0) then  ! 2.21 and above
    ! For latest IMB-FITS, the structure has no possible latitude
    call imbfits_message(seve%w,rname,'IMB-FITS version 2.21 and above have experimental support')
    call imbfits_hdus_preset_2_21(file,nsub%val,hdus,error)
    if (error)  return
  elseif (imbftsve%val.gt.2.199999d0) then  ! 2.20
    ! For latest IMB-FITS, the structure has no possible latitude
    call imbfits_message(seve%w,rname,'IMB-FITS version 2.20 and above have experimental support')
    call imbfits_hdus_preset_2_20(file,nsub%val,hdus,error)
    if (error)  return
  elseif (imbftsve%val.ge.2.d0) then  ! 2.0 and above
    ! For latest IMB-FITS, the structure has no possible latitude
    call imbfits_hdus_preset_2_0(file,hdus,error)
    if (error)  return
  else  ! Below 2.0
    ! For old IMB-FITS, there are various case (e.g. HERA or not HERA, etc)
    ! Use the auto-detection engine
    call imbfits_hdus_autodetect(file,hdus,error)
    if (error)  return
  endif
  !
end subroutine imbfits_hdus
!
subroutine imbfits_hdus_preset_2_0(file,hdus,error)
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ private
  !  Set up the HDUs description which is used later on when we access
  ! the subscan HDUs. The description is forced to the IMB-FITS V2.0
  ! (included) up to V2.2 (excluded)
  !---------------------------------------------------------------------
  type(imbfits_file_t), intent(in)    :: file
  type(imbfits_hdus_t), intent(out)   :: hdus
  logical,              intent(inout) :: error
  !
  hdus%nlead = 4
  hdus%npersubscan = 3
  !
  ! Leading HDUs: absolute positions
  hdus%pos(:) = 0
  hdus%pos(hdu_scan)     = 1
  hdus%pos(hdu_frontend) = 2
  hdus%pos(hdu_backend)  = 3
  !
  ! Subscan HDUs: relative positions in subscan
  hdus%pos(hdu_backdata)     = 1
  hdus%pos(hdu_antslow)      = 2
  hdus%pos(hdu_antfast)      = 2
  hdus%pos(hdu_subreflector) = 3
  !
  ! Derot and/or cryostat were never written in this format.
  !
end subroutine imbfits_hdus_preset_2_0
!
subroutine imbfits_hdus_preset_2_20(file,nsub,hdus,error)
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ private
  !  Set up the HDUs description which is used later on when we access
  ! the subscan HDUs. The description is forced to the IMB-FITS V2.20
  ! (included)
  !---------------------------------------------------------------------
  type(imbfits_file_t), intent(in)    :: file   !
  integer(kind=4),      intent(in)    :: nsub   ! Number of subscans in file
  type(imbfits_hdus_t), intent(out)   :: hdus   !
  logical,              intent(inout) :: error  !
  !
  hdus%nlead = 4
  hdus%npersubscan = 3
  !
  ! Leading HDUs: absolute positions (NB: numering starts at 1 for Primary)
  hdus%pos(:) = 0
  hdus%pos(hdu_scan)     = 2
  hdus%pos(hdu_frontend) = 3
  hdus%pos(hdu_backend)  = 4
  !
  ! Subscan HDUs: relative positions in subscan
  hdus%pos(hdu_antslow)      = 1
  hdus%pos(hdu_antfast)      = 1
  hdus%pos(hdu_subreflector) = 2
  hdus%pos(hdu_backdata)     = 3
  !
  ! If present, cryot assumed to be found at right after the subscans
  !
  ! If present, derot assumed to be found at right after cryot
  hdus%pos(hdu_derot) = hdus%nlead + hdus%npersubscan*nsub + 2
  !
end subroutine imbfits_hdus_preset_2_20
!
subroutine imbfits_hdus_preset_2_21(file,nsub,hdus,error)
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ private
  !  Set up the HDUs description which is used later on when we access
  ! the subscan HDUs. The description is forced to the IMB-FITS V2.21
  ! (included)
  !---------------------------------------------------------------------
  type(imbfits_file_t), intent(in)    :: file   !
  integer(kind=4),      intent(in)    :: nsub   ! Number of subscans in file
  type(imbfits_hdus_t), intent(out)   :: hdus   !
  logical,              intent(inout) :: error  !
  !
  hdus%nlead = 6
  hdus%npersubscan = 3
  !
  ! Leading HDUs: absolute positions (NB: numering starts at 1 for Primary)
  hdus%pos(:) = 0
  hdus%pos(hdu_scan)     = 2
  hdus%pos(hdu_frontend) = 3
  hdus%pos(hdu_backend)  = 4
! hdus%pos(hdu_cryot)    = 5
  hdus%pos(hdu_derot)    = 6
  !
  ! Subscan HDUs: relative positions in subscan
  hdus%pos(hdu_antslow)      = 1
  hdus%pos(hdu_antfast)      = 1
  hdus%pos(hdu_subreflector) = 2
  hdus%pos(hdu_backdata)     = 3
  !
end subroutine imbfits_hdus_preset_2_21
!
subroutine imbfits_hdus_autodetect(file,hdus,error)
  use imbfits_types
  use imbfits_interfaces, except_this=>imbfits_hdus_autodetect
  !---------------------------------------------------------------------
  ! @ private
  !  Analyse the (first) HDUs in the FITS file in order to guess:
  !   - the number of "leading" HDUs (i.e. the ones which are present
  !     only once at the beginning)
  !   - the number of HDUs per subscan
  !   - the order of the HDUs
  !  There is a slight cost because we open several HDUs.
  !---------------------------------------------------------------------
  type(imbfits_file_t), intent(in)    :: file
  type(imbfits_hdus_t), intent(out)   :: hdus
  logical,              intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='HDUS>AUTODETECT'
  integer(kind=4) :: ihdu
  type(fits_char_0d_t) :: extname
  logical :: first
  !
  hdus%pos(:) = 0
  hdus%nlead = 0
  hdus%npersubscan = 0
  !
  ihdu = 1
  do
    ! Next HDU (NB: numbering starts at 1, we skip the Primary)
    ihdu = ihdu+1
    !
    ! Move to the HDU
    call imbfits_mvhdu_pos(ihdu,file,error)
    if (error) then
      ! We can have a "read past end of file" if the number of subscan is 0 or 1
      ! If Nsub is 0, the following has no meaning but anyway Mrtcal will not
      ! attempt to read a subscan HDU
      ! If Nsub is 1, the following should be correct, and anyway not really
      ! important for a single subscan (see where it is used).
      hdus%npersubscan = ihdu-hdus%nlead-1
      ! ZZZ we could think having a non-verbose mode in imbfits_mvhdu_pos.
    endif
    ! Get its name
    call imbfits_read_key(rname,file,'extname',extname,error)
    if (error) return
    !
    first = .true.  ! This will skip the HDUs we do not (want to) recognize
    ! Leading HDUs
    if (extname%val.eq.'IMBF-scan') then
      call leadinghdu(ihdu,hdu_scan,first)
    elseif (extname%val.eq.'IMBF-frontend') then
      call leadinghdu(ihdu,hdu_frontend,first)
    elseif (extname%val.eq.'IMBF-backend') then  ! Full name search
      call leadinghdu(ihdu,hdu_backend,first)
    !
    ! Subscan HDUs
    elseif (extname%val(1:12).eq.'IMBF-backend') then  ! Substring search e.g. IMBF-backendVESPA
      call subscanhdu(ihdu,hdu_backdata,first)
    elseif (extname%val.eq.'IMBF-antenna') then
      call subscanhdu(ihdu,hdu_antslow,first)
      call subscanhdu(ihdu,hdu_antfast,first)
    elseif (extname%val.eq.'IMBF-subreflector') then
      call subscanhdu(ihdu,hdu_subreflector,first)
    elseif (extname%val.eq.'IMBF-hera-derot') then  ! We could search only for 'derot'
      call subscanhdu(ihdu,hdu_derot,first)
    endif
    !
    if (.not.first) then
      ! This means we reached the 2nd subscan
      hdus%npersubscan = ihdu-hdus%nlead-1
      exit
    endif
    !
  enddo
  !
contains
  subroutine leadinghdu(ihdu,kind,first)
    integer(kind=4), intent(in)  :: ihdu,kind
    logical,         intent(out) :: first
    !
    first = hdus%pos(kind).eq.0  ! Should never be .false. for a leading HDU
    if (first)  hdus%pos(kind) = ihdu
  end subroutine leadinghdu
  !
  subroutine subscanhdu(ihdu,kind,first)
    integer(kind=4), intent(in)  :: ihdu,kind
    logical,         intent(out) :: first
    !
    if (hdus%nlead.eq.0)  hdus%nlead = ihdu-1
    first = hdus%pos(kind).eq.0
    if (first)  hdus%pos(kind) = ihdu-hdus%nlead
  end subroutine subscanhdu
  !
end subroutine imbfits_hdus_autodetect
!
subroutine imbfits_mvhdu_name(key,file,error)
  use gbl_message
  use cfitsio_api
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_mvhdu_name
  !---------------------------------------------------------------------
  ! @ private
  ! Move to the ***first*** HDU with the given name
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: key
  type(imbfits_file_t), intent(in)    :: file
  logical,              intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='IMBFITS>MVHDU>NAME'
  ! character(len=message_length) :: mess
  integer(kind=4) :: status
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  ! Sanity check
  if (file%unit.eq.0) then
    call imbfits_message(seve%e,rname,'No file connected to unit')
    error = .true.
    return
  endif
  !
  status = 0
  call ftmnhd(file%unit,code_cfitsio_binary_tbl,key,0,status)
  if (status.gt.0) then
    call imbfits_message(seve%e,rname,'Error while moving to HDU '//key)
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  ! write(mess,'(A,A,A)')  'Moved to HDU ''',trim(key),''''
  ! call imbfits_message(seve%i,rname,mess)
  !
end subroutine imbfits_mvhdu_name
!
subroutine imbfits_mvhdu_subscan(isub,hduid,imbf,error)
  use imbfits_interfaces, except_this => imbfits_mvhdu_subscan
  use imbfits_messaging
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ public
  ! Move to appropriate HDU for the isub-th subscan
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: isub   ! Subscan number
  integer(kind=4), intent(in)    :: hduid  ! HDU identifier
  type(imbfits_t), intent(in)    :: imbf   !
  logical,         intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='IMBFITS>MVHDU>SUBSCAN'
  integer(kind=4) :: ihdu
  character(len=message_length) :: mess
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
  if (isub.le.0 .or. isub.gt.imbf%primary%n_obs%val) then
    write(mess,'(A,I0,A,I0,A)')  &
      'No subscan #',isub,' (file has only ',imbf%primary%n_obs%val,' subscans)'
    call imbfits_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  if (imbf%hdus%pos(hduid).eq.0) then
    call imbfits_message(seve%e,rname,'HDU position not known')
    error = .true.
    return
  endif
  !
  select case (hduid)
  case (hdu_scan,hdu_frontend,hdu_backend)  ! Leading HDUs
    ! This is not a subroutine for those HDUs (but we could enable this anyway)
    call imbfits_message(seve%e,rname,'Incorrect HDU identifier')
    error = .true.
    return
  case (hdu_backdata,hdu_antslow,hdu_antfast,hdu_subreflector,hdu_derot)  ! Subscan HDUs
    ihdu = imbf%hdus%nlead + (isub-1)*imbf%hdus%npersubscan + imbf%hdus%pos(hduid)
  case default
    call imbfits_message(seve%e,rname,'HDU kind not implemented')
    error = .true.
    return
  end select
  !
  write(mess,'(A,I0,A,I0,A,I0,A)')  &
    'Moving to subscan #',isub,', HDU id: ',hduid,' (#',ihdu,')'
  call imbfits_message(iseve%other,rname,mess)
  call imbfits_mvhdu_pos(ihdu,imbf%file,error)
  if (error)  return
  !
end subroutine imbfits_mvhdu_subscan
!
subroutine imbfits_mvhdu_pos(ihdu,file,error)
  use gbl_message
  use cfitsio_api
  use imbfits_types
  use imbfits_interfaces, except_this => imbfits_mvhdu_pos
  !---------------------------------------------------------------------
  ! @ private
  ! Move to the HDU with the given absolute position
  !---------------------------------------------------------------------
  integer(kind=4),      intent(in)    :: ihdu
  type(imbfits_file_t), intent(in)    :: file
  logical,              intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='IMBFITS>MVHDU>POS'
  character(len=message_length) :: mess
  integer(kind=4) :: status,hdutype
  !
  call imbfits_message(seve%t,rname,'Welcome')
  !
! Computing NHDU with FTTHDU is highly unefficient => not available.
!   if (ihdu.gt.file%nhdu) then
!     write(mess,'(A,I0,A,I0,A)')  &
!       'IMBFITS file has only ',file%nhdu,' HDUs (requested ',ihdu,')'
!     call imbfits_message(seve%e,rname,mess)
!     error = .true.
!     return
!   endif
  !
  ! Sanity check
  if (file%unit.eq.0) then
    call imbfits_message(seve%e,rname,'No file connected to unit')
    error = .true.
    return
  endif
  !
  status = 0
  call ftmahd(file%unit,ihdu,hdutype,status)
  if (status.gt.0) then
    write(mess,'(A,I0)')  'Error while moving to HDU #',ihdu
    call imbfits_message(seve%e,rname,mess)
    call cfitsio_message(status)
    error = .true.
    return
  endif
  !
  ! write(mess,'(A,I0)')  'Moved to HDU #',ihdu
  ! call imbfits_message(seve%i,rname,mess)
  !
end subroutine imbfits_mvhdu_pos
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine cfitsio_message(status)
  use cfitsio_api
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! Print the CFITSIO error message given the error status. Should
  ! probably be public.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: status
  ! Local
  character(len=*), parameter :: rname='CFITSIO'
  character(len=message_length) :: mess
  !
  call ftgerr(status,mess)
  !
  if (status.eq.0) then
    call imbfits_message(seve%i,rname,mess)
  else
    call imbfits_message(seve%e,rname,mess)
  endif
  !
end subroutine cfitsio_message
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine imbfits_resample_header_backend(in,owidth,out,error)
  use imbfits_interfaces, except_this=>imbfits_resample_header_backend
  use imbfits_messaging
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ private
  !  Resample a backend table, by splitting each chunk into several
  ! "sub-chunks". Cut at best in the USED channels at almost equal
  ! width.
  !---------------------------------------------------------------------
  type(imbfits_back_t),  intent(in)    :: in
  real(kind=4),          intent(in)    :: owidth   ! Desired cal. bandwidth [MHz]
  type(imbfits_back_t),  intent(inout) :: out
  logical,               intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='RESAMPLE>HEADER>BACKEND'
  integer(kind=4) :: nsub(in%head%desc%naxis2%val)  ! Number of divisions for each chunk
  integer(kind=4) :: nline2,iin,iout,isub,used,usedtot,nchanshift
  character(len=message_length) :: mess
  real(kind=4) :: iwidth,ispacing,awidth
  !
  !-----------
  ! Divisions
  ! Do not assume each chunk has same width, must loop on all of them
  do iin=1,in%head%desc%naxis2%val
    ispacing = abs(in%table%spacing%val(iin))  ! 1 channel
    iwidth = in%table%used%val(iin)*ispacing   ! USED channels
    if (owidth.gt.iwidth) then
      write(mess,'(A,2(F0.2,A))')  'Desired calibration bandwidth (',owidth,  &
        ' MHz) is larger than native bandwidth (',iwidth,' MHz) in USED channels'
      call imbfits_message(iseve%other,rname,mess)
      nsub(iin) = 1
    elseif (owidth.lt.ispacing) then
      ! Note that this happens every time with BBC = single 8000 MHz channel
      write(mess,'(A,2(F0.2,A))')  'Desired calibration bandwidth (',owidth,  &
        ' MHz) is lower than channel spacing (',ispacing,' MHz)'
      call imbfits_message(iseve%other,rname,mess)
      nsub(iin) = in%table%used%val(iin)
    else
      nsub(iin) = nint(iwidth/owidth)
    endif
  enddo
  !
  if (in%head%desc%naxis2%val.le.0) then
    ! This happens in case of empty IMBF-backend table (0 rows).
    call imbfits_message(iseve%other,rname,'IMBF-Backend tables are 0 sized')
    awidth = 0.
  else
    ! Some feedback for the time being (print last chunk division)
    awidth = iwidth/nsub(in%head%desc%naxis2%val)  ! Actual width
    write(mess,'(A,F0.1,A,I0,A)')  &
      'IMBF-Backend tables sliced to ',awidth,  &
      ' MHz (',nsub(in%head%desc%naxis2%val),' subdivisions)'
    call imbfits_message(iseve%other,rname,mess)
  endif
  !
  !--------
  ! Header
  ! Everything identical...
  out%head = in%head
  ! ... except one:
  out%head%desc%naxis2%val = sum(nsub)
  !
  !--------
  ! Tables
  !
  ! (Re)allocations:
  nline2 = out%head%desc%naxis2%val
  call reallocate_fits_inte_1d(in%table%part%key,nline2,out%table%part,error)
  if (error)  return
  call reallocate_fits_inte_1d(in%table%refchan%key,nline2,out%table%refchan,error)
  if (error)  return
  call reallocate_fits_inte_1d(in%table%chans%key,nline2,out%table%chans,error)
  if (error)  return
  call reallocate_fits_inte_1d(in%table%dropped%key,nline2,out%table%dropped,error)
  if (error)  return
  call reallocate_fits_inte_1d(in%table%used%key,nline2,out%table%used,error)
  if (error)  return
  call reallocate_fits_inte_1d(in%table%pixel%key,nline2,out%table%pixel,error)
  if (error)  return
  call reallocate_fits_char_1d(in%table%receiver%key,nline2,out%table%receiver,error)
  if (error)  return
  call reallocate_fits_inte_1d(in%table%ifront%key,nline2,out%table%ifront,error)
  if (error)  return
  call reallocate_fits_char_1d(in%table%band%key,nline2,out%table%band,error)
  if (error)  return
  call reallocate_fits_char_1d(in%table%frontend%key,nline2,out%table%frontend,error)
  if (error)  return
  call reallocate_fits_char_1d(in%table%polar%key,nline2,out%table%polar,error)
  if (error)  return
  call reallocate_fits_real_1d(in%table%reffreq%key,nline2,out%table%reffreq,error)
  if (error)  return
  call reallocate_fits_real_1d(in%table%spacing%key,nline2,out%table%spacing,error)
  if (error)  return
  call reallocate_fits_char_1d(in%table%linename%key,nline2,out%table%linename,error)
  if (error)  return
  call reallocate_fits_logi_1d(in%table%dataflip%key,nline2,out%table%dataflip,error)
  if (error)  return
  !
  ! Resampling:
  iout = 0
  do iin=1,in%head%desc%naxis2%val
    ! Split each line into Nsub(iin) "sub-chunks":
    usedtot = 0
    nchanshift = in%table%dropped%val(iin)
    do isub=1,nsub(iin)
      iout = iout+1
      !
      ! Easy ones (unchanged)
      out%table%part%val(iout)     = in%table%part%val(iin)
      out%table%pixel%val(iout)    = in%table%pixel%val(iin)
      out%table%receiver%val(iout) = in%table%receiver%val(iin)
      out%table%ifront%val(iout)   = in%table%ifront%val(iin)
      out%table%band%val(iout)     = in%table%band%val(iin)
      out%table%frontend%val(iout) = in%table%frontend%val(iin)
      out%table%polar%val(iout)    = in%table%polar%val(iin)
      out%table%spacing%val(iout)  = in%table%spacing%val(iin)
      out%table%linename%val(iout) = in%table%linename%val(iin)
      out%table%dataflip%val(iout) = in%table%dataflip%val(iin)
      !
      ! More complicated: frequency axis. Build new chunks with USED channels
      ! only, no DROPPED at the edges.
      !
      ! USED: example 20 channels divided in 6
      ! - Naive code would give equal length like this:
      !     3+3+3+3+3+3 = 18 channels (loose or add channels!)
      ! - Less naive would fix this in the last:
      !     3+3+3+3+3+5 = 20 channels (can end with very inegal division)
      ! - Following code does:
      !     3+4+3+3+4+3 = 20 channels (better alignment of the integer grid
      !       onto the floating point grid, + at most 1 channel difference)
      used = nint(real(isub*in%table%used%val(iin),kind=8)/nsub(iin) - usedtot)
      out%table%used%val(iout) = used
      !
      out%table%dropped%val(iout) = 0
      !
      out%table%chans%val(iout) = used
      !
      out%table%refchan%val(iout) = in%table%refchan%val(iin)+nchanshift
      !
      ! Shift REFFREQ by nchanshift, but be careful not to introduce roundoff
      ! errors (=> use double precision computations)
      out%table%reffreq%val(iout) = real(in%table%reffreq%val(iin),kind=8) +  &
        nchanshift*real(in%table%spacing%val(iin),kind=8)
      !
      ! For next sub-chunk:
      nchanshift = nchanshift+used
      usedtot = usedtot+used
    enddo
    !
    ! Safe-guard: ensure we do not loose or add USEful channels:
    if (usedtot.ne.in%table%used%val(iin)) then
      write(mess,'(A,I0,A,I0,A)')  'Error splitting the USED channels (got ',  &
        usedtot,', expected ',in%table%used%val(iin),')'
      call imbfits_message(seve%e,rname,mess)
      error = .true.
      return
    endif
  enddo
  !
  ! Add a comment in CHANS column (should be done in all columns actually...)
  write(out%table%chans%comment,'(A,F0.1,A)')  &
    'WARNING! Chunks were sliced by pieces of ',awidth,' MHz'
  !
end subroutine imbfits_resample_header_backend
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine imbfits_copy_back_chunks(ichunks,ochunks,error)
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  type(imbfits_back_chunks_t), intent(in)    :: ichunks
  type(imbfits_back_chunks_t), intent(inout) :: ochunks
  logical,                     intent(inout) :: error
  !
  call reallocate_eclass_2inte2char(ochunks%eclass,ichunks%eclass%nval,error)
  if (error)  return
  ochunks%eclass%nval = ichunks%eclass%nval
  ochunks%eclass%nequ = ichunks%eclass%nequ
  ochunks%eclass%val1 = ichunks%eclass%val1
  ochunks%eclass%val2 = ichunks%eclass%val2
  ochunks%eclass%val3 = ichunks%eclass%val3
  ochunks%eclass%val4 = ichunks%eclass%val4
  ochunks%eclass%cnt  = ichunks%eclass%cnt
  ochunks%eclass%bak  = ichunks%eclass%bak
  !
  if (allocated(ochunks%used))  deallocate(ochunks%used)
  allocate(ochunks%used(size(ichunks%used)))
  ochunks%used(:) = ichunks%used(:)
  !
  if (allocated(ochunks%kind))  deallocate(ochunks%kind)
  allocate(ochunks%kind(size(ichunks%kind)))
  ochunks%kind(:) = ichunks%kind(:)
  !
end subroutine imbfits_copy_back_chunks
!
subroutine imbfits_free_back_chunks(chunks,error)
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  type(imbfits_back_chunks_t), intent(inout) :: chunks
  logical,                     intent(inout) :: error
  !
  if (allocated(chunks%used))  deallocate(chunks%used)
  if (allocated(chunks%kind))  deallocate(chunks%kind)
  call free_eclass_2inte2char(chunks%eclass,error)
  !
end subroutine imbfits_free_back_chunks
!
subroutine imbfits_init_stokesloop(book,error)
  use gbl_message
  use imbfits_types
  use imbfits_interfaces, except_this=>imbfits_init_stokesloop
  !---------------------------------------------------------------------
  ! @ public
  !  Initialize the stokesset_book_t for later use by
  ! imbfits_get_next_stokesset
  !---------------------------------------------------------------------
  type(stokesset_book_t), intent(inout) :: book
  logical,                intent(inout) :: error
  !
  book%next = 1
  !
end subroutine imbfits_init_stokesloop
!
subroutine imbfits_get_next_stokesset(cdesc,book,error)
  use gbl_message
  use imbfits_types
  use imbfits_interfaces, except_this=>imbfits_get_next_stokesset
  !---------------------------------------------------------------------
  ! @ public
  !  Get the next stokeset. As of today a stokeset can be:
  !  - A unique NONE chunkset (no polarimetry)
  !  - A collection AXISH+AXISV+REAL+IMAG (polarimetric chunksets)
  !---------------------------------------------------------------------
  type(imbfits_back_chunks_t), intent(in)    :: cdesc  ! Chunks description
  type(stokesset_book_t),      intent(inout) :: book   !
  logical,                     intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='IMBFITS>GET>NEXT>STOKESSET'
  integer(kind=4) :: iequ,istokes
  ! logical :: found(mstokes)
  !
  book%found = .false.
  book%nstokes = 0
  ! found(:) = .false.
  !
  ! ZZZ Should trap N inserted at bad place e.g. H V N R I
  ! ZZZ Should trap incorrect sequence e.g. H V H V R I
  ! ZZZ Do we want to reorder the chunksets found in the stokesset?
  do iequ=book%next,cdesc%eclass%nequ
    istokes = cdesc%kind(iequ)
    book%nstokes = book%nstokes+1
    book%kind(book%nstokes) = istokes
    book%iset(book%nstokes) = iequ
    book%next = iequ+1
    !
    select case (istokes)
    case (code_n)
      book%found = .true.
      return  ! NONE is returned alone
      !
    case (code_h,code_v,code_r,code_i)
      book%found = book%nstokes.eq.mstokes
      if (book%found)  return
      !
    case default
      call imbfits_message(seve%e,rname,'Unexpected stokes kind')
      error = .true.
      return
    end select
    !
  enddo
  !
end subroutine imbfits_get_next_stokesset
!
subroutine imbfits_count_polar_stokesset(cdesc,nset,error)
  use imbfits_interfaces, except_this=>imbfits_count_polar_stokesset
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ public
  !  Count the number POLARIMETRIC stokesets that would be found when
  ! iterating with imbfits_get_next_stokesset
  !---------------------------------------------------------------------
  type(imbfits_back_chunks_t), intent(in)    :: cdesc  ! Chunks description
  integer(kind=4),             intent(out)   :: nset   ! Number of stokesset
  logical,                     intent(inout) :: error  ! Logical error flag
  ! Local
  type(stokesset_book_t) :: book
  !
  call imbfits_init_stokesloop(book,error)
  if (error) return
  !
  nset = 0
  do
    call imbfits_get_next_stokesset(cdesc,book,error)
    if (error) return
    if (.not.book%found)  exit
    if (book%nstokes.eq.4)  nset = nset+1
  enddo
  !
end subroutine imbfits_count_polar_stokesset
!
subroutine imbfits_upcase_column(char,error)
  use imbfits_interfaces, except_this => imbfits_upcase_column
  use imbfits_types
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  type(fits_char_1d_t), intent(inout) :: char
  logical,              intent(inout) :: error
  ! Local
  integer(kind=4) :: iline
  !
  do iline=1,char%n
    call sic_upper(char%val(iline))
  enddo
  !
end subroutine imbfits_upcase_column
