subroutine gfits_getreal(fd,ndat,array,scal,zero,error)
  use gildas_def
  use gbl_message
  use gfits_interfaces, except_this=>gfits_getreal
  use gfits_types
  !---------------------------------------------------------------------
  ! @ public
  ! Read NDAT data values from FITS data area, with scaling SCALE and
  ! offset ZERO
  !---------------------------------------------------------------------
  type(gfits_hdesc_t),       intent(in)    :: fd           !
  integer(kind=size_length), intent(in)    :: ndat         ! Number of desired data values
  real(kind=4),              intent(inout) :: array(ndat)  ! Data values
  real(kind=4),              intent(in)    :: scal         ! Scale factor
  real(kind=4),              intent(in)    :: zero         ! Offset
  logical,                   intent(inout) :: error        ! Error flag
  ! Local
  integer(kind=size_length) :: nsize,nfill,nbyt
  integer(kind=4) :: ier
  integer(kind=size_length), save :: mbyt=0
  integer(kind=1), allocatable, save :: mybuf(:)
  character(len=60) :: mess
  !
  select case (fd%nbit)
  case (8)
    nbyt = ndat
  case (16)
    nbyt = 2_8*ndat
  case (32,-32)
    nbyt = 4_8*ndat
  case (-64)
    nbyt = 8_8*ndat
  case default
    write(mess,*) 'BITPIX = ',fd%nbit,' not yet supported'
    call gfits_message(seve%e,'GETREAL',mess)
    error = .true.
    return
  end select
  !
  if (nbyt.gt.mbyt) then
    if (mbyt.ne.0) deallocate(mybuf)
    allocate (mybuf(nbyt),stat=ier)
    if (ier.ne.0) then
      write(mess,*) 'Allocation error ',ier,mbyt
      call gfits_message(seve%e,'GETREAL',mess)
      error = .true.
      return 
    endif
    mbyt = nbyt
  endif
  !
  call gfits_getbuf(mybuf,nbyt,error)
  if (error) return
  !
  nfill = 0
  nsize = ndat
  !
  select case (fd%nbit)
    case (8)
      call byte_to_real(mybuf,ndat,array,nsize,nfill,scal,zero)
    case (16)
      call int2_to_real(mybuf,ndat,array,nsize,nfill,scal,zero)
    case (32)
      call int4_to_real(mybuf,ndat,array,nsize,nfill,scal,zero)
    case (-32)
      call ieee32_to_real(mybuf,ndat,array,nsize,nfill,scal,zero,fd%bval0)
    case (-64)
      call ieee64_to_real(mybuf,ndat,array,nsize,nfill,scal,zero,fd%bval0)
  end select
end subroutine gfits_getreal
!
subroutine gfits_putbuf(int1,nr,error)
  use gfits_interfaces, except_this=>gfits_putbuf
  use gfits_buf
  !---------------------------------------------------------------------
  ! @ public
  ! Write one row of a binary table to a FITS logical record
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: nr        ! Length of buffer
  integer(kind=1), intent(in)    :: int1(nr)  ! Buffer
  logical,         intent(inout) :: error     ! Error flag
  ! Local
  integer(kind=4) :: j, kb
  !
  if ((nr+ib).lt.2880) then
    ! fits into current buffer
    call bytoby(int1,buffer(ib+1),nr)
    ib = ib+nr
  else
    ! Would overflow buffer: will have to write to disk or tape
    ! Fill in previous buffer, and dump it to physical medium
    if (ib.ne.0) then
      call bytoby(int1,buffer(ib+1),2880-ib)
      call gfits_putrec(buffer,error)
      kb = 2880-ib
    else
      call gfits_putrec(int1,error)
      kb = 2880
    endif
    if (error) return
    kb = kb+1
    ! Now dump full buffers (double buffering is useless here)
    do j = 2880-ib+1, nr-2880+1, 2880
      call gfits_putrec(int1(kb),error)
      if (error) return
      kb = kb + 2880
    enddo
    ! Store leftover bits
    ib = nr-kb+1
    if (ib.gt.0) call bytoby(int1(kb),buffer(1),ib)
  endif
