!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeadm_get
  use cubetools_parameters
  use cubetuple_format_class
  use cubeadm_messaging
  use cubedag_directory_type
  use cubeadm_cubeid_types
  use cubeadm_opened
  use cubeadm_ioloop
  !
  public :: cubeadm_get_cube
  public :: cubeadm_get_header,cubeadm_get_fheader
  public :: cubeadm_access_header,cubeadm_access_fheader
  public :: cubeadm_get_last_cube
  private
  !
  ! We have 2 main use cases here.
  ! 1) Get the header of an exact type(cube_t) or an exact type(uv_t) etc, or
  ! 2) Get the header of a class(format_t) for more generic uses (the exact
  !    type can be cube_t or uv_t, etc).
  ! Since a type(cube_t) is also a class(format_t), this is ambiguous and
  ! we can not create a generic interface for this. Must rely on 2
  ! different API names.
  !
  interface cubeadm_get_header
    module procedure get_cube_header_from_id
    module procedure get_cube_header_from_cubeid
  ! module procedure get_uv_header_from_id        ! Not yet implemented
  ! module procedure get_uv_header_from_cubeid    ! Not yet implemented
  end interface cubeadm_get_header
  !
  interface cubeadm_get_fheader
  ! module procedure get_format_header_from_id    ! Not yet implemented
    module procedure get_format_header_from_cubeid
  end interface cubeadm_get_fheader
  !
  interface cubeadm_access_header
    module procedure cubeadm_access_cube_header
  ! module procedure cubeadm_access_uv_header     ! Not yet implemented
  end interface cubeadm_access_header
  !
  interface cubeadm_access_fheader
    module procedure cubeadm_access_format_header
  end interface cubeadm_access_fheader
  !
