!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_subcube_real
  use cubemain_messaging
  !
  public :: subcube_iterator_t,subcube_t
  private
  !
  type subcube_iterator_t
    integer(kind=entr_k) :: num  ! Subcube number
    integer(kind=data_k) :: infirst,inlast    ! Range for input cubes (get)
    integer(kind=data_k) :: outfirst,outlast  ! Range for output cubes (put)
    integer(kind=data_k) :: nplane
  contains
    procedure :: init => cubemain_subcube_iterator
  end type subcube_iterator_t
  !
  type subcube_t
     integer(kind=4) :: code_pointer = code_pointer_null
     real(kind=sign_k), pointer :: data(:,:,:) => null()
     integer(kind=data_k) :: n1 = 0
     integer(kind=data_k) :: n2 = 0
     integer(kind=data_k) :: n3 = 0
  contains
     procedure :: init       => cubemain_subcube_init
     procedure :: reallocate => cubemain_subcube_reallocate
     procedure :: initval    => cubemain_subcube_initval
     procedure :: get        => cubemain_subcube_get
     procedure :: put        => cubemain_subcube_put
     final     :: cubemain_subcube_free
  end type subcube_t
  !
contains
  subroutine cubemain_subcube_iterator(scubiter,taskiter,isubcube,error)
    use cubeadm_taskloop
    !-------------------------------------------------------------------
    ! Convert a taskloop iterator to a subcube iterator for subcube
    ! #isubcube
    !-------------------------------------------------------------------
    class(subcube_iterator_t), intent(out)   :: scubiter
    type(cubeadm_iterator_t),  intent(in)    :: taskiter
    integer(kind=entr_k),      intent(in)    :: isubcube
    logical,                   intent(inout) :: error
    !
    character(len=*), parameter :: rname='SUBCUBE>ITERATOR'
    !
    ! ZZZ This assumes 1 subcube per task
    !
    scubiter%num      = isubcube
    scubiter%infirst  = taskiter%firstplane
    scubiter%inlast   = taskiter%lastplane
    scubiter%outfirst = taskiter%firstplane-taskiter%offsetplane
    scubiter%outlast  = taskiter%lastplane-taskiter%offsetplane
    scubiter%nplane   = taskiter%lastplane-taskiter%firstplane+1
  end subroutine cubemain_subcube_iterator
  !
  subroutine cubemain_subcube_reassociate(n1,n2,kind,subcube,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    integer(kind=data_k), intent(in)    :: n1,n2
    character(len=*),     intent(in)    :: kind
    type(subcube_t),      intent(inout) :: subcube
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='SUBCUBE>REASSOCIATE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (n1.le.0 .or. n2.le.0) then
       call cubemain_message(seve%e,rname,'Negative or zero-sized dimensions')
       error = .true.
      return
    endif
    !
    ! The request is to get a null pointer without memory leak => Free when needed.
    call cubemain_subcube_free(subcube)
    ! Association success => subcube%code_pointer may be updated
    subcube%code_pointer = code_pointer_associated
  end subroutine cubemain_subcube_reassociate
  !
  subroutine cubemain_subcube_reallocate(subcube,cube,iter,error)
    use cube_types
    !----------------------------------------------------------------------
    ! (Re)allocation given the cube and the iterator. In return the subcube
    ! is suited to fit for the whole range being iterated.
    !----------------------------------------------------------------------
    class(subcube_t),         intent(inout) :: subcube
    type(cube_t),             intent(in)    :: cube
    type(subcube_iterator_t), intent(in)    :: iter
    logical,                  intent(inout) :: error
    !
    integer(kind=data_k) :: n1,n2,n3
    !
    n1 = cube%tuple%current%desc%n1
    n2 = cube%tuple%current%desc%n2
    n3 = iter%nplane
    !
    call cubemain_subcube_reallocate_dims(subcube,n1,n2,n3,'subcube',error)
    if (error)  return
    !
  end subroutine cubemain_subcube_reallocate
  !
  subroutine cubemain_subcube_reallocate_dims(subcube,n1,n2,n3,kind,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! (Re)allocation given the dimensions
    !----------------------------------------------------------------------
    class(subcube_t),     intent(inout) :: subcube
    integer(kind=data_k), intent(in)    :: n1,n2,n3
    character(len=*),     intent(in)    :: kind
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SUBCUBE>REALLOCATE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (n1.le.0 .or. n2.le.0 .or. n3.le.0) then
      write(mess,'(3(a,i0))') 'Negative or zero dimensions: ',n1,' x ',n2,' x ',n3
      call cubemain_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    !
    alloc = .true.
    if (subcube%code_pointer.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (subcube%n1.eq.n1 .and.  &
           subcube%n2.eq.n2 .and.  &
           subcube%n3.eq.n3) then
          write(mess,'(a,3(a,i0))')  &
            kind,' data already allocated at the right size: ',n1,' x ',n2,' x ',n3
          call cubemain_message(mainseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',kind,  &
               ' data already allocated but with a different size => Freeing it first'
          call cubemain_message(mainseve%alloc,rname,mess)
          call cubemain_subcube_free(subcube)
          if (error) return
       endif
    else
       ! subcube%data is either null or associated, so I will need to allocate it anyway
    endif
    if (alloc) then
       allocate(subcube%data(n1,n2,n3),stat=ier)
       if (failed_allocate(rname,trim(kind)//' subcube data',ier,error)) return
    endif
    ! Allocation success => subcube%code_pointer may be updated
    subcube%n1 = n1
    subcube%n2 = n2
    subcube%n3 = n3
    subcube%code_pointer = code_pointer_allocated
  end subroutine cubemain_subcube_reallocate_dims
  !
!   subroutine cubemain_subcube_reallocate_and_init(cube,name,initval,subcube,error)
!     use cube_types
!     !----------------------------------------------------------------------
!     !
!     !----------------------------------------------------------------------
!     type(cube_t),      intent(in)    :: cube
!     character(len=*),  intent(in)    :: name
!     real(kind=sign_k), intent(in)    :: initval
!     type(subcube_t),   intent(inout) :: subcube
!     logical,           intent(inout) :: error
!     !
!     integer(kind=data_k) :: n1,n2,n3
!     integer(kind=pixe_k) :: i1,i2,i3
!     character(len=*), parameter :: rname='SUBCUBE>REALLOCATE>AND>INIT'
!     !
!     call cubemain_message(mainseve%trace,rname,'Welcome')
!     !
!     ! Allocate
!     n1 = ???
!     n2 = ???
!     n3 = ???
!     call cubemain_subcube_reallocate_dims(n1,n2,n3,name,subcube,error)
!     if (error) return
!     !
!     ! Initialize
!     call cubemain_subcube_initval(subcube,initval,error)
!     if (error)  return
!   end subroutine cubemain_subcube_reallocate_and_init
  !
  subroutine cubemain_subcube_initval(subcube,initval,error)
    use cube_types
    !----------------------------------------------------------------------
    ! Initialize all data to the init value
    !----------------------------------------------------------------------
    class(subcube_t),  intent(inout) :: subcube
    real(kind=sign_k), intent(in)    :: initval
    logical,           intent(inout) :: error
    !
    integer(kind=data_k) :: i1,i2,i3
    character(len=*), parameter :: rname='SUBCUBE>INITVAL'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    do i3=1,subcube%n3
      do i2=1,subcube%n2
        do i1=1,subcube%n1
          subcube%data(i1,i2,i3) = initval
        enddo
      enddo
    enddo
  end subroutine cubemain_subcube_initval
  !
  subroutine cubemain_subcube_free(subcube)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(subcube_t), intent(inout) :: subcube
    !
    character(len=*), parameter :: rname='SUBCUBE>FREE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (subcube%code_pointer.eq.code_pointer_allocated) then
       if (associated(subcube%data))  deallocate(subcube%data)
    else
       subcube%data => null()
    endif
    subcube%n1 = 0
    subcube%n2 = 0
    subcube%n3 = 0
    subcube%code_pointer = code_pointer_null
  end subroutine cubemain_subcube_free
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_subcube_init(subcube,cube,error)
    use cube_types
    !----------------------------------------------------------------------
    ! Prepare the subcube to POINT to the given cube data.
    !----------------------------------------------------------------------
    class(subcube_t), intent(out)   :: subcube
    type(cube_t),     intent(in)    :: cube
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='SUBCUBE>INIT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Associate
    call cubemain_subcube_reassociate(cube%tuple%current%desc%n1,  &
                                      cube%tuple%current%desc%n2,  &
                                      'subcube',subcube,error)
    if (error) return
    !
    ! Fill
  !!$  if (code.eq.code_pointer_allocated) then
  !!$     image%z(ix,iy) = gr4nan
  !!$  else
  !!$     ! Does nothing
  !!$  endif
  end subroutine cubemain_subcube_init
  !
  subroutine cubemain_subcube_get(subcube,cube,iter,error)
    use cube_types
    use cubeio_subcube
    use cubetuple_entry
    !---------------------------------------------------------------------
    ! Get the subcube from the given cube (whole range being iterated).
    ! When subcube%data 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
    type(cube_t),             intent(inout) :: cube
    type(subcube_iterator_t), intent(in)    :: iter
    logical,                  intent(inout) :: error
    !
    type(cubeio_subcube_t) :: iosubc
    integer(kind=data_k) :: i3,n3
    character(len=*), parameter :: rname='SUBCUBE>GET'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (cube%iscplx()) then
      call cubemain_message(seve%e,rname,  &
        'Invalid attempt to get a R*4 subcube from a C*4 cube')
      error = .true.
      return
    endif
    !
    ! During the iteration, it is valid to request planes beyond
    ! the cube (e.g. surset extraction with EXTRACT). Deal with this:
    n3 = cube%tuple%current%desc%n3
    if (iter%infirst.gt.n3 .or. 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(iosubc,error)
      if (error)  return
      subcube%n1 = cube%tuple%current%desc%n1
      subcube%n2 = cube%tuple%current%desc%n2
      subcube%n3 = 0  ! IMPORTANT
      return
    endif
    if ((iter%infirst.lt.1  .and. iter%inlast.ge.1) .or. &
        (iter%infirst.le.n3 .and. iter%inlast.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.
      call cubemain_message(seve%e,rname,  &
        'Internal error: the input subcube overlaps the cube boundaries')
      error = .true.
      return
    endif
    !
    call cubetuple_get_subcube(cube%user,cube%prog,cube,  &
      iter%infirst,iter%inlast,iosubc,error)
    if (error) return
    !
    if (subcube%code_pointer.eq.code_pointer_allocated) then
      do i3=1,iosubc%n3
        subcube%data(:,:,i3) = iosubc%r4(:,:,i3)
      enddo
    else
      subcube%data => iosubc%r4
      subcube%code_pointer = code_pointer_associated
    endif
    subcube%n1 = iosubc%n1
    subcube%n2 = iosubc%n2
    subcube%n3 = iosubc%n3
    !
    call cubeio_free_subcube(iosubc,error)
    if (error)  return
  end subroutine cubemain_subcube_get
  !
  subroutine cubemain_subcube_put(subcube,cube,iter,error)
    use cube_types
    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
    type(cube_t),             intent(inout) :: cube
    type(subcube_iterator_t), intent(in)    :: iter
    logical,                  intent(inout) :: error
    !
    type(cubeio_subcube_t) :: iosubc
    character(len=*), parameter :: rname='SUBCUBE>REAL>PUT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (cube%iscplx()) then
      call cubemain_message(seve%e,rname,  &
        'Invalid attempt to put a R*4 subcube to a C*4 cube')
      error = .true.
      return
    endif
    !
    iosubc%allocated = code_pointer_associated
    iosubc%n1 =  subcube%n1
    iosubc%n2 =  subcube%n2
    iosubc%n3 =  subcube%n3
    iosubc%r4 => subcube%data
    iosubc%iscplx = .false.
    !
    call cubetuple_put_subcube(cube%user,cube%prog,cube,  &
      iter%outfirst,iter%outlast,iosubc,error)
    if (error) return
  end subroutine cubemain_subcube_put
  !
end module cubemain_subcube_real
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
