module cubedag_node_class
  use cubedag_messaging
  use cubedag_parameters
  use cubedag_link_type
  use cubedag_nodedesc_type
  !---------------------------------------------------------------------
  ! Support module for the cubedag_node_object_t, i.e. the generic
  ! object class which is able to store any kind of object without
  ! knowing it (cubes, UV tables, etc).
  !---------------------------------------------------------------------

  ! Placeholder for a 'node object' reference, i.e. for files indexed here. This
  ! type is extended by the external libraries using the DAG, to support their
  ! own object kinds (with their own Fortran types)
  type, abstract, extends(dag_object_t) :: cubedag_node_object_t
    type(cubedag_node_desc_t) :: node
  contains
    procedure(ltype_interface),    deferred, public :: ltype     ! Return string describing the polymorphic type (used e.g. in LIST)
    procedure(memsize_interface),  deferred, public :: memsize   ! Return the memory footprint
    procedure(memsize_interface),  deferred, public :: disksize  ! Return the disk footprint
    procedure(memsize_interface),  deferred, public :: datasize  ! Return the data size
    procedure(snapshot_interface), deferred, public :: snapshot  ! Snapshot the object to the tmp directory
    procedure(finish_interface),   deferred, public :: reimport  ! Reimport the object from disk to DAG
    procedure(finish_interface),   deferred, public :: finish    ! Finish the object after command execution
  ! procedure(),                   deferred         :: free      !
  ! procedure(),                   deferred         :: getsize   ! Useful for garbage collecting?
    ! Get property methods (generic and ad-hoc)
    procedure, public :: get_id       => cubedag_node_get_id
    procedure         :: get_value_i4 => cubedag_node_get_value_i4  ! [private]
    procedure         :: get_value_i8 => cubedag_node_get_value_i8  ! [private]
    procedure         :: get_value_r4 => cubedag_node_get_value_r4  ! [private]
    procedure         :: get_value_r8 => cubedag_node_get_value_r8  ! [private]
    procedure         :: get_value_cc => cubedag_node_get_value_cc  ! [private]
    procedure, public :: get_lrepr    => cubedag_node_get_lrepr
    procedure, public :: get_repr     => cubedag_node_get_repr
    procedure, public :: get_header   => cubedag_node_get_header
    ! Set property methods (generic and ad-hoc)
    generic,   public  :: set_value     => set_value_i4,set_value_i8,set_value_r4, &
                                           set_value_r8,set_value_cc
    procedure, private :: set_value_i4  => cubedag_node_set_value_i4
    procedure, private :: set_value_i8  => cubedag_node_set_value_i8
    procedure, private :: set_value_r4  => cubedag_node_set_value_r4
    procedure, private :: set_value_r8  => cubedag_node_set_value_r8
    procedure, private :: set_value_cc  => cubedag_node_set_value_cc
    procedure, public  :: set_flags     => cubedag_node_set_flags
    procedure, public  :: set_header    => cubedag_node_set_header
    procedure, public  :: set_uservar   => cubedag_node_set_uservar
    procedure, public  :: unset_uservar => cubedag_node_unset_uservar
    ! Others
    procedure, public :: final => cubedag_node_final
  end type cubedag_node_object_t

  public :: cubedag_node_object_t
  public :: cubedag_node_ptr
  private

