(j3.2006) C713 question

Van Snyder Van.Snyder
Wed Apr 1 16:58:01 EDT 2009


On Wed, 2009-04-01 at 13:27 -0700, Bill Long wrote:
> Could you fill in the ... below.  I'm interested to see how you would 
> write this assignment routine.

Probably not optimal or bug free, but you should get the idea:

type tree_cdr
  integer :: nsons
  integer :: first
  ...
end type tree_cdr
type tree_link
  integer, allocatable :: sons(:)
  ...
end type tree_link

subroutine TreeCopy ( A, B )
  ! Copy the tree in B, represented in link form, to A,
  ! represented in CDR-code form.  The root of B is in B(1).
  type(tree_cdr), intent(inout) :: A(*)
  type(tree_link), intent(in) :: B(:)
  integer :: Stack(size(b))
  integer :: Tree_ix, Stack_ptr
  tree_ix = 1
  stack_ptr = 0
  a(1) = tree_cdr(size(b%sons),0,...)
  call SubtreeCopy ( a, b, 1, a(1)%first )
contains
  recursive subroutine SubtreeCopy ( a, b, root, firstSon )
    type(tree_cdr), intent(inout) :: A(*)
    type(tree_link), intent(in) :: B(:)
    integer, intent(in) :: root
    integer, intent(out) :: FirstSon ! To where in A is first
                                     ! son of B copied?
    integer :: sons ! of b
    do sons = 1, size(b%sons)
      stack_ptr = stack_ptr + 1
      stack(stack_ptr) = b(root)%sons(sons)
    end do
    do sons = 1, size(b%sons)
      call subtreeCopy ( a, b, b%sons(sons), firstSon )
    end do
    do sons = 1, size(b%sons)
      tree_ix = tree_ix + 1
      a(tree_ix) = tree_cdr(size(b%sons), firstSon,...)
    end do
    firstSon = tree_ix - size(b%sons) + 1
    stack_ptr = stack_ptr - size(b%sons)
  end subroutine SubtreeCopy
end subroutine TreeCopy





More information about the J3 mailing list