!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeio_file
  use image_def
  use gkernel_interfaces
  use cubetools_parameters
  use cubetools_dataformat
  use cubefitsio_header
  use cubeio_messaging
  use cubeio_block
  !
  type :: cubeio_file_t
    ! Descriptor
    character(len=file_l) :: name = ''                    ! File name on disk
    integer(kind=code_k)  :: kind = code_dataformat_none  ! FITS or GDF?
    ! File (1 used at a time, according to filekind)
    type(gildas)          :: hgdf   ! [private] GDF header
    type(fitsio_header_t) :: hfits  ! [private] FITS header descriptor
    ! File buffering
    type(cubeio_block_t)  :: block  ! [private]
  contains
    procedure :: iskind        => cubeio_file_iskind
    procedure :: memsize       => cubeio_file_memsize
    procedure :: list          => cubeio_file_list
    procedure :: open          => cubeio_file_open
    procedure :: close         => cubeio_file_close
    procedure :: init          => cubeio_file_init
    procedure :: free          => cubeio_file_free
    procedure :: read_header   => cubeio_file_read_header
    procedure :: export_header => cubeio_file_export_header
    procedure :: is_cube       => cubeio_file_iscube
    procedure :: is_uvt        => cubeio_file_isuvt
  end type cubeio_file_t
  !
  public :: cubeio_file_t
  public :: file_allocate_new
  private
  !
