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 60