!
!     For the purposes of this description, a tree data
!  structure consists of a set of connected nodes, arranged in levels.
!  The top node points to some nonzero number of nodes at the second
!  level. All other nodes point at zero or more nodes at the next lower
!  level, and point back to exactly one node at the next higher level.
!  The set of nodes pointed at by a single higher node is referred
!  to as a layer. This is thus a standard tree of mother nodes each
!  connected to a set of daughter nodes.
!
!     The module supports an arbitrary number of independent trees. They
!  may be manipulated simultaneously (but see note on subroutine
!  start below).
!
!     At each node are stored, as far as the user is concerned:
!
!        an index number supplied by the user (does not have to be
!           sequential),
!        the index of the node that the node points back to (its mother
!           node),
!        an optional fixed character component (could be made variable),
!        an optional integer array,
!        an optional real array,
!        and the optional links (pointers) to nodes with specified
!        index numbers (the daughter nodes).
!
!  The node contains also a running index number maintained by the
!  module.
!
!     In a development version,
!  an optional array of a fixed derived-data type may also be stored
!  at each node, as well as a single reference link to another node
!  (even in a different tree). A reference link is a pointer between
!  any two nodes and is not part of the tree structure as such.
!
!     The user interfaces are:
!
!  [start] must be called to initialise a tree immediately before
!          the first call to new_node for that tree (i.e. no
!          reference to another tree may be made between these two
!          calls).
!  [new_node] stores the data provided at the node whose index number is
!          supplied as a second argument,
!          and sets up pointers to all the specified daughter nodes that
!          will be stored in
!          subsequent calls. It makes some consistency checks.
!  [retrieve] retrieves a specified node; the data arrays (if present)
!          are accessed via pointers, as are the
!          links (pointers) to any daughter nodes.
!  [next]  like retrieve, for the node with the next
!          following running index number (not user index number).
!  [next_in_layer] like next, for the next node in the current layer.
!          (In a sequence of calls, the next layer down
!          will be automatically taken when the
!          current one is exhausted, and this can be detected by a change
!          in the value of the back pointer. If such a call follows
!          one to next or retrieve the next layer is not taken.)
!  [previous] retrieves the data in the mother node of the last node
!           accessed.
!  [dump_tree] write a complete tree to a specified unit.
!  [restore_tree] read a complete tree from a specified unit
!          (initialisation is not required, even for a new tree).
!  [set_reference] establishes a reference link between
!          a node of one tree and a node of the same or another tree.
!  [get_reference] like retrieve, but for the data at the node that is
!          the target of the reference link at the specified node.
!  [finish] deallocate all the storage occupied by a complete tree.
!
!  These interfaces are simple. To add a new node to a tree, with a name,
!  some integer data, and links to three daughter nodes, we write,
!  for example,
!
!       call new_node(tree_name, index, node_name,                     &
!             integer_data = (/ (i, i = 1, 10) /), links = (/ 2, 3, 5/))
!
!  and to retrieve data we write
!
!       call retrieve(tree_name, index, back, name, j, y, link)
!
!  where back is the index of the mother of the node index, and
!  j, y, and link are pointers to any optional integer data, real
!  data or links stored at that node. These names are chosen by the
!  user, and retrieved data can be referred to directly, say as j(16).
!
!     Internally, the module allocates a node, and allocates data at that
!  node if the corresponding argument is present in the call to new_node.
!
module ddl
! Contains a type definition that is to become a component of the node
! data type.
   type user_type
      character(8)     :: layout
      integer, pointer :: i_field(:)
      real, pointer    :: f_field(:)
   end type user_type
!
!
   integer, parameter  :: max_elem = 10        ! maximum size of user field
end module ddl
module eagle    ! Soars above the rest
   use ddl
!                      **********11/04/94**********
! Stong typing imposed
   implicit none
!
! Only the data type, the subroutine interfaces, the length of the character
! component, the user type, and the I/O unit are public
   private
   public finish, new_node, next, next_in_layer, previous, retrieve, start,    &
       dump_tree, restore_tree, set_reference, get_reference,                  &
       user_type, unit, max_char
