!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeadm_clone
  use gkernel_interfaces
  use cubetools_parameters
  use cubedag_flag
  use cubeio_interfaces_public
  use cube_types
  use cubeadm_messaging
  !
  public :: cubeadm_clone_header,cubeadm_create_header
  private
  !
  interface cubeadm_clone_header
    module procedure cubeadm_clone_header_0d
    module procedure cubeadm_clone_header_1d
  end interface cubeadm_clone_header
  !
  interface cubeadm_create_header
    module procedure cubeadm_create_header_0d
    module procedure cubeadm_create_header_1d
  end interface cubeadm_create_header
  !
contains
  !
  subroutine cubeadm_create_header_0d(newflag,access,ndim,dim,ou,error)
    !----------------------------------------------------------------------
    ! Create a new node object of type 'cube', for future insertion in the
    ! DAG. Plus, create a new header for the output cube.
    ! ---
    ! 0D 'flag' version
    !----------------------------------------------------------------------
    type(flag_t),         intent(in)    :: newflag
    integer(kind=4),      intent(in)    :: access      ! code_cube_*
    integer(kind=ndim_k), intent(in)    :: ndim
    integer(kind=data_k), intent(in)    :: dim(:)
    type(cube_t),         pointer       :: ou
    logical,              intent(inout) :: error
    !
    call cubeadm_create_header_1d([newflag],access,ndim,dim,ou,error)
    if (error)  return
  end subroutine cubeadm_create_header_0d
  !
  subroutine cubeadm_create_header_1d(newflags,access,ndim,dim,ou,error)
    use gbl_format
    use cubetools_access
    use cubetools_header_interface
    use cubetools_header_types
    !----------------------------------------------------------------------
    ! Create a new node object of type 'cube', for future insertion in the
    ! DAG. Plus, create a new header for the output cube.
    ! ---
    ! 1D 'flag' version
    !----------------------------------------------------------------------
    type(flag_t),         intent(in)    :: newflags(:)
    integer(kind=4),      intent(in)    :: access      ! code_cube_*
    integer(kind=ndim_k), intent(in)    :: ndim
    integer(kind=data_k), intent(in)    :: dim(:)
    type(cube_t),         pointer       :: ou
    logical,              intent(inout) :: error
    ! Local
    type(cube_header_interface_t) :: interf
    integer(kind=code_k) :: order
    character(len=*), parameter :: rname='CREATE>HEADER'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    order = cubetools_access2order(access)
    call cubeadm_create_node(ou,order,access,'UNKNOWN',newflags,error)
    if (error)  return
    !
    ! Set initial header
    call interf%create(fmt_r4,access,ndim,dim,error)
    if (error) return
    call cubetools_header_import_and_derive(interf,ou%head,error)
    if (error)  return
  end subroutine cubeadm_create_header_1d
  !
  subroutine cubeadm_clone_header_0d(in,newflag,ou,error,access,keepflags)
    !----------------------------------------------------------------------
    ! Create a new node object of type 'cube', for future insertion in the
    ! DAG. Plus, clone the header of the input cube for the output cube.
    ! ---
    ! 0D 'flag' version
    !----------------------------------------------------------------------
    type(cube_t),              intent(in)    :: in
    type(flag_t),              intent(in)    :: newflag
    type(cube_t),              pointer       :: ou
    logical,                   intent(inout) :: error
    integer(kind=4), optional, intent(in)    :: access      ! code_cube_*
    logical,         optional, intent(in)    :: keepflags
    !
    call cubeadm_clone_header_1d(in,[newflag],ou,error,access,keepflags)
    if (error)  return
  end subroutine cubeadm_clone_header_0d
  !
  subroutine cubeadm_clone_header_1d(in,newflags,ou,error,access,keepflags)
    use cubetools_access
    use cubetools_header_types
    use cubedag_node
    !----------------------------------------------------------------------
    ! Create a new node object of type 'cube', for future insertion in the
    ! DAG. Plus, clone the header of the input cube for the output cube.
    ! ---
    ! 1D 'flag' version
    !----------------------------------------------------------------------
    type(cube_t),              intent(in)    :: in
    type(flag_t),              intent(in)    :: newflags(:)
    type(cube_t),              pointer       :: ou
    logical,                   intent(inout) :: error
    integer(kind=4), optional, intent(in)    :: access
    logical,         optional, intent(in)    :: keepflags
    ! Local
    integer(kind=code_k) :: laccess,lorder
    type(flag_t), pointer :: flag
    type(flag_t), allocatable :: oflags(:)
    integer(kind=4) :: isize,nsize,osize,jflag,ier
    character(len=*), parameter :: rname='CLONE>HEADER'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    ! Set up file order and access mode. Default is same as input cube
    lorder = in%order()
    laccess = in%access()
    if (present(access)) then
      laccess = access
      if (laccess.eq.code_access_imaset .or.  &
          laccess.eq.code_access_speset) then
        lorder = cubetools_access2order(laccess)
      else
        ! Other accesses (e.g. subcube) do not change the output cube order
      endif
    endif
    !
    ! Set up flags
    nsize = size(newflags)
    if (present(keepflags).and.keepflags) then
      isize = in%node%flag%n
      osize = nsize+isize
      allocate(oflags(osize),stat=ier)
      if (failed_allocate(rname,'oflags',ier,error)) return
      oflags(1:nsize) = newflags(:)
      !
      do jflag=1,isize
        flag => cubedag_flag_ptr(in%node%flag%list(jflag)%p,error)
        if (error)  return
        oflags(nsize+jflag) = flag
      enddo
    else
      allocate(oflags(nsize),stat=ier)
      if (failed_allocate(rname,'oflags',ier,error)) return
      oflags(:) = newflags(:)
    endif
    !
    call cubeadm_create_node(ou,lorder,laccess,in%node%family,oflags,error)
    if (error)  return
    !
    ! Set header (copy from input one)
    call cubetools_header_copy(in%head,ou%head,error)
    if (error)  return
  end subroutine cubeadm_clone_header_1d
  !
  subroutine cubeadm_create_node(ou,order,access,family,oflags,error)
    use cubetools_dataformat
    use cubedag_parameters
    use cubedag_types
    use cubedag_dag
    use cubedag_node
    use cubeio_cube_define
    use cubeio_file
    use cubeadm_init
    use cubeadm_opened
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(cube_t),         pointer       :: ou
    integer(kind=code_k), intent(in)    :: order
    integer(kind=code_k), intent(in)    :: access
    character(len=*),     intent(in)    :: family
    type(flag_t),         intent(in)    :: oflags(:)
    logical,              intent(inout) :: error
    !
    class(cubedag_node_object_t), pointer :: dno
    character(len=*), parameter :: rname='CREATE>NODE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    ! Insert a new object in the DAG. Dangling, parents will be attached
    ! when object is finalized.
    call cubedag_dag_newnode(dno,code_ftype_cube,error)
    if (error)  return
    ou => cubetuple_cube_ptr(dno,error)
    if (error)  return
    call cubeio_cube_define_order(ou%prog,order,error)
    if (error)  return
    call cubeio_cube_define_access(ou%prog,access,error)
    if (error)  return
    if (access.eq.code_access_fullset) then
      call cubeio_cube_define_buffering(ou%prog,code_buffer_memory,error)
      if (error)  return
    endif
    !
    ! Set up the buffer kind on disk (used only if relevant)
    ! => default is to work with GDF format (no byte-swapping)
    call cubeio_cube_define_filekind(ou%prog,code_dataformat_gdf,error)
    if (error)  return
    ! Set up buffer name on disk (used only if relevant)
    call cubeadm_set_cubename(ou,order,error)
    if (error)  return
    ! => Both file kind and name can be overloaded by commands afterwards
    !
    ! Fill the properties in index
    call cubedag_node_set_origin(dno,code_origin_created,error)
    if (error)  return
    call cubedag_node_set_family(dno,family,error)
    if (error)  return
    call cubedag_node_set_flags(dno,oflags,error)
    if (error)  return
    !
    ! Success
    call cubeadm_children_add(dno,code_write)
  end subroutine cubeadm_create_node
  !
  subroutine cubeadm_set_cubename(cube,order,error)
    use cubetools_parameters
    use cubetools_access
    use cubeio_cube_define
    use cubeadm_directory_type
    !---------------------------------------------------------------------
    ! Set temporary cube file name according to identifier, cube order,
    ! and tmp directory
    !---------------------------------------------------------------------
    type(cube_t),    intent(inout) :: cube
    integer(kind=4), intent(in)    :: order
    logical,         intent(inout) :: error
    ! Local
    character(len=base_l) :: oubase
    character(len=exte_l) :: ouext
    character(len=file_l) :: ouname
    !
    call cubeadm_directory_create(dir%tmp,error)
    if (error)  return
    !
    write(oubase,'(I0)')  cube%node%id
    ouext = cubetools_order2ext(order)
    call sic_parse_file(oubase,dir%tmp,ouext,ouname)
    !
    call cubeio_cube_define_filename(cube%prog,ouname,error)
    if (error)  return
  end subroutine cubeadm_set_cubename
end module cubeadm_clone
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
