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

! Miscellaneous tests for private variables.

! { dg-do run }


! Test of gang-private variables declared on loop directive.

subroutine t1()
  integer :: x, i, arr(32)

  do i = 1, 32
     arr(i) = i
  end do

  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  !$acc loop gang private(x)
  do i = 1, 32
     x = i * 2;
     arr(i) = arr(i) + x
  end do
  !$acc end parallel

  do i = 1, 32
     if (arr(i) .ne. i * 3) call abort
  end do
end subroutine t1


! Test of gang-private variables declared on loop directive, with broadcasting
! to partitioned workers.

subroutine t2()
  integer :: x, i, j, arr(0:32*32)

  do i = 0, 32*32-1
     arr(i) = i
  end do

  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  !$acc loop gang private(x)
  do i = 0, 31
     x = i * 2;

     !$acc loop worker
     do j = 0, 31
        arr(i * 32 + j) = arr(i * 32 + j) + x
     end do
  end do
  !$acc end parallel

  do i = 0, 32 * 32 - 1
     if (arr(i) .ne. i + (i / 32) * 2) call abort
  end do
end subroutine t2


! Test of gang-private variables declared on loop directive, with broadcasting
! to partitioned vectors.

subroutine t3()
  integer :: x, i, j, arr(0:32*32)

  do i = 0, 32*32-1
     arr(i) = i
  end do

  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  !$acc loop gang private(x)
  do i = 0, 31
     x = i * 2;

     !$acc loop vector
     do j = 0, 31
        arr(i * 32 + j) = arr(i * 32 + j) + x
     end do
  end do
  !$acc end parallel

  do i = 0, 32 * 32 - 1
     if (arr(i) .ne. i + (i / 32) * 2) call abort
  end do
end subroutine t3


! Test of gang-private addressable variable declared on loop directive, with
! broadcasting to partitioned workers.

subroutine t4()
  type vec3
     integer x, y, z, attr(13)
  end type vec3

  integer i, j, arr(0:32*32)
  type(vec3) pt
  
  do i = 0, 32*32-1
     arr(i) = i
  end do

  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  !$acc loop gang private(pt)
  do i = 0, 31
     pt%x = i
     pt%y = i * 2
     pt%z = i * 4
     pt%attr(5) = i * 6

     !$acc loop vector
     do j = 0, 31
        arr(i * 32 + j) = arr(i * 32 + j) + pt%x + pt%y + pt%z + pt%attr(5);
     end do
  end do
  !$acc end parallel

  do i = 0, 32 * 32 - 1
     if (arr(i) .ne. i + (i / 32) * 13) call abort
  end do
end subroutine t4


! Test of vector-private variables declared on loop directive.

subroutine t5()
  integer :: x, i, j, k, idx, arr(0:32*32*32)

  do i = 0, 32*32*32-1
     arr(i) = i
  end do

  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  !$acc loop gang
  do i = 0, 31
     !$acc loop worker
     do j = 0, 31
        !$acc loop vector private(x)
        do k = 0, 31
           x = ieor(i, j * 3)
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
        end do
        !$acc loop vector private(x)
        do k = 0, 31
           x = ior(i, j * 5)
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
        end do
     end do
  end do
  !$acc end parallel

  do i = 0, 32 - 1
     do j = 0, 32 -1
        do k = 0, 32 - 1
           idx = i * 1024 + j * 32 + k
           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
              call abort
           end if
        end do
     end do
  end do
end subroutine t5


! Test of vector-private variables declared on loop directive. Array type.

subroutine t6()
  integer :: i, j, k, idx, arr(0:32*32*32), pt(2)

  do i = 0, 32*32*32-1
     arr(i) = i
  end do

  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  !$acc loop gang
  do i = 0, 31
     !$acc loop worker
     do j = 0, 31
        !$acc loop vector private(x, pt)
        do k = 0, 31
           pt(1) = ieor(i, j * 3)
           pt(2) = ior(i, j * 5)
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(1) * k
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(2) * k
        end do
     end do
  end do
  !$acc end parallel

  do i = 0, 32 - 1
     do j = 0, 32 -1
        do k = 0, 32 - 1
           idx = i * 1024 + j * 32 + k
           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
              call abort
           end if
        end do
     end do
  end do
end subroutine t6


! Test of worker-private variables declared on a loop directive.

subroutine t7()
  integer :: x, i, j, arr(0:32*32)
  common x

  do i = 0, 32*32-1
     arr(i) = i
  end do

  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  !$acc loop gang private(x)
  do i = 0, 31
     !$acc loop worker private(x)
     do j = 0, 31
        x = ieor(i, j * 3)
        arr(i * 32 + j) = arr(i * 32 + j) + x
     end do
  end do
  !$acc end parallel

  do i = 0, 32 * 32 - 1
     if (arr(i) .ne. i + ieor(i / 32, mod(i, 32) * 3)) call abort
  end do
end subroutine t7


! Test of worker-private variables declared on a loop directive, broadcasting
! to vector-partitioned mode.

subroutine t8()
  integer :: x, i, j, k, idx, arr(0:32*32*32)

  do i = 0, 32*32*32-1
     arr(i) = i
  end do

  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  !$acc loop gang
  do i = 0, 31
     !$acc loop worker private(x)
     do j = 0, 31
        x = ieor(i, j * 3)

        !$acc loop vector
        do k = 0, 31
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
        end do
     end do
  end do
  !$acc end parallel

  do i = 0, 32 - 1
     do j = 0, 32 -1
        do k = 0, 32 - 1
           idx = i * 1024 + j * 32 + k
           if (arr(idx) .ne. idx + ieor(i, j * 3) * k) call abort
        end do
     end do
  end do
end subroutine t8


