!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetuple_format
  use cubetools_parameters
  use cubetools_header_types
  use cubetools_processing_types
  use cubetools_setup_types
  use cubedag_node_type
  use cubeio_cube_define
  use cubetuple_messaging
  use cubetuple_tuple
  !---------------------------------------------------------------------
  ! Support module for any data kind which can be described with a
  ! cube_header_t, 0 or more DAPS, and some data with consistent shape.
  !---------------------------------------------------------------------
  !
  type, extends(cubedag_node_object_t) :: format_t
    type(cube_header_t)          :: head   ! [public]  User friendly cube description
  ! type(daps_t)                 :: daps   !
    type(cubetuple_t)            :: tuple  ! [private]
    type(cube_define_t)          :: prog   ! [private] program request
    type(cube_setup_t), pointer  :: user   ! [private] user    request
    type(cubetools_processing_t) :: proc   ! [private] technical components for processing
  contains
    procedure :: init           => cubetuple_format_init
    procedure :: list           => cubetuple_format_list
    procedure :: close          => cubetuple_format_close
    procedure :: finish         => cubetuple_format_finish
    procedure :: order          => cubetuple_format_get_order
    procedure :: attach_file    => cubetuple_format_attach_file
    procedure :: head_from_file => cubetuple_format_head_from_file
    procedure :: dag_upsert     => cubetuple_format_dag_upsert
    final     :: cubetuple_format_final
  end type format_t
  !
  public :: format_t
  public :: cubetuple_format_ptr
  private
  !
