l4/pkg/libgomp/lib/contrib/gcc-4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90

   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