libgomp/testsuite/libgomp.oacc-fortran/private-variables.f90

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