end subroutine gfits_putbuf
!
subroutine gfits_getbuf(int1,nr,error)
  use gildas_def
  use gfits_interfaces, except_this=>gfits_getbuf
  use gfits_buf
  !---------------------------------------------------------------------
  ! @ public-mandatory
  ! Get one row of a binary table from a FITS logical record
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)    :: nr        ! Length of buffer
  integer(kind=1),           intent(inout) :: int1(nr)  ! Buffer
  logical,                   intent(inout) :: error     ! Error flag
  ! Local
  integer(kind=size_length) :: j,kb
  !
  if (nr+ib.le.2880) then
    ! Already in prefetch buffer
    call bytoby_sl(buffer(ib+1),int1,nr)
    ib = ib+nr
  else
    ! Will need to read from disk
    ! Empty previous buffer
    if (ib.lt.2880) then 
      call bytoby(buffer(ib+1),int1,2880-ib)
      kb = 2880-ib+1
    else
      kb = 1
    endif
    ! Now read full buffers from physical medium
    do j = 2880-ib+1, nr-2880, 2880
      call gfits_getrec(int1(kb:kb+2880-1),error)
      if (error) return
      kb = kb+2880
    enddo
    ! Read one more buffer, and move part of it.
    call gfits_getrec(buffer,error)
    if (error) return
    ib = nr-kb+1
    if (ib.gt.0) call bytoby(buffer(1),int1(kb),ib)
  endif
end subroutine gfits_getbuf
!
subroutine gfits_skibuf(nb,error)
  use gildas_def
  use gfits_interfaces, except_this=>gfits_skibuf
  use gfits_buf
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! Skip NB bytes on input file
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)    :: nb     ! Bytes to skip
  logical,                   intent(inout) :: error  ! Error flag
  ! Local
  integer(kind=record_length) :: nrec
  character(len=message_length) :: mess
  !
  if (nb+ib.le.2880) then
    ! Remains within current buffer
    ib = ib+nb
  else 
    ! Need to skip records on input medium
    nrec = ((nb+ib)/2880)-1
    ! Make sure we can read the last record here
    if (nrec*2880.ge.nb) nrec = nrec-1 ! In case IB = 2880 at start
    call gfits_skirec(nrec,error)
    if (error) return
    ! Read last record, and set pointer
    call gfits_getrec(buffer,error)
    if (error) return
    ib = nb+ib-(nrec+1)*2880
    if (ib.lt.1.or.ib.gt.2880) then
      write(mess,*) 'Internal logic error. ',ib,nrec
      call gfits_message(seve%e,'FSKIBUF',mess)
    endif
  endif
end subroutine gfits_skibuf
!
subroutine gfits_skidat(fd,ndat,error)
  use gildas_def
  use gbl_message
  use gfits_interfaces, except_this=>gfits_skidat
  use gfits_types
  !---------------------------------------------------------------------
  ! @ public
  !  Skip NDAT data values from FITS data area,
  !---------------------------------------------------------------------
  type(gfits_hdesc_t),       intent(in)    :: fd     !
  integer(kind=size_length), intent(in)    :: ndat   ! Number of desired data values
  logical,                   intent(inout) :: error  ! Error flag
  ! Local
  integer(kind=size_length) :: nbyt
  character(len=60) :: mess
  !
  select case (fd%nbit)
    case (8)
      nbyt = ndat
    case (16)
      nbyt = 2*ndat
    case (32,-32)
      nbyt = 4*ndat
    case (-64)
      nbyt = 8*ndat
    case default
      write(mess,*) 'BITPIX = ',fd%nbit,' not yet supported'
      call gfits_message(seve%e,'FSKIDAT',mess)
      error = .true.
      return
  end select
  !
  call gfits_skibuf(nbyt,error)
