]> gcc.gnu.org Git - gcc.git/blame - libgomp/testsuite/libgomp.fortran/examples-4/declare_target-4.f90
omp-low.c (lower_omp_target): Fix up argument to is_reference.
[gcc.git] / libgomp / testsuite / libgomp.fortran / examples-4 / declare_target-4.f90
CommitLineData
122d7303
AT
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
b4c3a85b 19 !$omp target map(tmp)
122d7303
AT
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
This page took 0.249249 seconds and 5 git commands to generate.