|
0
|
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
|
