gomp-20050608-branch/libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90

   1 ! { dg-do run }
   2 ! { dg-options "-ffixed-form" }
   3       REAL FUNCTION FN1(I)
   4         INTEGER I
   5         FN1 = I * 2.0
   6         RETURN
   7       END FUNCTION FN1
   8
   9       REAL FUNCTION FN2(A, B)
  10         REAL A, B
  11         FN2 = A + B
  12         RETURN
  13       END FUNCTION FN2
  14
  15       PROGRAM A18
  16       INCLUDE "omp_lib.h"     ! or USE OMP_LIB
  17       INTEGER ISYNC(256)
  18       REAL    WORK(256)
  19       REAL    RESULT(256)
  20       INTEGER IAM, NEIGHBOR
  21 !$OMP PARALLEL PRIVATE(IAM, NEIGHBOR) SHARED(WORK, ISYNC) NUM_THREADS(4)
  22           IAM = OMP_GET_THREAD_NUM() + 1
  23           ISYNC(IAM) = 0
  24 !$OMP BARRIER
  25 !     Do computation into my portion of work array
  26           WORK(IAM) = FN1(IAM)
  27 !     Announce that I am done with my work.
  28 !     The first flush ensures that my work is made visible before
  29 !     synch. The second flush ensures that synch is made visible.
  30 !$OMP FLUSH(WORK,ISYNC)
  31        ISYNC(IAM) = 1
  32 !$OMP FLUSH(ISYNC)
  33
  34 !      Wait until neighbor is done. The first flush ensures that
  35 !      synch is read from memory, rather than from the temporary
  36 !      view of memory. The second flush ensures that work is read
  37 !      from memory, and is done so after the while loop exits.
  38        IF (IAM .EQ. 1) THEN
  39             NEIGHBOR = OMP_GET_NUM_THREADS()
  40         ELSE
  41             NEIGHBOR = IAM - 1
  42         ENDIF
  43         DO WHILE (ISYNC(NEIGHBOR) .EQ. 0)
  44 !$OMP FLUSH(ISYNC)
  45         END DO
  46 !$OMP FLUSH(WORK, ISYNC)
  47         RESULT(IAM) = FN2(WORK(NEIGHBOR), WORK(IAM))
  48 !$OMP END PARALLEL
  49         DO I=1,4
  50           IF (I .EQ. 1) THEN
  51                 NEIGHBOR = 4
  52           ELSE
  53                 NEIGHBOR = I - 1
  54           ENDIF
  55           IF (RESULT(I) .NE. I * 2 + NEIGHBOR * 2) THEN
  56             CALL ABORT
  57           ENDIF
  58         ENDDO
  59         END PROGRAM A18