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 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) call abort 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