!
! Global module constants
   character(*), parameter:: eot = 'End-of-Tree.....'
   integer, parameter     :: max_len = 1000    ! maximum length of data buffers
!
! Global constants
   integer, parameter     :: unit = 4,                                         &
                             max_char = 16     ! length of character component
!
! Define a pointer data type
   type ptr
      type(data), pointer :: pp
   end type ptr
!
! Define the data structure holding the state of a tree
   type state
      type(data), pointer :: current, parent
      integer             :: count, last_code
   end type state
!
! Define the basic node type
   type, public :: data
   private
      integer                     index, amount(4), running_index
      character(max_char)         header
      integer, pointer         :: j(:), link(:)
      real, pointer            :: y(:)
      type(ptr), pointer       :: p(:)
      type(user_type), pointer :: user(:)
      type(data), pointer      :: back, reference, ref_back
      type(state), pointer     :: own_state
   end type data
!
! Some global module variables
   type(data), pointer    :: current, parent
   integer                :: count, last_code
   type(state), pointer   :: tree_state        ! tree state variable
!
! The module procedures
contains

   subroutine add_user(node_out, node_in)
!
! To make the assigment of the user data to a node. Knowlege of
! the actual structure of user_type is required.
      type(user_type), intent(out) :: node_out(:)
      type(user_type), intent(in)  :: node_in(:)
      integer loop
!
      do loop = 1, size(node_in)
         node_out(loop)%layout = node_in(loop)%layout
         allocate(node_out(loop)%i_field(size(node_in(loop)%i_field)))
         allocate(node_out(loop)%f_field(size(node_in(loop)%f_field)))
         node_out(loop)%i_field = node_in(loop)%i_field
         node_out(loop)%f_field = node_in(loop)%f_field
      end do
   end subroutine add_user

   subroutine check_state(tree)
!
! To check that this is the same tree as on the last call, and to
! switch the state variable if not.
      type(data), intent(in) :: tree
!
      if (.not.associated(tree%own_state, tree_state)) then
         tree_state => tree%own_state
         count =  tree_state%count
         last_code = tree_state%last_code
         current => tree_state%current
         parent => tree_state%parent
      end if
   end subroutine check_state

   subroutine dump_tree (tree)
!
! Traverse a complete tree or subtree, writing out its contents
      type(data), intent(in) :: tree
      logical :: too_long = .false.
!
      call out(tree)
      write(unit) 0, eot, (/ 0, 0, 0, 0 /)
      if (too_long) print *,   'at least one field written was longer than the &
                             &input buffer size (max_len)'
   contains
      recursive subroutine out(tree)
         type(data), intent(in) :: tree
         integer loop, i
!
! Write whole node
         write(unit) tree%index,                                               &
                     tree%header, tree%amount, tree%j, tree%y, tree%link,      &
             (tree%user(i)%layout,                                             &
              size(tree%user(i)%i_field), tree%user(i)%i_field,                &
              size(tree%user(i)%f_field), tree%user(i)%f_field,                &
                                                       i = 1, size(tree%user) )
!
! Check component lengths
         if ( any(tree%amount(:3) > max_len) ) too_long = .true.
         do loop = 1, size(tree%user)
            if (size(tree%user(loop)%i_field) > max_len .or.                   &
                size(tree%user(loop)%f_field) > max_len ) too_long = .true.
         end do
!
! Loop through whole tree
         do loop = 1, size(tree%p)
            if(associated(tree%p(loop)%pp)) then      ! Precaution
               call out (tree%p(loop)%pp)
            else
               print *, 'attempt to write tree with disassociated node'
            end if
         end do
      end subroutine out
   end subroutine dump_tree

   recursive subroutine finish (tree)
!
! Traverse a complete tree or subtree, deallocating all storage
! (except the state variable).
      type(data), pointer :: tree
      integer loop
