1! { dg-do run }
2! Fortran version of libgomp.c-c++-common/lastprivate-conditional-10.c
3
4module m
5  implicit none
6  integer :: v = 0
7  integer :: x = 0
8contains
9  integer function foo (a)
10    integer, contiguous :: a(0:)
11    integer i
12
13    !$omp parallel do simd lastprivate (conditional: x) schedule(simd : static) if (simd : .false.)
14    do i = 0, 127
15      if (a(i) /= 0) x = a(i)
16    end do
17    foo = x
18  end
19
20  integer function bar (a, b)
21    integer, contiguous :: a(0:), b(0:)
22    integer :: i
23    !$omp parallel
24    !$omp do simd lastprivate (conditional: x, v) schedule(static, 16) simdlen (1)
25    do i = 16, 127
26      if (a(i) /= 0) x = a(i);
27      if (b(i) /= 0) v = b(i) + 10;
28    end do
29    !$omp end parallel
30    bar = x
31  end
32
33  integer function baz (a)
34    integer, contiguous :: a(0:)
35    integer :: i
36    !$omp parallel do simd if (simd : .false.) lastprivate (conditional: x) schedule(simd : dynamic, 16)
37    do i = 0, 127
38      if (a(i) /= 0) x = a(i) + 5
39    end do
40    baz = x
41  end
42end module m
43
44program main
45  use m
46  implicit none
47  integer :: a(0:127), b(0:127), i
48  do i = 0, 127
49      if (mod(i, 11) == 2) then
50         a(i) =  i + 10
51      else
52        a(i) = 0
53      endif
54      if (mod(i, 13) == 5) then
55        b(i) = i * 2
56      else
57        b(i) = 0
58      endif
59  end do
60  if (foo (a) /= 133) stop 1
61  if (bar (b, a) /= 244 .or. v /= 143) stop 2
62  if (baz (b) /= 249) stop 3
63end
64