Mercurial > hg > CbC > CbC_gcc
comparison libgomp/testsuite/libgomp.fortran/reduction6.f90 @ 0:a06113de4d67
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 | |
3 integer, dimension (6, 6) :: a | |
4 character (36) :: c | |
5 integer nthreads | |
6 a = 9 | |
7 nthreads = -1 | |
8 call foo (a (2:4, 3:5), nthreads) | |
9 if (nthreads .eq. 3) then | |
10 write (c, '(36i1)') a | |
11 if (c .ne. '999999999999966699966699966699999999') call abort | |
12 end if | |
13 contains | |
14 subroutine foo (b, nthreads) | |
15 use omp_lib | |
16 integer, dimension (3:, 5:) :: b | |
17 integer :: err, nthreads | |
18 b = 0 | |
19 err = 0 | |
20 !$omp parallel num_threads (3) reduction (+:b) | |
21 if (any (b .ne. 0)) then | |
22 !$omp atomic | |
23 err = err + 1 | |
24 end if | |
25 !$omp master | |
26 nthreads = omp_get_num_threads () | |
27 !$omp end master | |
28 b = 2 | |
29 !$omp end parallel | |
30 if (err .gt. 0) call abort | |
31 end subroutine foo | |
32 end |