!
      do loop = 1, size(tree%p)
         call finish (tree%p(loop)%pp)
      end do
      do loop = 1, size(tree%user)
         deallocate(tree%user(loop)%i_field, tree%user(loop)%f_field)
      end do
      deallocate(tree%j, tree%y, tree%user, tree%p, tree%link)
      if (associated(tree%ref_back)) nullify(tree%ref_back%reference)
      deallocate(tree)
   end subroutine finish

   subroutine get_reference (tree, code, back, name, point_to_j, point_to_y,   &
                        point_to_ud, links)
!
! Search for node referenced by a specified index value
      type(data), pointer      :: tree
      integer, intent(in)      :: code
      integer, intent(out)     :: back
      character(*)             :: name
      integer, pointer         :: point_to_j(:), links(:)
      real, pointer            :: point_to_y(:)
      type(user_type), pointer :: point_to_ud(:)
      type(data), pointer :: previous, reference
      real, target        :: a(1) = (/ huge(0.) /)
      integer, target     :: i(1) = (/ huge(0) /)
!
! Locate the node
      nullify(current)
      call inner(tree)
!
! Get the data from the referenced node
      if(associated(current) .and. associated(current%reference)) then
         reference => current%reference
         point_to_y => reference%y
         point_to_j => reference%j
         point_to_ud => reference%user
         links => reference%link
         name = reference%header
         previous => reference%back
         if (associated(previous)) then
            back = previous%index
         else
            back = 0
         endif
         last_code = reference%running_index
      else
         back = -1
         point_to_y => a
         point_to_j => i
         nullify(point_to_ud)
         links => i
         name = ''
      endif
!
      call update_state(tree)
   contains
      recursive subroutine inner (tree)
!
! Search for a specified index value
         type(data), pointer :: tree
         integer                loop
!
         if (tree%index == code) then
            current => tree
            parent => tree
         else
            do loop = 1, size(tree%p)
              call inner (tree%p(loop)%pp)
              if (associated(current)) return
            end do
            nullify(current)
         endif
      end subroutine inner
   end subroutine get_reference

   recursive subroutine new_data(node, number, node_link, name, real_data,     &
                                 integer_data, user_data, links)
!
! Add a new node to the tree
      type(data), pointer                :: node
      integer, intent(in)                :: number
      character(*), optional, intent(in) :: name
      real, optional, intent(in)         :: real_data(:)
      type(user_type), optional, intent(in) :: user_data(:)
      integer, optional, intent(in)      :: integer_data(:), links(:)
      type(data), pointer    :: other, first
      integer                :: loop, control, node_link
!
! Save the old counter
      control = count
!
! Test whether a node is already there, if it is go down one level
      if (associated(node)) then
         do loop = 1, size(node%p)
            call new_data(node%p(loop)%pp, number, node%link(loop), name,      &
                         real_data = real_data,                                &
                         integer_data = integer_data, user_data = user_data,   &
                         links = links)
!
! Modify back pointer if depends on higher layer
            if (loop == 1 .and. size(node%p) > 1 ) then
               first => node%p(1)%pp
               if(associated(first)) first => first%back    ! Precaution
            end if
!
! Have we added the node? If so reset the back pointer if necessary and exit.
            if (count > control) then
               if (loop > 1 ) then
                  other => node%p(loop)%pp
                  other%back => first
               end if
               exit
            endif
         end do
!
! If it isn't there, add it
      elseif (count == 0 .or. number == node_link) then
         count = count + 1
         allocate(node)
         node%own_state => tree_state
!
! Set the back pointer to a preliminary value
         if (count == 1) then
            nullify(node%back)
         else
            node%back => current
         end if
         node%index = number
         node%running_index = count
         nullify(node%reference, node%ref_back)
!
! Add the data where present
         if (present(name)) then
            node%header = name
         else
            node%header = ' '
         end if
         if (present(integer_data)) then
            allocate(node%j(size(integer_data)))
            node%j = integer_data
            node%amount(1) = size(integer_data)
         else
            allocate(node%j(0))
            node%amount(1) = 0
         end if
         if (present(real_data)) then
            allocate(node%y(size(real_data)))
            node%y = real_data
            node%amount(2) = size(real_data)
         else
            allocate(node%y(0))
            node%amount(2) = 0
         end if
         if (present(user_data)) then
            allocate(node%user(size(user_data)))
            call add_user(node%user, user_data)
            node%amount(4) = size(user_data)
         else
            allocate(node%user(0))
            node%amount(4) = 0
         end if
