1! { dg-do run } 2 3! { dg-additional-options "-Wopenacc-parallelism" } for testing/documenting 4! aspects of that functionality. 5 6! Integer reductions 7 8program 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 548end program reduction_1 549