module cubeio_highlevel
  use cubetools_parameters
  use cubetools_setup_types
  use cubedag_node_class
  use cubeio_messaging
  use cubeio_cube_define
  use cubeio_cube
  use cubeio_desc_setup
  use cubeio_interface
  use cubeio_header_iodesc
  use cubeio_header_interface
  use cubeio_flush
  !---------------------------------------------------------------------
  ! High level API which makes sense for outer libraries
  !---------------------------------------------------------------------

  public :: cubeio_get_header
  public :: cubeio_interface_put
  public :: cubeio_clone_header
  public :: cubeio_dump_cube
  public :: cubeio_cube_finish
  private

contains

  subroutine cubeio_get_header(cubset,cubdef,dno,cub,error)
    !----------------------------------------------------------------------
    ! Get the file header, derived from the file header on disk (whatever
    ! the file kind).
    ! Also set up the IO-descriptor internal structure.
    !----------------------------------------------------------------------
    type(cube_setup_t),           intent(in)    :: cubset
    type(cube_define_t),          intent(in)    :: cubdef
    class(cubedag_node_object_t), intent(inout) :: dno
    type(cubeio_cube_t),          intent(inout) :: cub
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='GET>HEADER'
    !
    call cubeio_message(ioseve%trace,rname,'Welcome')
    !
    call cubeio_cube_read_header(cubdef,dno,cub,error)
    if (error)  return
    !
    ! Set up descriptor
    call cubeio_set_descriptor_intrinsic(dno,cub,error)
    if (error)  return
    call cubeio_set_descriptor_external(cubset,cubdef,.true.,cub,error)
    if (error)  return
  end subroutine cubeio_get_header

  subroutine cubeio_interface_put(dno,order,cub,error)
    !-------------------------------------------------------------------
    ! From interface_t to header_t and iodesc_t
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: dno
    integer(kind=code_k),         intent(in)    :: order  ! code_order_*
    type(cubeio_cube_t),          intent(inout) :: cub
    logical,                      intent(inout) :: error
    !
    call cubeio_header_interface_transpose(dno%node%head,order,error)  ! Inplace
    if (error) return
    call dno%node%interf2head(error)
    if (error) return
    call cubeio_iodesc_import(dno%node%head,cub%desc,error)
    if (error) return
  end subroutine cubeio_interface_put

  subroutine cubeio_clone_header(cubset,cubdef,dno,cout,error)
    !---------------------------------------------------------------------
    ! Prepare the output descriptor according to input reference and
    ! optional changes
    !---------------------------------------------------------------------
    type(cube_setup_t),           intent(in)    :: cubset
    type(cube_define_t),          intent(in)    :: cubdef
    class(cubedag_node_object_t), intent(inout) :: dno
    type(cubeio_cube_t),          intent(inout) :: cout
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='CLONE>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
    !
    ! Set up the IO descriptor
    cout%file%name = cubdef%filename
    cout%file%hdu = cubdef%hdu
    call cubeio_header_put(dno,cubdef%order,cout%desc,error)
    if (error)  return
    call cubeio_set_descriptor_external(cubset,cubdef,.false.,cout,error)
    if (error)  return
  end subroutine cubeio_clone_header

  subroutine cubeio_dump_cube(cubset,cubdef,dno,cub,error)
    !---------------------------------------------------------------------
    ! Dump (i.e. write or update) all-at-once a cube from memory to disk,
    ! if relevant (i.e. nothing done for a read-only cube).
    ! ---
    ! ZZZ This all-at-once toolbox is a bit ad-hoc. Should it be ported
    ! to a more standard internal API (with blocks iteration)?
    !---------------------------------------------------------------------
    type(cube_setup_t),           intent(in)    :: cubset
    type(cube_define_t),          intent(in)    :: cubdef
    class(cubedag_node_object_t), intent(inout) :: dno
    type(cubeio_cube_t),          intent(inout) :: cub
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='DUMP>CUBE'
    !
    call cubeio_set_descriptor_external(cubset,cubdef,.false.,cub,error)
    if (error)  return
    !
    select case (cub%desc%action)
    case (code_read_head,code_read)
      ! Nothing to be done
    case (code_write)
      call cubeio_write_cube(cubset,cubdef,dno,cub,error)
    case (code_update)
      call cubeio_message(seve%e,rname,'Update mode not implemented')
      error = .true.
    case default
      call cubeio_message(seve%e,rname,'Invalid action code')
      error = .true.
    end select
    !
  end subroutine cubeio_dump_cube

  subroutine cubeio_write_cube(cubset,cubdef,dno,cub,error)
    !---------------------------------------------------------------------
    ! Write a cube from memory to disk
    !---------------------------------------------------------------------
    type(cube_setup_t),           intent(in)    :: cubset
    type(cube_define_t),          intent(in)    :: cubdef
    class(cubedag_node_object_t), intent(inout) :: dno
    type(cubeio_cube_t),          intent(inout) :: cub
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='WRITE>CUBE'
    !
    select case (cub%desc%buffered)
    case (code_buffer_none)
      call cubeio_message(seve%e,rname,'No data available')
      error = .true.
      return
      !
    case (code_buffer_memory)
      if (.not.cubset%output%write)  return  ! Writing is disabled
      !
      ! Sanity
      if (.not.cubdef%dofilename) then
        call cubeio_message(seve%e,rname,'Missing file name')
        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
      !
      ! Write everything (header+data) from memory to disk
      call cubeio_cube_write_cube(cub,cubdef,dno,error)
      if (error)  return
      call cubeio_message(seve%i,rname,'Cube written to file '//cubdef%filename)
      !
    case (code_buffer_disk)
      ! Already on disk... might need flushing the last buffer.
      call cubeio_flush_block(dno,cub,cub%file%block,error)
      if (error)  return
      call cubeio_message(seve%i,rname,'Cube flushed to file '//cub%file%hgdf%file)
      !
    case default
      call cubeio_message(seve%e,rname,'Unexpected buffering kind')
      error = .true.
      return
    end select
  end subroutine cubeio_write_cube

  subroutine cubeio_cube_finish(cubset,dno,cub,error)
    use gkernel_interfaces
    !---------------------------------------------------------------------
    ! This subroutine is to be invoked once the cube is fully read or
    ! created or modified, to leave it in a 'better' state.
    !---------------------------------------------------------------------
    type(cube_setup_t),           intent(in)    :: cubset
    class(cubedag_node_object_t), intent(inout) :: dno
    type(cubeio_cube_t),          intent(inout) :: cub
    logical,                      intent(inout) :: error
    !
    ! Might need flushing of last block in case of disk mode
    call cubeio_flush_block(dno,cub,cub%file%block,error)
    if (error)  continue
    !
    ! Free temporary buffers as they are not needed anymore
    call cub%file%block%free(error)
    if (error)  continue
    !
    if (cub%desc%action.eq.code_write .or.  &
        cub%desc%action.eq.code_update) then
      ! Reload FITS header for extra entries
      call cubeio_cube_reload_header(cub,error)
      if (error)  return
    endif
    !
    ! Timing feedback?
    call gag_cputime_get(cub%time%total)  ! Get total time on this cube
    call cub%feedback()
  end subroutine cubeio_cube_finish

end module cubeio_highlevel