!
! Add links if present and valid
         if (present(links)) then
            if (size(links) > 0) then
               if (all(links > count)) then
                  allocate(node%p(size(links)), node%link(size(links)))
                  current => node
                  node%link = links
                  node%amount(3) = size(links)
                  do loop = 1, size(links)
                     nullify(node%p(loop)%pp)
                  end do
               else
                  print *,  'attempt to link node',  count,   'to higher-level &
                          &(node one of:', links, ')'
                  stop 'link error'
               end if
            else
               allocate(node%p(0), node%link(0))
               node%amount(3) = 0
            end if
         else
            allocate(node%p(0), node%link(0))
            node%amount(3) = 0
         end if
      end if
   end subroutine new_data

   subroutine new_node(tree, number, name, real_data, integer_data, user_data, &
                       links)
!
! To add a node efficiently and to check that a node actually gets added
      type(data), pointer                :: tree
      integer, intent(in)                :: number
      character(*), optional, intent(in) :: name
      real, optional, intent(in)         :: real_data(:)
      type(user_type), optional, intent(in) :: user_data(:)
      integer, optional, intent(in)      :: integer_data(:), links(:)
      type(data), pointer    :: bottom
      integer                :: control, dummy_link = 0
!
      if (count /= 0) call check_state(tree)
!
! First try to attach to last node added,
      control = count
      if (associated(current)) then
         if (size(current%p) /= 0) then
            bottom => current
            call new_data(bottom, number, dummy_link, name,                    &
                                        real_data = real_data,                 &
                   integer_data = integer_data, user_data = user_data,         &
                   links = links)
         end if
      endif
      if (count == control) then
!
! otherwise, do complete search.
         call new_data(tree, number, dummy_link, name,                         &
                                   real_data = real_data,                      &
                   integer_data = integer_data, user_data = user_data,         &
                   links = links)
         if (count == control) print *, 'new node', number,                    &
                                  ' could not be added to closed tree'
      endif
      call update_state(tree)
   end subroutine new_node

   subroutine next(tree, index, back, name, point_to_j, point_to_y,            &
                   point_to_ud, links)
!
! Get next node by index in tree
      type(data), pointer       :: tree
      integer, intent(out)      :: index, back
      character(*), intent(out) :: name
      integer, pointer          :: point_to_j(:), links(:)
      real, pointer             :: point_to_y(:)
      type(user_type), pointer  :: point_to_ud(:)
      real, target        :: a(1) = (/ huge(0.) /)
      integer, target     :: i(1) = (/ huge(0) /)
      type(data), pointer :: look, previous
!
      call check_state(tree)
!
! Get the data in next node, trying first from current,
      look => current
      if (associated(current)) call move(look)          ! Precaution
!
! and otherwise from tree.
      if(.not.associated(current)) call move(tree)
!
! Define output variables (to null if no next node)
      if(associated(current)) then
         point_to_y => current%y
         point_to_j => current%j
         point_to_ud => current%user
         links => current%link
         name = current%header
         index = current%index
         previous => current%back
         if(associated(previous)) then                 ! Precaution
            back = previous%index
         else
            back = -1
         end if
         last_code = current%running_index
         parent => current%back
      else
         index = 0
         back = -1
         point_to_y => a
         point_to_j => i
         nullify(point_to_ud)
         links => i
         name = ''
      end if
      call update_state(tree)
   contains
      recursive subroutine move (tree)
!
! Looks for a specified index value - and moves to that node
         type(data), pointer :: tree
         integer                loop
!
         if (tree%running_index /= last_code + 1) then
            do loop = 1, size(tree%p)
               if (associated(tree%p(loop)%pp)) call move (tree%p(loop)%pp)
                                                ! Precaution
               if (associated(current)) return
            end do
            nullify(current)
         else
            current => tree
         endif
      end subroutine move
   end subroutine next

   subroutine next_in_layer(tree, index, back, name, point_to_j, point_to_y,   &
                            point_to_ud, links)
