annotate 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
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 ! { dg-do run }
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
2
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
3 integer, dimension (6, 6) :: a
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
4 character (36) :: c
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 integer nthreads
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
6 a = 9
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 nthreads = -1
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
8 call foo (a (2:4, 3:5), nthreads)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
9 if (nthreads .eq. 3) then
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
10 write (c, '(36i1)') a
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
11 if (c .ne. '999999999999966699966699966699999999') call abort
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
12 end if
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
13 contains
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
14 subroutine foo (b, nthreads)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
15 use omp_lib
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
16 integer, dimension (3:, 5:) :: b
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
17 integer :: err, nthreads
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
18 b = 0
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
19 err = 0
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
20 !$omp parallel num_threads (3) reduction (+:b)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
21 if (any (b .ne. 0)) then
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
22 !$omp atomic
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
23 err = err + 1
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
24 end if
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
25 !$omp master
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
26 nthreads = omp_get_num_threads ()
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
27 !$omp end master
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
28 b = 2
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
29 !$omp end parallel
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
30 if (err .gt. 0) call abort
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
31 end subroutine foo
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
32 end