libgomp/testsuite/libgomp.fortran/examples-4/target_update-2.f90

   1 ! { dg-do run }
   2
   3 module e_52_2_mod
   4 contains
   5   subroutine init (v1, v2, N)
   6     integer :: i, N
   7     real :: v1(N), v2(N)
   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 init_again (v1, v2, N)
  15     integer :: i, N
  16     real :: v1(N), v2(N)
  17     do i = 1, N
  18       v1(i) = i - 3.0
  19       v2(i) = i + 2.0
  20     end do
  21   end subroutine
  22
  23   subroutine check (p, N)
  24     integer :: i, N
  25     real, parameter :: EPS = 0.00001
  26     real :: diff, p(N)
  27     do i = 1, N
  28       diff = p(i) - (i * i + (i + 2.0) * (i - 3.0))
  29       if (diff > EPS .or. -diff > EPS) call abort
  30     end do
  31   end subroutine
  32
  33   logical function maybe_init_again (v, N)
  34     real :: v(N)
  35     integer :: i, N
  36     do i = 1, N
  37       v(i) = i
  38     end do
  39     maybe_init_again = .true.
  40   end function
  41
  42   subroutine vec_mult (p, v1, v2, N)
  43     real :: p(N), v1(N), v2(N)
  44     integer :: i, N
  45     logical :: changed
  46     call init (v1, v2, N)
  47     !$omp target data map(to: v1, v2) map(from: p)
  48       !$omp target
  49         !$omp parallel do
  50         do i = 1, N
  51           p(i) = v1(i) * v2(i)
  52         end do
  53       !$omp end target
  54       changed = maybe_init_again (v1, N)
  55       !$omp target update if(changed) to(v1(:N))
  56       changed = maybe_init_again (v2, N)
  57       !$omp target update if(changed) to(v2(:N))
  58       !$omp target
  59         !$omp parallel do
  60         do i = 1, N
  61           p(i) = p(i) + v1(i) * v2(i)
  62         end do
  63       !$omp end target
  64     !$omp end target data
  65     call check (p, N)
  66   end subroutine
  67 end module
  68
  69 program e_52_2
  70   use e_52_2_mod, only : vec_mult
  71   integer :: n
  72   real, pointer :: p(:), v1(:), v2(:)
  73   n = 1000
  74   allocate (p(n), v1(n), v2(n))
  75   call vec_mult (p, v1, v2, n)
  76   deallocate (p, v1, v2)
  77 end program