module cubecdf_image_utils
  use cubecdf_messaging
  use cubecdf_header
  !---------------------------------------------------------------------
  ! Support module for CDF 'images' (e.g. 2D images or 3D cubes)
  !---------------------------------------------------------------------

  public :: cubecdf_image_subset,cubecdf_image_close
  private

contains

  subroutine cubecdf_image_subset(hcdf,iblc,itrc,nelem_new,error)
    use cubetools_parameters
    !-------------------------------------------------------------------
    ! Convert a [BLC:TRC] range (multidimensional) into proper arguments
    ! for FTGSF* subroutines (i.e. I*4 arguments).
    !-------------------------------------------------------------------
    type(cdf_header_t),          intent(in)    :: hcdf
    integer(kind=index_length),  intent(in)    :: iblc(maxdim)
    integer(kind=index_length),  intent(in)    :: itrc(maxdim)
    integer(kind=size_length),   intent(out)   :: nelem_new
    logical,                     intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='IMAGE>SUBSET'
    integer(kind=4) :: ndim,idime,ier
    integer(kind=index_length) :: blc(maxdim),trc(maxdim),first,last
    integer(kind=size_length) :: nelements
    !
    ! Sanity
    if (any(hcdf%dim.gt.huge(1_4))) then
      call cubecdf_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 cubecdf_message(seve%e,rname,  &
        'Not implemented: extracting more than 2**31 values in one dimension')
      error = .true.
      return
    endif
    !
    ! Convert automatic BLC/TRC
    blc(:) = iblc(:)
    trc(:) = itrc(:)
    do idime=1,hcdf%ndim
      if (iblc(idime).eq.0)  blc(idime) = 1
      if (itrc(idime).eq.0)  trc(idime) = hcdf%dim(idime)
    enddo
    !
    ! Sanity check: BLC/TRC should not request non-contiguous subsets
    ! 1) find last non-degenerate dimension
    ndim = 1
    do idime=hcdf%ndim,1,-1
      if (hcdf%dim(idime).gt.1) then
        ndim = idime
        exit
      endif
    enddo
    ! 2) check all but last dimension are completely used
    do idime=1,ndim-1
      if (blc(idime).ne.1 .or. trc(idime).ne.hcdf%dim(idime)) then
        ! NB: see CFITSIO subroutine FTPSSE to write non-contiguous subsets
        call cubecdf_message(seve%e,rname,  &
          'Not implemented: reading or writing a non-contiguous subset on first dimensions')
        error = .true.
        return
      endif
    enddo
    !
    ! Compute first record number and number of elements to write
    nelements = 1
    do idime=1,ndim-1
      nelements = nelements*hcdf%dim(idime)
    enddo
    first = blc(ndim)
    last = trc(ndim)
    !
    ! Note: we could use FSEEK to force going to the right position.
    ! But our use case is always (?) to read or write contiguously.
    if (first.eq.1) then
      call cubecdf_message(seve%d,rname,'Rewinding file')
      rewind(unit=hcdf%unit,iostat=ier)
      if (ier.ne.0) then
        call cubecdf_message(seve%e,rname,'Rewind error')
        error = .true.
        return
      endif
    endif
    !
    nelem_new = (last-first+1)*nelements
  end subroutine cubecdf_image_subset

  subroutine cubecdf_image_close(hcdf,error)
    !-------------------------------------------------------------------
    ! Close the currently opened image
    !-------------------------------------------------------------------
    type(cdf_header_t), intent(inout) :: hcdf
    logical,            intent(inout) :: error
    !
    call hcdf%close(error)
    if (error)  return
  end subroutine cubecdf_image_close

end module cubecdf_image_utils
