1! { dg-do run { target vect_simd_clones } }
2! { dg-additional-options "-msse2" { target sse2_runtime } }
3! { dg-additional-options "-mavx" { target avx_runtime } }
4
5module SIMD2_mod
6contains
7  function add1(a,b,fact) result(c)
8  !$omp declare simd(add1) uniform(fact)
9     double precision :: a,b,fact, c
10     c = a + b + fact
11  end function
12
13  function add2(a,b,i, fact) result(c)
14  !$omp declare simd(add2) uniform(a,b,fact) linear(i:1)
15     integer,          value        :: i
16     double precision, dimension(:) :: a, b
17     double precision               :: fact, c
18     c = a(i) + b(i) + fact
19  end function
20
21  subroutine work(a, b, n )
22     implicit none
23     double precision           :: a(n),b(n), tmp
24     integer                    :: n, i
25
26     !$omp simd private(tmp)
27     do i = 1,n
28        tmp  = add1(a(i), b(i), 1.0d0)
29        a(i) = add2(a,    b, i, 1.0d0) + tmp
30        a(i) = a(i) + b(i) + 1.0d0
31     end do
32  end subroutine
33
34  subroutine work_ref(a, b, n )
35     implicit none
36     double precision           :: a(n),b(n), tmp
37     integer                    :: n, i
38
39     do i = 1,n
40        tmp  = add1(a(i), b(i), 1.0d0)
41        a(i) = add2(a,    b, i, 1.0d0) + tmp
42        a(i) = a(i) + b(i) + 1.0d0
43     end do
44  end subroutine
45
46  subroutine check (a, b, n)
47      integer :: i, n
48      double precision, parameter :: EPS = 0.0000000000001
49      double precision :: diff, a(*), b(*)
50      do i = 1, n
51        diff = a(i) - b(i)
52        if (diff > EPS .or. -diff > EPS) STOP 1
53      end do
54  end subroutine
55end module
56
57program main
58   use SIMD2_mod
59   integer, parameter :: N=32
60   integer :: i
61   double precision   :: a(N), b(N), a_ref(N)
62   do i = 1,N
63      a(i) = i-1
64      a_ref(i) = a(i)
65      b(i) = N-(i-1)
66   end do
67
68   call work(a, b, N )
69   call work_ref(a_ref, b, N )
70
71   call check(a, a_ref, N )
72end program
73