end subroutine gfits_skidat
!
subroutine gfits_skip_hdu(fd,ihdu,list,error)
  use gildas_def
  use gbl_message
  use gfits_interfaces, except_this=>gfits_skip_hdu
  use gfits_types
  !---------------------------------------------------------------------
  ! @ private
  ! Skip entirely the current HDU. Optionaly list its contents.
  !---------------------------------------------------------------------
  type(gfits_hdesc_t), intent(inout) :: fd     !
  integer(kind=4),     intent(in)    :: ihdu   ! HDU we are skipping (1=Primary)
  logical,             intent(in)    :: list   !
  logical,             intent(inout) :: error  ! Error flag
  ! Local
  character(len=*), parameter :: rname='FITS'
  type(gfits_hdict_t) :: fhdict
  integer(kind=size_length) :: ndat
  integer(kind=4) :: ndim,pcount,gcount
  integer(kind=index_length) :: dims(10)  ! Arbitrary number of dimensions
  character(len=message_length) :: mess
  logical :: groups
  !
  ! 1) Skip the header. As we need to get the data description, reading
  !    the entire header is the easiest
  call gfits_load_header(fhdict,.false.,gfits_getnosymbol,error)
  if (error)  return
  call gfits_flush_header(error)
  if (error)  return
  !
  ! 2) Compute the data size. Trickiest part...
  call gfits_compute_ndat(ndat,error)
  if (error)  return
  !
  ! 3) Skip the data
  call gfits_skidat(fd,ndat,error)
  if (error)  return
  call gfits_flush_data(error)
  if (error)  return
  !
  if (list) then
    call gfits_list_hdu(error)
    if (error)  return
  else
    ! Just some debugging
    write(mess,'(A,I0,A)')  'Skipped HDU of size ',ndat,' elements'
    call gfits_message(seve%d,rname,mess)
  endif
  !
contains
  subroutine gfits_compute_ndat(ndat,error)
    !-------------------------------------------------------------------
    ! Compute the data size in current HDU
    !-------------------------------------------------------------------
    integer(kind=size_length), intent(out)   :: ndat
    logical,                   intent(inout) :: error
    ! Local
    integer(kind=4) :: fmt
    logical :: found
    !
    if (ihdu.eq.1) then  ! We are skipping the Primary HDU
      call gfits_check_simple(fhdict%card(1),error)
      if (error)  return
    else    ! We are skipping an Xtension
      call gfits_check_xtension(fhdict%card(1),error)
      if (error)  return
    endif
    call gfits_check_format(fhdict%card(2),fd%nbit,fmt,error)
    if (error)  return
    call gfits_check_naxis(fhdict%card(3),ndim,error)
    if (error)  return
    call gfits_check_naxisi(fhdict,dims(:),error)
    if (error)  return
    !
    groups = .false.
    call gfits_get_value(fhdict,'GROUPS',found,groups,error)
    if (error)  return
    !
    if (groups) then
      ! Minimalist test. UVFITS readers should perform exhaustive tests.
      call gfits_get_value(fhdict,'GCOUNT',found,gcount,error)
      if (error)  return
      if (.not.found) then
        call gfits_message(seve%e,rname,'Missing keyword GCOUNT for Random Groups')
        error = .true.
        return
      endif
      call gfits_get_value(fhdict,'PCOUNT',found,pcount,error)
      if (error)  return
      if (.not.found) then
        call gfits_message(seve%e,rname,'Missing keyword PCOUNT for Random Groups')
        error = .true.
        return
      endif
      ndat = gcount * (pcount + product(dims(2:ndim)))
    elseif (ndim.eq.0) then
      ndat = 0
    else
      ndat = product(dims(1:ndim))
    endif
    !
  end subroutine gfits_compute_ndat
  !
  subroutine gfits_list_hdu(error)
    !-------------------------------------------------------------------
    ! Display a one-line description of the current HDU
    !-------------------------------------------------------------------
    logical, intent(inout) :: error  !
    ! Local
    character(len=16) :: extkind
    character(len=20) :: extname
    character(len=64) :: extdims
    integer(kind=4) :: tfields,nc,idime
    logical :: found,tfields_defined
    !
    tfields = 0
    call gfits_get_value(fhdict,'TFIELDS',tfields_defined,tfields,error)
    if (error)  return
    !
    if (ihdu.eq.1) then
      ! Primary HDU have no explicit kind. Have to guess what it is.
      if (groups) then  ! Already read by gfits_compute_ndat
        extkind = 'RANDOM GROUPS'
      elseif (tfields_defined) then
        extkind = 'BINTABLE'
      else
        extkind = 'IMAGE'
      endif
    else
      ! Rely on the XTENSION declaration
      extkind = '(UNKNOWN)'
      call gfits_get_value(fhdict,'XTENSION',found,extkind,error)
      if (error)  return
    endif
    !
    if (ihdu.eq.1) then
      extname = 'Primary'
    else
      extname = '(UNNAMED)'
      call gfits_get_value(fhdict,'EXTNAME',found,extname,error)
      if (error)  return
    endif
    !
    if (ndim.eq.0) then
      extdims = '0'
      !
    elseif (extkind.eq.'BINTABLE') then
      write(extdims,'(I0,A)')  tfields,' cols'
      do idime=2,ndim
        nc = len_trim(extdims)+2
        if (idime.eq.2) then
          write(extdims(nc:),'(A,I0,A)')  'x ',dims(idime),' rows'
        else
          write(extdims(nc:),'(A,I0)')    'x ',dims(idime)  ! More than 2 dims? Should not happen
        endif
      enddo
      !
    elseif (extkind.eq.'RANDOM GROUPS') then
      write(extdims,'(A,I0,A,I0)')  '(',pcount,' + ',dims(2)
      do idime=3,ndim
        nc = len_trim(extdims)+1
        write(extdims(nc:),'(A,I0)')  'x',dims(idime)
      enddo
      nc = len_trim(extdims)+1
      write(extdims(nc:),'(A,I0,A)')  ') x ',gcount,' visibilities'
      !
    else  ! Fallback for all others kinds (including IMAGE)
      write(extdims,'(I0)')  dims(1)
      do idime=2,ndim
        nc = len_trim(extdims)+2
        write(extdims(nc:),'(A,I0)')  'x ',dims(idime)
      enddo
    endif
    !
    write(mess,'(A,I0,T9,A,A,A)')  'HDU #',ihdu,extkind,extname,extdims
    call gfits_message(seve%r,rname,mess)
  end subroutine gfits_list_hdu
  !
