!-----------------------------------------------------------------------
! Support subroutines to clone a cube and header from an input one,
! with possible adjustments
!-----------------------------------------------------------------------
!
subroutine cubeio_clone_cube_header(cubset,cubdef,hin,cout,error)
  use gkernel_interfaces
  use cubetools_access
  use cubetools_header_types
  use cubetools_setup_types
  use cubeio_header
  use cubeio_cube
  use cubeio_cube_define
  use cubeio_desc_setup
  use cubeio_messaging
  use cubeio_interfaces, except_this=>cubeio_clone_cube_header
  use cubeio_timing
  !---------------------------------------------------------------------
  ! @ public
  ! ZZZ RENAME THIS SUBROUTINE WHICH IS NOT A HGDF CLONING ANYMORE
  ! Prepare the GDF header according to input reference and optional
  ! changes
  !---------------------------------------------------------------------
  type(cube_setup_t),  intent(in)    :: cubset
  type(cube_define_t), intent(in)    :: cubdef
  type(cube_header_t), intent(in)    :: hin
  type(cubeio_cube_t), intent(inout) :: cout
  logical,             intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CLONE>CUBE>HEADER'
  !
  ! Sanity
  if (.not.cubdef%dofilename) then
    call cubeio_message(seve%e,rname,'Internal error: cube file name must be set')
    error = .true.
    return
  endif
  if (.not.cubdef%doorder) then
    call cubeio_message(seve%e,rname,'Internal error: output order must be set')
    error = .true.
    return
  endif
  if (.not.cubdef%doaccess) then
    call cubeio_message(seve%e,rname,'Internal error: output access mode must be set')
    error = .true.
    return
  endif
  !
  call cout%time%init(error)
  if (error)  return
  !
  ! Set up the IO descriptor
  cout%file%name = cubdef%filename
  call cubeio_header_put(hin,cubdef%order,cout%desc,.not.verbose,error)
  if (error)  return
  call cubeio_set_descriptor_external(cubset,cubdef,.false.,cout,error)
  if (error)  return
  !
end subroutine cubeio_clone_cube_header
!
subroutine cubeio_create_hgdf(header,desc,oorder,hgdf,error)
  use image_def
  use cubetools_header_types
  use cubeio_header
  use cubeio_desc
  use cubeio_cube
  use cubeio_interfaces, except_this=>cubeio_create_hgdf
  use cubeio_messaging
  !---------------------------------------------------------------------
  ! @ public
  ! Create or recreate the hgdf by converting the header with requested
  ! order.
  !---------------------------------------------------------------------
  type(cube_header_t),  intent(in)    :: header
  type(cubeio_desc_t),  intent(in)    :: desc
  integer(kind=code_k), intent(in)    :: oorder
  type(gildas),         intent(inout) :: hgdf
  logical,              intent(inout) :: error
  !
  character(len=*), parameter :: rname='CREATE>HGDF'
  !
  call cubeio_header_put(header,oorder,hgdf,.not.verbose,error)
  if (error)  return
  !
  if (desc%reblank) then
    call cubeio_message(seve%d,rname,'Enabling HGDF blanking section')
    hgdf%gil%blan_words = 1
    hgdf%gil%bval = desc%bval
    hgdf%gil%eval = desc%eval
  endif
  !
end subroutine cubeio_create_hgdf
!
subroutine cubeio_create_and_truncate_hgdf(header,desc,oorder,dim3,hgdf,error)
  use image_def
  use cubetools_header_types
  use cubeio_header
  use cubeio_cube
  use cubeio_desc
  use cubeio_interfaces, except_this=>cubeio_create_and_truncate_hgdf
  use cubeio_messaging
  !---------------------------------------------------------------------
  ! @ private
  ! Same as cubeio_create_hgdf, but truncate the 3rd dimension to
  ! requested size.
  !---------------------------------------------------------------------
  type(cube_header_t),  intent(in)    :: header
  type(cubeio_desc_t),  intent(in)    :: desc
  integer(kind=code_k), intent(in)    :: oorder
  integer(kind=data_k), intent(in)    :: dim3
  type(gildas),         intent(inout) :: hgdf
  logical,              intent(inout) :: error
  !
  character(len=*), parameter :: rname='CREATE>AND>TRUNCATE>HGDF'
  !
  call cubeio_create_hgdf(header,desc,oorder,hgdf,error)
  if (error)  return
  !
  ! Sanity check
  select case (hgdf%gil%ndim)
  case (1,2)
    if (dim3.gt.1) then
      call cubeio_message(seve%e,rname,  &
        'Internal error: can not truncate 3rd dimension while cube is 1D or 2D')
      error = .true.
      return
    endif
  case (3)
    if (dim3.gt.hgdf%gil%dim(3)) then
      call cubeio_message(seve%e,rname,  &
        'Internal error: can not truncate beyond the 3rd dimension')
      error = .true.
      return
    endif
    hgdf%gil%dim(3) = dim3
  case default
    call cubeio_message(seve%e,rname,  &
      'Not implemented: truncating last dimension of a 4D (or more) cube')
    error = .true.
    return
  end select
end subroutine cubeio_create_and_truncate_hgdf
!
subroutine cubeio_create_hfits(header,oorder,hfits,error)
  use cubefitsio_header
  use cubetools_parameters
  use cubetools_header_types
  use cubeio_header
  use cubeio_interfaces, except_this=>cubeio_create_hfits
  !---------------------------------------------------------------------
  ! @ private
  ! Create or recreate the hfits by converting the header with requested
  ! order.
  !---------------------------------------------------------------------
  type(cube_header_t),   intent(in)    :: header
  integer(kind=code_k),  intent(in)    :: oorder
  type(fitsio_header_t), intent(inout) :: hfits
  logical,               intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CREATE>HFITS'
  !
  call cubeio_header_put(header,oorder,hfits,.not.verbose,error)
  if (error)  return
  !
end subroutine cubeio_create_hfits
!
subroutine cubeio_create_and_truncate_hfits(header,oorder,dim3,hfits,error)
  use cubefitsio_header
  use cubetools_parameters
  use cubetools_header_types
  use cubeio_header
  use cubeio_interfaces, except_this=>cubeio_create_and_truncate_hfits
  use cubeio_messaging
  !---------------------------------------------------------------------
  ! @ private
  ! Same as cubeio_create_hgdf, but truncate the 3rd dimension to
  ! requested size.
  !---------------------------------------------------------------------
  type(cube_header_t),   intent(in)    :: header
  integer(kind=code_k),  intent(in)    :: oorder
  integer(kind=data_k),  intent(in)    :: dim3
  type(fitsio_header_t), intent(inout) :: hfits
  logical,               intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='CREATE>AND>TRUNCATE>HFITS'
  !
  call cubeio_create_hfits(header,oorder,hfits,error)
  if (error)  return
  !
  ! Sanity check
  select case (hfits%ndim)
  case (1,2)
    if (dim3.gt.1) then
      call cubeio_message(seve%e,rname,  &
        'Internal error: can not truncate 3rd dimension while cube is 1D or 2D')
      error = .true.
      return
    endif
  case (3)
    if (dim3.gt.hfits%dim(3)) then
      call cubeio_message(seve%e,rname,  &
        'Internal error: can not truncate beyond the 3rd dimension')
      error = .true.
      return
    endif
    hfits%dim(3) = dim3
  case default
    call cubeio_message(seve%e,rname,  &
      'Not implemented: truncating last dimension of a 4D (or more) cube')
    error = .true.
    return
  end select
  !
end subroutine cubeio_create_and_truncate_hfits
