!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetuple_get
  use gkernel_interfaces
  use cubetools_access
  use cubetools_setup_types
  use cubedag_tuple
  use cubeio_interfaces_public
  use cubeio_cube_define
  use cubetuple_messaging
  use cubetuple_format
  !
  public :: cubetuple_get_cube_header,cubetuple_read_cube_header
  private
  !
contains
  !
  subroutine cubetuple_get_cube_header(cub,error)
    !-------------------------------------------------------------------
    ! Get the header of a tuple. Basically 2 possibilities:
    ! 1) already loaded in memory => nothing to do
    ! 2) not yet loaded => read from disk
    ! Also set the desired access as current default. Take care of
    ! possible transposition involved.
    !-------------------------------------------------------------------
    class(format_t), intent(inout) :: cub
    logical,         intent(inout) :: error
    ! Local
    logical :: found
    character(len=file_l) :: cubename
    character(len=*), parameter :: rname='GET>CUBE>HEADER'
    !
    if (.not.cub%prog%doaccess) then
      call cubetuple_message(seve%e,rname,'Expected cube access is not set')
      error = .true.
      return
    endif
    !
    ! Search for header in memory
    call cubetuple_get_cube_header_from_memory(cub%user,cub%prog,cub,found,error)
    if (error)  return
    if (found) then
      call cubetuple_message(seve%d,rname,  &
        'Header already available in memory => not reloaded')
      return
    endif
    !
    ! Search for data in memory (should not happen!)
    call cubetuple_search_dagcube(cub%node%tuple,cub%prog%access,  &
      code_buffer_memory,found,cubename,error)
    if (error) return
    if (found) then
      call cubetuple_message(seve%e,rname,'Internal error: cube data '//  &
        'is declared found in memory but its header is not available')
      error = .true.
      return
    endif

    ! Search for header on disk and load it
    call cubedag_tuple_diskupdate(cub%node%tuple,error)
    if (error)  return
    call cubetuple_search_dagcube(cub%node%tuple,cub%prog%access,  &
      code_buffer_disk,found,cubename,error)
    if (error) return
    if (found) then
      call cubetuple_message(seve%d,rname,  &
        'Header not yet available in memory => loading from disk')
      call cubetuple_read_cube_header(cubename,'???',cub,error)
      return
    endif
    !
    ! Error
    call cubetuple_message(seve%e,rname,'The requested access was not found in memory nor disk')
    error = .true.
    return
  end subroutine cubetuple_get_cube_header
  !
  subroutine cubetuple_read_cube_header(cubename,cubeid,cub,error)
    !-------------------------------------------------------------------
    ! Read the header of a tuple, (re)loaded from disk.
    ! Also set the desired access as current default. Take care of
    ! possible transposition involved.
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: cubename
    character(len=*), intent(in)    :: cubeid  ! Identifier (feedback only)
    class(format_t),  intent(inout) :: cub
    logical,          intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='READ>CUBE>HEADER'
    !
    call cubeio_cube_define_filename(cub%prog,cubename,error)
    if (error)  return
    call cubeio_cube_define_id(cub%prog,cubeid,error)
    if (error)  return
    call cubetuple_get_cube_header_from_disk(cub%user,cub%prog,cub,error)
    if (error)  return
  end subroutine cubetuple_read_cube_header
  !
  subroutine cubetuple_search_dagcube(tuple,access,location,found,cubename,error)
    !-------------------------------------------------------------------
    ! Search if the DAG references an up-to-date version of the data,
    ! either in memory or disk, either direct or transposed.
    !-------------------------------------------------------------------
    type(cubedag_tuple_t), intent(in)    :: tuple
    integer(kind=code_k),  intent(in)    :: access    ! Per spectrum/image/any?
    integer(kind=code_k),  intent(in)    :: location  ! Memory or disk?
    logical,               intent(out)   :: found     !
    character(len=*),      intent(out)   :: cubename  ! Cube name on disk, if relevant
    logical,               intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='SEARCH>DAGCUBE'
    integer(kind=code_k) :: laccess(3)
    integer(kind=4) :: naccess,iaccess
    !
    select case (access)
    case (code_access_imaset,code_access_speset)
      naccess = 2
      laccess(1) = access
      laccess(2) = cubetools_transpose_access(access)
    case (code_access_imaset_or_speset)
      naccess = 2
      laccess(1) = code_cube_speset  ! ZZZ Is this the default?
      laccess(2) = code_cube_imaset
    case (code_access_any,code_access_subset,code_access_fullset)
      naccess = 3
      laccess(1) = code_cube_speset  ! ZZZ Is this the default?
      laccess(2) = code_cube_imaset
      laccess(3) = code_cube_unkset
    case default
      call cubetuple_message(seve%e,rname,'Internal error: unsupported access code')
      error = .true.
      return
    end select
    !
    do iaccess=1,naccess
      found = cubedag_tuple_hasuptodatefile(tuple,laccess(iaccess),location,  &
        cubename,error)
      if (error)  return
      if (found)  return
    enddo
  end subroutine cubetuple_search_dagcube
  !
  subroutine cubetuple_get_cube_header_from_memory(cubset,cubdef,cub,found,error)
    use cubeio_desc_setup
    !----------------------------------------------------------------------
    ! From a cube already in memory, set the desired access as the default
    ! one
    !----------------------------------------------------------------------
    type(cube_setup_t),      intent(in)    :: cubset
    type(cube_define_t),     intent(in)    :: cubdef
    class(format_t), target, intent(inout) :: cub
    logical,                 intent(out)   :: found
    logical,                 intent(inout) :: error
    ! Local
    integer(kind=4) :: dcube
    character(len=*), parameter :: rname='GET>CUBE>HEADER>FROM>MEMORY'
    !
    call cubetuple_message(seve%t,rname,'Welcome')
    !
    found = .false.
    !
    ! Search in memory
    call cubetuple_search_tuplecube(rname,cubset,cubdef,cub,dcube,error)
    if (error)  return
    !
    if (dcube.eq.0)  return
    !
    ! Set this access as the current one
    found = .true.
    cub%tuple%current => cub%tuple%cube(dcube)
    !
    ! Update the descriptor (external components which might need changes)
    call cubeio_set_descriptor_external(cubset,cubdef,.true.,cub%tuple%current,error)
    if (error)  return
  end subroutine cubetuple_get_cube_header_from_memory
  !
  subroutine cubetuple_get_cube_header_from_disk(cubset,cubdef,cub,error)
    !----------------------------------------------------------------------
    ! Get the type(cube_header_t) of a cube, and set the current access
    ! mode for future get_chan or get_pix
    !----------------------------------------------------------------------
    type(cube_setup_t),      intent(in)    :: cubset
    type(cube_define_t),     intent(in)    :: cubdef
    class(format_t), target, intent(inout) :: cub
    logical,                 intent(inout) :: error
    ! Local
    integer(kind=4) :: dcube
    character(len=*), parameter :: rname='GET>CUBE>HEADER>FROM>DISK'
    !
    call cubetuple_message(seve%t,rname,'Welcome')
    !
    ! Read header from disk
    call cubeio_get_header(cubset,cubdef,cub%head,cub%tuple%cube(1),error)
    if (error)  return
    !
    ! Search if it is direct or transposed cube
    call cubetuple_search_tuplecube(rname,cubset,cubdef,cub,dcube,error)
    if (error)  return
    !
    ! Sanity: should not happen
    if (dcube.eq.0) then
      call cubetuple_message(seve%e,rname,'Internal error: could not get proper access')
      error = .true.
      return
    endif
    !
    ! Set this access as the current one
    cub%tuple%current => cub%tuple%cube(dcube)
  end subroutine cubetuple_get_cube_header_from_disk
  !
  subroutine cubetuple_search_tuplecube(rname,cubset,cubdef,cub,dcube,error)
    use cubetuple_tuple
    !-------------------------------------------------------------------
    ! Find which cube in the cub%tuple structure is the 'direct' one for
    ! cubdef%access
    !-------------------------------------------------------------------
    character(len=*),    intent(in)    :: rname
    type(cube_setup_t),  intent(in)    :: cubset
    type(cube_define_t), intent(in)    :: cubdef
    class(format_t),     intent(inout) :: cub
    integer(kind=4),     intent(out)   :: dcube  ! Direct cube. Return 0 if not available
    logical,             intent(inout) :: error  !
    ! Local
    integer(kind=4) :: tcube  ! Transposed cube
    integer(kind=code_k) :: fromorder
    logical :: already_in_memory
    !
    ! Search direct access in cubes already in memory
    dcube = cubetuple_find_access(cub%tuple,cubdef%access)
    if (dcube.ne.0) then
      ! The direct cube is found
      return  ! Already loaded: nothing more to do
    endif
    !
    if (cubdef%access.ne.code_access_imaset .and.  &
        cubdef%access.ne.code_access_speset) then
      ! If we are searching for exact image or spectrum access, the direct
      ! access was not found, try to search for its transposed. Otherwise,
      ! there is nothing more we can search => leave
      return
    endif
    !
    ! Not found: search transposed access in cubes already in memory
    tcube = cubetuple_find_access(cub%tuple,cubetools_transpose_access(cubdef%access))
    if (tcube.eq.0)  return  ! The transposed cube is not available => nothing more we can do
    !
    ! The transposed cube was found in the tuple. Derive the direct cube
    ! from it:
    ! 1) Memory-to-memory transposition of header
    fromorder = cub%tuple%cube(tcube)%order()
    call cubetools_transpose_operator(  &
      fromorder,  &
      cubetools_access2order(cubdef%access),  &
      cub%tuple%trans%code,error)
    if (error)  return
    dcube = cubetuple_naccess+1-tcube  ! Swap 1 <-> 2
    call cubeio_transpose_cube_desc(cubset,cubdef,  &
                                    cub%tuple%cube(tcube),  &
                                    cub%tuple%cube(dcube),  &
                                    error)
    if (error)  return
    ! 2) Enable later transposition of data
    already_in_memory = cub%tuple%cube(tcube)%desc%buffered.eq.code_buffer_memory .and.  &
                        cub%tuple%cube(tcube)%ready()
    if (already_in_memory .or. cubset%buff%input.eq.code_buffer_memory) then
      call cubetuple_message(seve%d,rname,  &
        'Data will be transposed in memory')
      cub%tuple%trans%do = code_trans_memo
    else
      call cubetuple_message(seve%d,rname,  &
        'Data will be transposed on disk to file '//trim(cub%tuple%cube(dcube)%file%name))
      cub%tuple%trans%do = code_trans_disk
    endif
    cub%tuple%trans%from = tcube
    cub%tuple%trans%to   = dcube
    !
  end subroutine cubetuple_search_tuplecube
  !
  function cubetuple_find_access(tuple,access)
    use cubetuple_tuple
    !---------------------------------------------------------------------
    ! Find which cube in the cubetuple_t (return its index in this
    ! structure) provides the desired access
    !---------------------------------------------------------------------
    integer(kind=4) :: cubetuple_find_access
    type(cubetuple_t), intent(in) :: tuple
    integer(kind=4),   intent(in) :: access  ! Desired access, can be code for any
    ! Local
    integer(kind=4) :: iaccess
    !
    cubetuple_find_access = 0
    do iaccess=1,cubetuple_naccess  ! Look in all the cubetuple_t structure
       if (tuple%trans%do.ne.code_trans_none .and.  &
           tuple%trans%to.eq.iaccess) then
         ! A transposition for this access is pending: this access
         ! is not ready for use.
         cycle
       endif
       select case (access)
       case (code_access_any,code_access_subset,code_access_fullset)  ! Any access is accepted
          ! ZZZ should pick up the one with data already available
          if (tuple%cube(iaccess)%order().ne.code_null) then
             cubetuple_find_access = iaccess
             exit
          endif
       case (code_access_imaset_or_speset)
          ! ZZZ should pick up the one with data already available
          if (tuple%cube(iaccess)%order().eq.code_cube_imaset .or.  &
              tuple%cube(iaccess)%order().eq.code_cube_speset) then
             cubetuple_find_access = iaccess
             exit
          endif
       case (code_access_imaset,code_access_speset)  ! A specific access is requested
          if (tuple%cube(iaccess)%order().eq.cubetools_access2order(access)) then
             cubetuple_find_access = iaccess
             exit
          endif
       end select
    enddo ! iaccess
  end function cubetuple_find_access
end module cubetuple_get
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
