Retro68/gcc/libgomp/testsuite/libgomp.oacc-fortran/private-variables.f90
2017-04-10 13:32:00 +02:00

545 lines
12 KiB
Fortran

! 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