!
! Get next node in layer of tree.
! If previous call was to retrieve or next and the last node found
! was the final leaf of the tree, no data are returned;
! if the previous call was to next_in_layer, then the next layer is
! taken if necessary.
      type(data), pointer       :: tree
      integer, intent(out)      :: index, back
      character(*), intent(out) :: name
      integer, pointer          :: point_to_j(:), links(:)
      real, pointer             :: point_to_y(:)
      type(user_type), pointer  :: point_to_ud(:)
      type(data), pointer :: look, old, previous
      integer                loop, old_code
      real, target        :: a(1) = (/ huge(0.) /)
      integer, target     :: i(1) = (/ huge(0) /)
!
      call check_state(tree)
!
! Get the data in next node
      old_code = last_code
      if (associated(parent) .and. size(parent%p) > 0) then  ! Precaution
         do loop = 1, size(parent%p)
            look => parent%p(loop)%pp
            if (.not.associated(look)) cycle
            if (look%running_index <= last_code) cycle
            point_to_y => look%y
            point_to_j => look%j
            point_to_ud => look%user
            links => look%link
            name = look%header
            index = look%index
            previous => look%back
            back = previous%index
            last_code = look%running_index
            old => parent
            current => look
            exit
         end do
!
! Need to back up if final leaf,
         if (loop == size(parent%p)) then
            do loop = 1, size(parent%p)
               look => parent%p(loop)%pp
               if (size(look%p) /= 0)  then
                  last_code = parent%running_index
                  parent => look
                  exit
               end if
            end do
!
! and even further if layer exhausted.
            if (old%index == parent%index) then
               nullify(parent)
               call move(tree, index + 1)
            end if
         end if
      else
         index = 0
         back = -1
         point_to_y => a
         point_to_j => i
         nullify(point_to_ud)
         links => i
         name = ''
      end if
!
! Layer was already exhausted before call (by retrieve or next)
      if(old_code == last_code) then
         index = 0
         back = -1
         point_to_y => a
         point_to_j => i
         nullify(point_to_ud)
         links => i
         name = ''
      endif
      call update_state(tree)
   contains
      recursive subroutine move (node, code)
!
! Looks for a specified index value - and moves to that node
         type(data), pointer :: node
         integer, intent(in) :: code
         integer loop
!
         if (node%index == code) then
            parent => node
         else
            do loop = 1, size(node%p)
               call move (node%p(loop)%pp, code)
               if (associated(parent)) return
            end do
         endif
      end subroutine move
   end subroutine next_in_layer

   subroutine previous (tree, index, back, name, point_to_j, point_to_y,       &
                        point_to_ud, links)
!
! Search for node on which current node depends
      type(data), target, intent(in) :: tree
      integer, intent(out)           :: index, back
      character(*)                      name
      integer, pointer               :: point_to_j(:), links(:)
      real, pointer                  :: point_to_y(:)
      type(user_type), pointer       :: point_to_ud(:)
      type(data), pointer:: former
      real, target        :: a(1) = (/ huge(0.) /)
      integer, target     :: i(1) = (/ huge(0) /)
!
      call check_state(tree)
!
! Get the data
      current => current%back
      if(associated(current)) then
         point_to_y => current%y
         point_to_j => current%j
         point_to_ud => current%user
         links => current%link
         name = current%header
         former => current%back
         if (associated(former)) then     ! Precaution
            back = former%index
         else
            back = 0
         endif
         index = current%index
         last_code = current%running_index
      else
         index = 0
         back = -1
         point_to_y => a
         point_to_j => i
         nullify(point_to_ud)
         links => i
         name = ''
      endif
!
      call update_state(tree)
   end subroutine previous

   subroutine restore_tree(tree)
!
! Read and restore a complete tree
      type(data), pointer :: tree, temp
      integer loop, len1, len2, i, j, k
      integer, allocatable :: i_field(:, :)
      real, allocatable    :: f_field(:, :)
