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

   1 ! { dg-do run }
   2
   3 ! double precision reductions
   4
   5 program reduction_3
   6   implicit none
   7
   8   integer, parameter    :: n = 10, ng = 8, nw = 4, vl = 32
   9   integer               :: i
  10   double precision      :: vresult, rg, rw, rv, rc
  11   double precision, parameter :: e = 0.001
  12   logical               :: lrg, lrw, lrv, lrc, lvresult
  13   double precision, dimension (n) :: array
  14
  15   do i = 1, n
  16      array(i) = i
  17   end do
  18
  19   !
  20   ! '+' reductions
  21   !
  22
  23   rg = 0
  24   rw = 0
  25   rv = 0
  26   rc = 0
  27   vresult = 0
  28
  29   !$acc parallel num_gangs(ng) copy(rg)
  30   !$acc loop reduction(+:rg) gang
  31   do i = 1, n
  32      rg = rg + array(i)
  33   end do
  34   !$acc end parallel
  35
  36   !$acc parallel num_workers(nw) copy(rw)
  37   !$acc loop reduction(+:rw) worker
  38   do i = 1, n
  39      rw = rw + array(i)
  40   end do
  41   !$acc end parallel
  42
  43   !$acc parallel vector_length(vl) copy(rv)
  44   !$acc loop reduction(+:rv) vector
  45   do i = 1, n
  46      rv = rv + array(i)
  47   end do
  48   !$acc end parallel
  49
  50   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
  51   !$acc loop reduction(+:rc) gang worker vector
  52   do i = 1, n
  53      rc = rc + array(i)
  54   end do
  55   !$acc end parallel
  56
  57   ! Verify the results
  58   do i = 1, n
  59      vresult = vresult + array(i)
  60   end do
  61
  62   if (abs (rg - vresult) .ge. e) STOP 1
  63   if (abs (rw - vresult) .ge. e) STOP 2
  64   if (abs (rv - vresult) .ge. e) STOP 3
  65   if (abs (rc - vresult) .ge. e) STOP 4
  66
  67   !
  68   ! '*' reductions
  69   !
  70
  71   rg = 1
  72   rw = 1
  73   rv = 1
  74   rc = 1
  75   vresult = 1
  76
  77   !$acc parallel num_gangs(ng) copy(rg)
  78   !$acc loop reduction(*:rg) gang
  79   do i = 1, n
  80      rg = rg * array(i)
  81   end do
  82   !$acc end parallel
  83
  84   !$acc parallel num_workers(nw) copy(rw)
  85   !$acc loop reduction(*:rw) worker
  86   do i = 1, n
  87      rw = rw * array(i)
  88   end do
  89   !$acc end parallel
  90
  91   !$acc parallel vector_length(vl) copy(rv)
  92   !$acc loop reduction(*:rv) vector
  93   do i = 1, n
  94      rv = rv * array(i)
  95   end do
  96   !$acc end parallel
  97
  98   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
  99   !$acc loop reduction(*:rc) gang worker vector
 100   do i = 1, n
 101      rc = rc * array(i)
 102   end do
 103   !$acc end parallel
 104
 105   ! Verify the results
 106   do i = 1, n
 107      vresult = vresult * array(i)
 108   end do
 109
 110   if (abs (rg - vresult) .ge. e) STOP 5
 111   if (abs (rw - vresult) .ge. e) STOP 6
 112   if (abs (rv - vresult) .ge. e) STOP 7
 113   if (abs (rc - vresult) .ge. e) STOP 8
 114
 115   !
 116   ! 'max' reductions
 117   !
 118
 119   rg = 0
 120   rw = 0
 121   rv = 0
 122   rc = 0
 123   vresult = 0
 124
 125   !$acc parallel num_gangs(ng) copy(rg)
 126   !$acc loop reduction(max:rg) gang
 127   do i = 1, n
 128      rg = max (rg, array(i))
 129   end do
 130   !$acc end parallel
 131
 132   !$acc parallel num_workers(nw) copy(rw)
 133   !$acc loop reduction(max:rw) worker
 134   do i = 1, n
 135      rw = max (rw, array(i))
 136   end do
 137   !$acc end parallel
 138
 139   !$acc parallel vector_length(vl) copy(rv)
 140   !$acc loop reduction(max:rv) vector
 141   do i = 1, n
 142      rv = max (rv, array(i))
 143   end do
 144   !$acc end parallel
 145
 146   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
 147   !$acc loop reduction(max:rc) gang worker vector
 148   do i = 1, n
 149      rc = max (rc, array(i))
 150   end do
 151   !$acc end parallel
 152
 153   ! Verify the results
 154   do i = 1, n
 155      vresult = max (vresult, array(i))
 156   end do
 157
 158   if (abs (rg - vresult) .ge. e) STOP 9
 159   if (abs (rw - vresult) .ge. e) STOP 10
 160   if (abs (rv - vresult) .ge. e) STOP 11
 161   if (abs (rc - vresult) .ge. e) STOP 12
 162
 163   !
 164   ! 'min' reductions
 165   !
 166
 167   rg = 0
 168   rw = 0
 169   rv = 0
 170   rc = 0
 171   vresult = 0
 172
 173   !$acc parallel num_gangs(ng) copy(rg)
 174   !$acc loop reduction(min:rg) gang
 175   do i = 1, n
 176      rg = min (rg, array(i))
 177   end do
 178   !$acc end parallel
 179
 180   !$acc parallel num_workers(nw) copy(rw)
 181   !$acc loop reduction(min:rw) worker
 182   do i = 1, n
 183      rw = min (rw, array(i))
 184   end do
 185   !$acc end parallel
 186
 187   !$acc parallel vector_length(vl) copy(rv)
 188   !$acc loop reduction(min:rv) vector
 189   do i = 1, n
 190      rv = min (rv, array(i))
 191   end do
 192   !$acc end parallel
 193
 194   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
 195   !$acc loop reduction(min:rc) gang worker vector
 196   do i = 1, n
 197      rc = min (rc, array(i))
 198   end do
 199   !$acc end parallel
 200
 201   ! Verify the results
 202   do i = 1, n
 203      vresult = min (vresult, array(i))
 204   end do
 205
 206   if (rg .ne. vresult) STOP 13
 207   if (rw .ne. vresult) STOP 14
 208   if (rv .ne. vresult) STOP 15
 209   if (rc .ne. vresult) STOP 16
 210
 211   !
 212   ! '.and.' reductions
 213   !
 214
 215   lrg = .true.
 216   lrw = .true.
 217   lrv = .true.
 218   lrc = .true.
 219   lvresult = .true.
 220
 221   !$acc parallel num_gangs(ng) copy(lrg)
 222   !$acc loop reduction(.and.:lrg) gang
 223   do i = 1, n
 224      lrg = lrg .and. (array(i) .ge. 5)
 225   end do
 226   !$acc end parallel
 227
 228   !$acc parallel num_workers(nw) copy(lrw)
 229   !$acc loop reduction(.and.:lrw) worker
 230   do i = 1, n
 231      lrw = lrw .and. (array(i) .ge. 5)
 232   end do
 233   !$acc end parallel
 234
 235   !$acc parallel vector_length(vl) copy(lrv)
 236   !$acc loop reduction(.and.:lrv) vector
 237   do i = 1, n
 238      lrv = lrv .and. (array(i) .ge. 5)
 239   end do
 240   !$acc end parallel
 241
 242   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
 243   !$acc loop reduction(.and.:lrc) gang worker vector
 244   do i = 1, n
 245      lrc = lrc .and. (array(i) .ge. 5)
 246   end do
 247   !$acc end parallel
 248
 249   ! Verify the results
 250   do i = 1, n
 251      lvresult = lvresult .and. (array(i) .ge. 5)
 252   end do
 253
 254   if (lrg .neqv. lvresult) STOP 17
 255   if (lrw .neqv. lvresult) STOP 18
 256   if (lrv .neqv. lvresult) STOP 19
 257   if (lrc .neqv. lvresult) STOP 20
 258
 259   !
 260   ! '.or.' reductions
 261   !
 262
 263   lrg = .false.
 264   lrw = .false.
 265   lrv = .false.
 266   lrc = .false.
 267   lvresult = .false.
 268
 269   !$acc parallel num_gangs(ng) copy(lrg)
 270   !$acc loop reduction(.or.:lrg) gang
 271   do i = 1, n
 272      lrg = lrg .or. (array(i) .ge. 5)
 273   end do
 274   !$acc end parallel
 275
 276   !$acc parallel num_workers(nw) copy(lrw)
 277   !$acc loop reduction(.or.:lrw) worker
 278   do i = 1, n
 279      lrw = lrw .or. (array(i) .ge. 5)
 280   end do
 281   !$acc end parallel
 282
 283   !$acc parallel vector_length(vl) copy(lrv)
 284   !$acc loop reduction(.or.:lrv) vector
 285   do i = 1, n
 286      lrv = lrv .or. (array(i) .ge. 5)
 287   end do
 288   !$acc end parallel
 289
 290   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
 291   !$acc loop reduction(.or.:lrc) gang worker vector
 292   do i = 1, n
 293      lrc = lrc .or. (array(i) .ge. 5)
 294   end do
 295   !$acc end parallel
 296
 297   ! Verify the results
 298   do i = 1, n
 299      lvresult = lvresult .or. (array(i) .ge. 5)
 300   end do
 301
 302   if (lrg .neqv. lvresult) STOP 21
 303   if (lrw .neqv. lvresult) STOP 22
 304   if (lrv .neqv. lvresult) STOP 23
 305   if (lrc .neqv. lvresult) STOP 24
 306
 307   !
 308   ! '.eqv.' reductions
 309   !
 310
 311   lrg = .true.
 312   lrw = .true.
 313   lrv = .true.
 314   lrc = .true.
 315   lvresult = .true.
 316
 317   !$acc parallel num_gangs(ng) copy(lrg)
 318   !$acc loop reduction(.eqv.:lrg) gang
 319   do i = 1, n
 320      lrg = lrg .eqv. (array(i) .ge. 5)
 321   end do
 322   !$acc end parallel
 323
 324   !$acc parallel num_workers(nw) copy(lrw)
 325   !$acc loop reduction(.eqv.:lrw) worker
 326   do i = 1, n
 327      lrw = lrw .eqv. (array(i) .ge. 5)
 328   end do
 329   !$acc end parallel
 330
 331   !$acc parallel vector_length(vl) copy(lrv)
 332   !$acc loop reduction(.eqv.:lrv) vector
 333   do i = 1, n
 334      lrv = lrv .eqv. (array(i) .ge. 5)
 335   end do
 336   !$acc end parallel
 337
 338   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
 339   !$acc loop reduction(.eqv.:lrc) gang worker vector
 340   do i = 1, n
 341      lrc = lrc .eqv. (array(i) .ge. 5)
 342   end do
 343   !$acc end parallel
 344
 345   ! Verify the results
 346   do i = 1, n
 347      lvresult = lvresult .eqv. (array(i) .ge. 5)
 348   end do
 349
 350   if (lrg .neqv. lvresult) STOP 25
 351   if (lrw .neqv. lvresult) STOP 26
 352   if (lrv .neqv. lvresult) STOP 27
 353   if (lrc .neqv. lvresult) STOP 28
 354
 355   !
 356   ! '.neqv.' reductions
 357   !
 358
 359   lrg = .true.
 360   lrw = .true.
 361   lrv = .true.
 362   lrc = .true.
 363   lvresult = .true.
 364
 365   !$acc parallel num_gangs(ng) copy(lrg)
 366   !$acc loop reduction(.neqv.:lrg) gang
 367   do i = 1, n
 368      lrg = lrg .neqv. (array(i) .ge. 5)
 369   end do
 370   !$acc end parallel
 371
 372   !$acc parallel num_workers(nw) copy(lrw)
 373   !$acc loop reduction(.neqv.:lrw) worker
 374   do i = 1, n
 375      lrw = lrw .neqv. (array(i) .ge. 5)
 376   end do
 377   !$acc end parallel
 378
 379   !$acc parallel vector_length(vl) copy(lrv)
 380   !$acc loop reduction(.neqv.:lrv) vector
 381   do i = 1, n
 382      lrv = lrv .neqv. (array(i) .ge. 5)
 383   end do
 384   !$acc end parallel
 385
 386   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
 387   !$acc loop reduction(.neqv.:lrc) gang worker vector
 388   do i = 1, n
 389      lrc = lrc .neqv. (array(i) .ge. 5)
 390   end do
 391   !$acc end parallel
 392
 393   ! Verify the results
 394   do i = 1, n
 395      lvresult = lvresult .neqv. (array(i) .ge. 5)
 396   end do
 397
 398   if (lrg .neqv. lvresult) STOP 29
 399   if (lrw .neqv. lvresult) STOP 30
 400   if (lrv .neqv. lvresult) STOP 31
 401   if (lrc .neqv. lvresult) STOP 32
 402 end program reduction_3