1! { dg-do run }
2
3module e_53_4_mod
4  !$omp declare target (N, Q)
5  integer, parameter :: N = 10
6  real :: Q(N,N)
7contains
8  real function Pfun (i, k)
9    !$omp declare target
10    integer, intent(in) :: i, k
11    Pfun = (Q(i,k) * Q(k,i))
12  end function
13end module
14
15real function accum (k) result (tmp)
16  use e_53_4_mod
17  integer :: i, k
18  tmp = 0.0e0
19  !$omp target
20    !$omp parallel do reduction(+:tmp)
21    do i = 1, N
22      tmp = tmp + Pfun (k, i)
23    end do
24  !$omp end target
25end function
26
27real function accum_ref (k) result (tmp)
28  use e_53_4_mod
29  integer :: i, k
30  tmp = 0.0e0
31  do i = 1, N
32    tmp = tmp + Pfun (k, i)
33  end do
34end function
35
36subroutine init ()
37  use e_53_4_mod
38  integer :: i, j
39  do i = 1, N
40    do j = 1, N
41      Q(i,j) = 0.001 * i * j
42    end do
43  end do
44end subroutine
45
46subroutine check (a, b)
47  real :: a, b, err
48  real, parameter :: EPS = 0.00001
49  if (b == 0.0) then
50    err = a
51  else if (a == 0.0) then
52    err = b
53  else
54    err = (a - b) / b
55  end if
56  if (err > EPS .or. err < -EPS) call abort
57end subroutine
58
59program e_53_4
60  use e_53_4_mod
61  integer :: i
62  real :: accum, accum_ref
63  call init ()
64  !$omp target update to(Q)
65  do i = 1, N
66    call check (accum (i), accum_ref (i))
67  end do
68end program
69