1! { dg-do run }
2
3  interface
4    real function foo (x)
5      !$omp declare target
6      real, intent(in) :: x
7    end function foo
8  end interface
9  integer, parameter :: n = 1000
10  integer, parameter :: c = 100
11  integer :: i, j
12  real :: a(n)
13  do i = 1, n
14    a(i) = i
15  end do
16  !$omp parallel
17  !$omp single
18  do i = 1, n, c
19    !$omp task shared(a)
20      !$omp target map(a(i:i+c-1))
21        !$omp parallel do
22          do j = i, i + c - 1
23            a(j) = foo (a(j))
24          end do
25      !$omp end target
26    !$omp end task
27  end do
28  !$omp end single
29  !$omp end parallel
30  do i = 1, n
31    if (a(i) /= i + 1) stop 1
32  end do
33end
34real function foo (x)
35  !$omp declare target
36  real, intent(in) :: x
37  foo = x + 1
38end function foo
39