!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetuple_get
  use gkernel_interfaces
  use cubetools_parameters
  use cubetools_access_types
  use cubetools_setup_types
  use cubedag_tuple
  use cubeio_cube_define
  use cubetuple_messaging
  use cubetuple_format_class
  use cubetuple_tuple
  !
  public :: cubetuple_get_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
    integer(kind=4) :: hdu
    character(len=maxdim) :: iorder
    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,iorder,cubename,hdu,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,iorder,cubename,hdu,error)
    if (error) return
    if (found) then
      ! Note that the 'iorder' (intrinsic order) fetched from the DAG is
      ! valid for the returned cubename[hdu] (not its transposed)
      call cubetuple_message(seve%d,rname,  &
        'Header not yet available in memory => loading from disk')
      call cubetuple_read_cube_header(cubename,hdu,'???',iorder,cub,error)
      return
    endif

    ! Last fallback: file is not loaded in memory and was not found on
    ! disk. Likely the disk file was removed. Header interface was saved in
    ! the DAG file and was loaded in the DAG node.
    ! Note the data is lost and will not be accessible later on.
    call cubetuple_get_cube_header_from_dag(cub%user,cub%prog,cub,error)
    if (error)  return
  end subroutine cubetuple_get_cube_header
  !
  subroutine cubetuple_read_cube_header(cubename,hdu,cubeid,iorder,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
    integer(kind=4),  intent(in)    :: hdu
    character(len=*), intent(in)    :: cubeid  ! Identifier (feedback only)
    character(len=*), intent(in)    :: iorder  ! Associated intrinsic order for cubename[hdu]
    class(format_t),  intent(inout) :: cub     ! In return might be the direct or transposed cube
    logical,          intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='READ>CUBE>HEADER'
    !
    call cub%prog%set_filename(cubename,hdu,error)
    if (error)  return
    call cub%prog%set_id(cubeid,error)
    if (error)  return
    call cubetuple_get_cube_header_from_disk(cub%user,cub%prog,iorder,cub,error)
    if (error)  return
  end subroutine cubetuple_read_cube_header
  !
  subroutine cubetuple_search_dagcube(tuple,access,location,found,  &
    iorder,cubename,hdu,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)   :: iorder    ! If found, associated intrinsic order
    character(len=*),      intent(out)   :: cubename  ! Cube name on disk, if relevant
    integer(kind=4),       intent(out)   :: hdu       ! HDU number in the disk file, 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 (code_access_user)
      call cubetuple_message(seve%e,rname,  &
        'Internal error: code_access_user should have been resolved at run time')
      error = .true.
      return
    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,  &
        iorder,cubename,hdu)
      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.
    call cub%tuple%set_current(dcube,error)
    if (error)  return
    !
    ! 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,iorder,cub,error)
    use cubeio_highlevel
    !----------------------------------------------------------------------
    ! 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
    character(len=*),        intent(in)    :: iorder
    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,cub%tuple%cube(1),error)
    if (error)  return
    ! The iorder is valid for the input cubdef%filename and hdu => set it for
    ! this cube:
    call cub%tuple%cube(1)%set_iorder(iorder,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
    call cub%tuple%set_current(dcube,error)
    if (error)  return
  end subroutine cubetuple_get_cube_header_from_disk
  !
  subroutine cubetuple_get_cube_header_from_dag(cubset,cubdef,cub,error)
    use cubeio_highlevel
    use cubeio_desc_setup
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    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
    character(len=*), parameter :: rname='GET>CUBE>HEADER>FROM>DAG'
    !
    call cubetuple_message(seve%t,rname,'Welcome')
    !
    call cubeio_interface_put(cub,cub%prog%access,cub%tuple%current,error)
    if (error) return
    !
    ! 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_dag
  !
  subroutine cubetuple_search_tuplecube(rname,cubset,cubdef,cub,dcube,error)
    use cubeio_transpose
    !-------------------------------------------------------------------
    ! 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_norder+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(tupleseve%trans,rname,  &
        'Data will be transposed in memory')
      cub%tuple%trans%do = code_trans_memo
    else
      call cubetuple_message(tupleseve%trans,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.
    !
    ! This subroutine precisely offers the heuristic to choose the proper
    ! order corresponding to the requested 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) :: iorder
    !
    ! print *,">>> Searching for ",cubetools_accessname(access)
    cubetuple_find_access = 0
    !
    ! Search in the cubes list, i.e. in
    !    tuple%cube(1)
    !    tuple%cube(2)
    !    etc (should there be more)
    ! which cube matches the desired access. When the access is flexible
    ! (like code_access_any), precedence is given to the 'current' order.
    ! ZZZ If we are flexible, we should also give precedence to the cubes
    !     with data already available.
    !
    if (tuple%icurrent.ne.0) then  ! Can it really be 0?
      ! Try current cube first:
      if (this_cube_matches(tuple%icurrent)) then
        cubetuple_find_access = tuple%icurrent
        return
      endif
    endif
    !
    ! Then try all cubes (except current, already tested)
    do iorder=1,cubetuple_norder
      if (iorder.eq.tuple%icurrent)  cycle
      if (this_cube_matches(iorder)) then
        cubetuple_find_access = iorder
        return
      endif
    enddo
    !
  contains
    !
    function this_cube_matches(iorder)
      logical :: this_cube_matches
      integer(kind=4), intent(in) :: iorder
      ! Local
      integer(kind=code_k) :: thisorder
      !
      this_cube_matches = .false.
      ! Sanity
      if (tuple%trans%do.ne.code_trans_none .and. tuple%trans%to.eq.iorder) then
        ! A transposition for this access is pending: this access is not
        ! ready for use.
        return
      endif
      thisorder = tuple%cube(iorder)%order()
      ! print *,">>> Testing for ",cubetools_ordername(thisorder)
      select case (access)
      case (code_access_any,code_access_subset,code_access_fullset)  ! Any access is accepted
        this_cube_matches = thisorder.ne.code_null
      case (code_access_imaset_or_speset)
        this_cube_matches = thisorder.eq.code_cube_imaset .or.  &
                            thisorder.eq.code_cube_speset
      case (code_access_imaset,code_access_speset)  ! A specific access is requested
        this_cube_matches = thisorder.eq.cubetools_access2order(access)
      end select
    end function this_cube_matches
  end function cubetuple_find_access
end module cubetuple_get
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
