Retro68/gcc/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90
2018-12-28 16:30:48 +01:00

61 lines
1.6 KiB
Fortran

! { dg-do run }
SUBROUTINE F1(Q)
COMMON /DATA/ P, X
INTEGER, TARGET :: X
INTEGER, POINTER :: P
INTEGER Q
Q=1
!$OMP FLUSH
! X, P and Q are flushed
! because they are shared and accessible
END SUBROUTINE F1
SUBROUTINE F2(Q)
COMMON /DATA/ P, X
INTEGER, TARGET :: X
INTEGER, POINTER :: P
INTEGER Q
!$OMP BARRIER
Q=2
!$OMP BARRIER
! a barrier implies a flush
! X, P and Q are flushed
! because they are shared and accessible
END SUBROUTINE F2
INTEGER FUNCTION G(N)
COMMON /DATA/ P, X
INTEGER, TARGET :: X
INTEGER, POINTER :: P
INTEGER N
INTEGER I, J, SUM
I=1
SUM = 0
P=1
!$OMP PARALLEL REDUCTION(+: SUM) NUM_THREADS(2)
CALL F1(J)
! I, N and SUM were not flushed
! because they were not accessible in F1
! J was flushed because it was accessible
SUM = SUM + J
CALL F2(J)
! I, N, and SUM were not flushed
! because they were not accessible in f2
! J was flushed because it was accessible
SUM = SUM + I + J + P + N
!$OMP END PARALLEL
G = SUM
END FUNCTION G
PROGRAM A19
COMMON /DATA/ P, X
INTEGER, TARGET :: X
INTEGER, POINTER :: P
INTEGER RESULT, G
P => X
RESULT = G(10)
PRINT *, RESULT
IF (RESULT .NE. 30) THEN
STOP 1
ENDIF
END PROGRAM A19