!
! Allocate input buffers
      allocate(temp)
      allocate(temp%j(max_len), temp%y(max_len), temp%link(max_len))
      allocate(temp%user(max_elem))
      allocate(i_field(max_elem, max_len), f_field(max_elem, max_len)) !!!
!
! Initialise new tree
      call start(tree)
!
! Read and store tree
      do
         read (unit) temp%index,                                               &
                     temp%header, temp%amount, temp%j(:temp%amount(1)),        &
                          temp%y(:temp%amount(2)), temp%link(:temp%amount(3)), &
             (temp%user(i)%layout,                                             &
              len1, (i_field(i, j), j = 1, len1),                              &
              len2, (f_field(i, k), k = 1, len2),                              &
                                                       i = 1, temp%amount(4) )
         do loop = 1, temp%amount(4)
            allocate(temp%user(loop)%i_field(len1),                            &
                     temp%user(loop)%f_field(len2))
            temp%user(loop)%i_field = i_field(loop, :len1)
            temp%user(loop)%f_field = f_field(loop, :len2)
         end do
         if ( any(temp%amount(:3) > max_len) ) then
            print *, 'input buffer too small (', max_len, ' but need one of',  &
                     temp%amount,')'
            stop 'input error'
         end if
         if (temp%header == eot) exit
         call new_node(tree, temp%index, temp%header, temp%y(:temp%amount(2)), &
                          temp%j(:temp%amount(1)), temp%user(:temp%amount(4)), &
                          temp%link(:temp%amount(3)))
         do loop = 1, temp%amount(4)
            deallocate(temp%user(loop)%i_field, temp%user(loop)%f_field)
         end do
      end do
!
! Deallocate buffers
      deallocate(temp%j, temp%y, temp%link)
      deallocate(i_field, f_field)
      deallocate(temp%user)
      deallocate(temp)
   end subroutine restore_tree

   subroutine retrieve (tree, code, back, name, point_to_j, point_to_y,        &
                        point_to_ud, links)
!
! Search for a specified index value
      type(data), pointer      :: tree
      integer, intent(in)      :: code
      integer, intent(out)     :: back
      character(*)                name
      integer, pointer         :: point_to_j(:), links(:)
      real, pointer            :: point_to_y(:)
      type(user_type), pointer :: point_to_ud(:)
      type(data), pointer :: previous
      real, target        :: a(1) = (/ huge(0.) /)
      integer, target     :: i(1) = (/ huge(0) /)
!
! Locate the node
      nullify(current)
      call inner(tree)
!
! Get the data
      if(associated(current)) then
         point_to_y => current%y
         point_to_j => current%j
         point_to_ud => current%user
         links => current%link
         name = current%header
         previous => current%back
         if (associated(previous)) then    ! Precaution
            back = previous%index
         else
            back = 0
         endif
         last_code = current%running_index
      else
         back = -1
         point_to_y => a
         point_to_j => i
         nullify(point_to_ud)
         links => i
         name = ''
      endif
!
      call update_state(tree)
   contains
      recursive subroutine inner (tree)
!
! Search for a specified index value
         type(data), pointer :: tree
         integer                loop
!
         if (tree%index == code) then
            current => tree
            parent => tree
         else
            do loop = 1, size(tree%p)
              if (associated(tree%p(loop)%pp)) call inner (tree%p(loop)%pp)
                                               ! Precaution
              if (associated(current)) return
            end do
            nullify(current)
         endif
      end subroutine inner
   end subroutine retrieve

   subroutine set_reference (tree1, code1, tree2, code2)
!
! Set a reference link between two nodes, even in different trees.
! An existing link is overwritten if one exists already.
      type(data), pointer :: tree1, tree2
      integer, intent(in) :: code1, code2
      type(data), pointer :: node, node1, node2
      integer code
!
! Locate the nodes
      nullify(node)
      code = code1
      call inner(tree1)
      node1 => node
      nullify(node)
      code = code2
      call inner(tree2)
      node2 => node
!
! Establish the symmetric link
      if(associated(node1) .and. associated(node2)) then
         node1%reference => node2
         if (associated(node2%ref_back)) nullify(node2%ref_back%reference)
         node2%ref_back  => node1
      else
         print *, 'reference link could not be established'
      endif
   contains
      recursive subroutine inner (tree)
