1! PR middle-end/100905
2!
3PROGRAM test_loop_order_concurrent
4  implicit none
5  integer :: a, cc(64), dd(64)
6
7  dd = 54
8  cc = 99
9
10  call test_loop()
11  call test_affinity(a)
12  if (a /= 5) stop 3
13  call test_scan(cc, dd)
14  if (any (cc /= 99)) stop 4
15  if (dd(1) /= 5  .or. dd(2) /= 104) stop 5
16
17CONTAINS
18
19  SUBROUTINE test_loop()
20    INTEGER,DIMENSION(1024):: a, b, c
21    INTEGER:: i
22
23    DO i = 1, 1024
24       a(i) = 1
25       b(i) = i + 1
26       c(i) = 2*(i + 1)
27    END DO
28
29   !$omp loop order(concurrent) bind(thread)
30    DO i = 1, 1024
31       a(i) = a(i) + b(i)*c(i)
32    END DO
33
34    DO i = 1, 1024
35       if (a(i) /= 1 + (b(i)*c(i))) stop 1
36    END DO
37  END SUBROUTINE test_loop
38
39  SUBROUTINE test_affinity(aa)
40    integer :: aa
41    !$omp task affinity(aa)
42      a = 5
43    !$omp end task
44  end
45
46  subroutine test_scan(c, d)
47    integer i, c(*), d(*)
48    !$omp simd reduction (inscan, +: a)
49    do i = 1, 64
50      d(i) = a
51      !$omp scan exclusive (a)
52      a = a + c(i)
53    end do
54  end
55END PROGRAM test_loop_order_concurrent
56