libgomp/testsuite/libgomp.fortran/examples-4/target-4.f90

   1 ! { dg-do run }
   2
   3 module e_50_4_mod
   4 contains
   5   subroutine init (v1, v2, N)
   6     integer :: i, N
   7     real, pointer, dimension(:) :: v1, v2
   8     do i = 1, N
   9       v1(i) = i + 2.0
  10       v2(i) = i - 3.0
  11     end do
  12   end subroutine
  13
  14   subroutine check (p, N)
  15     integer :: i, N
  16     real, parameter :: EPS = 0.00001
  17     real, pointer, dimension(:) :: p
  18     do i = 1, N
  19       diff = p(i) - (i + 2.0) * (i - 3.0)
  20       if (diff > EPS .or. -diff > EPS) call abort
  21     end do
  22   end subroutine
  23
  24   subroutine vec_mult_1 (p, v1, v2, N)
  25     integer :: i, N
  26     real, pointer, dimension(:) :: p, v1, v2
  27     !$omp target map(to: v1(1:N), v2(:N)) map(from: p(1:N))
  28       !$omp parallel do
  29       do i = 1, N
  30         p(i) = v1(i) * v2(i)
  31       end do
  32     !$omp end target
  33   end subroutine
  34
  35   subroutine vec_mult_2 (p, v1, v2, N)
  36     real, dimension(*) :: p, v1, v2
  37     integer :: i, N
  38     !$omp target map(to: v1(1:N), v2(:N)) map(from: p(1:N))
  39       !$omp parallel do
  40       do i = 1, N
  41         p(i) = v1(i) * v2(i)
  42       end do
  43     !$omp end target
  44   end subroutine
  45 end module
  46
  47 program e_50_4
  48   use e_50_4_mod, only : init, check, vec_mult_1, vec_mult_2
  49   real, pointer, dimension(:) :: p1, p2, v1, v2
  50   integer :: n
  51   n = 1000
  52   allocate (p1(n), p2(n), v1(n), v2(n))
  53   call init (v1, v2, n)
  54   call vec_mult_1 (p1, v1, v2, n)
  55   call vec_mult_2 (p2, v1, v2, n)
  56   call check (p1, N)
  57   call check (p2, N)
  58   deallocate (p1, p2, v1, v2)
  59 end program