contains
  !
  function file_allocate_new(error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Allocate and initialize a new file_t in memory and return a
    ! pointer to this allocation
    !-------------------------------------------------------------------
    type(cubeio_file_t), pointer  :: file_allocate_new
    logical, intent(inout) :: error
    !
    integer(kind=4) :: ier
    character(len=*), parameter :: rname='ALLOCATE>NEW'
    !
    allocate(file_allocate_new,stat=ier)
    if (failed_allocate(rname,'object',ier,error)) return
    call file_allocate_new%init(error)
    if (error)  return
  end function file_allocate_new
  !
  function cubeio_file_iskind(file,code_dataformat)
    !-------------------------------------------------------------------
    ! Return .true. if the cubeio_file_t provides the requested kind of
    ! file
    !-------------------------------------------------------------------
    logical :: cubeio_file_iskind
    class(cubeio_file_t), intent(in) :: file
    integer(kind=code_k), intent(in) :: code_dataformat
    !
    select case (code_dataformat)
    case (code_dataformat_fits)
      ! Test if the hfits structure is used to describe some FITS header
      cubeio_file_iskind = file%hfits%type.ne.code_null
    case (code_dataformat_gdf)
      ! Test if the hgdf structure is used to describe some GDF header
      ! The GDF header provides both GDF description and some technical
      ! components around the file. Try to return .true. if the GDF
      ! description is filled independently of any file on disk.
      cubeio_file_iskind = file%hgdf%gil%ndim.gt.0
    case default
      cubeio_file_iskind = .false.
    end select
  end function cubeio_file_iskind
  !
  function cubeio_file_memsize(file)
    !-------------------------------------------------------------------
    ! Return the memory footprint in bytes
    !-------------------------------------------------------------------
    integer(kind=size_length) :: cubeio_file_memsize
    class(cubeio_file_t), intent(in) :: file
    !
    cubeio_file_memsize = file%block%memsize()
  end function cubeio_file_memsize
  !
  subroutine cubeio_file_list(file,code_dataformat,error)
    use gfits_types
    !-------------------------------------------------------------------
    ! List the tuple header under requested format if available
    !-------------------------------------------------------------------
    class(cubeio_file_t), intent(in)    :: file
    integer(kind=code_k), intent(in)    :: code_dataformat
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='FILE>LIST'
    !
    select case (code_dataformat)
    case (code_dataformat_gdf)
      if (.not.file%iskind(code_dataformat_gdf)) then
        call cubeio_message(seve%e,rname,'Current IO cube header is not GDF')
        error = .true.
        return
      endif
      call gdf_print_header(file%hgdf)
    case (code_dataformat_fits)
      if (.not.file%iskind(code_dataformat_fits)) then
        call cubeio_message(seve%e,rname,'Current IO cube header is not FITS')
        error = .true.
        return
      endif
      call gfits_list_dict(file%hfits%dict,error)
      if (error)  return
    case default
      call cubeio_message(seve%e,rname,'Unknown requested data format')
      error = .true.
      return
    end select
  end subroutine cubeio_file_list
  !
  subroutine cubeio_file_open(file,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Open (or reopen) a 'cubeio_file_t' instance for READ-ONLY access,
    ! if not yet opened.
    !-------------------------------------------------------------------
    class(cubeio_file_t), intent(inout) :: file   !
    logical,              intent(inout) :: error  !
    !
    character(len=*), parameter :: rname='FILE>OPEN'
    !
    select case (file%kind)
    case (code_dataformat_fits)
      if (file%hfits%unit.gt.0)  return  ! Already opened
      call file%hfits%open(file%name,'???',error)
      if (error)  return
    case (code_dataformat_gdf)
      if (file%hgdf%loca%islo.gt.0)  return  ! Already opened
      ! ZZZ Unfortunately, there is no symetric to gdf_close_image. For the
      ! time being, this re-reads the whole header...
      file%hgdf%file = file%name
      file%hgdf%blc = 0
      file%hgdf%trc = 0
      call gdf_read_header(file%hgdf,error)
      if (error) return
    case default
      call cubeio_message(seve%e,rname,'No associated file on disk')
      error = .true.
      return
    end select
  end subroutine cubeio_file_open
  !
  subroutine cubeio_file_close(file,error)
    use cubefitsio_image_utils
    !-------------------------------------------------------------------
    ! Close a 'cubeio_file_t' instance. This is worth calling this
    ! subroutine as some ressources like GIO slots are limited
    !-------------------------------------------------------------------
    class(cubeio_file_t), intent(inout) :: file   !
    logical,              intent(inout) :: error  !
    ! Local
    character(len=*), parameter :: rname='FILE>CLOSE'
    logical :: myerror
    !
    ! Free image slot
    myerror = .false.
    select case (file%kind)
    case (code_dataformat_fits)
      call cubefitsio_image_close(file%hfits,myerror)
      if (myerror)  continue
    case (code_dataformat_gdf)
      if (file%hgdf%loca%islo.gt.0) then
        call gdf_close_image(file%hgdf,myerror)
        if (myerror)  continue
      endif
    case default
      ! For a generic use, it is valid to "close" a cube with no
      ! associated file on disk.
      continue
    end select
    if (myerror)  error = .true.
  end subroutine cubeio_file_close
  !
  subroutine cubeio_file_init(file,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Initialize a cubeio_file_t
    !-------------------------------------------------------------------
    class(cubeio_file_t), intent(inout) :: file
    logical,              intent(inout) :: error
    !
    ! Initialize the HGDF header. Must be done once and only once, before
    ! first use of the header. Must come before cubeio_free_cubeio_cube so
    ! that it works properly. Use same test as GIO does internally:
    if (file%hgdf%header.ne.1)  call gildas_null(file%hgdf)
    !
    ! Initialize the buffer block. 'free' subroutine does this correctly.
    call file%block%free(error)
    if (error)  return
  end subroutine cubeio_file_init
  !
  subroutine cubeio_file_free(file,error)
    !-------------------------------------------------------------------
    ! Free the memory-consuming components of a 'cubeio_file_t' instance.
    ! The cubeio_file_t remains useable after this free.
    !-------------------------------------------------------------------
    class(cubeio_file_t), intent(inout) :: file
    logical,              intent(inout) :: error
    !
    call file%block%free(error)
    if (error)  return
  end subroutine cubeio_file_free
  !
  subroutine cubeio_file_read_header(file,name,cubeid,error)
    use cubefitsio_image_read
    use cubefitsio_header_read
    !------------------------------------------------------------------
    ! Read the file header from disk in the structure dedicated for
    ! the relevant data format
    !------------------------------------------------------------------
    class(cubeio_file_t), intent(inout) :: file    !
    character(len=*),     intent(in)    :: name    ! File name
    character(len=*),     intent(in)    :: cubeid  ! Identifier (feedback only)
    logical,              intent(inout) :: error   !
    ! Local
    character(len=*), parameter :: rname='FILE>READ>HEADER'
    integer(kind=4) :: filekind
    !
    ! Read header to get the file information
    call gag_file_guess(rname,name,filekind,error)
    if (error)  return
    !
    select case (filekind)
    case (1)
      file%name = name
      file%kind = code_dataformat_gdf
      file%hgdf%file = name
      file%hgdf%blc = 0
      file%hgdf%trc = 0
      call gdf_read_header(file%hgdf,error)
      if (error) return
    case (2)
      file%name = name
      file%kind = code_dataformat_fits
      call cubefitsio_image_open(file%hfits,name,cubeid,error)
      if (error)  return
      call cubefitsio_header_fill(file%hfits,error)
      if (error)  return
    case default
      call cubeio_message(seve%e,rname,'Unsupported file kind')
      error = .true.
      return
    end select
  end subroutine cubeio_file_read_header
  !
  subroutine cubeio_file_export_header(file,interf,error)
    use cubetools_header_interface
    use cubeio_header_hgdf
    use cubeio_header_hfits
    !------------------------------------------------------------------
    ! Export the proper header to interface_t
    !------------------------------------------------------------------
    class(cubeio_file_t),          intent(inout) :: file
    type(cube_header_interface_t), intent(inout) :: interf
    logical,                       intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='FILE>EXPORT>HEADER'
    !
    select case (file%kind)
    case (code_dataformat_gdf)
      call cubeio_hgdf_export(file%hgdf,interf,error)
      if (error)  return
    case (code_dataformat_fits)
      call cubeio_hfits_export(file%hfits,interf,error)
      if (error)  return
    case default
      call cubeio_message(seve%e,rname,'Unsupported file kind')
      error = .true.
      return
    end select
  end subroutine cubeio_file_export_header
  !
  function cubeio_file_iscube(file)
    !-------------------------------------------------------------------
    ! Determine is the cubeio_file_t provides a 3D-like cube
    !-------------------------------------------------------------------
    logical :: cubeio_file_iscube
    class(cubeio_file_t), intent(in) :: file
    !
    select case(file%kind)
    case (code_dataformat_gdf)
      cubeio_file_iscube = abs(file%hgdf%gil%type_gdf).eq.code_gdf_image
    case (code_dataformat_fits)
      cubeio_file_iscube = .true.  ! ZZZ to be improved to discriminate UV tables
    case default
      cubeio_file_iscube = .false.
    end select
  end function cubeio_file_iscube
  !
  function cubeio_file_isuvt(file)
    !-------------------------------------------------------------------
    ! Determine is the cubeio_file_t provides a UV table
    !-------------------------------------------------------------------
    logical :: cubeio_file_isuvt
    class(cubeio_file_t), intent(in) :: file
    !
    select case(file%kind)
    case (code_dataformat_gdf)
      cubeio_file_isuvt = abs(file%hgdf%gil%type_gdf).eq.code_gdf_uvt
    case (code_dataformat_fits)
      cubeio_file_isuvt = .false.  ! ZZZ to be improved to discriminate UV tables
    case default
      cubeio_file_isuvt = .false.
    end select
  end function cubeio_file_isuvt
  !
end module cubeio_file
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
