Example F Program--Generic Procedure

! Copyright (c) 1994-2002 The Fortran Company
!
! Developed at Unicomp, Inc.
!
! Permission to use, copy, modify, and distribute this
! software is freely granted, provided that this notice 
! is preserved.

module tree_sort_module

public :: insert, print_tree

type, public :: node
   integer :: value
   type (node), pointer :: left => null(), &
                           right => null()
end type node

integer, public :: number

contains

   recursive subroutine insert (t)

      type (node), pointer :: t  ! A tree

      ! If (sub)tree is empty, put number at root
      if (.not. associated (t)) then
         allocate (t)
         t % value = number
      ! Otherwise, insert into correct subtree
      else if (number < t % value) then
         call insert (t % left)
      else
         call insert (t % right)
      end if

   end subroutine insert

   recursive subroutine print_tree (t)
   ! Print tree in infix order

      type (node), pointer :: t  ! A tree

      if (associated (t)) then
         call print_tree (t % left)
         print *, t % value
         call print_tree (t % right)
      end if

   end subroutine print_tree

end module tree_sort_module

program tree_sort
! Sorts a file of integers by building a
! tree, sorted in infix order.
! This sort has expected behavior n log n,
! but worst case (input is sorted) n ** 2.

   use tree_sort_module

   type (node), pointer :: t  ! A tree
   integer :: ios

   ! Start with empty tree
   do
      read (unit=*, fmt=*, iostat = ios) number
      if (ios < 0) then
         exit
      end if
      call insert (t) ! Put next number in tree
   end do
   ! Print nodes of tree in infix order
   call print_tree (t)

end program tree_sort

Back to F Example Codes Page

Back to F Homepage