mirror of git://gcc.gnu.org/git/gcc.git
60 lines
1.7 KiB
Fortran
60 lines
1.7 KiB
Fortran
! { dg-do run }
|
|
! { dg-options "-ffixed-form" }
|
|
REAL FUNCTION FN1(I)
|
|
INTEGER I
|
|
FN1 = I * 2.0
|
|
RETURN
|
|
END FUNCTION FN1
|
|
|
|
REAL FUNCTION FN2(A, B)
|
|
REAL A, B
|
|
FN2 = A + B
|
|
RETURN
|
|
END FUNCTION FN2
|
|
|
|
PROGRAM A18
|
|
INCLUDE "omp_lib.h" ! or USE OMP_LIB
|
|
INTEGER ISYNC(256)
|
|
REAL WORK(256)
|
|
REAL RESULT(256)
|
|
INTEGER IAM, NEIGHBOR
|
|
!$OMP PARALLEL PRIVATE(IAM, NEIGHBOR) SHARED(WORK, ISYNC) NUM_THREADS(4)
|
|
IAM = OMP_GET_THREAD_NUM() + 1
|
|
ISYNC(IAM) = 0
|
|
!$OMP BARRIER
|
|
! Do computation into my portion of work array
|
|
WORK(IAM) = FN1(IAM)
|
|
! Announce that I am done with my work.
|
|
! The first flush ensures that my work is made visible before
|
|
! synch. The second flush ensures that synch is made visible.
|
|
!$OMP FLUSH(WORK,ISYNC)
|
|
ISYNC(IAM) = 1
|
|
!$OMP FLUSH(ISYNC)
|
|
|
|
! Wait until neighbor is done. The first flush ensures that
|
|
! synch is read from memory, rather than from the temporary
|
|
! view of memory. The second flush ensures that work is read
|
|
! from memory, and is done so after the while loop exits.
|
|
IF (IAM .EQ. 1) THEN
|
|
NEIGHBOR = OMP_GET_NUM_THREADS()
|
|
ELSE
|
|
NEIGHBOR = IAM - 1
|
|
ENDIF
|
|
DO WHILE (ISYNC(NEIGHBOR) .EQ. 0)
|
|
!$OMP FLUSH(ISYNC)
|
|
END DO
|
|
!$OMP FLUSH(WORK, ISYNC)
|
|
RESULT(IAM) = FN2(WORK(NEIGHBOR), WORK(IAM))
|
|
!$OMP END PARALLEL
|
|
DO I=1,4
|
|
IF (I .EQ. 1) THEN
|
|
NEIGHBOR = 4
|
|
ELSE
|
|
NEIGHBOR = I - 1
|
|
ENDIF
|
|
IF (RESULT(I) .NE. I * 2 + NEIGHBOR * 2) THEN
|
|
CALL ABORT
|
|
ENDIF
|
|
ENDDO
|
|
END PROGRAM A18
|