1! Program to test COMMON and EQUIVALENCE.
2program common
3   real (kind=8) a(8)
4   real (kind=8) b(5), c(5)
5   common /com1/b,c
6   equivalence (a(1), b(2))
7   b = 100
8   c = 200
9   call common_pass
10   call common_par (a, b,c)
11   call global_equiv
12   call local_equiv
13end
14
15! Use common block to pass values
16subroutine common_pass
17   real (kind=8) a(8)
18   real (kind=8) b(5), c(5)
19   common /com1/b,c
20   equivalence (a(1), b(2))
21   if (any (a .ne. (/100,100,100,100,200,200,200,200/))) call abort
22end subroutine
23
24! Common variables as argument
25subroutine common_par (a, b, c)
26   real (kind=8) a(8), b(5), c(5)
27   if (any (a .ne. (/100,100,100,100,200,200,200,200/))) call abort
28   if (any (b .ne. (/100,100,100,100,100/))) call abort
29   if (any (c .ne. (/200,200,200,200,200/))) call abort
30end subroutine
31
32! Global equivalence
33subroutine global_equiv
34   real (kind=8) a(8), b(5), c(5), x(8), y(4), z(4)
35   common /com2/b, c, y, z
36   equivalence (a(1), b(2))
37   equivalence (x(4), y(1))
38   b = 100
39   c = 200
40   y = 300
41   z = 400
42   if (any (a .ne. (/100,100,100,100,200,200,200,200/))) call abort
43   if (any (x .ne. (/200,200,200,300,300,300,300,400/))) call abort
44end
45
46! Local equivalence
47subroutine local_equiv
48  real (kind=8) a(8), b(10)
49  equivalence (a(1), b(3))
50  b(1:5) = 100
51  b(6:10) = 200
52  if (any (a .ne. (/100,100,100,200,200,200,200,200/))) call abort
53end subroutine
54