libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90

   1
   2 ! { dg-do run }
   3 ! { dg-additional-options "-cpp" }
   4
   5 #define M 8
   6 #define N 32
   7
   8 program main
   9   integer :: i
  10   integer :: a(N)
  11   integer :: b(M * N)
  12
  13   do i = 1, N
  14     a(i) = 0
  15   end do
  16
  17   !$acc parallel copy (a)
  18   !$acc loop seq
  19     do i = 1, N
  20       call seq (a)
  21     end do
  22   !$acc end parallel
  23
  24   do i = 1, N
  25     if (a(i) .ne.N) call abort
  26   end do
  27
  28   !$acc parallel copy (a)
  29   !$acc loop seq
  30     do i = 1, N
  31       call gang (a)
  32     end do
  33   !$acc end parallel
  34
  35   do i = 1, N
  36     if (a(i) .ne. (N + (N * (-1 * i)))) call abort
  37   end do
  38
  39   do i = 1, N
  40     b(i) = i
  41   end do
  42
  43   !$acc parallel copy (b)
  44   !$acc loop seq
  45     do i = 1, N
  46       call worker (b)
  47     end do
  48   !$acc end parallel
  49
  50   do i = 1, N
  51     if (b(i) .ne. N + i) call abort
  52   end do
  53
  54   do i = 1, N
  55     a(i) = i
  56   end do
  57
  58   !$acc parallel copy (a)
  59   !$acc loop seq
  60     do i = 1, N
  61       call vector (a)
  62     end do
  63   !$acc end parallel
  64
  65   do i = 1, N
  66     if (a(i) .ne. 0) call abort
  67   end do
  68
  69 contains
  70
  71 subroutine vector (a)
  72   !$acc routine vector
  73   integer, intent (inout) :: a(N)
  74   integer :: i
  75
  76   !$acc loop vector
  77   do i = 1, N
  78     a(i) = a(i) - a(i)
  79   end do
  80
  81 end subroutine vector
  82
  83 subroutine worker (b)
  84   !$acc routine worker
  85   integer, intent (inout) :: b(M*N)
  86   integer :: i, j
  87
  88   !$acc loop worker
  89   do i = 1, N
  90   !$acc loop vector
  91     do j = 1, M
  92       b(j + ((i - 1) * M)) = b(j + ((i - 1) * M)) + 1
  93     end do
  94   end do
  95
  96 end subroutine worker
  97
  98 subroutine gang (a)
  99   !$acc routine gang
 100   integer, intent (inout) :: a(N)
 101   integer :: i
 102
 103   !$acc loop gang
 104   do i = 1, N
 105     a(i) = a(i) - i
 106   end do
 107
 108 end subroutine gang
 109
 110 subroutine seq (a)
 111   !$acc routine seq
 112   integer, intent (inout) :: a(M)
 113   integer :: i
 114
 115   do i = 1, N
 116     a(i) = a(i) + 1
 117   end do
 118
 119 end subroutine seq
 120
 121 end program main