associated.f
c<html>
c<body>
c<pre>
program association
c
c Demonstration of association of pointers with targets
c and testing for the status of association.
c
c<a name="target"><font color="FF0000">
real, target :: a=1.111, b=2.222
c</font></a>
c<a name="point"><font color="FF0000">
real, pointer :: p1, p2, p3
c</font></a>
c
c Associate p1 with a and p2 with b
c
p1 => a
write(*,*)' After p1=>a'
c
c Here is how you can check to see if a pointer is associated
c With a specific target
c
if (associated(p1,target=a)) then
write(*,*) 'p1 is associated with "a"'
endif
c
c Check one that we haven't touched
c
c<a name="11"><font color="FF0000">
if (associated(p2)) then
write(*,*) 'p2 is associated with a target'
else
write(*,*) 'p2 is not associated with a target'
endif
c</a></font>
c I can associate a second pointer with the same variable
c
p2 => a
write(*,2001)
write(*,*)' After p2=>a'
c
write (*,2000) 'p1',p1,'p2',p2,'a',a
c
c Here is how you can check to see if two pointers are associated
c with the same target
c
if (associated(p2,target=p1)) then
write(*,*) 'p2 and p1 are associated with the same target'
else
write(*,*) 'p2 and p1 are not associated with the same target'
endif
c
c When I associate one pointer with another, I am making an association
c with the target of the second pointer
c
p3 => p2
c
write(*,2001)
write(*,*)' After p3=>p2'
write (*,2000) 'p1',p1,'p2',p2,'p3',p3,'a',a
c
if (associated(p3,target=a )) then
write(*,*) 'p3 is associated with "a"'
else
write(*,*) 'p3 is not associated with "a"'
endif
c
c I can disassociate p2 from it's target, but notice that p3 stays
c associated with "a". Notice that although the "associated"
c function claims p2 is no longer associated with "a", at least on
c our machine use of p2 still gives the contents of "a" as a result
c I would consider this to be a bad feature (IBM software only has
c features, never bugs) in the compiler.
c<a name="6"><font color="FF0000">
nullify(p2)
c</a></font>
c
write(*,2001)
write(*,*) 'After "nullify(p2)"'
write (*,2000) 'p1',p1,'p2',p2,'p3',p3,'a',a
c
if (associated(p2,target=a )) then
write(*,*) 'p2 is associated with "a"'
else
write(*,*) 'p2 is not associated with "a"'
endif
c
if (associated(p3,target=a )) then
write(*,*) 'p3 is associated with "a"'
else
write(*,*) 'p3 is not associated with "a"'
endif
c
c Even after pointing p2 at a totally different variable
c p3 stays associated with "a"
c
p2 => b
c
write(*,2001)
write(*,*) 'After p2 => b '
write (*,2000) 'p1',p1,'p2',p2,'p3',p3,'a',a,'b',b
c
if (associated(p2,target=a )) then
write(*,*) 'p2 is associated with "a"'
else
write(*,*) 'p2 is not associated with "a"'
endif
c
if (associated(p3,target=a )) then
write(*,*) 'p3 is associated with "a"'
else
write(*,*) 'p3 is not associated with "a"'
endif
c
c
2000 format (a,' =',f6.3, 8(', ',a,' =',f6.3))
2001 format(80('-'))
stop
end
c</pre>
c</body>
c</html>