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

   1 ! { dg-do run }
   2
   3 ! Integer reductions
   4
   5 program reduction_1
   6   implicit none
   7
   8   integer, parameter    :: n = 10, vl = 2
   9   integer               :: i, vresult, result
  10   logical               :: lresult, lvresult
  11   integer, dimension (n) :: array
  12
  13   do i = 1, n
  14      array(i) = i
  15   end do
  16
  17   result = 0
  18   vresult = 0
  19
  20   ! '+' reductions
  21
  22   !$acc parallel vector_length(vl) num_gangs(1)
  23   !$acc loop reduction(+:result)
  24   do i = 1, n
  25      result = result + array(i)
  26   end do
  27   !$acc end parallel
  28
  29   ! Verify the results
  30   do i = 1, n
  31      vresult = vresult + array(i)
  32   end do
  33
  34   if (result.ne.vresult) call abort
  35
  36   result = 0
  37   vresult = 0
  38
  39   ! '*' reductions
  40
  41   !$acc parallel vector_length(vl) num_gangs(1)
  42   !$acc loop reduction(*:result)
  43   do i = 1, n
  44      result = result * array(i)
  45   end do
  46   !$acc end parallel
  47
  48   ! Verify the results
  49   do i = 1, n
  50      vresult = vresult * array(i)
  51   end do
  52
  53   if (result.ne.vresult) call abort
  54
  55   result = 0
  56   vresult = 0
  57
  58   ! 'max' reductions
  59
  60   !$acc parallel vector_length(vl) num_gangs(1)
  61   !$acc loop reduction(max:result)
  62   do i = 1, n
  63      result = max (result, array(i))
  64   end do
  65   !$acc end parallel
  66
  67   ! Verify the results
  68   do i = 1, n
  69      vresult = max (vresult, array(i))
  70   end do
  71
  72   if (result.ne.vresult) call abort
  73
  74   result = 1
  75   vresult = 1
  76
  77   ! 'min' reductions
  78
  79   !$acc parallel vector_length(vl) num_gangs(1)
  80   !$acc loop reduction(min:result)
  81   do i = 1, n
  82      result = min (result, array(i))
  83   end do
  84   !$acc end parallel
  85
  86   ! Verify the results
  87   do i = 1, n
  88      vresult = min (vresult, array(i))
  89   end do
  90
  91   if (result.ne.vresult) call abort
  92
  93   result = 1
  94   vresult = 1
  95
  96   ! 'iand' reductions
  97
  98   !$acc parallel vector_length(vl) num_gangs(1)
  99   !$acc loop reduction(iand:result)
 100   do i = 1, n
 101      result = iand (result, array(i))
 102   end do
 103   !$acc end parallel
 104
 105   ! Verify the results
 106   do i = 1, n
 107      vresult = iand (vresult, array(i))
 108   end do
 109
 110   if (result.ne.vresult) call abort
 111
 112   result = 1
 113   vresult = 1
 114
 115   ! 'ior' reductions
 116
 117   !$acc parallel vector_length(vl) num_gangs(1)
 118   !$acc loop reduction(ior:result)
 119   do i = 1, n
 120      result = ior (result, array(i))
 121   end do
 122   !$acc end parallel
 123
 124   ! Verify the results
 125   do i = 1, n
 126      vresult = ior (vresult, array(i))
 127   end do
 128
 129   if (result.ne.vresult) call abort
 130
 131   result = 0
 132   vresult = 0
 133
 134   ! 'ieor' reductions
 135
 136   !$acc parallel vector_length(vl) num_gangs(1)
 137   !$acc loop reduction(ieor:result)
 138   do i = 1, n
 139      result = ieor (result, array(i))
 140   end do
 141   !$acc end parallel
 142
 143   ! Verify the results
 144   do i = 1, n
 145      vresult = ieor (vresult, array(i))
 146   end do
 147
 148   if (result.ne.vresult) call abort
 149
 150   lresult = .false.
 151   lvresult = .false.
 152
 153   ! '.and.' reductions
 154
 155   !$acc parallel vector_length(vl) num_gangs(1)
 156   !$acc loop reduction(.and.:lresult)
 157   do i = 1, n
 158      lresult = lresult .and. (array(i) .ge. 5)
 159   end do
 160   !$acc end parallel
 161
 162   ! Verify the results
 163   do i = 1, n
 164      lvresult = lvresult .and. (array(i) .ge. 5)
 165   end do
 166
 167   if (result.ne.vresult) call abort
 168
 169   lresult = .false.
 170   lvresult = .false.
 171
 172   ! '.or.' reductions
 173
 174   !$acc parallel vector_length(vl) num_gangs(1)
 175   !$acc loop reduction(.or.:lresult)
 176   do i = 1, n
 177      lresult = lresult .or. (array(i) .ge. 5)
 178   end do
 179   !$acc end parallel
 180
 181   ! Verify the results
 182   do i = 1, n
 183      lvresult = lvresult .or. (array(i) .ge. 5)
 184   end do
 185
 186   if (result.ne.vresult) call abort
 187
 188   lresult = .false.
 189   lvresult = .false.
 190
 191   ! '.eqv.' reductions
 192
 193   !$acc parallel vector_length(vl) num_gangs(1)
 194   !$acc loop reduction(.eqv.:lresult)
 195   do i = 1, n
 196      lresult = lresult .eqv. (array(i) .ge. 5)
 197   end do
 198   !$acc end parallel
 199
 200   ! Verify the results
 201   do i = 1, n
 202      lvresult = lvresult .eqv. (array(i) .ge. 5)
 203   end do
 204
 205   if (result.ne.vresult) call abort
 206
 207   lresult = .false.
 208   lvresult = .false.
 209
 210   ! '.neqv.' reductions
 211
 212   !$acc parallel vector_length(vl) num_gangs(1)
 213   !$acc loop reduction(.neqv.:lresult)
 214   do i = 1, n
 215      lresult = lresult .neqv. (array(i) .ge. 5)
 216   end do
 217   !$acc end parallel
 218
 219   ! Verify the results
 220   do i = 1, n
 221      lvresult = lvresult .neqv. (array(i) .ge. 5)
 222   end do
 223
 224   if (result.ne.vresult) call abort
 225 end program reduction_1