!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeadm_get
  use cubetools_parameters
  use cubetools_access
  use cubedag_flag
  use cubeio_interfaces_public
  use cubetuple_format
  use cube_types
  use cubeadm_messaging
  use cubeadm_find
  !
  public :: cubeadm_get_cube,cubeadm_get_cheader,cubeadm_access_header
  public :: cubeadm_get_fheader,cubeadm_cubeid_get_header
  public :: cubeadm_get_last_cube
  private
  !
  ! We should make no distinction between the two interfaces, as they use
  ! arguments:
  !    type(cube_t), pointer    AND
  !    type(format_t), pointer
  ! However, Fortran polymorphism does not work when using the pointer attribute!
  !
  ! Get a cube header (cube%header) from various inputs
  interface cubeadm_get_cheader  ! All variants include insertion in parent list
    module procedure cubeadm_get_cheader_from_id
    module procedure cubeadm_get_cheader_from_flags  ! ZZZ Obsolete to be removed ASAP
    module procedure cubeadm_get_cheader_from_cubeid
  end interface cubeadm_get_cheader
  !
  ! Get a format header (format%header) from various inputs
  interface cubeadm_get_fheader
    module procedure cubeadm_get_fheader_from_cubeid
  end interface cubeadm_get_fheader
  !
  interface cubeadm_cubeid_get_header  ! ZZZ Obsolete name to be replaced everywhere ASAP
    module procedure cubeadm_get_cheader_from_cubeid
  end interface cubeadm_cubeid_get_header
  !
