1! { dg-do run { target vect_simd_clones } }
2! { dg-options "-O2" }
3! { dg-additional-options "-msse2" { target sse2_runtime } }
4! { dg-additional-options "-mavx" { target avx_runtime } }
5
6module e_53_5_mod
7  !$omp declare target (N, Q)
8  integer, parameter :: N = 10000, M = 1024
9  real :: Q(N,N)
10contains
11  real function Pfun (k, i)
12    !$omp declare simd(Pfun) uniform(i) linear(k) notinbranch
13    !$omp declare target
14    integer, value, intent(in) :: i, k
15    Pfun = (Q(k,i) * Q(i,k))
16  end function
17end module
18
19real function accum () result (tmp)
20  use e_53_5_mod
21  real :: tmp1
22  integer :: i
23  tmp = 0.0e0
24  !$omp target map(tofrom: tmp)
25    !$omp parallel do private(tmp1) reduction(+:tmp)
26    do i = 1, N
27      tmp1 = 0.0e0
28      !$omp simd reduction(+:tmp1)
29      do k = 1, M
30        tmp1 = tmp1 + Pfun (k, i)
31      end do
32      tmp = tmp + tmp1
33    end do
34  !$omp end target
35end function
36
37real function accum_ref () result (tmp)
38  use e_53_5_mod
39  real :: tmp1
40  integer :: i
41  tmp = 0.0e0
42  do i = 1, N
43    tmp1 = 0.0e0
44    do k = 1, M
45      tmp1 = tmp1 + Pfun (k, i)
46    end do
47    tmp = tmp + tmp1
48  end do
49end function
50
51subroutine init ()
52  use e_53_5_mod
53  integer :: i, j
54  do i = 1, N
55    do j = 1, N
56      Q(i,j) = 0.001 * i * j
57    end do
58  end do
59end subroutine
60
61subroutine check (a, b)
62  real :: a, b, err
63  real, parameter :: EPS = 0.00001
64  if (b == 0.0) then
65    err = a
66  else if (a == 0.0) then
67    err = b
68  else
69    err = (a - b) / b
70  end if
71  if (err > EPS .or. err < -EPS) stop 1
72end subroutine
73
74program e_53_5
75  use e_53_5_mod
76  real :: accum, accum_ref, d
77  call init ()
78  !$omp target update to(Q)
79  call check (accum (), accum_ref ())
80end program
81