Mercurial > hg > CbC > CbC_gcc

comparison libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90 @ 0:a06113de4d67

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
first commit
author kent <kent@cr.ie.u-ryukyu.ac.jp>
date Fri, 17 Jul 2009 14:47:48 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
-1:000000000000 0:a06113de4d67
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