contains
  !
  subroutine cubeadm_get_cube(id,access,action,oucube,error)
    use cubedag_parameters
    use cubeio_cube_define
    use cube_types
    !----------------------------------------------------------------------
    ! Get header + data in MEMORY only
    ! ---
    ! OBSOLESCENT DO NOT USE!
    ! To be removed when OLDLOAD /SYNTAX HGDF is gone
    !----------------------------------------------------------------------
    integer(kind=iden_l), intent(in)    :: id      ! Cube ID number
    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 get_cube_header_from_id(id,access,action,oucube,error,  &
      bufferin=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 oucube%prog%reset(error)
    if (error) return
  end subroutine cubeadm_get_cube
  !
  !---------------------------------------------------------------------
  !
  subroutine get_cube_header_from_id(id,access,action,oucube,error,  &
    bufferin)
    use cubedag_parameters
    use cubedag_node_class
    use cubedag_dag_buffer
    use cube_types
    !----------------------------------------------------------------------
    ! 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   !
    integer(kind=code_k), intent(in), optional :: bufferin  ! OBSOLESCENT only for cubeadm_get_cube
    ! 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 => cubeformats_cube_ptr(ounode,error)
    if (error) return
    call fill_format_header(access,action,oucube,error,bufferin)
    if (error) return
    call cubeadm_parents_add(ounode,action)
  end subroutine get_cube_header_from_id
  !
  subroutine get_format_header_from_cubeid(cubearg,user,pformat,error,access,action)
    use cubedag_parameters
    use cubedag_dag_buffer
    use cubedag_node_class
    !----------------------------------------------------------------------
    ! Get a format header directly from the cubeid_user_cube_t
    ! ---
    ! With insertion in parent list.
    !----------------------------------------------------------------------
    type(cubeid_arg_t),   intent(in)           :: cubearg  ! The cube argument
    type(cubeid_user_t),  intent(in)           :: user     ! User cubeid registered
    class(format_t),      pointer              :: pformat  ! Resolved format pointer
    logical,              intent(inout)        :: error    !
    integer(kind=code_k), intent(in), optional :: access   ! Overload the cubearg access?
    integer(kind=code_k), intent(in), optional :: action   ! Overload the cubearg action?
    ! Local
    integer(kind=code_k) :: laccess,laction
    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')
    !
    call cubedag_cubeid_user2prog_one(cubearg,user%cube(cubearg%inum),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
    if (present(access)) then
      ! Developer has overloaded the cubearg predeclared access.
      laccess = access
    else
      laccess = cubearg%access
    endif
    if (present(action)) then
      ! Developer has overloaded the cubearg predeclared access.
      laction = action
    else
      laction = cubearg%action
    endif
    call fill_format_header(laccess,laction,pformat,error)
    if (error) return
    call cubeadm_parents_add(cubearg,user%cube(cubearg%inum),ounode,laction)
  end subroutine get_format_header_from_cubeid
  !
  subroutine get_cube_header_from_cubeid(cubearg,user,pcube,error,access,action)
    use cube_types
    !----------------------------------------------------------------------
    ! Get a format header directly from the cubeid_user_cube_t
    ! ---
    ! With insertion in parent list.
    !----------------------------------------------------------------------
    type(cubeid_arg_t),   intent(in)           :: cubearg  ! The cube argument
    type(cubeid_user_t),  intent(in)           :: user     ! User cubeid register
    type(cube_t),         pointer              :: pcube    ! Resolved cube pointer
    logical,              intent(inout)        :: error    !
    integer(kind=code_k), intent(in), optional :: access   ! Overload the cubearg access?
    integer(kind=code_k), intent(in), optional :: action   ! Overload the cubearg action?
    !
    class(format_t), pointer :: pformat
    !
    call get_format_header_from_cubeid(cubearg,user,pformat,error,access,action)
    if (error) return
    pcube => cubeformats_cube_ptr(pformat,error)
    if (error) return
  end subroutine get_cube_header_from_cubeid
  !
  !---------------------------------------------------------------------
  !
  subroutine cubeadm_access_cube_header(cube,access,action,error,opened)
    use cubedag_node_class
    use cube_types
    !----------------------------------------------------------------------
    ! * Same as cubeadm_get_header, 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, except if
    !   option 'opened' is present and .false.
    !----------------------------------------------------------------------
    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   !
    logical, optional,    intent(in)    :: opened  !
    !
    class(format_t), pointer :: format
    !
    format => cube
    call cubeadm_access_format_header(format,access,action,error,opened)
    if (error)  return
  end subroutine cubeadm_access_cube_header
  !
  subroutine cubeadm_access_format_header(cube,access,action,error,opened)
    use cubedag_node_class
    !----------------------------------------------------------------------
    ! * Same as cubeadm_get_header, 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, except if
    !   option 'opened' is present and .false.
    !----------------------------------------------------------------------
    class(format_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   !
    logical, optional,    intent(in)    :: opened  !
    ! Local
    character(len=*), parameter :: rname='ACCESS>FORMAT>HEADER'
    class(cubedag_node_object_t), pointer :: node
    logical :: lopened
    !
    ! 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 fill_format_header(access,action,cube,error)
    if (error) return
    !
    ! Add to the list of parents for this command
    if (present(opened)) then
      lopened = opened
    else
      lopened = .true.
    endif
    if (lopened) then
      node => cube
      call cubeadm_parents_add(node,action)
    endif
  end subroutine cubeadm_access_format_header
  !
  subroutine fill_format_header(access,action,oucube,error,buffering)
    use cubetools_access_types
    use cubeio_cube_define
    use cubetuple_get
    !----------------------------------------------------------------------
    ! 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  ! OBSOLESCENT only for cubeadm_get_cube
    ! Local
    character(len=*), parameter :: rname='GET>HEADER'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    if (action.eq.code_read_none)  return  ! Header not requested at all
    !
    call oucube%prog%set_access(access,error)
    if (error) return
    if (access.eq.code_access_imaset .or.  &
        access.eq.code_access_speset) then
      call oucube%prog%set_order(cubetools_access2order(access),error)
      if (error) return
    else
      ! Leave unset, should not be needed.
    endif
    call oucube%prog%set_action(action,error)
    if (error) return
    if (access.eq.code_access_fullset) then
      ! Enforce memory mode
      call oucube%prog%set_buffering(code_buffer_memory,error)
      if (error) return
    elseif (present(buffering)) then
      call oucube%prog%set_buffering(buffering,error)
      if (error) return
    endif
    ! If the file is to be generated as a transposed cube, set its file name
    call oucube%prog%set_transname(cubeadm_transname(oucube%node%id,access,error),  &
                                   error)
    if (error) return
    !
    ! Fetch from memory or read from disk the header:
    call cubetuple_get_cube_header(oucube,error)
    if (error) return
    !
  end subroutine fill_format_header
  !
  function cubeadm_transname(id,taccess,error)
    use cubetools_access_types
    use cubedag_parameters
    !---------------------------------------------------------------------
    ! Return the transposed file name (path+base+extension) from the
    ! original file name.
    ! If iname has the form: ipath/ibase.iext
    !    tname is set as:    dir%tmp/id.text
    !
    ! Note that for 100% robustness, the transposed file does not use the
    ! same basename as its original file. This because we can be dealing
    ! with 2 raw files raw1/foo.lmv and raw2/foo.lmv, and both transposed
    ! would be named tmp/foo.vlm
    !---------------------------------------------------------------------
    character(len=file_l)               :: cubeadm_transname
    integer(kind=iden_l), intent(in)    :: id
    integer(kind=4),      intent(in)    :: taccess  ! code_cube_*
    logical,              intent(inout) :: error
    !
    write(cubeadm_transname,'(a,i0,a)') trim(dir%tmp),id,cubetools_access2ext(taccess)
  end function cubeadm_transname
  !
  !---------------------------------------------------------------------
  !
  subroutine cubeadm_get_last_cube(cube,error)
    use cubedag_node_class
    use cubedag_link_type
    use cubedag_find_types
    use cube_types
    !----------------------------------------------------------------------
    ! Gets the last cube in the DAG
    !----------------------------------------------------------------------
    type(cube_t), pointer       :: cube
    logical,      intent(inout) :: error
    !
    type(dag_find_t) :: find
    type(cubedag_link_t) :: idx
    class(cubedag_node_object_t), pointer :: dno
    character(len=*), parameter :: rname='GET>LAST>CUBE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call find%ix2optx(idx,error)
    if (error) return
    dno => cubedag_node_ptr(idx%list(idx%n)%p,error)
    if (error) return
    cube => cubeformats_cube_ptr(dno,error)
    if (error) return
  end subroutine cubeadm_get_last_cube
end module cubeadm_get
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
