libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90

! { 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
            STOP 1
          ENDIF
        ENDDO
        END PROGRAM A18