1! { dg-do run }
2
3module e_50_3_mod
4contains
5  subroutine init (v1, v2, N)
6    integer :: i, N
7    real :: v1(N), v2(N)
8    do i = 1, N
9      v1(i) = i + 2.0
10      v2(i) = i - 3.0
11    end do
12  end subroutine
13
14  subroutine check (p, N)
15    integer :: i, N
16    real, parameter :: EPS = 0.00001
17    real :: diff, p(N)
18    do i = 1, N
19      diff = p(i) - (i + 2.0) * (i - 3.0)
20      if (diff > EPS .or. -diff > EPS) call abort
21    end do
22  end subroutine
23
24  subroutine vec_mult (N)
25    integer :: i, N
26    real :: p(N), v1(N), v2(N)
27    call init (v1, v2, N)
28    !$omp target map(to: v1,v2) map(from: p)
29      !$omp parallel do
30      do i = 1, N
31        p(i) = v1(i) * v2(i)
32      end do
33    !$omp end target
34    call check (p, N)
35  end subroutine
36end module
37
38program e_50_3
39  use e_50_3_mod, only : vec_mult
40  integer :: n
41  n = 1000
42  call vec_mult (n)
43end program
44