end subroutine gfits_skip_hdu
!
subroutine gfits_goto_hdu(fd,khdu,error)
  use gildas_def
  use gbl_message
  use gfits_interfaces, except_this=>gfits_goto_hdu
  use gfits_types
  use gfits_buf
  !---------------------------------------------------------------------
  ! @ public
  ! Go to the requested HDU
  !---------------------------------------------------------------------
  type(gfits_hdesc_t), intent(inout) :: fd     !
  integer(kind=4),     intent(in)    :: khdu   ! Requested HDU (1=Primary)
  logical,             intent(inout) :: error  ! Error flag
  ! Local
  character(len=*), parameter :: rname='FITS'
  integer(kind=4) :: ihdu
  character(len=message_length) :: mess
  !
  if (khdu.le.0) then
    write(mess,'(A,I0)')  'Invalid HDU number ',khdu
    call gfits_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! Rewind to start of file
  call gfits_rewind_file(error)
  if (error)  return
  !
  ! Skip undesired HDUs
  do ihdu=1,khdu-1
    call gfits_skip_hdu(fd,ihdu,.false.,error)
    if (error)  return
    if (gfits_iseof()) then
      write(mess,'(A,I0,A)') 'FITS file has only ',ihdu,' HDUs'
      call gfits_message(seve%e,rname,mess)
      error = .true.
      return
    endif
  enddo
  !
  ! Set the starting record of current HDU
  hdurec = irec
  !
end subroutine gfits_goto_hdu
!
subroutine gfits_list_hdus(name,error)
  use gbl_message
  use gfits_interfaces, except_this=>gfits_list_hdus
  use gfits_types
  !---------------------------------------------------------------------
  ! @ public
  ! Go to the requested HDU
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: name   ! File name
  logical,          intent(inout) :: error  ! Error flag
  ! Local
  character(len=*), parameter :: rname='FITS'
  integer(kind=4) :: ihdu
  type(gfits_hdesc_t) :: fd
  !
  call gfits_open(name,'IN',error)
  if (error)  return
  !
  ! Loop over HDUs
  ihdu = 0
  do
    ihdu = ihdu+1
    call gfits_skip_hdu(fd,ihdu,.true.,error)
    if (error)  exit  ! Need to close the file
    if (gfits_iseof())  exit  ! No more HDUs
  enddo
  !
  call gfits_close(error)
  !
end subroutine gfits_list_hdus
