libgomp/testsuite/libgomp.oacc-fortran/subarrays-1.f90

   1 ! { dg-do run }
   2 !
   3 program subarrays
   4   integer, parameter     :: n = 20, c = 10
   5   integer                :: i, a(n), b(n)
   6
   7   a(:) = 0
   8   b(:) = 0
   9
  10   ! COPY
  11
  12   !$acc parallel copy (a(1:n))
  13   !$acc loop
  14   do i = 1, n
  15      a(i) = i
  16   end do
  17   !$acc end parallel
  18
  19   do i = 1, n
  20      b(i) = i
  21   end do
  22
  23   call check (a, b, n)
  24
  25   ! COPYOUT
  26
  27   a(:) = 0
  28
  29   !$acc parallel copyout (a(1:n))
  30   !$acc loop
  31   do i = 1, n
  32      a(i) = i
  33   end do
  34   !$acc end parallel
  35
  36   do i = 1, n
  37      if (a(i) .ne. b(i)) STOP 1
  38   end do
  39   call check (a, b, n)
  40
  41   ! COPYIN
  42
  43   a(:) = 0
  44
  45   !$acc parallel copyout (a(1:n)) copyin (b(1:n))
  46   !$acc loop
  47   do i = 1, n
  48      a(i) = i
  49   end do
  50   !$acc end parallel
  51
  52   call check (a, b, n)
  53
  54   ! PRESENT_OR_COPY
  55
  56   !$acc parallel pcopy (a(1:n))
  57   !$acc loop
  58   do i = 1, n
  59      a(i) = i
  60   end do
  61   !$acc end parallel
  62
  63   call check (a, b, n)
  64
  65   ! PRESENT_OR_COPYOUT
  66
  67   a(:) = 0
  68
  69   !$acc parallel pcopyout (a(1:n))
  70   !$acc loop
  71   do i = 1, n
  72      a(i) = i
  73   end do
  74   !$acc end parallel
  75
  76   call check (a, b, n)
  77
  78   ! PRESENT_OR_COPYIN
  79
  80   a(:) = 0
  81
  82   !$acc parallel pcopyout (a(1:n)) pcopyin (b(1:n))
  83   !$acc loop
  84   do i = 1, n
  85      a(i) = i
  86   end do
  87   !$acc end parallel
  88
  89   call check (a, b, n)
  90 end program subarrays
  91
  92 subroutine check (a, b, n)
  93   integer :: n, a(n), b(n)
  94   integer :: i
  95
  96   do i = 1, n
  97      if (a(i) .ne. b(i)) STOP 2
  98   end do
  99 end subroutine check