!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeadm_fullcube_types
  use cubetools_parameters
  use cubetools_array_types
  use cube_types
  use cubeadm_messaging
  !
  public :: fullcube_t
  private
  !
  type, extends(real_3d_t) :: fullcube_t
     type(cube_t), pointer :: cube => null() ! Associated cube
   contains
     procedure, public  :: allocate  => cubeadm_fullcube_allocate
     procedure, public  :: associate => cubeadm_fullcube_associate
     procedure, private :: prepare   => cubeadm_fullcube_prepare
     procedure, public  :: get       => cubeadm_fullcube_get
     procedure, public  :: put       => cubeadm_fullcube_put
  end type fullcube_t
  !
contains
  !
  subroutine cubeadm_fullcube_allocate(fullcube,name,cube,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(fullcube_t), intent(out)   :: fullcube
    character(len=*),  intent(in)    :: name
    type(cube_t),      intent(in)    :: cube
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='FULLCUBE>ALLOCATE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call fullcube%prepare(name,cube,error)
    if (error)  return
    call fullcube%reallocate(name,&
         cube%tuple%current%desc%n1,&
         cube%tuple%current%desc%n2,&
         ! *** JP
         cube%tuple%current%desc%n3,&
         ! *** JP
         error)
    if (error) return
  end subroutine cubeadm_fullcube_allocate
  !
  subroutine cubeadm_fullcube_associate(fullcube,name,cube,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(fullcube_t), intent(out)   :: fullcube
    character(len=*),  intent(in)    :: name
    type(cube_t),      intent(in)    :: cube
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='FULLCUBE>ASSOCIATE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call fullcube%prepare(name,cube,error)
    if (error)  return
    call fullcube%prepare_association(name,&
         cube%tuple%current%desc%n1,&
         cube%tuple%current%desc%n2,&
         ! *** JP
         cube%tuple%current%desc%n3,&
         ! *** JP
         error)
    if (error) return
  end subroutine cubeadm_fullcube_associate
  !
  subroutine cubeadm_fullcube_prepare(fullcube,name,cube,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(fullcube_t),    intent(out)   :: fullcube
    character(len=*),     intent(in)    :: name
    type(cube_t), target, intent(in)    :: cube
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='FULLCUBE>PREPARE'
    !
    if (cube%iscplx()) then
       call cubeadm_message(seve%e,rname,  &
            'Invalid attempt to get a R*4 fullcube from a C*4 cube')
       error = .true.
       return
    endif
    !
    fullcube%cube => cube
  end subroutine cubeadm_fullcube_prepare
  !
  !------------------------------------------------------------------------
  !
  subroutine cubeadm_fullcube_get(fullcube,error)
    use cube_types
    use cubeio_subcube
    use cubetuple_entry
    !---------------------------------------------------------------------
    ! Get the fullcube from the given cube.
    ! When fullcube%val is an allocated pointer, we make a copy.
    ! In all other cases (associated or null), we make it point to the
    ! data.
    !---------------------------------------------------------------------
    class(fullcube_t), intent(inout) :: fullcube
    logical,           intent(inout) :: error
    ! 
    type(cubeio_subcube_t) :: entry
    integer(kind=indx_k) :: iz
    integer(kind=indx_k), parameter :: one=1
    character(len=*), parameter :: rname='FULLCUBE>GET'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    fullcube%nx = fullcube%cube%tuple%current%desc%n1
    fullcube%ny = fullcube%cube%tuple%current%desc%n2
    fullcube%nz = fullcube%cube%tuple%current%desc%n3
    !
    call cubetuple_get_subcube(fullcube%cube%user,fullcube%cube%prog,&
         fullcube%cube,one,fullcube%nz,entry,error)
    if (error) return
    !
    if (fullcube%pointeris.eq.code_pointer_allocated) then
       do iz=1,fullcube%nz
          fullcube%val(:,:,iz) = entry%r4(:,:,iz)
       enddo ! iz
    else
       fullcube%val => entry%r4
       fullcube%pointeris = code_pointer_associated
    endif
    fullcube%nx = entry%n1
    fullcube%ny = entry%n2
    fullcube%nz = entry%n3
    !
    call entry%free(error)
    if (error) return
  end subroutine cubeadm_fullcube_get
  !
  subroutine cubeadm_fullcube_put(fullcube,error)
    use cubeadm_ioloop
    use cubeio_subcube
    use cubetuple_entry
    !---------------------------------------------------------------------
    ! Put the fullcube to the cube
    ! Only use pointers => Nothing to free
    !---------------------------------------------------------------------
    class(fullcube_t), intent(in)    :: fullcube
    logical,           intent(inout) :: error
    !
    type(cubeio_subcube_t) :: entry
    integer(kind=indx_k), parameter :: one=1
    character(len=*), parameter :: rname='FULLCUBE>PUT'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    entry%allocated = code_pointer_associated
    entry%n1 = fullcube%nx
    entry%n2 = fullcube%ny
    entry%n3 = fullcube%nz
    entry%r4 => fullcube%val
    entry%iscplx = .false.
    !
    call cubetuple_put_subcube(&
         fullcube%cube%user,&
         fullcube%cube%prog,&
         fullcube%cube,&
         one,&
         one,fullcube%nz,&
         entry,&
         error)
    if (error) return
  end subroutine cubeadm_fullcube_put
end module cubeadm_fullcube_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
