Mercurial > hg > CbC > CbC_gcc
comparison libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90 @ 0:a06113de4d67
first commit
author | kent <kent@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Fri, 17 Jul 2009 14:47:48 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:a06113de4d67 |
---|---|
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 |