contains
  !
  subroutine cubetuple_format_init(format,setup,error)
    !-------------------------------------------------------------------
    ! Initialize a format_t
    !-------------------------------------------------------------------
    class(format_t),     intent(inout)       :: format
    type(cube_setup_t),  intent(in), target  :: setup
    logical,             intent(inout)       :: error
    !
    format%user => setup
    call format%tuple%init(error)
    if (error)  return
    call format%head%init(error)
    if (error) return
  end subroutine cubetuple_format_init
  !
  subroutine cubetuple_format_list(format,code_dataformat,error)
    use gfits_types
    use cubetools_dataformat
    use cubefitsio_header
    use cubeio_header
    use cubetools_header_vo
    !-------------------------------------------------------------------
    ! List the cube header under requested format
    !-------------------------------------------------------------------
    class(format_t),      intent(in)    :: format
    integer(kind=code_k), intent(in)    :: code_dataformat
    logical,              intent(inout) :: error
    !
    type(fitsio_header_t) :: hfits
    !
    select case (code_dataformat)
    case (code_dataformat_cube)
      call format%head%list(error)
      if (error) return
    case (code_dataformat_interface)
      call format%node%head%list(error)  ! format%node%head is interface_t
      if (error) return
    case (code_dataformat_fits)
      if (format%tuple%haskind(code_dataformat_fits)) then
        ! Tuple will just list its current FITS header
        call format%tuple%list(code_dataformat,error)
        if (error)  return
      else
        ! Convert format%head to FITS format
        call cubetuple_message(seve%w,'LIST','Current header is not FITS')
        ! NB: Display in its current order (no internal transposition at conversion
        ! time)
        call cubeio_header_put(format%head,format%tuple%order(),hfits,.false.,error)
        if (error)  return
        call gfits_list_dict(hfits%dict,error)
        if (error)  return
      endif
    case (code_dataformat_vo)
      call cubetools_header_vo_list(format%head,error)
      if (error) return
    case default
      call format%tuple%list(code_dataformat,error)
      if (error)  return
    end select
  end subroutine cubetuple_format_list
  !
  subroutine cubetuple_format_close(format,error)
    !---------------------------------------------------------------------
    ! GIO-close a 'format_t' instance. This is worth calling this
    ! subroutine as GIO slots are a limited ressource
    !---------------------------------------------------------------------
    class(format_t), intent(inout) :: format
    logical,         intent(inout) :: error
    !
    call format%tuple%close(error)
    if (error)  return
  end subroutine cubetuple_format_close
  !
  subroutine cubetuple_format_finish(format,error)
    use cubeio_desc
    use cubeio_interfaces_public
    !---------------------------------------------------------------------
    ! Properly finish a cube, e.g. flush the remaining buffers from memory
    ! to disk if relevant.
    !---------------------------------------------------------------------
    class(format_t), intent(inout) :: format
    logical,         intent(inout) :: error
    !
    character(len=*), parameter :: rname='FORMAT>FINISH'
    !
    ! File extrema
    call format%proc%put_extrema(format%head,error)
    if (error)  return
    !
    if (.not.associated(format%tuple%current)) then
      ! This can happen in error recovery mode
      return
    endif
    !
    if (format%tuple%trans%do.ne.code_trans_none) then
      call cubetuple_message(seve%d,rname,  &
        'Finishing the tuple but a transposition is pending')
      ! Two possibilities:
      ! - If the next command needs the direct access, there is no point
      !   performing this transposition.
      ! - If the next command needs the transposed access, we will re-
      !   prepare it from scratch. As of today leaving remnants breaks
      !   the transposition preparation.
      ! => forget the transposition preparation
      call cubeio_desc_reset(format%tuple%cube(format%tuple%trans%to)%desc,error)
      if (error)  continue
      call cubetuple_trans_reset(format%tuple%trans,error)
      if (error)  continue
    endif
    !
    ! ZZZ Should we finish all cubes or only the current one?
    call cubeio_cube_finish(format%user,format%head,format%tuple%current,error)
    if (error)  return
  end subroutine cubetuple_format_finish
  !
  function cubetuple_format_get_order(format)
    !-------------------------------------------------------------------
    ! Return the CURRENT cube order
    !-------------------------------------------------------------------
    integer(kind=code_k) :: cubetuple_format_get_order
    class(format_t), intent(in) :: format
    cubetuple_format_get_order = format%tuple%order()
  end function cubetuple_format_get_order
  !
  subroutine cubetuple_format_attach_file(format,file,error)
    use cubeio_file
    !-------------------------------------------------------------------
    ! Attach the pre-loaded cubeio_file_t and compute the associated
    ! header_t
    !-------------------------------------------------------------------
    class(format_t),     intent(inout)       :: format
    type(cubeio_file_t), intent(in), pointer :: file
    logical,             intent(inout)       :: error
    !
    call format%tuple%attach_file(file,error)
    if (error)  return
    call format%head_from_file(error)
    if (error)  return
  end subroutine cubetuple_format_attach_file
  !
  subroutine cubetuple_format_head_from_file(format,error)
    use cubetools_header_interface
    !-------------------------------------------------------------------
    ! (re)compute the type(cube_header_t) from the current file in tuple
    !-------------------------------------------------------------------
    class(format_t), intent(inout) :: format
    logical,         intent(inout) :: error
    !
    type(cube_header_interface_t) :: interf
    !
    call format%tuple%current%file%export_header(interf,error)
    if (error)  return
    call cubetools_header_import_and_derive(interf,format%head,error)
    if (error) return
  end subroutine cubetuple_format_head_from_file
  !
  subroutine cubetuple_format_dag_upsert(format,error)
    use cubedag_tuple
    !-------------------------------------------------------------------
    ! Upsert the format in DAG
    !-------------------------------------------------------------------
    class(format_t), intent(inout) :: format
    logical,         intent(inout) :: error
    ! Local
    integer(kind=code_k) :: code_where
    character(len=file_l) :: where
    !
    if (.not.associated(format%tuple%current)) then
      ! This can happen in error recovery mode
      return
    endif
    !
    if (format%tuple%trans%do.ne.code_trans_none) then
      ! This can happen if a transposition was prepared at get_header
      ! time, but was not actually performed because no data was
      ! actually accessed (get_image/get_spectrum).
      ! => no upsertion in the DAG as the data is not ready
      return
    endif
    !
    if (format%tuple%current%desc%buffered.eq.code_buffer_memory) then
      code_where = code_buffer_memory
      where = '<memory>'
    else
      code_where = code_buffer_disk
      where = format%tuple%current%file%name
    endif
    call cubedag_tuple_upsert(format%node%tuple,  &
                              format%order(),  &
                              code_where,  &
                              where,error)
    if (error)  return
    !
  end subroutine cubetuple_format_dag_upsert
  !
  subroutine cubetuple_format_final(format)
    use cubetools_header_types
    !---------------------------------------------------------------------
    ! Finalize a 'format_t' instance, i.e. free all its components before
    ! deleting the object itself
    !---------------------------------------------------------------------
    type(format_t), intent(inout) :: format
    !
    logical :: error
    !
    error = .false.
    call cubetools_header_final(format%head,error)
    if (error)  continue
    ! call cubetuple_final(format%tuple) => implicit at finalization time
  end subroutine cubetuple_format_final
  !
  function cubetuple_format_ptr(dno,error)
    !-------------------------------------------------------------------
    ! Check if the input class is a 'format_t', and return a
    ! pointer to it if relevant.
    !-------------------------------------------------------------------
    class(format_t), pointer :: cubetuple_format_ptr  ! Function value on return
    class(cubedag_node_object_t), pointer       :: dno
    logical,                      intent(inout) :: error
    !
    character(len=*), parameter :: rname='FORMAT>PTR'
    !
    select type(dno)
    class is (format_t)
      cubetuple_format_ptr => dno
    class default
      cubetuple_format_ptr => null()
      call cubetuple_message(seve%e,rname,'Internal error: object is not a format_t')
      error = .true.
      return
    end select
  end function cubetuple_format_ptr
  !
end module cubetuple_format
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
