Integer,Parameter :: rkind = Selected_Real_Kind(12,50)
Type real_tree_node
Private
Real(rkind) :: value
Type(real_tree_node),Pointer :: left,right
End Type
Contains
Recursive Subroutine traverse_and_apply(node,proc)
Type(real_tree_node) :: node
Interface
Subroutine proc(node)
!
! Without IMPORT, REAL_TREE_NODE could not have
! PRIVATE components, and a second module would
! be needed (or the SEQUENCE statement used),
! to access the type.
!
Import real_tree_node
Type(real_tree_node) :: node
End Subroutine
End Interface
If (Associated(node%left)) Then
Call traverse_and_apply(node%left,proc)
End If
Call proc(node)
If (Associated(node%right)) Then
Call traverse_and_apply(node%right,proc)
End If
End Subroutine
Function new(value,left,right)
Real(rkind),Intent(In) :: value
Type(real_tree_node),Optional,Pointer :: left,right
Type(real_tree_node),Pointer :: new
Allocate(new)
new%value = value
Nullify(new%left,new%right)
If (Present(left)) new%left => left
If (Present(right)) new%right => right
End Function
Subroutine print_node(node)
Type(real_tree_node) :: node
Print 1,node%value
1 Format(1x,'Value ',1PE12.3)
End Subroutine
End Module
Program import_example
Use real_tree_module
Type(real_tree_node),Pointer :: root
root => new(0.0_rkind, &
new(-3.0_rkind, &
right=new(-1.125_rkind)), &
new(555.875_rkind))
Call traverse_and_apply(root,print_node)
End Program
Execution ResultsValue -3.000E+00
Value -1.125E+00
Value 0.000E+00
Value 5.559E+02