!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubedag_remove_tool
  use gkernel_interfaces
  use cubedag_messaging
  use cubedag_parameters
  use cubedag_node_class
  use cubedag_tuple
  use cubedag_type_type
  !
  public :: noderm
  private
  !
  type :: cubedag_remove_tool_t
  contains
    procedure, nopass, public :: destroy => cubedag_node_destroy
    procedure, nopass, public :: remove  => cubedag_node_remove
  end type cubedag_remove_tool_t
  type(cubedag_remove_tool_t) :: noderm
  !
contains
  !
  subroutine cubedag_node_destroy(object,error)
    !-------------------------------------------------------------------
    ! Brute force destruction of a node object. Do not worry about
    ! family links between nodes.
    ! The object is a pointer which is expected to be deallocated and
    ! nullified in return.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), pointer       :: object
    logical,                      intent(inout) :: error
    !
    integer(kind=4) :: ivar
    character(len=*), parameter :: rname='NODE>DESTROY'
    !
    do ivar=1,object%node%nuservar
      ! As of today, on the command OLDLOAD creates user variables
      ! pointing to the actual cube data. This is likely to disappear
      ! when OLDLOAD is rewritten.
      call cubedag_message(seve%w,rname,'Removing variable '//  &
        trim(object%node%uservar(ivar))//' pointing to destroyed node')
      call sic_delvariable(object%node%uservar(ivar),.false.,error)
      if (error)  error = .false.
    enddo
    !
    ! Clean the object contents (common part). The polymorphic part
    ! must be cleaned by the specific deallocation subroutine invoked
    ! below
    call object%final(error)
    if (error)  continue
    !
    ! Deallocate the object in memory
    call nodetype%deallocate(object,error)
    if (error)  return
  end subroutine cubedag_node_destroy
  !
  subroutine cubedag_node_remove(object,error)
    use cubelist_types
    !-------------------------------------------------------------------
    ! Proper removal of a node object, taking care of the family links
    ! between the other nodes
    ! The object is a pointer which is expected to be deallocated and
    ! nullified in return.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), pointer       :: object
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='REMOVE'
    integer(kind=entr_k) :: irel
    class(cubedag_node_object_t), pointer :: relative
    class(list_object_t), pointer :: tot
    !
    if (object%node%links%children%n.gt.0) then
      call cubedag_message(seve%e,rname,'Node has one or more children')
      error = .true.
      return
    endif
    !
    ! Clean twins
    do irel=1,object%node%links%twins%n
      relative => cubedag_node_ptr(object%node%links%twins%list(irel)%p,error)
      if (error)  return
      tot => object
      call relative%node%links%twins%dissociate(tot,error)
      if (error)  return
    enddo
    ! Clean parents
    do irel=1,object%node%links%parents%n
      relative => cubedag_node_ptr(object%node%links%parents%list(irel)%p,error)
      if (error)  return
      tot => object
      call relative%node%links%children%dissociate(tot,error)
      if (error)  return
    enddo
    !
    ! Clean files on disk, only for non-raw cubes!
    if (object%node%origin.ne.code_origin_imported) then
      call cubedag_tuple_rmfiles(object%node%tuple,error)
      if (error)  return
    endif
    !
    ! Now destroy it
    call noderm%destroy(object,error)
    if (error)  return
  end subroutine cubedag_node_remove
  !
end module cubedag_remove_tool
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
