1! { dg-do compile }
2! { dg-options "-O2 -fopenmp -fdump-tree-ompexp" }
3! { dg-final { scan-tree-dump-times "GOMP_loop_start " 3 "ompexp" } }
4! { dg-final { scan-tree-dump-times "GOMP_loop_end_nowait " 3 "ompexp" } }
5
6module m
7  logical r
8end module m
9
10subroutine foo (a)
11  use m
12  implicit none
13  logical a(:)
14  integer :: i
15  !$omp do lastprivate(conditional: r)
16  do i = 1, 64
17    if (a(i)) &
18      r = a(i)
19  end do
20  !$omp end do nowait
21end
22
23subroutine bar (a)
24  use m
25  implicit none
26  logical a(:)
27  integer :: i
28  !$omp do lastprivate(conditional: r) schedule (static, 4)
29  do i = 1, 64
30    if (a(i)) &
31      r = a(i)
32  end do
33  !$omp end do nowait
34end
35
36subroutine baz (a)
37  use m
38  implicit none
39  logical a(:)
40  integer :: i
41  !$omp do lastprivate(conditional: r) schedule (runtime)
42  do i = 1, 64
43    if (a(i)) &
44      r = a(i)
45  end do
46  !$omp end do nowait
47end
48