contains
  !
  subroutine cubeadm_get_cube(identifier,flag,access,action,oucube,error)
    use cubeio_cube_define
    use cubeadm_ioloop
    !----------------------------------------------------------------------
    ! Get header + data in MEMORY only
    !----------------------------------------------------------------------
    character(len=*),     intent(in)    :: identifier
    type(flag_t),         intent(in)    :: flag
    integer(kind=code_k), intent(in)    :: access
    integer(kind=code_k), intent(in)    :: action  ! Read/write/update?
    type(cube_t),         pointer       :: oucube
    logical,              intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='GET>CUBE'
    integer(kind=entr_k) :: first,last
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    ! Header
    call cubeadm_get_cheader_from_flags(identifier,[flag],access,action,oucube,  &
      error,buffering=code_buffer_memory)
    if (error)  return
    !
    ! Data: request the whole entry range to be loaded in memory
    first = 1
    last = oucube%nentry()
    call cubeadm_io_iterate(first,last,oucube,error)
    if (error)  return
    !
    ! Reset the memory mode ZZZ Resetting everything is unsatisfying...
    call cubeio_cube_define_reset(oucube%prog,error)
    if (error)  return
  end subroutine cubeadm_get_cube
  !
  subroutine cubeadm_get_cheader_from_id(id,access,action,oucube,error)
    use cubeadm_opened
    use cubedag_parameters
    use cubedag_types
    use cubedag_dag
    !----------------------------------------------------------------------
    ! Get the header of the requested cube.
    ! File access and action is declared here, as a pre-declaration of the
    ! future data access.
    ! ---
    ! With insertion in parent list.
    !----------------------------------------------------------------------
    integer(kind=iden_l), intent(in)    :: id      ! Cube ID number
    integer(kind=code_k), intent(in)    :: access  ! code_access_*
    integer(kind=code_k), intent(in)    :: action  ! Read/write/update?
    type(cube_t),         pointer       :: oucube  !
    logical,              intent(inout) :: error   !
    ! Local
    character(len=*), parameter :: rname='GET>CHEADER>FROM>ID'
    class(cubedag_node_object_t), pointer :: ounode
    !
    call cubedag_dag_get_object(id,ounode,error)
    if (error)  return
    oucube => cubetuple_cube_ptr(ounode,error)
    if (error)  return
    call cubeadm_fill_header(access,action,oucube,error)
    if (error)  return
    call cubeadm_parents_add(ounode,action)
  end subroutine cubeadm_get_cheader_from_id
  !
  subroutine cubeadm_get_cheader_from_flags(identifier,flags,access,action,oucube,  &
    error,buffering)
    use cubeadm_opened
    use cubedag_types
    !----------------------------------------------------------------------
    ! *** JP: Obsolescent => To be removed asap.
    ! Get the header of the requested cube. This is done in 2 steps:
    !  1) identify the proper cube in the DAG, and get a pointer to it,
    !  2) read the header and fill the associated structure in memory.
    ! File access and action is declared here, as a pre-declaration of the
    ! future data access.
    ! ---
    ! With insertion in parent list.
    !----------------------------------------------------------------------
    character(len=*),     intent(in)           :: identifier
    type(flag_t),         intent(in)           :: flags(:)
    integer(kind=code_k), intent(in)           :: access
    integer(kind=code_k), intent(in)           :: action     ! Read/write/update?
    type(cube_t),         pointer              :: oucube
    logical,              intent(inout)        :: error
    integer(kind=code_k), intent(in), optional :: buffering
    ! Local
    character(len=*), parameter :: rname='GET>CHEADER>FROM>FLAGS'
    class(cubedag_node_object_t), pointer :: ounode
    !
    call cubeadm_find_node(rname,identifier,flags,ounode,error)
    if (error)  return
    oucube => cubetuple_cube_ptr(ounode,error)
    if (error)  return
    call cubeadm_fill_header(access,action,oucube,error,buffering)
    if (error)  return
    call cubeadm_parents_add(ounode,action)
  end subroutine cubeadm_get_cheader_from_flags
  !
  subroutine cubeadm_get_fheader_from_cubeid(opt,icube,user,access,action,pformat,error)
    use cubetools_primitive_arg
    use cubetools_structure
    use cubedag_parameters
    use cubedag_dag
    use cubedag_types
    use cubeadm_cubeid_types
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! Get a format header directly from the cubeid_user_cube_t
    ! ---
    ! With insertion in parent list.
    !----------------------------------------------------------------------
    type(option_t),       intent(in)    :: opt      ! Option
    integer(kind=cube_k), intent(in)    :: icube    ! icube
    type(cubeid_user_t),  intent(in)    :: user     ! User cubeid register
    integer(kind=code_k), intent(in)    :: access   ! Per spectrum/image/any?
    integer(kind=code_k), intent(in)    :: action   ! Read/write/update?
    class(format_t),      pointer       :: pformat  ! Resolved format pointer
    logical,              intent(inout) :: error    !
    ! Local
    type(cubeid_arg_t), pointer :: optarg
    class(cubedag_node_object_t), pointer :: ounode
    integer(kind=iden_l) :: id
    character(len=*), parameter :: rname='GET>FHEADER>FROM>CUBEID'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    optarg => cubeadm_cubeid_arg_ptr(opt%arg%list(icube)%p,error)
    if (error)  return
    call cubeadm_cubeid_user2prog_one(optarg,user%cube(icube),id,error)
    if (error)  return
    call cubedag_dag_get_object(id,ounode,error)
    if (error)  return
    pformat => cubetuple_format_ptr(ounode,error)
    if (error)  return
    call cubeadm_fill_header(access,action,pformat,error)
    if (error)  return
    call cubeadm_parents_add_v2(optarg,user%cube(icube),ounode,action)
  end subroutine cubeadm_get_fheader_from_cubeid
  !
  subroutine cubeadm_get_cheader_from_cubeid(opt,icube,user,access,action,pcube,error)
    use cubetools_structure
    use cubeadm_cubeid_types
    !----------------------------------------------------------------------
    ! Get a format header directly from the cubeid_user_cube_t
    ! ---
    ! With insertion in parent list.
    !----------------------------------------------------------------------
    type(option_t),       intent(in)    :: opt     ! Option
    integer(kind=cube_k), intent(in)    :: icube   ! icube
    type(cubeid_user_t),  intent(in)    :: user    ! User cubeid register
    integer(kind=code_k), intent(in)    :: access  ! Per spectrum/image/any?
    integer(kind=code_k), intent(in)    :: action  ! Read/write/update?
    type(cube_t),         pointer       :: pcube   ! Resolved cube pointer
    logical,              intent(inout) :: error   !
    !
    class(format_t), pointer :: pformat
    !
    call cubeadm_get_fheader_from_cubeid(opt,icube,user,access,action,pformat,error)
    if (error)  return
    pcube => cubetuple_cube_ptr_from_format(pformat,error)
    if (error)  return
  end subroutine cubeadm_get_cheader_from_cubeid
  !
  subroutine cubeadm_access_header(cube,access,action,error)
    use cubeadm_opened
    use cubedag_types
    !----------------------------------------------------------------------
    ! * Same as cubeadm_get_cheader, without the 'find' and 'read-header'
    !   parts.
    ! * From a cube with header already in memory, (re)declare the file
    !   access and action on the cube, as a pre-declaration of the future
    !   data access.
    ! * Also reference the cube in the opened parents list.
    !----------------------------------------------------------------------
    type(cube_t),         pointer       :: cube    !
    integer(kind=code_k), intent(in)    :: access  ! code_access_*
    integer(kind=code_k), intent(in)    :: action  ! Read/write/update?
    logical,              intent(inout) :: error   !
    ! Local
    character(len=*), parameter :: rname='ACCESS>HEADER'
    class(cubedag_node_object_t), pointer :: node
    !
    ! Sanity
    if (.not.associated(cube)) then
      call cubeadm_message(seve%e,rname,'Internal error: node pointer is null')
      error = .true.
      return
    endif
    ! ZZZ Should add sanity to check if the cube%head is available
    !
    ! The following subroutine is optimized to avoid re-filling the header
    ! if already present.
    call cubeadm_fill_header(access,action,cube,error)
    if (error)  return
    !
    node => cube
    call cubeadm_parents_add(node,action)
  end subroutine cubeadm_access_header
  !
  subroutine cubeadm_fill_header(access,action,oucube,error,buffering)
    use cubedag_tuple
    use cubedag_node
    use cubeio_cube_define
    use cubetuple_get
    use cubeadm_directory_type
    !----------------------------------------------------------------------
    ! Get the header in the requested order from the file whose filename is
    ! available on disk. Its action (read/update) is set at this stage of
    ! the process.
    !----------------------------------------------------------------------
    integer(kind=code_k), intent(in)           :: access     ! code_access_*
    integer(kind=code_k), intent(in)           :: action     ! Read/write/update?
    class(format_t),      intent(inout)        :: oucube     !
    logical,              intent(inout)        :: error      !
    integer(kind=code_k), intent(in), optional :: buffering  !
    ! Local
    character(len=*), parameter :: rname='GET>HEADER'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cubeio_cube_define_access(oucube%prog,access,error)
    if (error)  return
    if (access.eq.code_access_imaset .or.  &
        access.eq.code_access_speset) then
      call cubeio_cube_define_order(oucube%prog,cubetools_access2order(access),error)
      if (error)  return
    else
      ! Leave unset, should not be needed.
    endif
    call cubeio_cube_define_action(oucube%prog,action,error)
    if (error)  return
    if (access.eq.code_access_fullset) then
      ! Enforce memory mode
      call cubeio_cube_define_buffering(oucube%prog,code_buffer_memory,error)
      if (error)  return
    elseif (present(buffering)) then
      call cubeio_cube_define_buffering(oucube%prog,buffering,error)
      if (error)  return
    endif
    ! If the file is to be generated as a transposed cube, set its file name
    call cubeio_cube_define_transname(oucube%prog,  &
                                      cubeadm_transname(oucube%node%id,access,error),  &
                                      error)
    if (error)  return
    !
    ! Header already available?
    call cubetuple_get_cube_header(oucube,error)
    if (error) return
    !
  end subroutine cubeadm_fill_header
  !
  subroutine cubeadm_get_last_cube(cube,error)
    use cubedag_index
    use cubedag_find
    !----------------------------------------------------------------------
    ! Gets the last cube in the DAG
    !----------------------------------------------------------------------
    type(cube_t), pointer       :: cube
    logical,      intent(inout) :: error
    !
    type(cubedag_find_t) :: find
    type(cubedag_optimize_t) :: idx
    character(len=*), parameter :: rname='GET>LAST>CUBE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cubedag_find_ix2optx(find,idx,error)
    if (error) return
    cube => cubetuple_cube_ptr(idx%object(idx%next-1)%p,error)
    if (error)  return
  end subroutine cubeadm_get_last_cube
end module cubeadm_get
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