contains

  function ltype_interface(obj)
    !-------------------------------------------------------------------
    ! Dummy procedure providing its interface for the ltype method
    !-------------------------------------------------------------------
    character(len=2) :: ltype_interface
    class(cubedag_node_object_t), intent(in) :: obj
    ltype_interface = '??'
  end function ltype_interface

  function memsize_interface(obj)
    !-------------------------------------------------------------------
    ! Dummy procedure providing its interface for the memsize method
    !-------------------------------------------------------------------
    integer(kind=size_length) :: memsize_interface
    class(cubedag_node_object_t), intent(in) :: obj
    memsize_interface = 0
  end function memsize_interface

  subroutine snapshot_interface(obj,keep,done,error)
    !-------------------------------------------------------------------
    ! Dummy procedure providing its interface for the snapshot method
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: obj
    logical,                      intent(in)    :: keep
    logical,                      intent(out)   :: done
    logical,                      intent(inout) :: error
  end subroutine snapshot_interface

  subroutine finish_interface(obj,error)
    !-------------------------------------------------------------------
    ! Dummy procedure providing its interface for the finish method
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: obj
    logical,                      intent(inout) :: error
  end subroutine finish_interface

  function cubedag_node_get_id(obj)
    !-------------------------------------------------------------------
    ! Return the node identifier
    !-------------------------------------------------------------------
    integer(kind=iden_l) :: cubedag_node_get_id
    class(cubedag_node_object_t), intent(in) :: obj
    cubedag_node_get_id = obj%node%id
  end function cubedag_node_get_id

  function cubedag_node_ptr(tot,error)
    use cubelist_types
    !-------------------------------------------------------------------
    ! Check if the input class is a 'cubedag_node_object_t', and return
    ! a pointer to it if relevant.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), pointer :: cubedag_node_ptr  ! Function value on return
    class(list_object_t), target, intent(in)   :: tot
    logical,                      intent(inout) :: error
    !
    character(len=*), parameter :: rname='NODE>PTR'
    !
    select type(tot)
    class is (cubedag_node_object_t)
      cubedag_node_ptr => tot
    class default
      cubedag_node_ptr => null()
      call cubedag_message(seve%e,rname,'Internal error: object is not a cubedag_node_object_t')
      error = .true.
      return
    end select
  end function cubedag_node_ptr
  !
  subroutine cubedag_node_get_value_i4(obj,name,found,value,error)
    !-------------------------------------------------------------------
    ! Get an I*4 property from a cubedag_node_object_t. See
    ! requirements in cubelist_object_advanced_types.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: obj
    character(len=*),             intent(in)    :: name  ! Property name
    logical,                      intent(out)   :: found
    integer(kind=4),              intent(inout) :: value
    logical,                      intent(inout) :: error
    !
    found = .true.
    select case (name)
    case ('IDENTIFIER')
      value = obj%node%id
    case ('DATATYPE')
      value = obj%node%head%array_type
    case ('PROJTYPE')
      value = obj%node%head%spatial_projection_code
    case default
      found = .false.
      return
    end select
  end subroutine cubedag_node_get_value_i4
  !
  subroutine cubedag_node_set_value_i4(obj,name,value,error)
    !-------------------------------------------------------------------
    ! Set an I*4 property to a cubedag_node_object_t.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: obj
    character(len=*),             intent(in)    :: name  ! Property name
    integer(kind=4),              intent(in)    :: value
    logical,                      intent(inout) :: error
    !
    select case (name)
    case ('ORIGIN')
      obj%node%origin = value
    case ('HISTORY')
      obj%node%history = value
    case default
      return
    end select
  end subroutine cubedag_node_set_value_i4
  !
  subroutine cubedag_node_get_value_i8(obj,name,found,value,error)
    !-------------------------------------------------------------------
    ! Get an I*8 property from a cubedag_node_object_t. See
    ! requirements in cubelist_object_advanced_types.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: obj
    character(len=*),             intent(in)    :: name  ! Property name
    logical,                      intent(out)   :: found
    integer(kind=8),              intent(inout) :: value
    logical,                      intent(inout) :: error
    !
    found = .true.
    select case (name)
    case ('IDENTIFIER')
      value = obj%node%id
    case ('DATATYPE')
      value = obj%node%head%array_type
    case default
      found = .false.
      return
    end select
  end subroutine cubedag_node_get_value_i8
  !
  subroutine cubedag_node_set_value_i8(obj,name,value,error)
    !-------------------------------------------------------------------
    ! Set an I*8 property to a cubedag_node_object_t.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: obj
    character(len=*),             intent(in)    :: name  ! Property name
    integer(kind=8),              intent(in)    :: value
    logical,                      intent(inout) :: error
    !
    select case (name)
    case ('HISTORY')
      obj%node%history = value
    case default
      return
    end select
  end subroutine cubedag_node_set_value_i8
  !
  subroutine cubedag_node_get_value_r4(obj,name,found,value,error)
    !-------------------------------------------------------------------
    ! Get an R*4 property from a cubedag_node_object_t. See
    ! requirements in cubelist_object_advanced_types.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: obj
    character(len=*),             intent(in)    :: name  ! Property name
    logical,                      intent(out)   :: found
    real(kind=4),                 intent(inout) :: value
    logical,                      intent(inout) :: error
    !
    found = .true.
    select case (name)
    case default
      found = .false.
      return
    end select
  end subroutine cubedag_node_get_value_r4
  !
  subroutine cubedag_node_set_value_r4(obj,name,value,error)
    !-------------------------------------------------------------------
    ! Set an R*4 property to a cubedag_node_object_t.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: obj
    character(len=*),             intent(in)    :: name  ! Property name
    real(kind=4),                 intent(in)    :: value
    logical,                      intent(inout) :: error
    !
    select case (name)
    case default
      return
    end select
  end subroutine cubedag_node_set_value_r4
  !
  subroutine cubedag_node_get_value_r8(obj,name,found,value,error)
    !-------------------------------------------------------------------
    ! Get an R*8 property from a cubedag_node_object_t. See
    ! requirements in cubelist_object_advanced_types.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: obj
    character(len=*),             intent(in)    :: name  ! Property name
    logical,                      intent(out)   :: found
    real(kind=8),                 intent(inout) :: value
    logical,                      intent(inout) :: error
    !
    found = .true.
    select case (name)
    case default
      found = .false.
      return
    end select
  end subroutine cubedag_node_get_value_r8
  !
  subroutine cubedag_node_set_value_r8(obj,name,value,error)
    !-------------------------------------------------------------------
    ! Set an R*8 property to a cubedag_node_object_t.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: obj
    character(len=*),             intent(in)    :: name  ! Property name
    real(kind=8),                 intent(in)    :: value
    logical,                      intent(inout) :: error
    !
    select case (name)
    case default
      return
    end select
  end subroutine cubedag_node_set_value_r8
  !
  subroutine cubedag_node_get_value_cc(obj,name,found,value,error)
    !-------------------------------------------------------------------
    ! Get a C*(*) property from a cubedag_node_object_t. See
    ! requirements in cubelist_object_advanced_types.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: obj
    character(len=*),             intent(in)    :: name  ! Property name
    logical,                      intent(out)   :: found
    character(len=*),             intent(inout) :: value
    logical,                      intent(inout) :: error
    !
    found = .true.
    select case (name)
    case ('FAMILY')
      value = obj%node%family
    case ('FLAGS')
      call obj%node%flag%repr(strflag=value,error=error)
    case ('OBSERVATORY')
      call obj%node%head%obs%tostr(value,error)
    case ('SOURCE')
      value = obj%node%head%spatial_source
    case ('LINE')
      value = obj%node%head%spectral_line
    case default
      found = .false.
      return
    end select
  end subroutine cubedag_node_get_value_cc
  !
  subroutine cubedag_node_set_value_cc(obj,name,value,error)
    !-------------------------------------------------------------------
    ! Set a C*(*) property to a cubedag_node_object_t.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: obj
    character(len=*),             intent(in)    :: name  ! Property name
    character(len=*),             intent(in)    :: value
    logical,                      intent(inout) :: error
    !
    select case (name)
    case ('FAMILY')
      obj%node%family = value
    case default
      return
    end select
  end subroutine cubedag_node_set_value_cc
  !
  subroutine cubedag_node_get_lrepr(obj,name,width,error)
    !-------------------------------------------------------------------
    ! Return the best width for representing a property with LIST
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: obj
    character(len=*),             intent(in)    :: name  ! Column identifier
    integer(kind=4),              intent(out)   :: width
    logical,                      intent(inout) :: error
    !
    character(len=24) :: str24  ! Max column length for these is 24
    !
    select case (name)
    case ('IDENTIFIER')
      width = floor(log10(real(obj%node%id,kind=8)))+1
    case ('PARENTS','CHILDREN','TWINS')
      width = 20
    case ('UNIT')
      width = 12
    case ('SOURCE')
      width = len_trim(obj%node%head%spatial_source)
    case ('LINE')
      width = len_trim(obj%node%head%spectral_line)
    case ('PROJTYPE')
      width = 13
    case ('L0','M0')
      ! Trick because sexag wants at least 12 chars to show seconds and sub-seconds
      width = 11
    case ('PROJANGLE','BPA')
      width = 5
    case ('SPALINC','SPAMINC','SPEFREQINC')
      width = 7
    case ('SPEFREQVAL')
      width = 10
    case ('SPEVELOVAL','BMAJOR','BMINOR')
      width = 6
    case ('OBSERVATORY')
      call obj%node%head%obs%tostr(str24,error)
      if (error)  return
      width = len_trim(str24)
    case ('LOCATION')
      width = 30
    case ('ORDER')
      width = 7
    case ('ACCESS')
      width = 14
    case ('ORIGIN')
      width = 8
    case ('FAMILY')
      width = len_trim(obj%node%family)
    case ('FLAGS')
      call obj%node%flag%repr(lstrflag=width,error=error)
      if (error)  return
    case ('CUBEID')
      width = len_trim(obj%node%cubeid(error))
    case ('TYPE')
      width = 2
    case ('VARIABLE')
      width = 24
    case ('MEMSIZE','DISKSIZE','DATASIZE')
      width = 8
    case ('DATATYPE')
      width = 8
    case default
      width = 3  ! 'N/A'
    end select
  end subroutine cubedag_node_get_lrepr

  subroutine cubedag_node_get_repr(obj,name,width,repr,nline,error)
    use phys_const
    use gkernel_interfaces
    use cubetools_format
    use cubetools_string
    use cubesyntax_datatype_types
    !-------------------------------------------------------------------
    ! Return the representation (i.e. the character string) suited for
    ! command LIST. Note that some columns might spawn over several
    ! lines.
    ! The character string is assumed to best fill the 'repr' length
    ! (i.e. len(repr))
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: obj
    character(len=*),             intent(in)    :: name  ! Column identifier
    integer(kind=4),              intent(in)    :: width
    character(len=*),             intent(out)   :: repr(:)
    integer(kind=4),              intent(out)   :: nline
    logical,                      intent(inout) :: error
    !
    integer(kind=4) :: vali4,iloc
    logical :: found
    character(len=6) :: vformat
    character(len=maxdim) :: iorder
    integer(kind=code_k), parameter :: locations(2) = (/ code_buffer_memory, &
                                                         code_buffer_disk /)
    !
    nline = 1
    repr(1) = ''
    select case (name)
    case ('IDENTIFIER')
      if (obj%node%id.lt.0) then  ! Null id
        repr(1)(1:width) = '--------------------'
      else
        write(vformat,'(A,I0,A)')  '(I',width,')'
        write(repr(1)(1:width),vformat)   obj%node%id
      endif
    case ('PARENTS')
      call obj%node%links%parents%repr('p=',repr(1)(1:width))
    case ('CHILDREN')
      call obj%node%links%children%repr('c=',repr(1)(1:width))
    case ('TWINS')
      call obj%node%links%twins%repr('t=',repr(1)(1:width))
    case ('UNIT')
      repr(1)(1:width) = obj%node%head%array_unit
    case ('SOURCE')
      repr(1)(1:width) = obj%node%head%spatial_source
    case ('PROJTYPE')
      repr(1)(1:width) = projnam(obj%node%head%spatial_projection_code)
    case ('L0')
      ! Trick because sexag wants at least 12 chars to show seconds and sub-seconds
      call sexag(repr(1)(1:width+1),obj%node%head%spatial_projection_l0,24)
      repr(1)(width+1:width+1) = ' '  ! Suppress the last sub-second digit
    case ('M0')
      ! Trick because sexag wants at least 12 chars to show seconds and sub-seconds
      call sexag(repr(1)(1:width+1),obj%node%head%spatial_projection_m0,360)
      repr(1)(width+1:width+1) = ' '  ! Suppress the last sub-second digit
    case ('PROJANGLE')
      write(repr(1)(1:width),'(F5.1)')  obj%node%head%spatial_projection_pa*deg_per_rad
    case ('SPALINC')
      write(repr(1)(1:width),'(F7.2)')  obj%node%head%axset_convert  &
        (code_inc,obj%node%head%axset_ix)*sec_per_rad
    case ('SPAMINC')
      write(repr(1)(1:width),'(F7.2)')  obj%node%head%axset_convert  &
        (code_inc,obj%node%head%axset_iy)*sec_per_rad
    case ('LINE')
      repr(1)(1:width) = obj%node%head%spectral_line
    case ('SPEFREQVAL')
      write(repr(1)(1:width),'(F10.3)')  obj%node%head%spectral_signal_value
    case ('SPEFREQINC')
      write(repr(1)(1:width),'(F7.3)')  obj%node%head%spectral_increment_value
    case ('SPEVELOVAL')
      write(repr(1)(1:width),'(F6.2)')  obj%node%head%spectral_systemic_value
    case ('BMAJOR')
      write(repr(1)(1:width),'(F6.2)')  obj%node%head%spatial_beam_major*sec_per_rad
    case ('BMINOR')
      write(repr(1)(1:width),'(F6.2)')  obj%node%head%spatial_beam_minor*sec_per_rad
    case ('BPA')
      write(repr(1)(1:width),'(F5.1)')  obj%node%head%spatial_beam_pa*deg_per_rad
    case ('OBSERVATORY')
      call obj%node%head%obs%tostr(repr(1)(1:width),error)
    case ('LOCATION','ORDER','ACCESS','DISKSIZE')
      ! These columns spawn over several lines and must be displayed consistently
      nline = 0
      call obj%node%tuple%iterate_init()
      do while (obj%node%tuple%iterate(iorder))
        do iloc=1,2
          if (obj%node%tuple%hascube(iorder,locations(iloc))) then
            nline = nline+1
            if (name.eq.'LOCATION') then
              call obj%node%tuple%location(iorder,locations(iloc),repr(nline)(1:width))
            elseif (name.eq.'ORDER') then
              repr(nline)(1:width) = iorder
            elseif (name.eq.'ACCESS') then
              call cubedag_list_access(obj%node%tuple%access(iorder),repr(nline)(1:width),error)
            elseif (name.eq.'DISKSIZE') then
              repr(nline)(1:width) = cubetools_format_memsize(obj%node%tuple%disksize(iorder,locations(iloc)))
            endif
          endif
        enddo
      enddo
    case ('ORIGIN')
      call cubedag_list_origin(obj%node%origin,repr(1)(1:width),error)
    case ('FAMILY')
      repr(1)(1:width) = obj%node%family
    case ('FLAGS')
      call obj%node%flag%repr(strflag=repr(1)(1:width),error=error)
    case ('CUBEID')
      repr(1)(1:width) = obj%node%cubeid(error)
    case ('TYPE')
      repr(1)(1:width) = obj%ltype()
    case ('MEMSIZE')
      repr(1)(1:width) = cubetools_format_memsize(obj%memsize())
    case ('DATASIZE')
      repr(1)(1:width) = cubetools_format_memsize(obj%datasize())
    case ('DATATYPE')
      call obj%get_value('DATATYPE',found,vali4,error)
      if (error)  return
      repr(1)(1:width) = cubesyntax_datatype(vali4)
    case ('VARIABLE')
      call cubetools_string_concat(obj%node%nuservar,obj%node%uservar,',',repr(1)(1:width),error)
    case default
      repr(1) = 'N/A'
    end select
  contains
    subroutine cubedag_list_origin(origin,strorigin,error)
      integer(kind=code_k), intent(in)    :: origin
      character(len=*),     intent(out)   :: strorigin
      logical,              intent(inout) :: error
      select case (origin)
      case (1:dag_norigins)
        strorigin = dag_origin_names(origin)
      case default
        strorigin = '???'
      end select
    end subroutine cubedag_list_origin
    subroutine cubedag_list_access(access,straccess,error)
      integer(kind=code_k), intent(in)    :: access
      character(len=*),     intent(out)   :: straccess
      logical,              intent(inout) :: error
      select case (access)
      case (code_cube_speset)
        straccess = 'spectrum'
      case (code_cube_imaset)
        straccess = 'image'
      case (code_cube_unkset)
        straccess = 'unknown'
      case default
        straccess = '???'  ! Should not happen
      end select
    end subroutine cubedag_list_access
  end subroutine cubedag_node_get_repr

  subroutine cubedag_node_set_flags(obj,flags,error)
    use cubetools_flag_types
    !-------------------------------------------------------------------
    ! Set the flags of a 'cubedag_node_object_t'.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: obj
    type(flag_t),                 intent(in)    :: flags(:)
    logical,                      intent(inout) :: error
    !
    call obj%node%flag%create(flags,error)
  end subroutine cubedag_node_set_flags
  !
  subroutine cubedag_node_set_header(obj,head,error)
    use cubetools_header_types
    !-------------------------------------------------------------------
    ! The input cube_header_t is transfered to the DAG node header
    ! ZZZ This code should be made simpler when the cube_header_t
    !     becomes an extension of the cube_header_interface_t
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: obj
    type(cube_header_t),          intent(in)    :: head
    logical,                      intent(inout) :: error
    !
    call cubetools_header_export(head,obj%node%head,error)
    if (error)  return
  end subroutine cubedag_node_set_header
  !
  subroutine cubedag_node_get_header(object,head,error)
    use cubetools_header_types
    !-------------------------------------------------------------------
    ! The input DAG node header is transfered to the cube_header_t
    ! ZZZ This code should be made simpler when the cube_header_t
    !     becomes an extension of the cube_header_interface_t
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: object
    type(cube_header_t),          intent(inout) :: head
    logical,                      intent(inout) :: error
    !
    call cubetools_header_import_and_derive(object%node%head,head,error)
    if (error)  return
  end subroutine cubedag_node_get_header
  !
  subroutine cubedag_node_set_uservar(object,uservar,error)
    !-------------------------------------------------------------------
    ! Declare that a user variable points to this node
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: object
    character(len=*),             intent(in)    :: uservar
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='NODE>SET>USERVAR'
    integer(kind=4) :: nuservar
    !
    nuservar = object%node%nuservar+1
    if (nuservar.gt.dag_muservar) then
      call cubedag_message(seve%e,rname,'Too many user variables pointing to the same object')
      error = .true.
      return
    endif
    object%node%nuservar = nuservar
    object%node%uservar(nuservar) = uservar
  end subroutine cubedag_node_set_uservar
  !
  subroutine cubedag_node_unset_uservar(object,uservar,error)
    !-------------------------------------------------------------------
    ! Undeclare that a SIC variable points to this node
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: object
    character(len=*),             intent(in)    :: uservar
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='NODE>UNSET>USERVAR'
    integer(kind=4) :: iuservar,juservar
    !
    juservar = 0
    do iuservar=1,object%node%nuservar
      if (object%node%uservar(iuservar).eq.uservar) then
        juservar = iuservar
        exit
      endif
    enddo
    !
    if (juservar.eq.0) then
      call cubedag_message(seve%w,rname,'Internal error: no such reference to variable '//uservar)
      return
    endif
    !
    do iuservar=juservar+1,object%node%nuservar
      object%node%uservar(iuservar-1) = object%node%uservar(iuservar)
    enddo
    object%node%nuservar = object%node%nuservar-1
  end subroutine cubedag_node_unset_uservar
  !
  subroutine cubedag_node_final(obj,error)
    !-------------------------------------------------------------------
    ! Free the contents of a 'cubedag_node_object_t' (but do not take
    ! care of other links pointing to this object).
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: obj
    logical,                      intent(inout) :: error
    !
    call obj%node%flag%final(error)
    if (error)  continue
    call obj%node%links%final(error)
    if (error)  continue
  end subroutine cubedag_node_final

end module cubedag_node_class
