0
|
1 ! { dg-do run }
|
|
2 SUBROUTINE F1(Q)
|
|
3 COMMON /DATA/ P, X
|
|
4 INTEGER, TARGET :: X
|
|
5 INTEGER, POINTER :: P
|
|
6 INTEGER Q
|
|
7 Q=1
|
|
8 !$OMP FLUSH
|
|
9 ! X, P and Q are flushed
|
|
10 ! because they are shared and accessible
|
|
11 END SUBROUTINE F1
|
|
12 SUBROUTINE F2(Q)
|
|
13 COMMON /DATA/ P, X
|
|
14 INTEGER, TARGET :: X
|
|
15 INTEGER, POINTER :: P
|
|
16 INTEGER Q
|
|
17 !$OMP BARRIER
|
|
18 Q=2
|
|
19 !$OMP BARRIER
|
|
20 ! a barrier implies a flush
|
|
21 ! X, P and Q are flushed
|
|
22 ! because they are shared and accessible
|
|
23 END SUBROUTINE F2
|
|
24
|
|
25 INTEGER FUNCTION G(N)
|
|
26 COMMON /DATA/ P, X
|
|
27 INTEGER, TARGET :: X
|
|
28 INTEGER, POINTER :: P
|
|
29 INTEGER N
|
|
30 INTEGER I, J, SUM
|
|
31 I=1
|
|
32 SUM = 0
|
|
33 P=1
|
|
34 !$OMP PARALLEL REDUCTION(+: SUM) NUM_THREADS(2)
|
|
35 CALL F1(J)
|
|
36 ! I, N and SUM were not flushed
|
|
37 ! because they were not accessible in F1
|
|
38 ! J was flushed because it was accessible
|
|
39 SUM = SUM + J
|
|
40 CALL F2(J)
|
|
41 ! I, N, and SUM were not flushed
|
|
42 ! because they were not accessible in f2
|
|
43 ! J was flushed because it was accessible
|
|
44 SUM = SUM + I + J + P + N
|
|
45 !$OMP END PARALLEL
|
|
46 G = SUM
|
|
47 END FUNCTION G
|
|
48
|
|
49 PROGRAM A19
|
|
50 COMMON /DATA/ P, X
|
|
51 INTEGER, TARGET :: X
|
|
52 INTEGER, POINTER :: P
|
|
53 INTEGER RESULT, G
|
|
54 P => X
|
|
55 RESULT = G(10)
|
|
56 PRINT *, RESULT
|
|
57 IF (RESULT .NE. 30) THEN
|
|
58 CALL ABORT
|
|
59 ENDIF
|
|
60 END PROGRAM A19
|