1! { dg-do run } 2 3function dotprod_ref (B, C, N) result (sum) 4 implicit none 5 real :: B(N), C(N), sum 6 integer :: N, i 7 sum = 0.0e0 8 do i = 1, N 9 sum = sum + B(i) * C(i) 10 end do 11end function 12 13function dotprod (B, C, n) result(sum) 14 real :: B(N), C(N), sum 15 integer :: N, i 16 sum = 0.0e0 17 !$omp target map(to: B, C) map(tofrom: sum) 18 !$omp teams num_teams(8) thread_limit(16) reduction(+:sum) 19 !$omp distribute parallel do reduction(+:sum) & 20 !$omp& dist_schedule(static, 1024) schedule(static, 64) 21 do i = 1, N 22 sum = sum + B(i) * C(i) 23 end do 24 !$omp end teams 25 !$omp end target 26end function 27 28subroutine init (B, C, N) 29 real :: B(N), C(N) 30 integer :: N, i 31 do i = 1, N 32 B(i) = 0.0001 * i 33 C(i) = 0.000001 * i * i 34 end do 35end subroutine 36 37subroutine check (a, b) 38 real :: a, b, err 39 real, parameter :: EPS = 0.0001 40 if (b == 0.0) then 41 err = a 42 else if (a == 0.0) then 43 err = b 44 else 45 err = (a - b) / b 46 end if 47 if (err > EPS .or. err < -EPS) call abort 48end subroutine 49 50program e_54_4 51 integer :: n 52 real :: ref, d 53 real, pointer, dimension(:) :: B, C 54 n = 1024 * 1024 55 allocate (B(n), C(n)) 56 call init (B, C, n) 57 ref = dotprod_ref (B, C, n) 58 d = dotprod (B, C, n) 59 call check (ref, d) 60 deallocate (B, C) 61end program 62