blob: 3321485efc31157b7289c83970745bf4d6058ec7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
! { 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
|