1! { dg-do compile }
2
3interface
4  subroutine foo
5  end subroutine
6  function bar ()
7  integer :: bar
8  end function bar
9  elemental function baz ()
10  integer :: baz
11  end function baz
12end interface
13
14  integer :: i, j
15  real :: a, b (10), c
16  a = 0.5
17  b = 0.25
18!$omp parallel workshare
19  a = sin (a)
20  b = sin (b)
21  forall (i = 1:10) b(i) = cos (b(i)) - 0.5
22  j = baz ()
23!$omp parallel if (bar () .gt. 2) &
24!$omp & num_threads (bar () + 1)
25  i = bar ()
26!$omp end parallel
27!$omp parallel do schedule (static, bar () + 4)
28  do j = 1, 10
29    i = bar ()
30  end do
31!$omp end parallel do
32!$omp end parallel workshare
33!$omp parallel workshare
34  call foo			! { dg-error "CALL statement" }
35  i = bar ()			! { dg-error "non-ELEMENTAL" }
36!$omp critical
37  i = bar ()			! { dg-error "non-ELEMENTAL" }
38!$omp end critical
39!$omp atomic
40  j = j + bar ()		! { dg-error "non-ELEMENTAL" }
41!$omp end parallel workshare
42end
43