!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeio_interface
  use gkernel_interfaces
  use gkernel_types
  use cubetools_parameters
  use cubeio_dataformat_types
  use cubedag_node_class
  use cubeadm_timing  ! From cubedag
  use cubeio_cube_define
  use cubeio_messaging
  use cubeio_range
  use cubeio_cube
  ! Below the dataformat-specific modules
  use cubefitsio_header_read
  use cubeio_header_hgdf
  use cubeio_header_hcdf
  use cubeio_header_hfits
  use cubeio_header_iodesc
  use cubeio_cdf
  use cubeio_gdf
  use cubeio_fits
  !
  interface cubeio_header_put
    module procedure cubeio_header_put_tohgdf
    module procedure cubeio_header_put_tohcdf
    module procedure cubeio_header_put_tohfits
    module procedure cubeio_header_put_toiodesc
  end interface cubeio_header_put

  interface cubeio_cube_read_data
    module procedure cubeio_cube_read_data_r4
    module procedure cubeio_cube_read_data_c4
  end interface cubeio_cube_read_data

  interface cubeio_cube_write_data
    module procedure cubeio_cube_write_data_r4
    module procedure cubeio_cube_write_data_c4
  end interface cubeio_cube_write_data
  !
  ! Reading API
  public :: cubeio_header_get_and_derive
  public :: cubeio_cube_read_header
  public :: cubeio_cube_reload_header
  public :: cubeio_cube_read_data
  ! Writing API
  public :: cubeio_header_put
  public :: cubeio_cube_create_cube
  public :: cubeio_cube_update_header
  public :: cubeio_cube_write_cube
  public :: cubeio_cube_write_data
  private
  !
