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