!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeadm_subcube_types
  use cubetools_array_types
  use cube_types
  use cubeadm_messaging
  use cubeadm_taskloop
  use cubeadm_taskloop_iteration
  !
  public :: subcube_t
  private
  !
  type, extends(real_3d_t) :: subcube_t
     type(cube_t),              private, pointer :: cube => null() ! Associated cube
     type(cubeadm_iterator_t),  private, pointer :: task => null() ! Associated task iteration
     type(subcube_iteration_t), public           :: iter           ! Current iteration
   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
     !
     procedure, private :: iteration_subset => subcube_iteration_subset
  end type subcube_t
  !
contains
  !
  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(cubeadm_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%cube => cube
    subcube%task => iterator
    call subcube%iteration_subset(error)
    if (error)  return
    call subcube%reallocate(name,&
         subcube%iter%n1,subcube%iter%n2,subcube%iter%n3,&
         error)
    if (error) return
  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(cubeadm_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%cube => cube
    subcube%task => iterator
    call subcube%iteration_subset(error)
    if (error)  return
    call subcube%prepare_association(name,&
         subcube%iter%n1,subcube%iter%n2,subcube%iter%n3,&
         error)
    if (error) return
  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) :: n3,i1,i2,i3,j1,j2,j3
    type(cubeio_subcube_t) :: entry
    character(len=mess_l) :: mess
    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:
    n3 = subcube%cube%tuple%current%desc%n3
    if (subcube%iter%in3f.gt.n3 .or. subcube%iter%in3l.lt.1) then
      ! The range is fully off the cube. Free the pointer and assume
      ! the caller will not use it.
      call entry%free(error)
      if (error) return
      subcube%nx = subcube%iter%n1
      subcube%ny = subcube%iter%n2
      subcube%nz = 0 ! IMPORTANT
      return
    endif
    if ((subcube%iter%in3f.lt.1  .and. subcube%iter%in3l.ge.1) .or. &
        (subcube%iter%in3f.le.n3 .and. subcube%iter%in3l.gt.n3)) 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.
      write(mess,'(4(A,I0))')  'Internal error: '//  &
        'the input subcube overlaps the cube boundaries (requested: ',  &
        subcube%iter%in3f,'-',subcube%iter%in3l,', limits: 1-',n3,')'
      call cubeadm_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    !
    call cubetuple_get_subcube(subcube%cube%user,  &
                               subcube%cube%prog,  &
                               subcube%cube,       &
                               subcube%iter%in3f,  &
                               subcube%iter%in3l,  &
                               entry,error)
    if (error) return
    !
    ! Sanity check
    if (subcube%iter%in1f.lt.1 .or. subcube%iter%in1l.gt.entry%n1  .or.  &
        subcube%iter%in2f.lt.1 .or. subcube%iter%in2l.gt.entry%n2) then
      write(mess,'(9(A,I0))')  &
        'Region overlaps subcube range. Region: [',  &
        subcube%iter%in1f,':',subcube%iter%in1l,',',   &
        subcube%iter%in2f,':',subcube%iter%in2l,'], subcube: [',  &
        1,':',entry%n1,',',  &
        1,':',entry%n2,']'
      call cubeadm_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    !
    if (subcube%pointeris.eq.code_pointer_allocated) then
       do i3=1,subcube%iter%n3
         do i2=1,subcube%iter%n2
           do i1=1,subcube%iter%n1
             j1 = subcube%iter%in1f + i1 - 1
             j2 = subcube%iter%in2f + i2 - 1
             j3 = i3  ! 3rd dimension already extracted with above get
             subcube%val(i1,i2,i3) = entry%r4(j1,j2,j3)
           enddo ! i1
         enddo ! i2
       enddo ! i3
    else
       subcube%val => entry%r4(subcube%iter%in1f:subcube%iter%in1l,  &
                               subcube%iter%in2f:subcube%iter%in2l,  &
                               :)
       subcube%pointeris = code_pointer_associated
    endif
    subcube%nx = subcube%iter%n1
    subcube%ny = subcube%iter%n2
    subcube%nz = subcube%iter%n3
    !
    call entry%free(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%task%num,   &
                               subcube%iter%ou3f,  &
                               subcube%iter%ou3l,  &
                               entry,              &
                               error)
    if (error) return
  end subroutine cubeadm_subcube_put
  !
  subroutine subcube_iteration_subset(subcube,error)
    use cubetopology_firstlaststride_types
    !-------------------------------------------------------------------
    ! Compute the 1st-2nd-3rd ranges of the subcube iteration.
    !-------------------------------------------------------------------
    class(subcube_t), intent(inout) :: subcube
    logical,          intent(inout) :: error
    !
    type(firstlaststride_t), pointer :: reg1,reg2,reg3
    !
    reg1 => null()
    reg2 => null()
    reg3 => null()
    if (associated(subcube%task)) then
      if (associated(subcube%task%region)) then
        if (subcube%cube%order().eq.code_cube_imaset) then
          reg1 => subcube%task%region%ix
          reg2 => subcube%task%region%iy
          reg3 => subcube%task%region%iz
        else
          reg1 => subcube%task%region%iz
          reg2 => subcube%task%region%ix
          reg3 => subcube%task%region%iy
        endif
      endif
    endif
    !
    ! --- Leading dimensions ---
    subcube%iter%in1f = 1
    subcube%iter%in1l = subcube%cube%tuple%current%desc%n1
    subcube%iter%in2f = 1
    subcube%iter%in2l = subcube%cube%tuple%current%desc%n2
    if (associated(reg1)) then
      if (reg1%first.ne.code_indx_auto)  subcube%iter%in1f = reg1%first
      if (reg1%last .ne.code_indx_auto)  subcube%iter%in1l = reg1%last
      if (reg2%first.ne.code_indx_auto)  subcube%iter%in2f = reg2%first
      if (reg2%last .ne.code_indx_auto)  subcube%iter%in2l = reg2%last
    endif
    !
    subcube%iter%m1 = subcube%iter%in1l-subcube%iter%in1f+1
    subcube%iter%m2 = subcube%iter%in2l-subcube%iter%in2f+1
    subcube%iter%n1 = subcube%iter%m1
    subcube%iter%n2 = subcube%iter%m2
    !
  ! subcube%iter%ou1f = 1
  ! subcube%iter%ou1l = subcube%iter%n1
  ! subcube%iter%ou2f = 1
  ! subcube%iter%ou2l = subcube%iter%n2
    !
    ! --- Trailing dimension ---
    subcube%iter%m3 = subcube%cube%tuple%current%desc%n3
    if (associated(reg3)) then
      if (reg3%first.ne.code_indx_auto)  subcube%iter%m3 = reg3%last-reg3%first+1
    endif
    ! Input (read the whole task range)
    subcube%iter%in3f = subcube%task%ifp
    subcube%iter%in3l = subcube%task%ilp
    subcube%iter%n3 = subcube%iter%in3l-subcube%iter%in3f+1
    ! Output
    subcube%iter%ou3f = subcube%iter%in3f
    subcube%iter%ou3l = subcube%iter%in3l
    if (associated(reg3)) then
      if (reg3%first.ne.code_indx_auto)  subcube%iter%ou3f = subcube%iter%in3f - reg3%first + 1
      if (reg3%first.ne.code_indx_auto)  subcube%iter%ou3l = subcube%iter%in3l - reg3%first + 1
    endif
  end subroutine subcube_iteration_subset
  !
end module cubeadm_subcube_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
