!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeadm_index
  use cubetools_parameters
  use cubedag_link_type
  use cube_types
  use cubeadm_messaging
  !---------------------------------------------------------------------
  ! Support module for an index (list) of type(cube_t)
  !---------------------------------------------------------------------
  !
  public :: index_t, ncub_k
  private
  !
  integer(kind=4), parameter :: ncub_k = 4
  !
  type, extends(cubedag_link_t) :: index_t
     ! No more components added
   contains
     procedure, public :: get_cube         => cubeadm_index_get_cube_ptr
     procedure, public :: put_cube         => cubeadm_index_put_cube_ptr
     procedure, public :: get_from_current => cubeadm_index_get_from_current
     procedure, public :: get_from_cubeid  => cubeadm_index_get_from_cubeid
     final             ::                     cubeadm_index_final
  end type index_t
  !
contains
  !
  subroutine cubeadm_index_get_from_current(index,access,action,error)
    use cubedag_node_class
    use cubedag_find_types
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(index_t),       intent(inout) :: index
    integer(kind=code_k), intent(in)    :: access  ! code_access_*
    integer(kind=code_k), intent(in)    :: action  ! Read/write/update?
    logical,              intent(inout) :: error
    !
    type(dag_find_t) :: find
    type(cubedag_link_t) :: mycx
    integer(kind=ncub_k) :: icub
    class(cubedag_node_object_t), pointer :: dno
    type(cube_t), pointer :: cube
    character(len=*), parameter :: rname='INDEX>GET>FROM>CURRENT'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call find%cx2optx(mycx,error)
    if (error) return
    if (mycx%n.le.0)  call cubeadm_message(seve%w,rname,'Index is empty')
    do icub=1,mycx%n
       dno => cubedag_node_ptr(mycx%list(icub)%p,error)
       if (error) return
       call cubeadm_get_header(dno%node%id,access,action,cube,error)
       if (error) return
       call index%put_cube(icub,cube,error)
       if (error) return
    enddo
  end subroutine cubeadm_index_get_from_current
  !
  subroutine cubeadm_index_get_from_cubeid(index,opt,cubeids,error)
    use cubetools_structure
    use cubeadm_get
    use cubeadm_cubeid_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(index_t),       intent(inout) :: index
    type(option_t),       intent(in)    :: opt
    type(cubeid_user_t),  intent(in)    :: cubeids
    logical,              intent(inout) :: error
    !
    integer(kind=ncub_k) :: icub
    type(cubeid_arg_t), pointer :: arg
    type(cube_t), pointer :: cube
    character(len=*), parameter :: rname='INDEX>GET>FROM>CUBEID'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    do icub=1,cubeids%ncube
       ! Fetch the cubeid_arg_t from the option_t list of arguments
       arg => cubedag_cubeid_arg_ptr(opt%arg%list(icub)%p,error)
       if (error)  return
       ! Fetch the corresponding cube_t
       call cubeadm_get_header(arg,cubeids,cube,error)
       if (error) return
       call index%put_cube(icub,cube,error)
       if (error) return
    enddo
  end subroutine cubeadm_index_get_from_cubeid
  !
  function cubeadm_index_get_cube_ptr(index,icub,error)
    use cubelist_types
    !-------------------------------------------------------------------
    ! Return a pointer to a cube_t at index icub in the index
    !-------------------------------------------------------------------
    type(cube_t), pointer :: cubeadm_index_get_cube_ptr
    class(index_t),       intent(in)    :: index
    integer(kind=ncub_k), intent(in)    :: icub
    logical,              intent(inout) :: error
    !
    class(list_object_t), pointer :: not
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='INDEX>GET>CUBE'
    !
    if (index%n.lt.icub) then
      write(mess,'(A,I0,A)')  'No such cube #',icub,' in index'
      call cubeadm_message(seve%e,rname,mess)
      cubeadm_index_get_cube_ptr => null()
      error = .true.
      return
    endif
    !
    not => index%list(icub)%p
    select type(not)
    type is (cube_t)
      cubeadm_index_get_cube_ptr => not
    class default
      cubeadm_index_get_cube_ptr => null()
      call cubeadm_message(seve%e,rname,  &
        'Internal error: object is not a cube_t type')
      error = .true.
      return
    end select
  end function cubeadm_index_get_cube_ptr
  !
  subroutine cubeadm_index_put_cube_ptr(index,icub,cube,error)
    !-------------------------------------------------------------------
    ! Put a pointer to a cube_t in the index
    !-------------------------------------------------------------------
    class(index_t),       intent(inout) :: index
    integer(kind=ncub_k), intent(in)    :: icub
    type(cube_t), target, intent(in)    :: cube
    logical,              intent(inout) :: error
    !
    ! Increase index size if needed
    call index%reallocate(icub,error)
    if (error) return
    !
    index%list(icub)%p => cube
    index%n = max(index%n,icub)
  end subroutine cubeadm_index_put_cube_ptr
  !
  subroutine cubeadm_index_final(index)
    type(index_t), intent(inout) :: index
    logical :: error
    error = .false.
    call index%cubedag_link_t%final(error)
  end subroutine cubeadm_index_final
end module cubeadm_index
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
