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

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