contains
  subroutine cubeio_header_get_and_derive(cube,dno,error)
    !-------------------------------------------------------------------
    ! From cube%file%h* to interface_t and header_t
    !-------------------------------------------------------------------
    type(cubeio_cube_t),          intent(in)    :: cube
    class(cubedag_node_object_t), intent(inout) :: dno
    logical,                      intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>GET>AND>DERIVE'
    !
    select case (cube%file%kind)
    case (code_dataformat_gdf)
      call cubeio_header_get_and_derive_fromhgdf(cube%file%hgdf,dno,error)
      if (error)  return
    case (code_dataformat_cdf)
      call cubeio_header_get_and_derive_fromhcdf(cube%file%hcdf,dno,error)
      if (error)  return
    case (code_dataformat_fits)
      call cubeio_header_get_and_derive_fromhfits(cube%file%hfits,dno,error)
      if (error)  return
    case default
      call cubeio_message(seve%e,rname,'Unsupported file kind')
      error = .true.
      return
    end select
  end subroutine cubeio_header_get_and_derive
  !
  subroutine cubeio_cube_read_header(cubdef,dno,cube,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(cube_define_t),          intent(in)    :: cubdef
    class(cubedag_node_object_t), intent(inout) :: dno
    type(cubeio_cube_t),          intent(inout) :: cube
    logical,                      intent(inout) :: error
    !
    character(len=file_l) :: cubeid
    character(len=*), parameter :: rname='CUBE>READ>HEADER'
    !
    if (.not.cubdef%dofilename) then
      call cubeio_message(seve%e,rname,'Input cube name is not set')
      error = .true.
      return
    endif
    if (cubdef%doid) then
      cubeid = cubdef%id
    else
      cubeid = cubdef%filename
    endif
    ! Note 1: the HDU number is ignored if not a FITS file
    ! Note 2: re-reading the Primary HDU is incorrect if IMPORT /HDU was
    !         used in the first place (in the context of snapshots?)
    call cube%file%read_header(cubdef%filename,cubdef%hdu,cubeid,error)
    if (error)  return
    !
    ! Setup header
    select case (cube%file%kind)
    case (code_dataformat_fits)
      call cubeio_header_get_and_derive_fromhfits(cube%file%hfits,dno,error)
      if (error) return
    case (code_dataformat_gdf)
      call cubeio_header_get_and_derive_fromhgdf(cube%file%hgdf,dno,error)
      if (error) return
    case default
      call cubeio_message(seve%e,rname,'Data format not supported or no file on disk')
      error = .true.
      return
    end select
  end subroutine cubeio_cube_read_header
  !
  subroutine cubeio_cube_reload_header(cube,error)
    !-------------------------------------------------------------------
    ! Reload the header from disk to its proper file type. This is
    ! relevant in the case where the writing library does things out of
    ! our control (e.g. CFITSIO writing some extra entries in the header).
    ! Reloading is skipped if not relevant.
    ! This subroutine does not:
    ! - open the file,
    ! - transfer from file type to dno%node%head.
    !-------------------------------------------------------------------
    type(cubeio_cube_t), intent(inout) :: cube
    logical,             intent(inout) :: error
    !
    select case (cube%file%kind)
    case (code_dataformat_fits)
      ! We have written a FITS file. Reload its header in our
      ! dictionary. This is the best way to retrieve what is actually
      ! on disk, as CFITSIO adds its owns comments and keywords beyond
      ! our choice.
      if (cube%file%hfits%unit.gt.0) then  ! Can be zero if the file creation failed.
                                          ! ZZZ we should have a better way to
                                          ! support this case.
        call cubefitsio_header_fill(cube%file%hfits,error)
        if (error)  continue
      endif
    case default
      ! For the other file types, there is nothing new to reload.
    end select
  end subroutine cubeio_cube_reload_header
  !
  subroutine cubeio_cube_read_data_r4(cube,range,data,error)
    !---------------------------------------------------------------------
    ! Wrapper around writing data subroutines
    ! ---
    ! R*4 version
    !---------------------------------------------------------------------
    type(cubeio_cube_t),  intent(inout) :: cube
    type(cubeio_range_t), intent(in)    :: range
    real(kind=4),         intent(out)   :: data(:,:,:)
    logical,              intent(inout) :: error
    !
    type(cputime_t) :: tmp
    character(len=*), parameter :: rname='READ>CUBE>DATA>R4'
    !
    call gag_cputime_init(tmp)
    !
    ! Need to open or reopen (if not yet opened)
    call cube%open(error)
    if (error)  return
    !
    select case (cube%file%kind)
    case (code_dataformat_fits)
      call cubeio_fits_read_data(cube%file%hfits,data,range,error)
      if (error)  return
    case (code_dataformat_gdf)
      call cubeio_gdf_read_data(cube%file%hgdf,data,range,error)
      if (error)  return
    case (code_dataformat_cdf)
      call cubeio_cdf_read_data(cube%file%hcdf,data,range,error)
      if (error)  return
    case default
      call cubeio_message(seve%e,rname,'No associated file on disk')
      error = .true.
      return
    end select
    !
    call gag_cputime_add(cube%time%read,tmp)
  end subroutine cubeio_cube_read_data_r4
  !
  subroutine cubeio_cube_read_data_c4(cube,range,data,error)
    !---------------------------------------------------------------------
    ! Wrapper around writing data subroutines
    ! ---
    ! C*4 version
    !---------------------------------------------------------------------
    type(cubeio_cube_t),  intent(inout) :: cube
    type(cubeio_range_t), intent(in)    :: range
    complex(kind=4),      intent(out)   :: data(:,:,:)
    logical,              intent(inout) :: error
    !
    type(cputime_t) :: tmp
    character(len=*), parameter :: rname='READ>CUBE>DATA>C4'
    !
    call gag_cputime_init(tmp)
    !
    ! Need to open or reopen (if not yet opened)
    call cube%open(error)
    if (error)  return
    !
    select case (cube%file%kind)
    case (code_dataformat_fits)
      call cubeio_fits_read_data(cube%file%hfits,data,range,error)
      if (error)  return
    case (code_dataformat_gdf)
      call cubeio_gdf_read_data(cube%file%hgdf,data,range,error)
      if (error)  return
    case (code_dataformat_cdf)
      call cubeio_cdf_read_data(cube%file%hcdf,data,range,error)
      if (error)  return
    case default
      call cubeio_message(seve%e,rname,'No associated file on disk')
      error = .true.
      return
    end select
    !
    call gag_cputime_add(cube%time%read,tmp)
  end subroutine cubeio_cube_read_data_c4
  !
  subroutine cubeio_cube_create_cube(cube,cubdef,dno,dim,error)
    use cubetools_access_types
    use cubetools_system_tool
    use cubedag_node_class
    use cubecdf_image_write
    use cubefitsio_image_write
    !-------------------------------------------------------------------
    ! Create a file with dummy/minimal data area on disk. It will be
    ! extended later on by adding new blocks.
    !-------------------------------------------------------------------
    type(cubeio_cube_t),          intent(inout) :: cube
    type(cube_define_t),          intent(in)    :: cubdef
    class(cubedag_node_object_t), intent(inout) :: dno
    integer(kind=data_k),         intent(out)   :: dim(:)
    logical,                      intent(inout) :: error
    !
    character(len=base_l) :: cbasename
    character(len=exte_l) :: cextension,nextension
    character(len=file_l) :: cdire
    integer(kind=4) :: nch
    integer(kind=data_k), parameter :: initdim=1  ! 0 not allowed by GIO
    character(len=*), parameter :: rname='CUBE>CREATE>CUBE'
    !
    if (cubdef%dofilekind)  cube%file%kind = cubdef%filekind
    if (cubdef%dofilename)  cube%file%name = cubdef%filename
    if (cube%file%name.eq.'') then
      call cubeio_message(seve%e,rname,'Missing file name')
      error = .true.
      return
    endif
    !
    ! Parse file name for extension and directory
    call sic_parse_name(cube%file%name,cbasename,oext=cextension,odir=cdire)
    if (cdire.ne.'') then
      ! Prepare directory if needed
      call cubetools_directory_create(cdire,error)
      if (error) return
    endif
    !
    ! Prepare default extension
    nextension = ''
    select case (cube%file%kind)
    case (code_dataformat_fits) ! Accept predeclared extensions which contains 'fits'
      if (index(cextension,'fits').eq.0)  nextension = '.fits'
    case (code_dataformat_gdf)  ! Accept any predeclared extension
      if (cextension.eq.'')               nextension = cubetools_order2ext(cube%desc%order)
    case (code_dataformat_cdf)  ! Accept predeclared extensions which contains 'cdf'
      if (index(cextension,'cdf').eq.0)   nextension = '.cdf'
    case default                ! Accept any predeclared extension
      if (cextension.eq.'')               nextension = '.unk'
    end select
    if (nextension.ne.'') then
      ! Append correct extension to file name
      nch = len_trim(cube%file%name)
      cube%file%name = cube%file%name(1:nch)//nextension
    endif
    !
    ! Create a file with dummy/minimal data area:
    select case (cube%file%kind)
    case (code_dataformat_fits)
      call cubeio_create_and_truncate_hfits(dno,cubdef%order,initdim,cube%file%hfits,error)
      if (error)  return
      call cubefitsio_image_create(cube%file%hfits,cube%file%name,cubdef%dochecksum,error)
      if (error)  continue  ! Error message below
      dim(:) = cube%file%hfits%dim(:)
    case (code_dataformat_gdf)
      call gildas_null(cube%file%hgdf)
      call cubeio_create_and_truncate_hgdf(dno,cube%desc,cubdef%order,initdim,cube%file%hgdf,error)
      if (error)  return
      cube%file%hgdf%file = cube%file%name
      cube%file%hgdf%gil%extr_words = 0  ! Disable the extrema section. It will be reenabled if and when relevant
      call gdf_create_image(cube%file%hgdf,error)
      if (error)  continue  ! Error message below
      dim(:) = cube%file%hgdf%gil%dim(:)
    case (code_dataformat_cdf)
      call cubeio_create_and_truncate_hcdf(dno,cubdef%order,initdim,cube%file%hcdf,error)
      if (error)  return
      call cubecdf_image_create(cube%file%hcdf,cube%file%name,error)
      if (error)  continue  ! Error message below
      dim(:) = cube%file%hcdf%dim(:)
    case default
      call cubeio_message(seve%e,rname,'File kind not supported')
      error = .true.
    end select
    if (error) then
      call cubeio_message(seve%e,rname,'Error creating file '//cube%file%name)
      return
    endif
  end subroutine cubeio_cube_create_cube
  !
  subroutine cubeio_cube_write_cube(cube,cubdef,dno,error)
    use cubetools_system_tool
    use cubedag_node_class
    !-------------------------------------------------------------------
    ! Write the whole cube (header+data) from memory to disk
    !-------------------------------------------------------------------
    type(cubeio_cube_t),          intent(inout) :: cube
    type(cube_define_t),          intent(in)    :: cubdef
    class(cubedag_node_object_t), intent(inout) :: dno
    logical,                      intent(inout) :: error
    !
    character(len=*), parameter :: rname='CUBE>WRITE>CUBE'
    !
    ! Prepare directory if needed
    call cubetools_directory_create_for_file(cubdef%filename,error)
    if (error) return
    !
    select case (cubdef%filekind)
    case (code_dataformat_fits)
      call cubeio_create_hfits(dno,cubdef%order,cube%file%hfits,error)
      if (error)  return
      if (cube%desc%iscplx) then
        call cubeio_fits_write_cube(cube%file%hfits,cubdef%filename,cubdef%dochecksum,  &
          cube%memo%c4,error)
        if (error)  return
      else
        call cubeio_fits_write_cube(cube%file%hfits,cubdef%filename,cubdef%dochecksum,  &
          cube%memo%r4,error)
        if (error)  return
      endif
      !
    case (code_dataformat_gdf)
      call cubeio_create_hgdf(dno,cube%desc,cubdef%order,cube%file%hgdf,error)
      if (error)  return
      if (cube%desc%iscplx) then
        call cubeio_gdf_write_cube(cube%file%hgdf,cubdef%filename,cube%memo%c4,error)
        if (error)  return
      else
        call cubeio_gdf_write_cube(cube%file%hgdf,cubdef%filename,cube%memo%r4,error)
        if (error)  return
      endif
      !
    case default
      call cubeio_message(seve%e,rname,'Data format not implemented')
      error = .true.
      return
    end select
  end subroutine cubeio_cube_write_cube
  !
  subroutine cubeio_cube_update_header(cube,dno,last,error)
    use gkernel_interfaces
    use cubedag_node_class
    use cubecdf_image_write
    use cubefitsio_image_write
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(cubeio_cube_t),          intent(inout) :: cube
    class(cubedag_node_object_t), intent(inout) :: dno
    integer(kind=index_length),   intent(in)    :: last
    logical,                      intent(inout) :: error
    !
    character(len=*), parameter :: rname='CUBE>UPDATE>HEADER'
    !
    ! Update the header on disk (e.g. the extrema section might be updated after
    ! processing each block)
    select case (cube%file%kind)
    case (code_dataformat_fits)
      if (cube%desc%action.eq.code_write) then
        ! No need to close and extend (done at data write time)
        call cubeio_create_and_truncate_hfits(dno,cube%order(),last,cube%file%hfits,error)
        if (error)  return
      else  ! code_update
        call cubeio_create_hfits(dno,cube%order(),cube%file%hfits,error)
        if (error)  return
      endif
      call cubefitsio_image_header_update(cube%file%hfits,error)
      if (error)  return
      !
    case (code_dataformat_cdf)
      if (cube%desc%action.eq.code_write) then
        ! No need to close and extend (done at data write time)
        call cubeio_create_and_truncate_hcdf(dno,cube%order(),last,cube%file%hcdf,error)
        if (error)  return
      else  ! code_update
        call cubeio_create_hcdf(dno,cube%order(),cube%file%hcdf,error)
        if (error)  return
      endif
      call cubecdf_image_header_update(cube%file%hcdf,error)
      if (error)  return
      !
    case (code_dataformat_gdf)
      if (cube%desc%action.eq.code_write) then
        ! NB: the current header in memory is transfered to the file AFTER
        ! gdf_extend_image so that the new dimension is correctly applied by
        ! gdf_extend_image. This means the data is first added/updated (with
        ! consistent dimensions), then the header (remaining sections) is updated.
        if (cube%file%hgdf%loca%islo.gt.0) then  ! Close (if relevant) before reopening
          call gdf_close_image(cube%file%hgdf,error)
          if (error)  return
        endif
        call gdf_extend_image(cube%file%hgdf,last,error)
        if (error)  return
        call cubeio_create_and_truncate_hgdf(dno,cube%desc,cube%order(),last,cube%file%hgdf,error)
        if (error)  return
      else  ! code_update
        call cubeio_create_hgdf(dno,cube%desc,cube%order(),cube%file%hgdf,error)
        if (error)  return
      endif
      call gdf_update_header(cube%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_cube_update_header
  !
  subroutine cubeio_cube_write_data_r4(cube,range,data,error)
    !---------------------------------------------------------------------
    ! Wrapper around writing data subroutines
    ! ---
    ! R*4 version
    !---------------------------------------------------------------------
    type(cubeio_cube_t),  intent(inout) :: cube
    type(cubeio_range_t), intent(in)    :: range
    real(kind=4),         intent(inout) :: data(:,:,:)
    logical,              intent(inout) :: error
    !
    type(cputime_t) :: tmp
    character(len=*), parameter :: rname='WRITE>CUBE>DATA>R4'
    !
    call gag_cputime_init(tmp)
    !
    select case (cube%file%kind)
    case (code_dataformat_fits)
      call cubeio_fits_write_data(cube%file%hfits,data,range,error)
      if (error)  return
    case (code_dataformat_gdf)
      call cubeio_gdf_write_data(cube%file%hgdf,data,range,error)
      if (error)  return
    case (code_dataformat_cdf)
      call cubeio_cdf_write_data(cube%file%hcdf,data,range,error)
      if (error)  return
    case default
      call cubeio_message(seve%e,rname,'No associated file on disk')
      error = .true.
      return
    end select
    !
    call gag_cputime_add(cube%time%writ,tmp)
  end subroutine cubeio_cube_write_data_r4
  !
  subroutine cubeio_cube_write_data_c4(cube,range,data,error)
    !---------------------------------------------------------------------
    ! Wrapper around writing data subroutines
    ! ---
    ! C*4 version
    !---------------------------------------------------------------------
    type(cubeio_cube_t),  intent(inout) :: cube
    type(cubeio_range_t), intent(in)    :: range
    complex(kind=4),      intent(in)    :: data(:,:,:)
    logical,              intent(inout) :: error
    !
    type(cputime_t) :: tmp
    character(len=*), parameter :: rname='WRITE>CUBE>DATA>C4'
    !
    call gag_cputime_init(tmp)
    !
    select case (cube%file%kind)
    case (code_dataformat_fits)
      call cubeio_fits_write_data(cube%file%hfits,data,range,error)
      if (error)  return
    case (code_dataformat_gdf)
      call cubeio_gdf_write_data(cube%file%hgdf,data,range,error)
      if (error)  return
    case (code_dataformat_cdf)
      call cubeio_cdf_write_data(cube%file%hcdf,data,range,error)
      if (error)  return
    case default
      call cubeio_message(seve%e,rname,'No associated file on disk')
      error = .true.
      return
    end select
    !
    call gag_cputime_add(cube%time%writ,tmp)
  end subroutine cubeio_cube_write_data_c4
  !
end module cubeio_interface
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
