Fix gcc.c-torture/execute/ieee/cdivchkf.c on hpux
[official-gcc.git] / libgomp / testsuite / libgomp.fortran / examples-4 / target-5.f90
blobb4fd99efa7413af24b13efb98b3099704f9f0bd4
1 ! { dg-do run }
2 ! { dg-require-effective-target offload_device_nonshared_as }
4 module e_50_5_mod
5 integer, parameter :: THRESHOLD1 = 500, THRESHOLD2 = 100
6 contains
7 subroutine init (v1, v2, N)
8 integer :: i, N
9 real :: v1(N), v2(N)
10 do i = 1, N
11 v1(i) = i + 2.0
12 v2(i) = i - 3.0
13 end do
14 end subroutine
16 subroutine check (p, N)
17 integer :: i, N
18 real, parameter :: EPS = 0.00001
19 real :: diff, p(N)
20 do i = 1, N
21 diff = p(i) - (i + 2.0) * (i - 3.0)
22 if (diff > EPS .or. -diff > EPS) stop 1
23 end do
24 end subroutine
26 subroutine vec_mult (N)
27 use omp_lib, only: omp_is_initial_device
28 integer :: i, N
29 real :: p(N), v1(N), v2(N)
30 call init (v1, v2, N)
31 !$omp target if(N > THRESHOLD1) map(to: v1,v2) map(from: p)
32 if (omp_is_initial_device ()) stop 2
33 !$omp parallel do if(N > THRESHOLD2)
34 do i = 1, N
35 p(i) = v1(i) * v2(i)
36 end do
37 !$omp end target
38 call check (p, N)
39 end subroutine
40 end module
42 program e_50_5
43 use e_50_5_mod, only : vec_mult
44 integer :: n
45 n = 1000
46 call vec_mult (n)
47 end program