1! { dg-do run }
2!$ use omp_lib
3  call test_workshare
4
5contains
6  subroutine test_workshare
7    integer :: i, j, k, l, m
8    double precision, dimension (64) :: d, e
9    integer, dimension (10) :: f, g
10    integer, dimension (16, 16) :: a, b, c
11    integer, dimension (16) :: n
12    d(:) = 1
13    e = 7
14    f = 10
15    l = 256
16    m = 512
17    g(1:3) = -1
18    g(4:6) = 0
19    g(7:8) = 5
20    g(9:10) = 10
21    forall (i = 1:16, j = 1:16) a (i, j) = i * 16 + j
22    forall (j = 1:16) n (j) = j
23!$omp parallel num_threads (4) private (j, k)
24!$omp barrier
25!$omp workshare
26    i = 6
27    e(:) = d(:)
28    where (g .lt. 0)
29      f = 100
30    elsewhere (g .eq. 0)
31      f = 200 + f
32    elsewhere
33      where (g .gt. 6) f = f + sum (g)
34      f = 300 + f
35    end where
36    where (f .gt. 210) g = 0
37!$omp end workshare nowait
38!$omp workshare
39    forall (j = 1:16, k = 1:16) b (k, j) = a (j, k)
40    forall (k = 1:16) c (k, 1:16) = a (1:16, k)
41    forall (j = 2:16, n (17 - j) / 4 * 4 .ne. n (17 - j))
42      n (j) = n (j - 1) * n (j)
43    end forall
44!$omp endworkshare
45!$omp workshare
46!$omp atomic
47    i = i + 8 + 6
48!$omp critical
49!$omp critical (critical_foox)
50    l = 128
51!$omp end critical (critical_foox)
52!$omp endcritical
53!$omp parallel num_threads (2)
54!$  if (omp_get_thread_num () .eq. 0) m = omp_get_num_threads ()
55!$omp atomic
56    l = 1 + l
57!$omp end parallel
58!$omp end workshare
59!$omp end parallel
60
61    if (any (f .ne. (/100, 100, 100, 210, 210, 210, 310, 310, 337, 337/))) &
62&     stop 1
63    if (any (g .ne. (/-1, -1, -1, 0, 0, 0, 0, 0, 0, 0/))) stop 2
64    if (i .ne. 20) stop 3
65!$  if (l .ne. 128 + m) stop 4
66    if (any (d .ne. 1 .or. e .ne. 1)) stop 5
67    if (any (b .ne. transpose (a))) stop 6
68    if (any (c .ne. b)) stop 7
69    if (any (n .ne. (/1, 2, 6, 12, 5, 30, 42, 56, 9, 90, &
70&                     110, 132, 13, 182, 210, 240/))) stop 8
71  end subroutine test_workshare
72end
73