libgomp/testsuite/libgomp.fortran/examples-4/teams-6.f90

   1 ! { dg-do run }
   2
   3 module e_54_6_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     real :: diff
  19     do i = 1, N
  20       diff = p(i) - (i + 2.0) * (i - 3.0)
  21       if (diff > EPS .or. -diff > EPS) call abort
  22     end do
  23   end subroutine
  24
  25   subroutine vec_mult (p, v1, v2, N)
  26     real :: p(N), v1(N), v2(N)
  27     integer :: i, N
  28     !$omp target teams map(to: v1, v2) map(from: p)
  29       !$omp distribute parallel do simd
  30       do i = 1, N
  31         p(i) = v1(i) * v2(i)
  32       end do
  33     !$omp end target teams
  34   end subroutine
  35 end module
  36
  37 program e_54_6
  38   use e_54_6_mod, only : init, check, vec_mult
  39   real, pointer, dimension(:) :: p, v1, v2
  40   integer :: n
  41   n = 1000
  42   allocate (p(n), v1(n), v2(n))
  43   call init (v1, v2, n)
  44   call vec_mult (p, v1, v2, n)
  45   call check (p, N)
  46   deallocate (p, v1, v2)
  47 end program