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