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

   1 ! { dg-do run }
   2
   3 ! { dg-additional-options "-Wopenacc-parallelism" } for testing/documenting
   4 ! aspects of that functionality.
   5
   6 ! Integer reductions
   7
   8 program reduction_1
   9   implicit none
  10
  11   integer, parameter    :: n = 10, ng = 8, nw = 4, vl = 32
  12   integer               :: i, vresult, rg, rw, rv, rc
  13   logical               :: lrg, lrw, lrv, lrc, lvresult
  14   integer, dimension (n) :: array
  15
  16   do i = 1, n
  17      array(i) = i
  18   end do
  19
  20   !
  21   ! '+' reductions
  22   !
  23
  24   rg = 0
  25   rw = 0
  26   rv = 0
  27   rc = 0
  28   vresult = 0
  29
  30   !$acc parallel num_gangs(ng) copy(rg)
  31   !$acc loop reduction(+:rg) gang
  32   do i = 1, n
  33      rg = rg + array(i)
  34   end do
  35   !$acc end parallel
  36
  37   !$acc parallel num_workers(nw) copy(rw)
  38   !$acc loop reduction(+:rw) worker
  39   do i = 1, n
  40      rw = rw + array(i)
  41   end do
  42   !$acc end parallel
  43
  44   !$acc parallel vector_length(vl) copy(rv)
  45   !$acc loop reduction(+:rv) vector
  46   do i = 1, n
  47      rv = rv + array(i)
  48   end do
  49   !$acc end parallel
  50
  51   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
  52   !$acc loop reduction(+:rc) gang worker vector
  53   do i = 1, n
  54      rc = rc + array(i)
  55   end do
  56   !$acc end parallel
  57
  58   ! Verify the results
  59   do i = 1, n
  60      vresult = vresult + array(i)
  61   end do
  62
  63   if (rg .ne. vresult) STOP 1
  64   if (rw .ne. vresult) STOP 2
  65   if (rv .ne. vresult) STOP 3
  66   if (rc .ne. vresult) STOP 4
  67
  68   !
  69   ! '*' reductions
  70   !
  71
  72   rg = 1
  73   rw = 1
  74   rv = 1
  75   rc = 1
  76   vresult = 1
  77
  78   !$acc parallel num_gangs(ng) copy(rg)
  79   !$acc loop reduction(*:rg) gang
  80   do i = 1, n
  81      rg = rg * array(i)
  82   end do
  83   !$acc end parallel
  84
  85   !$acc parallel num_workers(nw) copy(rw)
  86   !$acc loop reduction(*:rw) worker
  87   do i = 1, n
  88      rw = rw * array(i)
  89   end do
  90   !$acc end parallel
  91
  92   !$acc parallel vector_length(vl) copy(rv)
  93   !$acc loop reduction(*:rv) vector
  94   do i = 1, n
  95      rv = rv * array(i)
  96   end do
  97   !$acc end parallel
  98
  99   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
 100   !$acc loop reduction(*:rc) gang worker vector
 101   do i = 1, n
 102      rc = rc * array(i)
 103   end do
 104   !$acc end parallel
 105
 106   ! Verify the results
 107   do i = 1, n
 108      vresult = vresult * array(i)
 109   end do
 110
 111   if (rg .ne. vresult) STOP 5
 112   if (rw .ne. vresult) STOP 6
 113   if (rv .ne. vresult) STOP 7
 114   if (rc .ne. vresult) STOP 8
 115
 116   !
 117   ! 'max' reductions
 118   !
 119
 120   rg = 0
 121   rw = 0
 122   rv = 0
 123   rc = 0
 124   vresult = 0
 125
 126   !$acc parallel num_gangs(ng) copy(rg)
 127   !$acc loop reduction(max:rg) gang
 128   do i = 1, n
 129      rg = max (rg, array(i))
 130   end do
 131   !$acc end parallel
 132
 133   !$acc parallel num_workers(nw) copy(rw)
 134   !$acc loop reduction(max:rw) worker
 135   do i = 1, n
 136      rw = max (rw, array(i))
 137   end do
 138   !$acc end parallel
 139
 140   !$acc parallel vector_length(vl) copy(rv)
 141   !$acc loop reduction(max:rv) vector
 142   do i = 1, n
 143      rv = max (rv, array(i))
 144   end do
 145   !$acc end parallel
 146
 147   !$acc parallel num_gangs(ng) Num_workers(nw) vector_length(vl) copy(rc)
 148   !$acc loop reduction(max:rc) gang worker vector
 149   do i = 1, n
 150      rc = max (rc, array(i))
 151   end do
 152   !$acc end parallel
 153
 154   ! Verify the results
 155   do i = 1, n
 156      vresult = max (vresult, array(i))
 157   end do
 158
 159   if (rg .ne. vresult) STOP 9
 160   if (rw .ne. vresult) STOP 10
 161   if (rv .ne. vresult) STOP 11
 162   if (rc .ne. vresult) STOP 12
 163
 164   !
 165   ! 'min' reductions
 166   !
 167
 168   rg = 0
 169   rw = 0
 170   rv = 0
 171   rc = 0
 172   vresult = 0
 173
 174   !$acc parallel num_gangs(ng) copy(rg)
 175   !$acc loop reduction(min:rg) gang
 176   do i = 1, n
 177      rg = min (rg, array(i))
 178   end do
 179   !$acc end parallel
 180
 181   !$acc parallel num_workers(nw) copy(rw)
 182   !$acc loop reduction(min:rw) worker
 183   do i = 1, n
 184      rw = min (rw, array(i))
 185   end do
 186   !$acc end parallel
 187
 188   !$acc parallel vector_length(vl) copy(rv)
 189   !$acc loop reduction(min:rv) vector
 190   do i = 1, n
 191      rv = min (rv, array(i))
 192   end do
 193   !$acc end parallel
 194
 195   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
 196   !$acc loop reduction(min:rc) gang worker vector
 197   do i = 1, n
 198      rc = min (rc, array(i))
 199   end do
 200   !$acc end parallel
 201
 202   ! Verify the results
 203   do i = 1, n
 204      vresult = min (vresult, array(i))
 205   end do
 206
 207   if (rg .ne. vresult) STOP 13
 208   if (rw .ne. vresult) STOP 14
 209   if (rv .ne. vresult) STOP 15
 210   if (rc .ne. vresult) STOP 16
 211
 212   !
 213   ! 'iand' reductions
 214   !
 215
 216   rg = 1
 217   rw = 1
 218   rv = 1
 219   rc = 1
 220   vresult = 1
 221
 222   !$acc parallel num_gangs(ng) copy(rg)
 223   !$acc loop reduction(iand:rg) gang
 224   do i = 1, n
 225      rg = iand (rg, array(i))
 226   end do
 227   !$acc end parallel
 228
 229   !$acc parallel num_workers(nw) copy(rw)
 230   !$acc loop reduction(iand:rw) worker
 231   do i = 1, n
 232      rw = iand (rw, array(i))
 233   end do
 234   !$acc end parallel
 235
 236   !$acc parallel vector_length(vl) copy(rv)
 237   !$acc loop reduction(iand:rv) vector
 238   do i = 1, n
 239      rv = iand (rv, array(i))
 240   end do
 241   !$acc end parallel
 242
 243   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
 244   !$acc loop reduction(iand:rc) gang worker vector
 245   do i = 1, n
 246      rc = iand (rc, array(i))
 247   end do
 248   !$acc end parallel
 249
 250   ! Verify the results
 251   do i = 1, n
 252      vresult = iand (vresult, array(i))
 253   end do
 254
 255   if (rg .ne. vresult) STOP 17
 256   if (rw .ne. vresult) STOP 18
 257   if (rv .ne. vresult) STOP 19
 258   if (rc .ne. vresult) STOP 20
 259
 260   !
 261   ! 'ior' reductions
 262   !
 263
 264   rg = 0
 265   rw = 0
 266   rv = 0
 267   rc = 0
 268   vresult = 0
 269
 270   !$acc parallel num_gangs(ng) copy(rg)
 271   !$acc loop reduction(ior:rg) gang
 272   do i = 1, n
 273      rg = ior (rg, array(i))
 274   end do
 275   !$acc end parallel
 276
 277   !$acc parallel num_workers(nw) copy(rw)
 278   !$acc loop reduction(ior:rw) worker
 279   do i = 1, n
 280      rw = ior (rw, array(i))
 281   end do
 282   !$acc end parallel
 283
 284   !$acc parallel vector_length(vl) copy(rv)
 285   ! { dg-warning "region is vector partitioned but does not contain vector partitioned code" "" { target *-*-* } .-1 }
 286   !$acc loop reduction(ior:rv) gang
 287   do i = 1, n
 288      rv = ior (rv, array(i))
 289   end do
 290   !$acc end parallel
 291
 292   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
 293   !$acc loop reduction(ior:rc) gang worker vector
 294   do i = 1, n
 295      rc = ior (rc, array(i))
 296   end do
 297   !$acc end parallel
 298
 299   ! Verify the results
 300   do i = 1, n
 301      vresult = ior (vresult, array(i))
 302   end do
 303
 304   if (rg .ne. vresult) STOP 21
 305   if (rw .ne. vresult) STOP 22
 306   if (rv .ne. vresult) STOP 23
 307   if (rc .ne. vresult) STOP 24
 308
 309   !
 310   ! 'ieor' reductions
 311   !
 312
 313   rg = 0
 314   rw = 0
 315   rv = 0
 316   rc = 0
 317   vresult = 0
 318
 319   !$acc parallel num_gangs(ng) copy(rg)
 320   !$acc loop reduction(ieor:rg) gang
 321   do i = 1, n
 322      rg = ieor (rg, array(i))
 323   end do
 324   !$acc end parallel
 325
 326   !$acc parallel num_workers(nw) copy(rw)
 327   !$acc loop reduction(ieor:rw) worker
 328   do i = 1, n
 329      rw = ieor (rw, array(i))
 330   end do
 331   !$acc end parallel
 332
 333   !$acc parallel vector_length(vl) copy(rv)
 334   !$acc loop reduction(ieor:rv) vector
 335   do i = 1, n
 336      rv = ieor (rv, array(i))
 337   end do
 338   !$acc end parallel
 339
 340   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
 341   !$acc loop reduction(ieor:rc) gang worker vector
 342   do i = 1, n
 343      rc = ieor (rc, array(i))
 344   end do
 345   !$acc end parallel
 346
 347   ! Verify the results
 348   do i = 1, n
 349      vresult = ieor (vresult, array(i))
 350   end do
 351
 352   if (rg .ne. vresult) STOP 25
 353   if (rw .ne. vresult) STOP 26
 354   if (rv .ne. vresult) STOP 27
 355   if (rc .ne. vresult) STOP 28
 356
 357   !
 358   ! '.and.' reductions
 359   !
 360
 361   lrg = .true.
 362   lrw = .true.
 363   lrv = .true.
 364   lrc = .true.
 365   lvresult = .true.
 366
 367   !$acc parallel num_gangs(ng) copy(lrg)
 368   !$acc loop reduction(.and.:lrg) gang
 369   do i = 1, n
 370      lrg = lrg .and. (array(i) .ge. 5)
 371   end do
 372   !$acc end parallel
 373
 374   !$acc parallel num_workers(nw) copy(lrw)
 375   !$acc loop reduction(.and.:lrw) worker
 376   do i = 1, n
 377      lrw = lrw .and. (array(i) .ge. 5)
 378   end do
 379   !$acc end parallel
 380
 381   !$acc parallel vector_length(vl) copy(lrv)
 382   !$acc loop reduction(.and.:lrv) vector
 383   do i = 1, n
 384      lrv = lrv .and. (array(i) .ge. 5)
 385   end do
 386   !$acc end parallel
 387
 388   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
 389   !$acc loop reduction(.and.:lrc) gang worker vector
 390   do i = 1, n
 391      lrc = lrc .and. (array(i) .ge. 5)
 392   end do
 393   !$acc end parallel
 394
 395   ! Verify the results
 396   do i = 1, n
 397      lvresult = lvresult .and. (array(i) .ge. 5)
 398   end do
 399
 400   if (lrg .neqv. lvresult) STOP 29
 401   if (lrw .neqv. lvresult) STOP 30
 402   if (lrv .neqv. lvresult) STOP 31
 403   if (lrc .neqv. lvresult) STOP 32
 404
 405   !
 406   ! '.or.' reductions
 407   !
 408
 409   lrg = .true.
 410   lrw = .true.
 411   lrv = .true.
 412   lrc = .true.
 413   lvresult = .false.
 414
 415   !$acc parallel num_gangs(ng) copy(lrg)
 416   !$acc loop reduction(.or.:lrg) gang
 417   do i = 1, n
 418      lrg = lrg .or. (array(i) .ge. 5)
 419   end do
 420   !$acc end parallel
 421
 422   !$acc parallel num_workers(nw) copy(lrw)
 423   !$acc loop reduction(.or.:lrw) worker
 424   do i = 1, n
 425      lrw = lrw .or. (array(i) .ge. 5)
 426   end do
 427   !$acc end parallel
 428
 429   !$acc parallel vector_length(vl) copy(lrv)
 430   !$acc loop reduction(.or.:lrv) vector
 431   do i = 1, n
 432      lrv = lrv .or. (array(i) .ge. 5)
 433   end do
 434   !$acc end parallel
 435
 436   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
 437   !$acc loop reduction(.or.:lrc) gang worker vector
 438   do i = 1, n
 439      lrc = lrc .or. (array(i) .ge. 5)
 440   end do
 441   !$acc end parallel
 442
 443   ! Verify the results
 444   do i = 1, n
 445      lvresult = lvresult .or. (array(i) .ge. 5)
 446   end do
 447
 448   if (lrg .neqv. lvresult) STOP 33
 449   if (lrw .neqv. lvresult) STOP 34
 450   if (lrv .neqv. lvresult) STOP 35
 451   if (lrc .neqv. lvresult) STOP 36
 452
 453   !
 454   ! '.eqv.' reductions
 455   !
 456
 457   lrg = .true.
 458   lrw = .true.
 459   lrv = .true.
 460   lrc = .true.
 461   lvresult = .true.
 462
 463   !$acc parallel num_gangs(ng) copy(lrg)
 464   !$acc loop reduction(.eqv.:lrg) gang
 465   do i = 1, n
 466      lrg = lrg .eqv. (array(i) .ge. 5)
 467   end do
 468   !$acc end parallel
 469
 470   !$acc parallel num_workers(nw) copy(lrw)
 471   !$acc loop reduction(.eqv.:lrw) worker
 472   do i = 1, n
 473      lrw = lrw .eqv. (array(i) .ge. 5)
 474   end do
 475   !$acc end parallel
 476
 477   !$acc parallel vector_length(vl) copy(lrv)
 478   !$acc loop reduction(.eqv.:lrv) vector
 479   do i = 1, n
 480      lrv = lrv .eqv. (array(i) .ge. 5)
 481   end do
 482   !$acc end parallel
 483
 484   !$acc parallel num_workers(nw) vector_length(vl) copy(lrc)
 485   !$acc loop reduction(.eqv.:lrc) gang worker vector
 486   do i = 1, n
 487      lrc = lrc .eqv. (array(i) .ge. 5)
 488   end do
 489   !$acc end parallel
 490
 491   ! Verify the results
 492   do i = 1, n
 493      lvresult = lvresult .eqv. (array(i) .ge. 5)
 494   end do
 495
 496   if (lrg .neqv. lvresult) STOP 37
 497   if (lrw .neqv. lvresult) STOP 38
 498   if (lrv .neqv. lvresult) STOP 39
 499   if (lrc .neqv. lvresult) STOP 40
 500
 501   !
 502   ! '.neqv.' reductions
 503   !
 504
 505   lrg = .true.
 506   lrw = .true.
 507   lrv = .true.
 508   lrc = .true.
 509   lvresult = .true.
 510
 511   !$acc parallel num_gangs(ng) copy(lrg)
 512   !$acc loop reduction(.neqv.:lrg) gang
 513   do i = 1, n
 514      lrg = lrg .neqv. (array(i) .ge. 5)
 515   end do
 516   !$acc end parallel
 517
 518   !$acc parallel num_workers(nw) copy(lrw)
 519   !$acc loop reduction(.neqv.:lrw) worker
 520   do i = 1, n
 521      lrw = lrw .neqv. (array(i) .ge. 5)
 522   end do
 523   !$acc end parallel
 524
 525   !$acc parallel vector_length(vl) copy(lrv)
 526   !$acc loop reduction(.neqv.:lrv) vector
 527   do i = 1, n
 528      lrv = lrv .neqv. (array(i) .ge. 5)
 529   end do
 530   !$acc end parallel
 531
 532   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
 533   !$acc loop reduction(.neqv.:lrc) gang worker vector
 534   do i = 1, n
 535      lrc = lrc .neqv. (array(i) .ge. 5)
 536   end do
 537   !$acc end parallel
 538
 539   ! Verify the results
 540   do i = 1, n
 541      lvresult = lvresult .neqv. (array(i) .ge. 5)
 542   end do
 543
 544   if (lrg .neqv. lvresult) STOP 41
 545   if (lrw .neqv. lvresult) STOP 42
 546   if (lrv .neqv. lvresult) STOP 43
 547   if (lrc .neqv. lvresult) STOP 44
 548 end program reduction_1