!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetuple_format_class
  use cubetools_parameters
  use cubetools_header_types
  use cubetools_processing_types
  use cubetools_setup_types
  use cubedag_node_class
  use cubeio_cube_define
  use cubetuple_messaging
  use cubetuple_iterator
  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, abstract, 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
    type(cubetuple_iterator_t), public :: iter  ! Iterator utilities when processing a command
  contains
    procedure          :: init            => cubetuple_format_init
    procedure          :: list            => cubetuple_format_list
    procedure, private :: close           => cubetuple_format_close
    procedure, public  :: reimport_format => cubetuple_format_reimport_format
    procedure          :: finish_format   => cubetuple_format_finish_format
    procedure, public  :: default_iorder  => cubetuple_format_default_intrinsic_order
    procedure, public  :: set_iorder      => cubetuple_format_set_intrinsic_order
    procedure          :: iorder          => cubetuple_format_get_intrinsic_order
    procedure          :: order           => cubetuple_format_get_mapped_order
    procedure          :: access          => cubetuple_format_get_access
    procedure, public  :: iscplx          => cubetuple_format_get_iscplx
    procedure          :: attach_file     => cubetuple_format_attach_file
    procedure, private :: dag_upsert      => cubetuple_format_dag_upsert
    procedure, private :: timing_collect  => cubetuple_format_timing_collect
    procedure, public  :: default_region  => cubetuple_format_default_region
    procedure, public  :: autotranspose   => cubetuple_format_autotranspose
    procedure, public  :: final_format    => cubetuple_format_final_format
  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
    call format%node%head_associate(format%head,error)
    if (error)  return
  end subroutine cubetuple_format_init
  !
  subroutine cubetuple_format_list(format,code_dataformat,error)
    use gfits_types
    use cubeio_dataformat_types
    use cubefitsio_header
    use cubeio_interface
    use cubetools_header_vo
    !-------------------------------------------------------------------
    ! List the cube header under requested format
    !-------------------------------------------------------------------
    class(format_t),      intent(inout) :: 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,format%tuple%order(),hfits,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_reimport_format(format,error)
    !---------------------------------------------------------------------
    ! Reimport a 'format_t' instance from disk to DAG
    !---------------------------------------------------------------------
    class(format_t), intent(inout) :: format
    logical,         intent(inout) :: error
    !
    call format%get_header(format%head,error)
    if (error) return
  end subroutine cubetuple_format_reimport_format
  !
  subroutine cubetuple_format_finish_format(format,error)
    use cubeio_desc
    use cubeio_highlevel
    !---------------------------------------------------------------------
    ! Properly finish a cube after command execution. Namely:
    ! - flush the remaining buffers from memory to disk if relevant
    ! - upsert in DAG
    ! - collect timing
    ! - free I/O ressources
    !---------------------------------------------------------------------
    class(format_t), intent(inout) :: format
    logical,         intent(inout) :: error
    !
    character(len=*), parameter :: rname='FORMAT>FINISH'
    !
    if (error) return  ! Error recovery: we should probably do some cleaning below!
    !
    ! File extrema
    call format%proc%put_extrema(format%head,error)
    if (error)  return
    !
    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 format%tuple%trans%reset(error)
      if (error)  continue
    endif
    !
    if (associated(format%tuple%current)) then
      ! It may not be associated e.g. in error recovery mode
      ! ZZZ Should we finish all cubes or only the current one?
      call cubeio_cube_finish(format%user,format,format%tuple%current,error)
      if (error)  return
    endif
    !
    ! The iterator is reset, so that it can not be used until next command
    call format%iter%finish(error)
    if (error)  return
    !
    ! The define type is reset, so that all requests are redefined by
    ! the next command
    call format%prog%reset(error)
    if (error)  continue
    !
    ! DAG upsertion
    call format%dag_upsert(error)
    if (error) continue
    !
    ! Execution timing
    call format%timing_collect(error)
    if (error) continue
    !
    ! Always free the GIO slot, which is a limited ressource. The other
    ! ressources are handled by the GC
    call format%close(error)
    if (error) return
  end subroutine cubetuple_format_finish_format
  !
  subroutine cubetuple_format_default_intrinsic_order(format,error)
    !-------------------------------------------------------------------
    ! Set the default intrinsic order string (e.g. "ABC") of the CURRENT
    ! cube
    !-------------------------------------------------------------------
    class(format_t), intent(inout) :: format
    logical,         intent(inout) :: error
    !
    call format%tuple%default_iorder(error)
    if (error)  return
  end subroutine cubetuple_format_default_intrinsic_order
  !
  subroutine cubetuple_format_set_intrinsic_order(format,iorder,error)
    !-------------------------------------------------------------------
    ! Set the intrinsic order string (e.g. "ABC") of the CURRENT cube
    !-------------------------------------------------------------------
    class(format_t),  intent(inout) :: format
    character(len=*), intent(in)    :: iorder
    logical,          intent(inout) :: error
    !
    call format%tuple%set_iorder(iorder,error)
    if (error)  return
  end subroutine cubetuple_format_set_intrinsic_order
  !
  function cubetuple_format_get_intrinsic_order(format)
    !-------------------------------------------------------------------
    ! Return the intrinsic order string (e.g. "ABC") of the CURRENT cube
    !-------------------------------------------------------------------
    character(len=maxdim) :: cubetuple_format_get_intrinsic_order
    class(format_t), intent(in) :: format
    cubetuple_format_get_intrinsic_order = format%tuple%iorder()
  end function cubetuple_format_get_intrinsic_order
  !
  function cubetuple_format_get_mapped_order(format)
    !-------------------------------------------------------------------
    ! Return the mapped order code (e.g. code_imaset) of the CURRENT cube
    !-------------------------------------------------------------------
    integer(kind=4) :: cubetuple_format_get_mapped_order
    class(format_t), intent(in) :: format
    cubetuple_format_get_mapped_order = format%tuple%order()
  end function cubetuple_format_get_mapped_order
  !
  function cubetuple_format_get_access(format)
    !-------------------------------------------------------------------
    ! Return the CURRENT cube access
    !-------------------------------------------------------------------
    integer(kind=code_k) :: cubetuple_format_get_access
    class(format_t), intent(in) :: format
    cubetuple_format_get_access = format%tuple%access()
  end function cubetuple_format_get_access
  !
  function cubetuple_format_get_iscplx(format)
    !-------------------------------------------------------------------
    ! Return .true. if the cube data is complex*4
    !-------------------------------------------------------------------
    logical :: cubetuple_format_get_iscplx
    class(format_t), intent(in) :: format
    cubetuple_format_get_iscplx = format%tuple%iscplx()
  end function cubetuple_format_get_iscplx
  !
  subroutine cubetuple_format_attach_file(format,file,error)
    use cubeio_file
    use cubeio_desc_setup
    !-------------------------------------------------------------------
    ! 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
    ! Propagate the header of this data type to interface_t, header_t, iodesc_t
    call cubeio_set_descriptor_intrinsic(format,format%tuple%current,error)
    if (error)  return
  end subroutine cubetuple_format_attach_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
    integer(kind=4) :: hdu
    character(len=file_l) :: where
    !
    if (.not.associated(format%tuple%current) .or. &
        format%iorder().eq.'') 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>'  ignored
      ! hdu = 0             ignored
    else
      code_where = code_buffer_disk
      where = format%tuple%current%file%name
      hdu = format%tuple%current%file%hdu
    endif
    call cubedag_tuple_upsert(format%node%tuple,  &
                              format%iorder(),  &
                              format%order(), &
                              code_where,  &
                              where,hdu,error)
    if (error)  return
    !
  end subroutine cubetuple_format_dag_upsert
  !
  subroutine cubetuple_format_timing_collect(format,error)
    use cubeadm_timing
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    class(format_t), intent(in)    :: format
    logical,         intent(inout) :: error
    !
    call cubeadm_timing_collect(format%tuple%elapsed_read(), &
                                format%tuple%elapsed_write(), &
                                format%tuple%elapsed_trans())
  end subroutine cubetuple_format_timing_collect
  !
  subroutine cubetuple_format_default_region(format,error,align)
    !-------------------------------------------------------------------
    ! 1) Declare the original axes of this cube to its iterator, i.e.
    !    the leading ones and the iterated one.
    ! 2) Declare that the region to be applied on the cube is the default
    !    one. In practice this means that the data access will use 100%
    !    of the cube (not more, not less), i.e. 100% of the axes.
    ! See also cuberegion_prog_t%apply_to_cube() if a region is to be
    ! applied.
    !-------------------------------------------------------------------
    class(format_t),      intent(inout)        :: format
    logical,              intent(inout)        :: error
    integer(kind=code_k), intent(in), optional :: align
    !
    integer(kind=code_k) :: lalign,order
    integer(kind=indx_k), parameter :: auto=code_indx_auto
    character(len=*), parameter :: rname='FORMAT>DEFAULT>REGION'
    !
    if (present(align)) then
      lalign = align
    else
      lalign = code_align_auto
    endif
    !
    ! Rely on internal data order (cub is already the cube with desired
    ! order), not the way we access it (e.g. by subcube):
    order = format%order()
    !
    ! Fetch this cube axes
    call format%iter%get_axes(format%head,order,lalign,error)
    if (error)  return
    !
    call format%iter%set_region_l(auto,auto,auto,error)
    if (error)  return
    call format%iter%set_region_m(auto,auto,auto,error)
    if (error)  return
    call format%iter%set_region_c(auto,auto,auto,error)
    if (error)  return
  end subroutine cubetuple_format_default_region
  !
  subroutine cubetuple_format_autotranspose(format,error)
    use cubedag_tuple
    use cubeio_cube
    use cubeio_transpose
    !-------------------------------------------------------------------
    ! If needed, perform the pending tranposition of the relevant file
    !-------------------------------------------------------------------
    class(format_t), target, intent(inout) :: format
    logical,                 intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='FORMAT>AUTOTRANSPOSE'
    character(len=file_l) :: ffilename,tfilename
    type(cubeio_cube_t), pointer :: cubin,cubout
    integer(kind=code_k) :: fromorder
    logical :: insertin
    integer(kind=4) :: hdu
    character(len=maxdim) :: iorder
    !
    if (format%tuple%trans%do.eq.code_trans_none)  return
    !
    ! Reinitialize timer before real transposition processing (so that
    ! we do not take into account overheads before reaching this point)
    call gag_cputime_init(format%tuple%trans%time)
    !
    cubin  => format%tuple%cube(format%tuple%trans%from)
    cubout => format%tuple%cube(format%tuple%trans%to)
    !
    ! Sanity
    if (.not.associated(cubout,format%tuple%current)) then
      call cubetuple_message(seve%e,rname,  &
        'Internal error: the cube to be created is not the current one')
      error = .true.
      return
    endif
    !
    ! ZZZ The new implementation in cubeio_transpose is actually able to
    ! deal with any case (input in memory or disk, output in memory or disk).
    ! But such mismatch does not make much sense as the input and output
    ! have strictly the same size.
    select case (format%tuple%trans%do)
    case (code_trans_memo)
      insertin = cubin%memo%ready.ne.code_buffer_memory
      call cubeio_transpose_memory(format%user,format%prog,format,cubin,cubout,error)
      if (error)  return
      !
      if (insertin) then
        ! Avoid reinserting the direct cube and changing its timestamp if it
        ! was already in memory
        call cubedag_tuple_upsert(format%node%tuple,cubin%iorder(),cubin%order(),  &
          code_buffer_memory,'<memory>',0,error)
        if (error)  return
      endif
      ! The transposed cube is now in memory
      call cubedag_tuple_upsert(format%node%tuple,cubout%iorder(),cubout%order(),  &
        code_buffer_memory,'<memory>',0,error)
      if (error)  return
      !
    case (code_trans_disk)
      ! Sanity
      if (cubout%desc%action.ne.code_read) then
        call cubetuple_message(seve%e,rname,'Internal error: implicit '//  &
          'transposition is relevant only for cubes opened in read mode')
        error = .true.
        return
      endif
      fromorder = format%tuple%cube(format%tuple%trans%from)%order()
      if (.not.cubedag_tuple_hasuptodatefile(format%node%tuple,fromorder,code_buffer_disk, &
        iorder,ffilename,hdu)) then
        call cubetuple_message(seve%e,rname,'Internal error: lost the file I am looking for')
        error = .true.
        return
      endif
      if (error)  return
      !
      tfilename = cubout%file%name
      call cubeio_transpose_disk(format%user,format%prog,ffilename,hdu,tfilename,  &
        format,cubin,cubout,error)
      if (error)  return
      !
      ! Insert this new/updated file in the tuple, and set the tuple as
      ! consistent at this precise moment
      call cubedag_tuple_upsert(format%node%tuple,cubout%iorder(),cubout%order(), &
        code_buffer_disk,tfilename,1,error)
      if (error)  return
      call cubedag_tuple_setconsistent(format%node%tuple,error)
      if (error)  return
      !
    case default
      call cubetuple_message(seve%e,rname,'Transposition mode not implemented')
      error = .true.
      return
    end select
    !
    ! Transposition is now done
    call format%tuple%trans%reset(error)
    if (error)  return
    !
    call gag_cputime_get(format%tuple%trans%time)
  end subroutine cubetuple_format_autotranspose
  !
  subroutine cubetuple_format_final_format(format,error)
    use cubetools_header_types
    !---------------------------------------------------------------------
    ! Finalize a 'format_t' instance, i.e. free all its components before
    ! deleting the object itself
    !---------------------------------------------------------------------
    class(format_t), intent(inout) :: format
    logical,         intent(inout) :: error
    !
    call cubetools_header_final(format%head,error)
    if (error)  continue
    ! call cubetuple_final(format%tuple) => implicit at finalization time
  end subroutine cubetuple_format_final_format
  !
  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_class
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