!
! Search for a specified index value
         type(data), pointer :: tree
         integer                loop
!
         if (tree%index == code) then
            node => tree
         else
            do loop = 1, size(tree%p)
               call inner (tree%p(loop)%pp)
               if (associated(node)) return
            end do
            nullify(node)
         endif
      end subroutine inner
   end subroutine set_reference

   subroutine start(tree)
!
! THE CALL TO START FOR A GIVEN TREE MUST IMMEDIATELY PRECEDE
! THE FIRST CALL TO NEW_NODE FOR THAT TREE.
!
! The fact that pointers are created undefined forces the use of this routine,
      type(data), pointer  :: tree
      type(state), pointer :: state_of_tree
!
      nullify(tree)
!
! but initialize some global variables too,
      count = 0
      last_code = 0
      current => tree
      parent => tree
!
! and set up state variable of tree.
      allocate(state_of_tree)
      state_of_tree%count     = count
      state_of_tree%last_code = last_code
      state_of_tree%current   => tree
      state_of_tree%parent    => parent
      tree_state              => state_of_tree
   end subroutine start

   subroutine update_state(tree)
! To update state variable in case next call to module is for a different
! tree.
      type(data), target, intent(in)  :: tree
      type(state), pointer:: state_of_tree
!
      state_of_tree           => tree%own_state
      state_of_tree%count     = count
      state_of_tree%last_code = last_code
      state_of_tree%current   => current
      state_of_tree%parent    => parent
   end subroutine update_state
end module eagle

program test
use ddl
use eagle
   type(data), pointer :: a, b, c, d
   real, pointer       :: y(:)
   integer, pointer    :: j(:), link(:)
   type(user_type), pointer :: my_name(:)
   type(user_type) :: mate(2)
   character(max_char)    name
   integer                back

! Define some values and link them together
   call start(a)
   call new_node(a, 1, integer_data = (/ (i, i = 1, 10) /),                    &
                    links = (/ 2, 3, 5/))

   call new_node(a, 2, 'My node', real_data = real((/ (i, i = 11, 15) /)),     &
                 links=(/ 4 /) )

   call new_node(a, 3, integer_data = (/ (i, i = 21, 30) /) )

   call new_node(a, 4, integer_data = (/ (i, i = 31, 35) /),                   &
                    real_data = (/ 3., 4. /) )
   call new_node(a, 5, real_data = real((/ (i, i = 31, 35) /) ),               &
                    links = (/ 6, 8/) )

   call new_node(a, 6, 'Your node', integer_data = (/ (i, i = 41, 50) /),      &
                    links = (/ 7 /)  )
   call new_node(a, 7, real_data = real((/ (i, i = 51, 55) /)) )
   allocate(mate(1)%i_field(3))
   allocate(mate(1)%f_field(3))
   allocate(mate(2)%i_field(3))
   allocate(mate(2)%f_field(3))
   mate(1)%i_field = (/ 1, 2, 3/)
   mate(1)%f_field = (/ 1., 2., 3./)
   mate(2)%i_field = (/ 4, 5, 6/)
   mate(2)%f_field = (/ 4., 5., 6./)
   call new_node(a, 8, real_data = real((/ (i, i = 61, 65) /)),                &
                    user_data = mate )
   deallocate(mate(1)%i_field, mate(1)%f_field)
   deallocate(mate(2)%i_field, mate(2)%f_field)
!!   call new_node(a, 9, real_data = real((/ (i, i = 61, 65) /)) ) ! excess node

   call start(b)
   call new_node(b, 10, real_data = real((/ (i, i = 11, 15) /) ),              &
                    links = (/ 20, 40, 70/) )

   call new_node(b, 20, 'Your node', integer_data = (/ (i, i = 21, 30) /),     &
                    links = (/ 30 /)  )
   call new_node(b, 30, real_data = real((/ (i, i = 31, 35) /)) )
   call new_node(b, 40, real_data = real((/ (i, i = 41, 45) /)),               &
                 links =(/ 50, 60 /) )
   call new_node(b, 50, real_data = real((/ (i, i = 51, 55) /)) )
   call new_node(b, 60, real_data = real((/ (i, i = 61, 65) /)) )
   call new_node(b, 70, real_data = real((/ (i, i = 71, 75) /)) )

