module cubefitsio_image_utils
  use cubefitsio_messaging
  use cubefitsio_header
  !---------------------------------------------------------------------
  ! Support module for FITS 'images' (e.g. 2D images or 3D cubes)
  !---------------------------------------------------------------------

  public :: cubefitsio_image_dataoffset,cubefitsio_image_subset,cubefitsio_image_close
  private

contains

  subroutine cubefitsio_image_dataoffset(hfits,iblc,itrc,blc,trc,  &
    fpixel,nelements4,error)
    use cubetools_parameters
    !-------------------------------------------------------------------
    ! Convert a [BLC:TRC] range (multidimensional) into a flat 1D
    ! range (position of 1st element + number of elements)
    !-------------------------------------------------------------------
    type(fitsio_header_t),      intent(in)    :: hfits
    integer(kind=index_length), intent(in)    :: iblc(maxdim)
    integer(kind=index_length), intent(in)    :: itrc(maxdim)
    integer(kind=index_length), intent(out)   :: blc(maxdim)  ! Resolved
    integer(kind=index_length), intent(out)   :: trc(maxdim)  ! Resolved
    integer(kind=4),            intent(out)   :: fpixel
    integer(kind=4),            intent(out)   :: nelements4
    logical,                    intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='IMAGE>DATAOFFSET'
    integer(kind=4) :: idime,ndim
    integer(kind=index_length) :: first,last
    integer(kind=size_length) :: nelements8
    !
    ! Convert automatic BLC/TRC
    blc(:) = iblc(:)
    trc(:) = itrc(:)
    do idime=1,hfits%ndim
      if (iblc(idime).eq.0)  blc(idime) = 1
      if (itrc(idime).eq.0)  trc(idime) = hfits%dim(idime)
    enddo
    !
    ! Find last non-degenerate dimension
    ndim = 1
    do idime=hfits%ndim,1,-1
      if (hfits%dim(idime).gt.1) then
        ndim = idime
        exit
      endif
    enddo
    !
    ! Sanity check: BLC/TRC should not request non-contiguous subsets
    nelements8 = 1
    do idime=1,ndim-1
      if (blc(idime).ne.1 .or. trc(idime).ne.hfits%dim(idime)) then
        ! NB: see CFITSIO subroutine FTPSSE to write non-contiguous subsets
        call cubefitsio_message(seve%e,rname,  &
          'Not implemented: reading or writing a non-contiguous subset on first dimensions')
        error = .true.
        return
      endif
      nelements8 = nelements8*hfits%dim(idime)
    enddo
    first = blc(ndim)
    last = trc(ndim)
    fpixel = (first-1)*nelements8+1
    nelements8 = (last-first+1)*nelements8
    if (nelements8.gt.huge(nelements4)) then
      ! This requires a CFITSIO API with I*8 arguments...
      call cubefitsio_message(seve%e,rname,  &
        'Not implemented: reading or writing more than 2**31 values to FITS data array')
      error = .true.
      return
    endif
    nelements4 = nelements8
    !
  end subroutine cubefitsio_image_dataoffset

  subroutine cubefitsio_image_subset(hfits,iblc,itrc,  &
    ndim,dims,blc,trc,incs,nelements,error)
    use cubetools_parameters
    !-------------------------------------------------------------------
    ! Convert a [BLC:TRC] range (multidimensional) into proper arguments
    ! for FTGSF* subroutines (i.e. I*4 arguments).
    !-------------------------------------------------------------------
    type(fitsio_header_t),      intent(in)    :: hfits
    integer(kind=index_length), intent(in)    :: iblc(maxdim)
    integer(kind=index_length), intent(in)    :: itrc(maxdim)
    ! Outputs
    integer(kind=4),            intent(out)   :: ndim
    integer(kind=4),            intent(out)   :: dims(maxdim)
    integer(kind=4),            intent(out)   :: blc(maxdim)
    integer(kind=4),            intent(out)   :: trc(maxdim)
    integer(kind=4),            intent(out)   :: incs(maxdim)
    integer(kind=size_length),  intent(out)   :: nelements
    logical,                    intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='IMAGE>SUBSET'
    integer(kind=4) :: idime
    integer(kind=index_length) :: first,last
    !
    ! Sanity
    if (any(hfits%dim.gt.huge(1_4))) then
      call cubefitsio_message(seve%e,rname,  &
        'Not implemented: one dimension is larger than 2**31')
      error = .true.
      return
    endif
    if (any(itrc.gt.huge(1_4))) then
      call cubefitsio_message(seve%e,rname,  &
        'Not implemented: extracting more than 2**31 values in one dimension')
      error = .true.
      return
    endif
    !
    ! Convert automatic BLC/TRC
    dims(:) = hfits%dim(:)
    blc(:) = iblc(:)
    trc(:) = itrc(:)
    incs(:) = 1
    do idime=1,hfits%ndim
      if (iblc(idime).eq.0)  blc(idime) = 1
      if (itrc(idime).eq.0)  trc(idime) = hfits%dim(idime)
    enddo
    !
    ! Find last non-degenerate dimension
    ndim = 1
    do idime=hfits%ndim,1,-1
      if (hfits%dim(idime).gt.1) then
        ndim = idime
        exit
      endif
    enddo
    !
    ! Sanity check: BLC/TRC should not request non-contiguous subsets
    nelements = 1
    do idime=1,ndim-1
      if (blc(idime).ne.1 .or. trc(idime).ne.hfits%dim(idime)) then
        ! NB: see CFITSIO subroutine FTPSSE to write non-contiguous subsets
        call cubefitsio_message(seve%e,rname,  &
          'Not implemented: reading or writing a non-contiguous subset on first dimensions')
        error = .true.
        return
      endif
      nelements = nelements*hfits%dim(idime)
    enddo
    first = blc(ndim)
    last = trc(ndim)
    nelements = (last-first+1)*nelements
  end subroutine cubefitsio_image_subset

  subroutine cubefitsio_image_close(hfits,error)
    !-------------------------------------------------------------------
    ! Close the currently opened image
    !-------------------------------------------------------------------
    type(fitsio_header_t), intent(inout) :: hfits
    logical,               intent(inout) :: error
    !
    call hfits%close(error)
    if (error)  return
    !
  end subroutine cubefitsio_image_close

end module cubefitsio_image_utils
