1! { dg-do compile }
2
3      SUBROUTINE SUB1(X)
4        DIMENSION X(10)
5        ! This use of X does not conform to the
6        ! specification. It would be legal Fortran 90,
7        ! but the OpenMP private directive allows the
8        ! compiler to break the sequence association that
9        ! A had with the rest of the common block.
10        FORALL (I = 1:10) X(I) = I
11      END SUBROUTINE SUB1
12      PROGRAM A28_5
13        COMMON /BLOCK5/ A
14        DIMENSION B(10)
15        EQUIVALENCE (A,B(1))
16        ! the common block has to be at least 10 words
17        A=0
18!$OMP PARALLEL PRIVATE(/BLOCK5/)
19          ! Without the private clause,
20          ! we would be passing a member of a sequence
21          ! that is at least ten elements long.
22          ! With the private clause, A may no longer be
23          ! sequence-associated.
24          CALL SUB1(A)
25!$OMP MASTER
26            PRINT *, A
27!$OMP END MASTER
28!$OMP END PARALLEL
29      END PROGRAM A28_5
30