! Test of worker-private variables declared on a loop directive, broadcasting
! to vector-partitioned mode.  Back-to-back worker loops.

subroutine t9()
  integer :: x, i, j, k, idx, arr(0:32*32*32)

  do i = 0, 32*32*32-1
     arr(i) = i
  end do

  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  !$acc loop gang
  do i = 0, 31
     !$acc loop worker private(x)
     do j = 0, 31
        x = ieor(i, j * 3)

        !$acc loop vector
        do k = 0, 31
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
        end do
     end do

     !$acc loop worker private(x)
     do j = 0, 31
        x = ior(i, j * 5)

        !$acc loop vector
        do k = 0, 31
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
        end do
     end do
  end do
  !$acc end parallel

  do i = 0, 32 - 1
     do j = 0, 32 -1
        do k = 0, 32 - 1
           idx = i * 1024 + j * 32 + k
           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
              call abort
           end if
        end do
     end do
  end do
end subroutine t9


! Test of worker-private variables declared on a loop directive, broadcasting
! to vector-partitioned mode.  Successive vector loops.  */

subroutine t10()
  integer :: x, i, j, k, idx, arr(0:32*32*32)

  do i = 0, 32*32*32-1
     arr(i) = i
  end do

  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  !$acc loop gang
  do i = 0, 31
     !$acc loop worker private(x)
     do j = 0, 31
        x = ieor(i, j * 3)

        !$acc loop vector
        do k = 0, 31
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
        end do

        x = ior(i, j * 5)

        !$acc loop vector
        do k = 0, 31
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
        end do
     end do
  end do
  !$acc end parallel

  do i = 0, 32 - 1
     do j = 0, 32 -1
        do k = 0, 32 - 1
           idx = i * 1024 + j * 32 + k
           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
              call abort
           end if
        end do
     end do
  end do
end subroutine t10


! Test of worker-private variables declared on a loop directive, broadcasting
! to vector-partitioned mode.  Addressable worker variable.

subroutine t11()
  integer :: i, j, k, idx, arr(0:32*32*32)
  integer, target :: x
  integer, pointer :: p

  do i = 0, 32*32*32-1
     arr(i) = i
  end do

  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  !$acc loop gang
  do i = 0, 31
     !$acc loop worker private(x, p)
     do j = 0, 31
        p => x
        x = ieor(i, j * 3)

        !$acc loop vector
        do k = 0, 31
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
        end do

        p = ior(i, j * 5)

        !$acc loop vector
        do k = 0, 31
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
        end do
     end do
  end do
  !$acc end parallel

  do i = 0, 32 - 1
     do j = 0, 32 -1
        do k = 0, 32 - 1
           idx = i * 1024 + j * 32 + k
           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
              call abort
           end if
        end do
     end do
  end do
end subroutine t11


! Test of worker-private variables declared on a loop directive, broadcasting
! to vector-partitioned mode.  Aggregate worker variable.

subroutine t12()
  type vec2
     integer x, y
  end type vec2
  
  integer :: i, j, k, idx, arr(0:32*32*32)
  type(vec2) :: pt
  
  do i = 0, 32*32*32-1
     arr(i) = i
  end do

  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  !$acc loop gang
  do i = 0, 31
     !$acc loop worker private(pt)
     do j = 0, 31
        pt%x = ieor(i, j * 3)
        pt%y = ior(i, j * 5)
        
        !$acc loop vector
        do k = 0, 31
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt%x * k
        end do

        !$acc loop vector
        do k = 0, 31
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt%y * k
        end do
     end do
  end do
  !$acc end parallel

  do i = 0, 32 - 1
     do j = 0, 32 -1
        do k = 0, 32 - 1
           idx = i * 1024 + j * 32 + k
           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
              call abort
           end if
        end do
     end do
  end do
end subroutine t12


! Test of worker-private variables declared on loop directive, broadcasting
! to vector-partitioned mode.  Array worker variable.

subroutine t13()
  integer :: i, j, k, idx, arr(0:32*32*32), pt(2)

  do i = 0, 32*32*32-1
     arr(i) = i
  end do

  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  !$acc loop gang
  do i = 0, 31
     !$acc loop worker private(pt)
     do j = 0, 31
        pt(1) = ieor(i, j * 3)
        pt(2) = ior(i, j * 5)
        
        !$acc loop vector
        do k = 0, 31
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(1) * k
        end do

        !$acc loop vector
        do k = 0, 31
           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(2) * k
        end do
     end do
  end do
  !$acc end parallel

  do i = 0, 32 - 1
     do j = 0, 32 -1
        do k = 0, 32 - 1
           idx = i * 1024 + j * 32 + k
           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
              call abort
           end if
        end do
     end do
  end do
end subroutine t13


! Test of gang-private variables declared on the parallel directive.

subroutine t14()
  use openacc
  integer :: x = 5
  integer, parameter :: n = 32
  integer :: arr(n)

  do i = 1, n
    arr(i) = 3
  end do

  !$acc parallel private(x) copy(arr) num_gangs(n) num_workers(8) vector_length(32)
    !$acc loop gang(static:1)
    do i = 1, n
      x = i * 2;
    end do

   !$acc loop gang(static:1)
    do i = 1, n
      if (acc_on_device (acc_device_host) .eqv. .TRUE.) x = i * 2
      arr(i) = arr(i) + x
    end do
  !$acc end parallel

  do i = 1, n
    if (arr(i) .ne. (3 + i * 2)) call abort
  end do

end subroutine t14


program main
  call t1()
  call t2()
  call t3()
  call t4()
  call t5()
  call t6()
  call t7()
  call t8()
  call t9()
  call t10()
  call t11()
  call t12()
  call t13()
  call t14()
end program main