1! { dg-do compile { target { { i?86-*-* x86_64-*-* } && ia32 } } }
2! { dg-options "-march=i486 -fopenmp -mavx -O3 -funroll-all-loops" }
3
4  call test_workshare
5
6contains
7  subroutine test_workshare
8    integer :: i, j, k, l, m
9    double precision, dimension (64) :: d, e
10    integer, dimension (10) :: f, g
11    integer, dimension (16, 16) :: a, b, c
12    integer, dimension (16) :: n
13!$omp parallel num_threads (4) private (j, k)
14!$omp barrier
15!$omp workshare
16    where (g .lt. 0)
17      f = 100
18    elsewhere
19      where (g .gt. 6) f = f + sum (g)
20      f = 300 + f
21    end where
22!$omp end workshare nowait
23!$omp workshare
24    forall (j = 1:16, k = 1:16) b (k, j) = a (j, k)
25    forall (j = 2:16, n (17 - j) / 4 * 4 .ne. n (17 - j))
26      n (j) = n (j - 1) * n (j)
27    end forall
28!$omp endworkshare
29!$omp end parallel
30
31  end subroutine test_workshare
32end
33