module cubefitsio_image_read
  use cfitsio_parameters
  use cfitsio_interfaces
  use cubefitsio_header
  use cubefitsio_messaging
  !---------------------------------------------------------------------
  ! Support module to read FITS 'images' (e.g. 2D images or 3D cubes)
  !---------------------------------------------------------------------

  public :: cubefitsio_image_open,cubefitsio_image_dataread
  private

contains

  subroutine cubefitsio_image_open(hfits,filename,id,error)
    use gkernel_interfaces
    use cubetools_parameters
    !-------------------------------------------------------------------
    ! Open an old IMAGE-FITS file from disk.
    !-------------------------------------------------------------------
    type(fitsio_header_t), intent(inout) :: hfits
    character(len=*),      intent(in)    :: filename
    character(len=*),      intent(in)    :: id  ! Some identifier string
    logical,               intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='IMAGE>OPEN'
    integer(kind=4), parameter :: ihdu=1  ! Primary
    integer(kind=4) :: status,hdutype
    !
    call hfits%open(filename,id,error)
    if (error)  return
    !
    status = 0
    call ftmahd(hfits%unit,ihdu,hdutype,status)
    if (cubefitsio_error(rname,status,error))  return
    if (hdutype.ne.code_cfitsio_image_hdu) then
      call cubefitsio_message(seve%e,rname,'Not an image HDU')
      error = .true.
      return
    endif
    !
  end subroutine cubefitsio_image_open
  !
  subroutine cubefitsio_image_dataread(hfits,data,iblc,itrc,error)
    use gkernel_interfaces
    use cubetools_parameters
    use cubetools_nan
    use cubefitsio_image_utils
    !-------------------------------------------------------------------
    ! Read a contiguous piece of data from the input file
    !-------------------------------------------------------------------
    type(fitsio_header_t),      intent(in)    :: hfits
    real(kind=4),               intent(out)   :: data(*)
    integer(kind=index_length), intent(in)    :: iblc(maxdim)
    integer(kind=index_length), intent(in)    :: itrc(maxdim)
    logical,                    intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='IMAGE>DATAREAD'
    integer(kind=4) :: status,group,ier
    ! real(kind=4) :: nullval
    logical, allocatable :: flags(:)
    logical :: anynull
    integer(kind=size_length) :: nelements,ielem
    integer(kind=4) :: naxis,naxes(maxdim),fpixels(maxdim),  &
                       lpixels(maxdim),incs(maxdim)
    !
    call cubefitsio_image_subset(hfits,iblc,itrc,  &
      naxis,naxes,fpixels,lpixels,incs,nelements,error)
    if (error)  return
    !
    status = 0
    group = 1
    !
    ! ---
    ! No patch for NULL values
    ! nullval = 0  ! => No check for undefined values
    ! call ftgpve(hfits%unit,group,fpixel,nelements,nullval,data,anynull,status)
    ! if (cubefitsio_error(rname,status,error))  return
    !
    ! Patch for NULL values: more memory and computation cost, but necessary
    ! for BITPIX > 0
    allocate(flags(nelements),stat=ier)
    if (failed_allocate(rname,'FLAGS',ier,error))  return
    !
    ! ---
    ! PROBLEM: FTGPFE needs fpixel and nelements to be be I*4, i.e. limited
    ! to 2**31-1
    ! call ftgpfe(hfits%unit,group,fpixel,nelements,data,flags,anynull,status)
    ! if (cubefitsio_error(rname,status,error))  return
    !
    ! ---
    ! Use FTGSFE which is able to deal with more than 2**31 elements to
    ! read, as long as the individual dimensions are below this limit (i.e. I*4)
    call ftgsfe(hfits%unit,group,naxis,naxes,fpixels,lpixels,incs,  &
                data,flags,anynull,status)
    if (cubefitsio_error(rname,status,error))  return
    !
    ! Patch NULL values
    if (anynull) then
      do ielem=1,nelements
        if (flags(ielem))  data(ielem) = gr4nan
      enddo
    endif
    deallocate(flags)
    !
  end subroutine cubefitsio_image_dataread

end module cubefitsio_image_read
