module cubefitsio_image_read
  use cfitsio_api
  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  ! Note: HDU stored in hfits%hdunum
    character(len=*),      intent(in)    :: id  ! Some identifier string
    logical,               intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='IMAGE>OPEN'
    integer(kind=4) :: status
    !
    call hfits%open(filename,id,error)
    if (error)  return
    !
    status = 0
    call ftmahd(hfits%unit,hfits%hdunum,hfits%hdutype,status)
    if (cubefitsio_error(rname,status,error))  return
  end subroutine cubefitsio_image_open
  !
#if defined(CFITSIO420)
  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), contiguous, target, 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
    real(kind=4) :: nullval
    logical :: anynull
    character(len=mess_l) :: mess
    real(kind=4), pointer :: data1(:)
    integer(kind=size_length) :: fpixel,nelements,ielem
    integer(kind=index_length) :: blc(maxdim),trc(maxdim)
    !
    call cubefitsio_message(fitsioseve%trace,rname,'Welcome')
    !
    call cubefitsio_image_dataoffset(hfits,iblc,itrc,blc,trc,  &
                                     fpixel,nelements,error)
    if (error)  return
    !
    ! Sanity check
    if (size(data,kind=size_length).lt.nelements) then
      ! Note that it is OK to receive a buffer which is too large. It is
      ! the responsibility of the caller to know that not all the buffer
      ! filled (thanks to blc/trc). This is the case in particular when
      ! reading by blocks: the last block is not shrinked before reading.
      write(mess,'(2(a,i0))')  'Internal error: trying to read ',nelements,  &
        ' values in a buffer of size ',size(data,kind=size_length)
      call cubefitsio_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    !
    !
    call cubefitsio_message(fitsioseve%others,rname,'Reading data with CFITSIO')
    ! nullval = 0       ! => No check for undefined values
    nullval = huge(1.)  ! => Undefined values returned with nullval
    group = 1
    status = 0
    call ftgpvell(hfits%unit,group,fpixel,nelements,nullval,  &
                  data,anynull,status)
    if (cubefitsio_error(rname,status,error))  return
    !
    ! Patch for NULL values: more computation cost, but necessary for BITPIX > 0
    if (anynull) then
      call cubefitsio_message(fitsioseve%others,rname,'Patching NULL values to NaN')
      data1(1:nelements) => data
      do ielem=1,nelements
        if (data1(ielem).eq.nullval)  data1(ielem) = gr4nan
      enddo
    endif
  end subroutine cubefitsio_image_dataread
#else /* CFITSIO420 */
  subroutine cubefitsio_image_dataread(hfits,data,iblc,itrc,error)
    use gkernel_interfaces
    use cubetools_parameters
    use cubetools_nan
    use cubefitsio_image_utils
    !-------------------------------------------------------------------
    ! OBSOLESCENT IMPLEMENTATION WITH INCORRECT USE OF BINTABLE API TO
    ! READ LARGE (>2GB) IMAGE HDUS, MEMORY GREEDY BECAUSE OF THE FLAGS
    ! ARRAY FOR BITPIX>0.
    !-------------------------------------------------------------------
    type(fitsio_header_t),            intent(in)    :: hfits
    real(kind=4), contiguous, target, 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
    character(len=mess_l) :: mess
    real(kind=4), pointer :: data1(:)
    integer(kind=size_length) :: nelements,ielem
    integer(kind=4) :: naxis,naxes(maxdim),fpixels(maxdim),  &
                       lpixels(maxdim),incs(maxdim)
    !
    call cubefitsio_message(fitsioseve%trace,rname,'Welcome')
    !
    call cubefitsio_image_subset(hfits,iblc,itrc,  &
      naxis,naxes,fpixels,lpixels,incs,nelements,error)
    if (error)  return
    !
    ! Sanity check
    if (size(data,kind=size_length).lt.nelements) then
      ! Note that it is OK to receive a buffer which is too large. It is
      ! the responsibility of the caller to know that not all the buffer
      ! filled (thanks to blc/trc). This is the case in particular when
      ! reading by blocks: the last block is not shrinked before reading.
      write(mess,'(2(a,i0))')  'Internal error: trying to read ',nelements,  &
        ' values in a buffer of size ',size(data,kind=size_length)
      call cubefitsio_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    !
    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
    call cubefitsio_message(fitsioseve%others,rname,'Allocating flags array')
    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 cubefitsio_message(fitsioseve%others,rname,'Reading data with CFITSIO')
    call ftgsfe(hfits%unit,group,naxis,naxes,fpixels,lpixels,incs,  &
                data,flags,anynull,status)
    if (cubefitsio_error(rname,status,error))  return
    !
    ! Patch NULL values
    call cubefitsio_message(fitsioseve%others,rname,'Patching NULL values to NaN')
    if (anynull) then
      data1(1:nelements) => data
      do ielem=1,nelements
        if (flags(ielem))  data1(ielem) = gr4nan
      enddo
    endif
    deallocate(flags)
  end subroutine cubefitsio_image_dataread
#endif /* CFITSIO420 */
end module cubefitsio_image_read
