1! RUN: %S/test_errors.sh %s %t %flang -fopenmp
2! REQUIRES: shell
3! OpenMP Version 4.5
4! Various checks with the ordered construct
5
6SUBROUTINE LINEAR_GOOD(N)
7  INTEGER N, i, j, a, b(10)
8  !$omp target
9  !$omp teams
10  !$omp distribute parallel do simd linear(i)
11  do i = 1, N
12     a = 3.14
13  enddo
14  !$omp end distribute parallel do simd
15  !$omp end teams
16  !$omp end target
17END SUBROUTINE LINEAR_GOOD
18
19SUBROUTINE LINEAR_BAD(N)
20  INTEGER N, i, j, a, b(10)
21
22  !$omp target
23  !$omp teams
24  !ERROR: Variable 'j' not allowed in `LINEAR` clause, only loop iterator can be specified in `LINEAR` clause of a construct combined with `DISTRIBUTE`
25  !$omp distribute parallel do simd linear(j)
26  do i = 1, N
27      a = 3.14
28  enddo
29  !$omp end distribute parallel do simd
30  !$omp end teams
31  !$omp end target
32
33  !$omp target
34  !$omp teams
35  !ERROR: Variable 'j' not allowed in `LINEAR` clause, only loop iterator can be specified in `LINEAR` clause of a construct combined with `DISTRIBUTE`
36  !ERROR: Variable 'b' not allowed in `LINEAR` clause, only loop iterator can be specified in `LINEAR` clause of a construct combined with `DISTRIBUTE`
37  !$omp distribute parallel do simd linear(j) linear(b)
38  do i = 1, N
39     a = 3.14
40  enddo
41  !$omp end distribute parallel do simd
42  !$omp end teams
43  !$omp end target
44
45  !$omp target
46  !$omp teams
47  !ERROR: Variable 'j' not allowed in `LINEAR` clause, only loop iterator can be specified in `LINEAR` clause of a construct combined with `DISTRIBUTE`
48  !ERROR: Variable 'b' not allowed in `LINEAR` clause, only loop iterator can be specified in `LINEAR` clause of a construct combined with `DISTRIBUTE`
49  !$omp distribute parallel do simd linear(j, b)
50  do i = 1, N
51     a = 3.14
52  enddo
53  !$omp end distribute parallel do simd
54  !$omp end teams
55  !$omp end target
56
57  !ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
58  !ERROR: Variable 'j' not allowed in `LINEAR` clause, only loop iterator can be specified in `LINEAR` clause of a construct combined with `DISTRIBUTE`
59  !$omp distribute simd linear(i,j)
60   do i = 1, N
61      do j = 1, N
62         a = 3.14
63      enddo
64   enddo
65   !$omp end distribute simd
66
67   !ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
68   !ERROR: Variable 'j' not allowed in `LINEAR` clause, only loop iterator can be specified in `LINEAR` clause of a construct combined with `DISTRIBUTE`
69   !$omp distribute simd linear(i,j) collapse(1)
70   do i = 1, N
71      do j = 1, N
72         a = 3.14
73      enddo
74   enddo
75   !$omp end distribute simd
76
77   !ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
78   !$omp distribute simd linear(i,j) collapse(2)
79   do i = 1, N
80      do j = 1, N
81         a = 3.14
82      enddo
83   enddo
84   !$omp end distribute simd
85
86END SUBROUTINE LINEAR_BAD
87