c42cfb5ca3
gcc/ PR lto/70289 PR ipa/70348 PR tree-optimization/70373 PR middle-end/70533 PR middle-end/70534 PR middle-end/70535 * gimplify.c (gimplify_adjust_omp_clauses): Add or adjust data clauses for acc parallel reductions as necessary. Error on those that are private. * omp-low.c (scan_sharing_clauses): Don't install variables which are used in acc parallel reductions. (lower_rec_input_clauses): Remove dead code. (lower_oacc_reductions): Add support for reference reductions. (lower_reduction_clauses): Remove dead code. (lower_omp_target): Don't remap variables appearing in acc parallel reductions. * tree.h (OMP_CLAUSE_MAP_IN_REDUCTION): New macro. gcc/testsuite/ * c-c++-common/goacc/reduction-5.c: New test. * c-c++-common/goacc/reduction-promotions.c: New test. * gfortran.dg/goacc/reduction-3.f95: New test. * gfortran.dg/goacc/reduction-promotions.f90: New test. libgomp/ * testsuite/libgomp.oacc-c-c++-common/loop-reduction-gang-np-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-gw-np-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-gwv-np-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-gwv-np-2.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-gwv-np-3.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-gwv-np-4.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-vector-p-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-vector-p-2.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-worker-p-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-wv-p-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-wv-p-2.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-wv-p-3.c: New test. * testsuite/libgomp.oacc-c-c++-common/par-loop-comb-reduction-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/par-loop-comb-reduction-2.c: New test. * testsuite/libgomp.oacc-c-c++-common/par-loop-comb-reduction-3.c: New test. * testsuite/libgomp.oacc-c-c++-common/par-loop-comb-reduction-4.c: New test. * testsuite/libgomp.oacc-c-c++-common/par-reduction-1.c: Add test coverage. * testsuite/libgomp.oacc-c-c++-common/par-reduction-2.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/parallel-dims.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/parallel-reduction.c: New test. * testsuite/libgomp.oacc-c-c++-common/pr70289.c: New test. * testsuite/libgomp.oacc-c-c++-common/pr70373.c: New test. * testsuite/libgomp.oacc-c-c++-common/reduction-1.c: Add test coverage. * testsuite/libgomp.oacc-c-c++-common/reduction-2.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/reduction-3.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/reduction-4.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/reduction-5.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/reduction-6.c: New test. * testsuite/libgomp.oacc-c-c++-common/reduction.h: New test. * testsuite/libgomp.oacc-fortran/parallel-reduction.f90: New test. * testsuite/libgomp.oacc-fortran/pr70289.f90: New test. * testsuite/libgomp.oacc-fortran/reduction-1.f90: Add test coverage. * testsuite/libgomp.oacc-fortran/reduction-2.f90: Likewise. * testsuite/libgomp.oacc-fortran/reduction-3.f90: Likewise. * testsuite/libgomp.oacc-fortran/reduction-4.f90: Likewise. * testsuite/libgomp.oacc-fortran/reduction-5.f90: Likewise. * testsuite/libgomp.oacc-fortran/reduction-6.f90: Likewise. * testsuite/libgomp.oacc-fortran/reduction-7.f90: New test. From-SVN: r234840
403 lines
8.4 KiB
Fortran
403 lines
8.4 KiB
Fortran
! { dg-do run }
|
|
|
|
! double precision reductions
|
|
|
|
program reduction_3
|
|
implicit none
|
|
|
|
integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32
|
|
integer :: i
|
|
double precision :: vresult, rg, rw, rv, rc
|
|
double precision, parameter :: e = 0.001
|
|
logical :: lrg, lrw, lrv, lrc, lvresult
|
|
double precision, dimension (n) :: array
|
|
|
|
do i = 1, n
|
|
array(i) = i
|
|
end do
|
|
|
|
!
|
|
! '+' reductions
|
|
!
|
|
|
|
rg = 0
|
|
rw = 0
|
|
rv = 0
|
|
rc = 0
|
|
vresult = 0
|
|
|
|
!$acc parallel num_gangs(ng) copy(rg)
|
|
!$acc loop reduction(+:rg) gang
|
|
do i = 1, n
|
|
rg = rg + array(i)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_workers(nw) copy(rw)
|
|
!$acc loop reduction(+:rw) worker
|
|
do i = 1, n
|
|
rw = rw + array(i)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel vector_length(vl) copy(rv)
|
|
!$acc loop reduction(+:rv) vector
|
|
do i = 1, n
|
|
rv = rv + array(i)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
|
|
!$acc loop reduction(+:rc) gang worker vector
|
|
do i = 1, n
|
|
rc = rc + array(i)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
! Verify the results
|
|
do i = 1, n
|
|
vresult = vresult + array(i)
|
|
end do
|
|
|
|
if (abs (rg - vresult) .ge. e) call abort
|
|
if (abs (rw - vresult) .ge. e) call abort
|
|
if (abs (rv - vresult) .ge. e) call abort
|
|
if (abs (rc - vresult) .ge. e) call abort
|
|
|
|
!
|
|
! '*' reductions
|
|
!
|
|
|
|
rg = 1
|
|
rw = 1
|
|
rv = 1
|
|
rc = 1
|
|
vresult = 1
|
|
|
|
!$acc parallel num_gangs(ng) copy(rg)
|
|
!$acc loop reduction(*:rg) gang
|
|
do i = 1, n
|
|
rg = rg * array(i)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_workers(nw) copy(rw)
|
|
!$acc loop reduction(*:rw) worker
|
|
do i = 1, n
|
|
rw = rw * array(i)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel vector_length(vl) copy(rv)
|
|
!$acc loop reduction(*:rv) vector
|
|
do i = 1, n
|
|
rv = rv * array(i)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
|
|
!$acc loop reduction(*:rc) gang worker vector
|
|
do i = 1, n
|
|
rc = rc * array(i)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
! Verify the results
|
|
do i = 1, n
|
|
vresult = vresult * array(i)
|
|
end do
|
|
|
|
if (abs (rg - vresult) .ge. e) call abort
|
|
if (abs (rw - vresult) .ge. e) call abort
|
|
if (abs (rv - vresult) .ge. e) call abort
|
|
if (abs (rc - vresult) .ge. e) call abort
|
|
|
|
!
|
|
! 'max' reductions
|
|
!
|
|
|
|
rg = 0
|
|
rw = 0
|
|
rv = 0
|
|
rc = 0
|
|
vresult = 0
|
|
|
|
!$acc parallel num_gangs(ng) copy(rg)
|
|
!$acc loop reduction(max:rg) gang
|
|
do i = 1, n
|
|
rg = max (rg, array(i))
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_workers(nw) copy(rw)
|
|
!$acc loop reduction(max:rw) worker
|
|
do i = 1, n
|
|
rw = max (rw, array(i))
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel vector_length(vl) copy(rv)
|
|
!$acc loop reduction(max:rv) vector
|
|
do i = 1, n
|
|
rv = max (rv, array(i))
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
|
|
!$acc loop reduction(max:rc) gang worker vector
|
|
do i = 1, n
|
|
rc = max (rc, array(i))
|
|
end do
|
|
!$acc end parallel
|
|
|
|
! Verify the results
|
|
do i = 1, n
|
|
vresult = max (vresult, array(i))
|
|
end do
|
|
|
|
if (abs (rg - vresult) .ge. e) call abort
|
|
if (abs (rw - vresult) .ge. e) call abort
|
|
if (abs (rv - vresult) .ge. e) call abort
|
|
if (abs (rc - vresult) .ge. e) call abort
|
|
|
|
!
|
|
! 'min' reductions
|
|
!
|
|
|
|
rg = 0
|
|
rw = 0
|
|
rv = 0
|
|
rc = 0
|
|
vresult = 0
|
|
|
|
!$acc parallel num_gangs(ng) copy(rg)
|
|
!$acc loop reduction(min:rg) gang
|
|
do i = 1, n
|
|
rg = min (rg, array(i))
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_workers(nw) copy(rw)
|
|
!$acc loop reduction(min:rw) worker
|
|
do i = 1, n
|
|
rw = min (rw, array(i))
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel vector_length(vl) copy(rv)
|
|
!$acc loop reduction(min:rv) vector
|
|
do i = 1, n
|
|
rv = min (rv, array(i))
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
|
|
!$acc loop reduction(min:rc) gang worker vector
|
|
do i = 1, n
|
|
rc = min (rc, array(i))
|
|
end do
|
|
!$acc end parallel
|
|
|
|
! Verify the results
|
|
do i = 1, n
|
|
vresult = min (vresult, array(i))
|
|
end do
|
|
|
|
if (rg .ne. vresult) call abort
|
|
if (rw .ne. vresult) call abort
|
|
if (rv .ne. vresult) call abort
|
|
if (rc .ne. vresult) call abort
|
|
|
|
!
|
|
! '.and.' reductions
|
|
!
|
|
|
|
lrg = .true.
|
|
lrw = .true.
|
|
lrv = .true.
|
|
lrc = .true.
|
|
lvresult = .true.
|
|
|
|
!$acc parallel num_gangs(ng) copy(lrg)
|
|
!$acc loop reduction(.and.:lrg) gang
|
|
do i = 1, n
|
|
lrg = lrg .and. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_workers(nw) copy(lrw)
|
|
!$acc loop reduction(.and.:lrw) worker
|
|
do i = 1, n
|
|
lrw = lrw .and. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel vector_length(vl) copy(lrv)
|
|
!$acc loop reduction(.and.:lrv) vector
|
|
do i = 1, n
|
|
lrv = lrv .and. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
|
|
!$acc loop reduction(.and.:lrc) gang worker vector
|
|
do i = 1, n
|
|
lrc = lrc .and. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
! Verify the results
|
|
do i = 1, n
|
|
lvresult = lvresult .and. (array(i) .ge. 5)
|
|
end do
|
|
|
|
if (lrg .neqv. lvresult) call abort
|
|
if (lrw .neqv. lvresult) call abort
|
|
if (lrv .neqv. lvresult) call abort
|
|
if (lrc .neqv. lvresult) call abort
|
|
|
|
!
|
|
! '.or.' reductions
|
|
!
|
|
|
|
lrg = .false.
|
|
lrw = .false.
|
|
lrv = .false.
|
|
lrc = .false.
|
|
lvresult = .false.
|
|
|
|
!$acc parallel num_gangs(ng) copy(lrg)
|
|
!$acc loop reduction(.or.:lrg) gang
|
|
do i = 1, n
|
|
lrg = lrg .or. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_workers(nw) copy(lrw)
|
|
!$acc loop reduction(.or.:lrw) worker
|
|
do i = 1, n
|
|
lrw = lrw .or. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel vector_length(vl) copy(lrv)
|
|
!$acc loop reduction(.or.:lrv) vector
|
|
do i = 1, n
|
|
lrv = lrv .or. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
|
|
!$acc loop reduction(.or.:lrc) gang worker vector
|
|
do i = 1, n
|
|
lrc = lrc .or. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
! Verify the results
|
|
do i = 1, n
|
|
lvresult = lvresult .or. (array(i) .ge. 5)
|
|
end do
|
|
|
|
if (lrg .neqv. lvresult) call abort
|
|
if (lrw .neqv. lvresult) call abort
|
|
if (lrv .neqv. lvresult) call abort
|
|
if (lrc .neqv. lvresult) call abort
|
|
|
|
!
|
|
! '.eqv.' reductions
|
|
!
|
|
|
|
lrg = .true.
|
|
lrw = .true.
|
|
lrv = .true.
|
|
lrc = .true.
|
|
lvresult = .true.
|
|
|
|
!$acc parallel num_gangs(ng) copy(lrg)
|
|
!$acc loop reduction(.eqv.:lrg) gang
|
|
do i = 1, n
|
|
lrg = lrg .eqv. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_workers(nw) copy(lrw)
|
|
!$acc loop reduction(.eqv.:lrw) worker
|
|
do i = 1, n
|
|
lrw = lrw .eqv. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel vector_length(vl) copy(lrv)
|
|
!$acc loop reduction(.eqv.:lrv) vector
|
|
do i = 1, n
|
|
lrv = lrv .eqv. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
|
|
!$acc loop reduction(.eqv.:lrc) gang worker vector
|
|
do i = 1, n
|
|
lrc = lrc .eqv. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
! Verify the results
|
|
do i = 1, n
|
|
lvresult = lvresult .eqv. (array(i) .ge. 5)
|
|
end do
|
|
|
|
if (lrg .neqv. lvresult) call abort
|
|
if (lrw .neqv. lvresult) call abort
|
|
if (lrv .neqv. lvresult) call abort
|
|
if (lrc .neqv. lvresult) call abort
|
|
|
|
!
|
|
! '.neqv.' reductions
|
|
!
|
|
|
|
lrg = .true.
|
|
lrw = .true.
|
|
lrv = .true.
|
|
lrc = .true.
|
|
lvresult = .true.
|
|
|
|
!$acc parallel num_gangs(ng) copy(lrg)
|
|
!$acc loop reduction(.neqv.:lrg) gang
|
|
do i = 1, n
|
|
lrg = lrg .neqv. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_workers(nw) copy(lrw)
|
|
!$acc loop reduction(.neqv.:lrw) worker
|
|
do i = 1, n
|
|
lrw = lrw .neqv. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel vector_length(vl) copy(lrv)
|
|
!$acc loop reduction(.neqv.:lrv) vector
|
|
do i = 1, n
|
|
lrv = lrv .neqv. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
!$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
|
|
!$acc loop reduction(.neqv.:lrc) gang worker vector
|
|
do i = 1, n
|
|
lrc = lrc .neqv. (array(i) .ge. 5)
|
|
end do
|
|
!$acc end parallel
|
|
|
|
! Verify the results
|
|
do i = 1, n
|
|
lvresult = lvresult .neqv. (array(i) .ge. 5)
|
|
end do
|
|
|
|
if (lrg .neqv. lvresult) call abort
|
|
if (lrw .neqv. lvresult) call abort
|
|
if (lrv .neqv. lvresult) call abort
|
|
if (lrc .neqv. lvresult) call abort
|
|
end program reduction_3
|