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

100 lines
2.0 KiB
Fortran

! { dg-do run }
! { dg-additional-options "-w" }
! subroutine reduction
program reduction
integer, parameter :: n = 40, c = 10
integer :: i, vsum, gs, ws, vs, cs, ns
call redsub_gang (gs, n, c)
call redsub_worker (ws, n, c)
call redsub_vector (vs, n, c)
call redsub_combined (cs, n, c)
call redsub_nested (ns, n, c)
vsum = 0
! Verify the results
do i = 1, n
vsum = vsum + c
end do
if (gs .ne. vsum) call abort ()
if (ws .ne. vsum) call abort ()
if (vs .ne. vsum) call abort ()
if (cs .ne. vsum) call abort ()
if (ns .ne. vsum) call abort ()
end program reduction
subroutine redsub_gang(sum, n, c)
integer :: sum, n, c
sum = 0
!$acc parallel copyin (n, c) num_gangs(n) copy(sum)
!$acc loop reduction(+:sum) gang
do i = 1, n
sum = sum + c
end do
!$acc end parallel
end subroutine redsub_gang
subroutine redsub_worker(sum, n, c)
integer :: sum, n, c
sum = 0
!$acc parallel copyin (n, c) num_workers(4) vector_length (32) copy(sum)
!$acc loop reduction(+:sum) worker
do i = 1, n
sum = sum + c
end do
!$acc end parallel
end subroutine redsub_worker
subroutine redsub_vector(sum, n, c)
integer :: sum, n, c
sum = 0
!$acc parallel copyin (n, c) vector_length(32) copy(sum)
!$acc loop reduction(+:sum) vector
do i = 1, n
sum = sum + c
end do
!$acc end parallel
end subroutine redsub_vector
subroutine redsub_combined(sum, n, c)
integer :: sum, n, c
sum = 0
!$acc parallel num_gangs (8) num_workers (4) vector_length(32) copy(sum)
!$acc loop reduction(+:sum) gang worker vector
do i = 1, n
sum = sum + c
end do
!$acc end parallel
end subroutine redsub_combined
subroutine redsub_nested(sum, n, c)
integer :: sum, n, c
integer :: ii, jj
ii = n / 10;
jj = 10;
sum = 0
!$acc parallel num_gangs (8) copy(sum)
!$acc loop reduction(+:sum) gang
do i = 1, ii
!$acc loop reduction(+:sum) vector
do j = 1, jj
sum = sum + c
end do
end do
!$acc end parallel
end subroutine redsub_nested