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

95 lines
1.8 KiB
Fortran

! { dg-do run }
! { dg-additional-options "-cpp -w" }
program reduction
implicit none
integer, parameter :: n = 100, n2 = 1000, chunksize = 10
integer :: i, gs1, gs2, ws1, ws2, vs1, vs2, cs1, cs2, hs1, hs2
integer :: j, red, vred
gs1 = 0
gs2 = 0
ws1 = 0
ws2 = 0
vs1 = 0
vs2 = 0
cs1 = 0
cs2 = 0
hs1 = 0
hs2 = 0
!$acc parallel num_gangs (1000)
!$acc loop reduction(+:gs1, gs2) gang
do i = 1, n
gs1 = gs1 + 1
gs2 = gs2 + 2
end do
!$acc end parallel
!$acc parallel num_workers (4) vector_length (32)
!$acc loop reduction(+:ws1, ws2) worker
do i = 1, n
ws1 = ws1 + 1
ws2 = ws2 + 2
end do
!$acc end parallel
!$acc parallel vector_length (32)
!$acc loop reduction(+:vs1, vs2) vector
do i = 1, n
vs1 = vs1 + 1
vs2 = vs2 + 2
end do
!$acc end parallel
!$acc parallel num_gangs(8) num_workers(4) vector_length(32)
!$acc loop reduction(+:cs1, cs2) gang worker vector
do i = 1, n
cs1 = cs1 + 1
cs2 = cs2 + 2
end do
!$acc end parallel
! Verify the results on the host
do i = 1, n
hs1 = hs1 + 1
hs2 = hs2 + 2
end do
if (gs1 .ne. hs1) call abort ()
if (gs2 .ne. hs2) call abort ()
if (ws1 .ne. hs1) call abort ()
if (ws2 .ne. hs2) call abort ()
if (vs1 .ne. hs1) call abort ()
if (vs2 .ne. hs2) call abort ()
if (cs1 .ne. hs1) call abort ()
if (cs2 .ne. hs2) call abort ()
! Nested reductions.
red = 0
vred = 0
!$acc parallel num_gangs(10) vector_length(32)
!$acc loop reduction(+:red) gang
do i = 1, n/chunksize
!$acc loop reduction(+:red) vector
do j = 1, chunksize
red = red + chunksize
end do
end do
!$acc end parallel
do i = 1, n/chunksize
do j = 1, chunksize
vred = vred + chunksize
end do
end do
if (red .ne. vred) call abort ()
end program reduction