!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeio_header_interface
  use cubetools_parameters
  use cubetools_header_interface
  use cubeio_messaging
  !---------------------------------------------------------------------
  ! Support module for IO-specific actions on cube_header_interface_t
  !---------------------------------------------------------------------
  !
  public :: cubeio_header_interface_derive_xyc
  public :: cubeio_header_interface_transpose
  public :: cubeio_header_interface_truncate
  private
  !
contains
  !
  subroutine cubeio_header_interface_derive_xyc(interface,ndim,  &
    ix,nx,iy,ny,ic,nc,error)
    use cubetools_unit
    !-------------------------------------------------------------------
    ! Simplified overlay to interface%derive_xyc(), returning the only
    ! elements relevant in the IO context.
    !-------------------------------------------------------------------
    type(cube_header_interface_t), intent(in)    :: interface
    integer(kind=ndim_k),          intent(out)   :: ndim
    integer(kind=ndim_k),          intent(out)   :: ix,iy,ic
    integer(kind=data_k),          intent(out)   :: nx,ny,nc
    logical,                       intent(inout) :: error
    !
    integer(kind=code_k) :: kind(maxdim)
    integer(kind=data_k) :: dim(maxdim)
    character(len=unit_l) :: name(maxdim),unit(maxdim)
    !
    ndim    = interface%axset_ndim
    dim(:)  = interface%axset_dim(:)
    name(:) = strg_unk  ! Unused
    unit(:) = strg_unk  ! Unused
    kind(:) = code_unit_unk  ! Unused
    call interface%derive_xyc(ix,nx,  &
                              iy,ny,  &
                              ic,nc,  &
                              ndim,dim,name,unit,kind,error)
    if (error)  return
  end subroutine cubeio_header_interface_derive_xyc
  !
  subroutine cubeio_header_interface_transpose(interface,oorder,error)
    !-------------------------------------------------------------------
    ! Ensure the interface is converted to the desired order. The
    ! interface_t usually comes from an header_t and it can be in
    ! whatever order. We need to sort it as wanted, which may include
    ! a transposition.
    !
    ! This piece of code is probably not 100% satisfying if the original
    ! order is not well recognized, i.e. if IX/IY/IC are missing. To be
    ! improved!
    !-------------------------------------------------------------------
    type(cube_header_interface_t), intent(inout) :: interface
    integer(kind=code_k),          intent(in)    :: oorder   ! Requested order
    logical,                       intent(inout) :: error
    !
    integer(kind=code_k) :: iorder  ! Current order
    integer(kind=ndim_k) :: ix,iy,ic
    integer(kind=data_k) :: nx,ny,nc
    integer(kind=ndim_k) :: idim,odim,ndim,tr(maxdim)
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='HEADER>INTERFACE>TRANSPOSE'
    !
    if (oorder.eq.code_access_any)  return  ! No particular access requested
    !
    iorder = cubeio_header_interface_order(interface)
    if (iorder.eq.oorder)  return  ! Already in correct access
    !
    if (oorder.eq.code_access_imaset_or_speset) then
      if (iorder.eq.code_cube_imaset .or.  &
          iorder.eq.code_cube_speset) then
        return  ! Already a correct access
      endif
    endif
    !
    ! Need to go to another order: we have to be coherent with
    ! cubeio_iodesc_import calling derive_xyc, which has the responsibility
    ! to decide what dimension is IX, IY, IC, in particular when one is
    ! missing.
    call cubeio_header_interface_derive_xyc(interface,ndim,  &
                                            ix,nx,  &
                                            iy,ny,  &
                                            ic,nc,error)
    if (error)  return
    !
    ! Note that this code does not need to know which access it comes from
    ! (could be unknown). It only needs to know where it goes to.
    select case (oorder)
    case (code_cube_speset)
      ! Put C dimension first
      tr(1) = ic
      odim = 1
      do idim=1,maxdim
        if (idim.eq.ic)  cycle
        odim = odim+1
        tr(odim) = idim
      enddo
      !
    case (code_cube_imaset)
      ! Put XY dimensions first
      tr(1) = ix
      tr(2) = iy
      odim = 2
      do idim=1,maxdim
        if (idim.eq.ix .or. idim.eq.iy)  cycle
        odim = odim+1
        tr(odim) = idim
      enddo
      !
    case default
      write(mess,'(A,I0,A,I0)')  &
        'Do not know how to go from order ',iorder,' to order ',oorder
      call cubeio_message(seve%e,rname,mess)
      error = .true.
      return
    end select
    !
    ! Note that this transposition may insert zero-sized dimensions
    ! between other ones.
    call interface%transpose(tr(1:ndim),error)
    if (error)  return
  end subroutine cubeio_header_interface_transpose
  !
  function cubeio_header_interface_order(interface)
    integer(kind=code_k) :: cubeio_header_interface_order
    type(cube_header_interface_t), intent(in) :: interface
    !
    ! ZZZ This code should also rely on derive_xyc to guess the cube order,
    ! in particular when IX, IY, or IC are missing
    if (interface%axset_ix.eq.1 .and. &
        interface%axset_iy.eq.2) then
      cubeio_header_interface_order = code_cube_imaset
    elseif (interface%axset_ic.eq.1) then
      cubeio_header_interface_order = code_cube_speset
    else
      cubeio_header_interface_order = code_cube_unkset
    endif
  end function cubeio_header_interface_order
  !
  subroutine cubeio_header_interface_truncate(interface,dim3,error)
    !-------------------------------------------------------------------
    ! Truncate the 3rd (i.e. iterated) dimension to the given value,
    ! including sanity checks.
    !
    ! This API is relevant e.g. when writing output files on disk. They
    ! are written with slices, and the header (dimensions) is updated
    ! accordingly at each increase of the data block, so that it remains
    ! consistent.
    !-------------------------------------------------------------------
    type(cube_header_interface_t), intent(inout) :: interface
    integer(kind=data_k),          intent(in)    :: dim3
    logical,                       intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>INTERFACE>TRUNCATE'
    !
    ! ZZZ This code should not modify interface%axset_dim(3), but
    !     interface%axset_dim(cube%desc%i3) instead!
    !
    ! Sanity check
    select case (interface%axset_ndim)
    case (1,2)
      if (dim3.gt.1) then
        call cubeio_message(seve%e,rname,  &
          'Internal error: can not truncate 3rd dimension while data is 1D or 2D')
        error = .true.
        return
      endif
    case (3)
      if (dim3.gt.interface%axset_dim(3)) then
        call cubeio_message(seve%e,rname,  &
          'Internal error: can not truncate beyond the 3rd dimension')
        error = .true.
        return
      endif
      interface%axset_dim(3) = dim3
    case default
      ! Reject only if some other dimension is non-degenerate
      if (any(interface%axset_dim(4:interface%axset_ndim).gt.1)) then
        call cubeio_message(seve%e,rname,  &
          'Not implemented: truncating last dimension of 4D (or more) data')
        error = .true.
        return
      endif
    end select
  end subroutine cubeio_header_interface_truncate
end module cubeio_header_interface
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
