!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeadm_subcube_types
  use cubetools_parameters
  use cubetools_array_types
  use cubetuple_format_class
  use cubeadm_messaging
  use cubeadm_taskloop
  use cubeadm_taskloop_iteration
  !
  public :: subcube_t
  private
  !
  type, extends(real_3d_t) :: subcube_t
     class(format_t),           private, pointer :: cube => null() ! Associated cube
     type(cubeadm_iterator_t),  private, pointer :: task => null() ! Associated task iteration
     integer(kind=indx_k),      private          :: n(3)           ! Subcube dimensions
     integer(kind=indx_k),      public           :: range1(2)      ! Min-max range of 1st dimension
     integer(kind=indx_k),      public           :: range2(2)      ! Min-max range of 2nd dimension
     integer(kind=indx_k),      public           :: range3(2)      ! Min-max range of 3rd dimension
     integer(kind=indx_k),      public           :: nvalid3        ! Valid   size  of 3rd dimension
     integer(kind=indx_k),      public           :: v3shift        ! 3rd dimension is shifted?
   contains
     procedure, public  :: allocate  => cubeadm_subcube_allocate
     procedure, public  :: associate => cubeadm_subcube_associate
     procedure, private :: prepare   => cubeadm_subcube_prepare
     procedure, public  :: get       => cubeadm_subcube_get
     procedure, public  :: put       => cubeadm_subcube_put
     procedure, public  :: put_in    => cubeadm_subcube_put_in
  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
    class(format_t),             intent(in)    :: cube
    type(cubeadm_iterator_t), intent(in)    :: iterator
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='SUBCUBE>ALLOCATE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call subcube%prepare(name,cube,iterator,error)
    if (error)  return
    call subcube%reallocate(name,&
         subcube%n(1),subcube%n(2),subcube%n(3),&
         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
    class(format_t),          intent(in)    :: cube
    type(cubeadm_iterator_t), intent(in)    :: iterator
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='SUBCUBE>ASSOCIATE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call subcube%prepare(name,cube,iterator,error)
    if (error)  return
    call subcube%prepare_association(name,&
         subcube%n(1),subcube%n(2),subcube%n(3),&
         error)
    if (error) return
  end subroutine cubeadm_subcube_associate
  !
  subroutine cubeadm_subcube_prepare(subcube,name,cube,iterator,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(subcube_t),                 intent(out)   :: subcube
    character(len=*),                 intent(in)    :: name
    class(format_t),          target, intent(in)    :: cube
    type(cubeadm_iterator_t), target, intent(in)    :: iterator
    logical,                          intent(inout) :: error
    !
    logical, parameter :: notruncate=.false.
    integer(kind=code_k) :: access
    character(len=*), parameter :: rname='SUBCUBE>PREPARE'
    !
    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
    access = cube%access()
    if (access.ne.code_access_subset .and. &
        access.ne.code_access_fullset) then
       call cubeadm_message(seve%e,rname,  &
            'Can not get a subcube from a cube with other access declared')
       error = .true.
       return
    endif
    if (.not.cube%iter%ready(rname,error)) then
       call cubeadm_message(seve%e,rname,  &
         'Failed to associate or allocate the '''//name//''' subcube on its cube')
       error = .true.
       return
    endif
    !
    subcube%cube => cube
    subcube%task => iterator
    !
    call cube%iter%subcube_region(subcube%range1,subcube%range2,error)
    if (error)  return
    ! By design the 3rd axis range is not truncated: ths is a feature of
    ! subcubes to "map" non-existing planes (to be ignored when the time
    ! comes).
    call cube%iter%range(iterator%prange,notruncate,subcube%range3,error)
    if (error)  return
    !
    call cube%iter%subcube_size(subcube%n(1),subcube%n(2),error)
    if (error)  return
    subcube%n(3) = subcube%range3(2)-subcube%range3(1)+1
  end subroutine cubeadm_subcube_prepare
  !
  !------------------------------------------------------------------------
  !
  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,valid3(2)
    type(cubeio_subcube_t) :: entry
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SUBCUBE>GET'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    n3 = subcube%cube%tuple%current%desc%n3
    !
    ! Range of valid planes in the input cube referential
    valid3(1) = subcube%range3(1)
    valid3(2) = subcube%range3(2)
    subcube%v3shift = 0
    !
    ! During the iteration, . Deal with this:
    if (subcube%range3(1).gt.n3 .or. subcube%range3(2).lt.1) then
      ! The range is fully off the cube. It is valid to request planes
      ! beyond the cube (e.g. surset extraction with EXTRACT). Free the
      ! pointer and assume the caller knows it can not use it.
      call entry%free(error)
      if (error) return
      subcube%nx = subcube%n(1)
      subcube%ny = subcube%n(2)
      subcube%nz = subcube%n(3)
      subcube%nvalid3 = 0
      return
    endif
    if (valid3(1).lt.1 .and. valid3(2).ge.1) then
      ! Some left planes missing (note: can happen with right planes missing)
      subcube%v3shift = subcube%range3(1)-1
      valid3(1) = 1  ! First valid plane to read from cube
    endif
    if (valid3(1).le.n3 .and. valid3(2).gt.n3) then
      ! Some right planes missing (note: can happen with left planes missing)
      valid3(2) = n3  ! Last valid plane to read from cube
    endif
    subcube%nvalid3 = valid3(2)-valid3(1)+1
    !
    call cubetuple_get_subcube(subcube%cube%user,  &
                               subcube%cube%prog,  &
                               subcube%cube,       &
                               valid3(1),          &
                               valid3(2),          &
                               entry,error)
    if (error) return
    !
    ! Sanity check on leading dimensions
    if (subcube%range1(1).lt.1 .or. subcube%range1(2).gt.entry%n1  .or.  &
        subcube%range2(1).lt.1 .or. subcube%range2(2).gt.entry%n2) then
      write(mess,'(9(A,I0))')  &
        'Region overlaps subcube range. Region: [',  &
        subcube%range1(1),':',subcube%range1(2),',',   &
        subcube%range2(1),':',subcube%range2(2),'], 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%nvalid3
         do i2=1,subcube%n(2)
           do i1=1,subcube%n(1)
             j1 = subcube%range1(1) + i1 - 1
             j2 = subcube%range2(1) + i2 - 1
             j3 = i3  ! 3rd dimension already extracted with above get. Subcube
                      ! is always filled to the left (1, 2, 3, ...) even in
                      ! case of missing leading planes, in order to remain
                      ! symetric to the pointer code_pointer_associated case.
                      ! subcube%v3shift is set accordingly
             subcube%val(i1,i2,i3) = entry%r4(j1,j2,j3)
           enddo ! i1
         enddo ! i2
       enddo ! i3
     ! do i3 = invalid planes
         ! Do not waste time blanking them here, the caller will do it if needed
     ! enddo
    else
       ! In case of missing planes, I would like to offer a syntax like
       !   subcube%val(:,:,2:3) => entry%r4(:,:,1:2)
       ! (i.e. customize the 3rd dimension numbering) but Fortran is touchy
       ! about pointer remapping. The caller has no better solution than
       ! using subcube%v3shift
       subcube%val => entry%r4(subcube%range1(1):subcube%range1(2),  &
                               subcube%range2(1):subcube%range2(2),  &
                               1:subcube%nvalid3)
       subcube%pointeris = code_pointer_associated
    endif
    subcube%nx = subcube%n(1)
    subcube%ny = subcube%n(2)
    subcube%nz = subcube%n(3)
    !
    call entry%free(error)
    if (error) return
  end subroutine cubeadm_subcube_get
  !
  subroutine cubeadm_subcube_put(subcube,error)
    !---------------------------------------------------------------------
    ! Put the subcube to the cube
    ! Only use pointers => Nothing to free
    !---------------------------------------------------------------------
    class(subcube_t), intent(inout) :: subcube
    logical,          intent(inout) :: error
    !
    call cubeadm_subcube_put_in(subcube,subcube%cube,error)
    if (error)  return
  end subroutine cubeadm_subcube_put
  !
  subroutine cubeadm_subcube_put_in(subcube,cube,error)
    use cubeio_subcube
    use cubetuple_entry
    !---------------------------------------------------------------------
    ! Put the subcube to the cube, from "first" to "last" planes
    ! Only use pointers => Nothing to free
    !
    ! This flavor, which explicitely states the output cube, should be used
    ! when the input subcube needs to be written in another cube without
    ! copy.
    !---------------------------------------------------------------------
    class(subcube_t), intent(in)    :: subcube
    class(format_t),  intent(inout) :: cube
    logical,          intent(inout) :: error
    !
    type(cubeio_subcube_t) :: entry
    character(len=*), parameter :: rname='SUBCUBE>PUT>IN'
    !
    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(cube%user,  &
                               cube%prog,  &
                               cube,       &
                               subcube%task%num,   &
                               subcube%range3(1),  &
                               subcube%range3(2),  &
                               entry,              &
                               error)
    if (error) return
  end subroutine cubeadm_subcube_put_in
end module cubeadm_subcube_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