! Traverse the structures
   call retrieve(a, 8, back, name, j, y, my_name, link)
   print *, back, name, j, y, my_name(1)%i_field, my_name(1)%f_field, link     &
            ,my_name(2)%i_field, my_name(2)%f_field
   call retrieve(a, 1, back, name, j, y, my_name, link)
   print *, back, name, j, y, link
   call next(a, index, back, name, j, y, my_name, link)
   print *, index, back, name, j, y, link
   call retrieve(b, 10, back, name, j, y, my_name, link)
   print *, back, name, j, y, link
   call next(b, index, back, name, j, y, my_name, link)
   print *, index, back, name, j, y, link
   do i = 3, 8
      call next_in_layer(a, index, back, name, j, y, my_name, link)
      print *, index, back, name, j, y, link
   end do

   call next(a, index, back, name, j, y, my_name, link)
   print *, index, back, name, j, y, link
   call next(a, index, back, name, j, y, my_name, link)
   print *, index, back, name, j, y, link
   call retrieve(a, 4, back, name, j, y, my_name, link)
   print *, back, name, j, y, link
   call next_in_layer(a, index, back, name, j, y, my_name, link)
   print *, index, back, name, j, y, link
   call next_in_layer(b, index, back, name, j, y, my_name, link)
   print *, index, back, name, j, y, link
   call next_in_layer(a, index, back, name, j, y, my_name, link)
   print *, index, back, name, j, y, link
   call next(a, index, back, name, j, y, my_name, link)
   print *, index, back, name, j, y, link
   call next_in_layer(a, index, back, name, j, y, my_name, link)
   print *, index, back, name, j, y, link

   call retrieve(b, 10, back, name, j, y, my_name, link)
   print *, back, name, j, y, link
   do i = 1, 3
      call next_in_layer(b, index, back, name, j, y, my_name, link)
      print *, index, back, name, j, y, link
   end do

   call retrieve(a, 1, back, name, j, y, my_name, link)
   print *, back, name, j, y, link
   do i = 1, 7
      call next(a, index, back, name, j, y, my_name, link)
      print *, index, back, name, j, y, link
   end do

   call retrieve(b, 10, back, name, j, y, my_name, link)
   print *, back, name, j, y, link
   do i = 1, 6
      call next(b, index, back, name, j, y, my_name, link)
      print *, index, back, name, j, y, link
   end do
!
! perform I/O of the structures
   OPEN (UNIT=unit, FILE='eagle.out', form = 'unformatted', ACTION='READWRITE')
   call dump_tree(a)
   call dump_tree(b)
   rewind unit
   call restore_tree(c)
   call restore_tree(d)
!
! ... and check they have been read back correctly
   call retrieve(c, 8, back, name, j, y, my_name, link)
   print *, back, name, j, y, my_name(1)%i_field, my_name(1)%f_field, link     &
            ,my_name(2)%i_field, my_name(2)%f_field
   call retrieve(d, 30, back, name, j, y, my_name, link)
   print *, back, name, j, y, link
   call previous(d, index, back, name, j, y, my_name, link)
   print *, index, back, name, j, y, link
   call previous(d, index, back, name, j, y, my_name, link)
   print *, index, back, name, j, y, link
   call previous(d, index, back, name, j, y, my_name, link)
   print *, index, back, name, j, y, link
   call retrieve(d, 33, back, name, j, y, my_name, link)
   print *, back, name, j, y, link
   call finish(a)
   call set_reference(b, 20, c, 3)
   call set_reference(b, 20, c, 33)
   call get_reference(b, 20, back, name, j, y, my_name, link)
   print *, name, j, y, link
   call finish(c)
   call get_reference(b, 20, back, name, j, y, my_name, link)
   print *, name, j, y
   call finish(b)
   call finish(d)
end