!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeadm_subcube_types
  use cubetools_array_types
  use cube_types
  use cubeadm_messaging
  !
  public :: subcube_t,subcube_iterator_t
  private
  !
  type subcube_iterator_t
    integer(kind=entr_k) :: num            ! Subcube number
    integer(kind=indx_k) :: infirst,inlast ! Range for input cubes (get)
    integer(kind=indx_k) :: oufirst,oulast ! Range for output cubes (put)
    integer(kind=indx_k) :: nplane
  contains
    procedure, public :: iterate => cubeadm_subcube_iterator_iterate
  end type subcube_iterator_t
  !
  type, extends(real_3d_t)             :: subcube_t
     type(cube_t),             pointer :: cube => null() ! Associated cube
     type(subcube_iterator_t), pointer :: iter           ! Associated iterator
   contains
     procedure, public :: allocate  => cubeadm_subcube_allocate
     procedure, public :: associate => cubeadm_subcube_associate
     procedure, public :: get       => cubeadm_subcube_get
     procedure, public :: put       => cubeadm_subcube_put
  end type subcube_t
  !
contains
  !
  subroutine cubeadm_subcube_iterator_iterate(subiter,taskiter,isubcube,error)
    use cubeadm_taskloop
    !-------------------------------------------------------------------
    ! Convert a taskloop iterator to a subcube iterator for subcube
    ! #isubcube
    ! Remember that this subcube iterator is shared by all input and output
    ! subcubes
    ! The iteration currently assumes 1 subcube per task
    !-------------------------------------------------------------------
    class(subcube_iterator_t), intent(out)   :: subiter
    type(cubeadm_iterator_t),  intent(in)    :: taskiter
    integer(kind=entr_k),      intent(in)    :: isubcube
    logical,                   intent(inout) :: error
    !
    character(len=*), parameter :: rname='SUBCUBE>ITERATOR>ITERATE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    subiter%num     = isubcube
    subiter%infirst = taskiter%firstplane
    subiter%inlast  = taskiter%lastplane
    subiter%oufirst = taskiter%firstplane-taskiter%offsetplane
    subiter%oulast  = taskiter%lastplane-taskiter%offsetplane
    subiter%nplane  = taskiter%lastplane-taskiter%firstplane+1
  end subroutine cubeadm_subcube_iterator_iterate
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeadm_subcube_allocate(subcube,name,cube,iterator,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(subcube_t),                 intent(out)   :: subcube
    character(len=*),                 intent(in)    :: name
    type(cube_t),             target, intent(in)    :: cube
    type(subcube_iterator_t), target, intent(in)    :: iterator
    logical,                          intent(inout) :: error
    !
    character(len=*), parameter :: rname='SUBCUBE>ALLOCATE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    if (cube%iscplx()) then
       call cubeadm_message(seve%e,rname,  &
            'Invalid attempt to get a R*4 subcube from a C*4 cube')
       error = .true.
       return
    endif
    !
    subcube%iter => iterator
    call subcube%reallocate(name,&
         cube%tuple%current%desc%n1,&
         cube%tuple%current%desc%n2,&
         subcube%iter%nplane,&
         error)
    if (error) return
    subcube%cube => cube
  end subroutine cubeadm_subcube_allocate
  !
  subroutine cubeadm_subcube_associate(subcube,name,cube,iterator,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(subcube_t),                 intent(out)   :: subcube
    character(len=*),                 intent(in)    :: name
    type(cube_t),             target, intent(in)    :: cube
    type(subcube_iterator_t), target, intent(in)    :: iterator
    logical,                          intent(inout) :: error
    !
    character(len=*), parameter :: rname='SUBCUBE>ASSOCIATE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    if (cube%iscplx()) then
       call cubeadm_message(seve%e,rname,  &
            'Invalid attempt to get a R*4 subcube from a C*4 cube')
       error = .true.
       return
    endif
    !
    subcube%iter => iterator
    call subcube%prepare_association(name,&
         cube%tuple%current%desc%n1,&
         cube%tuple%current%desc%n2,&
         subcube%iter%nplane,&
         error)
    if (error) return
    subcube%cube => cube
  end subroutine cubeadm_subcube_associate
  !
  !------------------------------------------------------------------------
  !
  subroutine cubeadm_subcube_get(subcube,error)
    use cube_types
    use cubeio_subcube
    use cubetuple_entry
    !---------------------------------------------------------------------
    ! Get the subcube from the given cube (whole range being iterated).
    ! When subcube%val is an allocated pointer, we make a copy.
    ! In all other cases (associated or null), we make it point to the
    ! data.
    !---------------------------------------------------------------------
    class(subcube_t), intent(inout) :: subcube
    logical,          intent(inout) :: error
    ! 
    integer(kind=indx_k) :: iz,nz
    type(cubeio_subcube_t) :: entry
    character(len=*), parameter :: rname='SUBCUBE>GET'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    ! During the iteration, it is valid to request planes beyond
    ! the cube (e.g. surset extraction with EXTRACT). Deal with this:
    nz = subcube%cube%tuple%current%desc%n3
    if (subcube%iter%infirst.gt.nz .or. subcube%iter%inlast.lt.1) then
      ! The range is fully off the cube. Free the pointer and assume
      ! the caller will not use it.
      call cubeio_free_subcube(entry,error)
      if (error)  return
      subcube%nx = subcube%cube%tuple%current%desc%n1
      subcube%ny = subcube%cube%tuple%current%desc%n2
      subcube%nz = 0 ! IMPORTANT
      return
    endif
    if ((subcube%iter%infirst.lt.1  .and. subcube%iter%inlast.ge.1) .or. &
        (subcube%iter%infirst.le.nz .and. subcube%iter%inlast.gt.nz)) then
      ! The range overlaps the cube boundaries. Solution?
      ! 1) Build a subcube with expected number of planes, this
      !    requires allocating a dedicated data array (instead of
      !    usual pointer, hence inefficient), and put NaN or valid
      !    values where relevant => too complicated.
      ! 2) Return a subcube with less planes (only the valid ones
      !    from the input cube => this breaks the rule which requires
      !    all the subcubes being processed to provide the same number
      !    of planes, introducing a mismatch.
      ! => Rejected! It is the responsibility of the taskloop iterator
      !    to split the ranges so that this does not happen.
      call cubeadm_message(seve%e,rname,  &
        'Internal error: the input subcube overlaps the cube boundaries')
      error = .true.
      return
    endif
    !
    call cubetuple_get_subcube(subcube%cube%user,subcube%cube%prog,&
         subcube%cube,subcube%iter%infirst,subcube%iter%inlast,entry,error)
    if (error) return
    !
    if (subcube%pointeris.eq.code_pointer_allocated) then
       do iz=1,subcube%nz
          subcube%val(:,:,iz) = entry%r4(:,:,iz)
       enddo ! iz
    else
       subcube%val => entry%r4
       subcube%pointeris = code_pointer_associated
    endif
    subcube%nx = entry%n1
    subcube%ny = entry%n2
    subcube%nz = entry%n3
    !
    call cubeio_free_subcube(entry,error)
    if (error) return
  end subroutine cubeadm_subcube_get
  !
  subroutine cubeadm_subcube_put(subcube,error)
    use cubeio_subcube
    use cubetuple_entry
    !---------------------------------------------------------------------
    ! Put the subcube to the cube, from "first" to "last" planes
    ! Only use pointers => Nothing to free
    !---------------------------------------------------------------------
    class(subcube_t), intent(in)    :: subcube
    logical,          intent(inout) :: error
    !
    type(cubeio_subcube_t) :: entry
    character(len=*), parameter :: rname='SUBCUBE>PUT'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    entry%allocated = code_pointer_associated
    entry%n1 = subcube%nx
    entry%n2 = subcube%ny
    entry%n3 = subcube%nz
    entry%r4 => subcube%val
    entry%iscplx = .false.
    !
    call cubetuple_put_subcube(subcube%cube%user,subcube%cube%prog,&
         subcube%cube,subcube%iter%oufirst,subcube%iter%oulast,entry,error)
    if (error) return
  end subroutine cubeadm_subcube_put
end module cubeadm_subcube_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
