diff options
Diffstat (limited to 'libgomp/testsuite/libgomp.oacc-fortran')
9 files changed, 1358 insertions, 233 deletions
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/parallel-reduction.f90 b/libgomp/testsuite/libgomp.oacc-fortran/parallel-reduction.f90 new file mode 100644 index 00000000000..31db7e12454 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/parallel-reduction.f90 @@ -0,0 +1,47 @@ +! { dg-do run } +! { dg-additional-options "-w" } + +program reduction + implicit none + integer, parameter :: n = 10 + integer s1, s2 + include "openacc_lib.h" + + s1 = 0 + s2 = 0 + + !$acc parallel reduction(+:s1,s2) num_gangs (n) copy(s1) + s1 = s1 + 1 + s2 = s2 + 1 + !$acc end parallel + + if (acc_get_device_type () .eq. acc_device_nvidia) then + if (s1 .ne. n) call abort + if (s2 .ne. n) call abort + else + if (s1 .ne. 1) call abort + if (s2 .ne. 1) call abort + end if + + ! Test reductions inside subroutines + + s1 = 0 + s2 = 0 + call redsub (s1, s2, n) + + if (acc_get_device_type () .eq. acc_device_nvidia) then + if (s1 .ne. n) call abort + else + if (s2 .ne. 1) call abort + end if +end program reduction + +subroutine redsub(s1, s2, n) + implicit none + integer :: s1, s2, n + + !$acc parallel reduction(+:s1,s2) num_gangs (10) copy(s1) + s1 = s1 + 1 + s2 = s2 + 1 + !$acc end parallel +end subroutine redsub diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr70289.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr70289.f90 new file mode 100644 index 00000000000..63bde44100d --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/pr70289.f90 @@ -0,0 +1,20 @@ +program foo + implicit none + integer :: i + integer :: temp = 0 + integer :: temp2 = 0 + + !$acc parallel + !$acc loop gang private(temp) + do i=1, 10000 + temp = 0 + enddo + !$acc end parallel + + !$acc parallel reduction(+:temp2) + !$acc loop gang reduction(+:temp2) + do i=1, 10000 + temp2 = 0 + enddo + !$acc end parallel +end program foo diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-1.f90 index db0a52d6a49..e51509f3397 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/reduction-1.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-1.f90 @@ -1,28 +1,55 @@ ! { dg-do run } +! { dg-additional-options "-w" } ! Integer reductions program reduction_1 implicit none - integer, parameter :: n = 10, vl = 32 - integer :: i, vresult, result - logical :: lresult, lvresult + integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32 + integer :: i, vresult, rg, rw, rv, rc + logical :: lrg, lrw, lrv, lrc, lvresult integer, dimension (n) :: array do i = 1, n array(i) = i end do - result = 0 + ! + ! '+' reductions + ! + + rg = 0 + rw = 0 + rv = 0 + rc = 0 vresult = 0 - ! '+' reductions + !$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 vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(+:result) + !$acc parallel num_workers(nw) copy(rw) + !$acc loop reduction(+:rw) worker do i = 1, n - result = result + array(i) + 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 @@ -31,17 +58,46 @@ program reduction_1 vresult = vresult + array(i) end do - if (result.ne.vresult) call abort - - result = 0 - vresult = 0 + if (rg .ne. vresult) call abort + if (rw .ne. vresult) call abort + if (rv .ne. vresult) call abort + if (rc .ne. vresult) call abort + ! ! '*' reductions + ! - !$acc parallel vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(*:result) + 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 - result = result * array(i) + 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 @@ -50,17 +106,46 @@ program reduction_1 vresult = vresult * array(i) end do - if (result.ne.vresult) call abort + if (rg .ne. vresult) call abort + if (rw .ne. vresult) call abort + if (rv .ne. vresult) call abort + if (rc .ne. vresult) call abort + + ! + ! 'max' reductions + ! - result = 0 + rg = 0 + rw = 0 + rv = 0 + rc = 0 vresult = 0 - ! 'max' reductions + !$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 vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(max:result) + !$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 - result = max (result, array(i)) + rc = max (rc, array(i)) end do !$acc end parallel @@ -69,17 +154,46 @@ program reduction_1 vresult = max (vresult, array(i)) end do - if (result.ne.vresult) call abort - - result = 1 - vresult = 1 + if (rg .ne. vresult) call abort + if (rw .ne. vresult) call abort + if (rv .ne. vresult) call abort + if (rc .ne. vresult) 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 vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(min:result) + !$acc parallel num_workers(nw) copy(rw) + !$acc loop reduction(min:rw) worker do i = 1, n - result = min (result, array(i)) + 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 @@ -88,17 +202,46 @@ program reduction_1 vresult = min (vresult, array(i)) end do - if (result.ne.vresult) call abort + if (rg .ne. vresult) call abort + if (rw .ne. vresult) call abort + if (rv .ne. vresult) call abort + if (rc .ne. vresult) call abort + + ! + ! 'iand' reductions + ! - result = 1 + rg = 1 + rw = 1 + rv = 1 + rc = 1 vresult = 1 - ! 'iand' reductions + !$acc parallel num_gangs(ng) copy(rg) + !$acc loop reduction(iand:rg) gang + do i = 1, n + rg = iand (rg, array(i)) + end do + !$acc end parallel + + !$acc parallel num_workers(nw) copy(rw) + !$acc loop reduction(iand:rw) worker + do i = 1, n + rw = iand (rw, array(i)) + end do + !$acc end parallel + + !$acc parallel vector_length(vl) copy(rv) + !$acc loop reduction(iand:rv) vector + do i = 1, n + rv = iand (rv, array(i)) + end do + !$acc end parallel - !$acc parallel vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(iand:result) + !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc) + !$acc loop reduction(iand:rc) gang worker vector do i = 1, n - result = iand (result, array(i)) + rc = iand (rc, array(i)) end do !$acc end parallel @@ -107,17 +250,46 @@ program reduction_1 vresult = iand (vresult, array(i)) end do - if (result.ne.vresult) call abort - - result = 1 - vresult = 1 + if (rg .ne. vresult) call abort + if (rw .ne. vresult) call abort + if (rv .ne. vresult) call abort + if (rc .ne. vresult) call abort + ! ! 'ior' reductions + ! + + rg = 0 + rw = 0 + rv = 0 + rc = 0 + vresult = 0 + + !$acc parallel num_gangs(ng) copy(rg) + !$acc loop reduction(ior:rg) gang + do i = 1, n + rg = ior (rg, array(i)) + end do + !$acc end parallel - !$acc parallel vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(ior:result) + !$acc parallel num_workers(nw) copy(rw) + !$acc loop reduction(ior:rw) worker do i = 1, n - result = ior (result, array(i)) + rw = ior (rw, array(i)) + end do + !$acc end parallel + + !$acc parallel vector_length(vl) copy(rv) + !$acc loop reduction(ior:rv) gang + do i = 1, n + rv = ior (rv, array(i)) + end do + !$acc end parallel + + !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc) + !$acc loop reduction(ior:rc) gang worker vector + do i = 1, n + rc = ior (rc, array(i)) end do !$acc end parallel @@ -126,17 +298,46 @@ program reduction_1 vresult = ior (vresult, array(i)) end do - if (result.ne.vresult) call abort + if (rg .ne. vresult) call abort + if (rw .ne. vresult) call abort + if (rv .ne. vresult) call abort + if (rc .ne. vresult) call abort - result = 0 + ! + ! 'ieor' reductions + ! + + rg = 0 + rw = 0 + rv = 0 + rc = 0 vresult = 0 - ! 'ieor' reductions + !$acc parallel num_gangs(ng) copy(rg) + !$acc loop reduction(ieor:rg) gang + do i = 1, n + rg = ieor (rg, array(i)) + end do + !$acc end parallel + + !$acc parallel num_workers(nw) copy(rw) + !$acc loop reduction(ieor:rw) worker + do i = 1, n + rw = ieor (rw, array(i)) + end do + !$acc end parallel - !$acc parallel vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(ieor:result) + !$acc parallel vector_length(vl) copy(rv) + !$acc loop reduction(ieor:rv) vector do i = 1, n - result = ieor (result, array(i)) + rv = ieor (rv, array(i)) + end do + !$acc end parallel + + !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc) + !$acc loop reduction(ieor:rc) gang worker vector + do i = 1, n + rc = ieor (rc, array(i)) end do !$acc end parallel @@ -145,17 +346,46 @@ program reduction_1 vresult = ieor (vresult, array(i)) end do - if (result.ne.vresult) call abort - - lresult = .false. - lvresult = .false. + 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 vector_length(vl) num_gangs(1) copy(lresult) - !$acc loop reduction(.and.:lresult) + !$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 - lresult = lresult .and. (array(i) .ge. 5) + lrc = lrc .and. (array(i) .ge. 5) end do !$acc end parallel @@ -164,17 +394,46 @@ program reduction_1 lvresult = lvresult .and. (array(i) .ge. 5) end do - if (result.ne.vresult) call abort + 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 + ! - lresult = .false. + lrg = .true. + lrw = .true. + lrv = .true. + lrc = .true. lvresult = .false. - ! '.or.' reductions + !$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 vector_length(vl) num_gangs(1) copy(lresult) - !$acc loop reduction(.or.:lresult) + !$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 - lresult = lresult .or. (array(i) .ge. 5) + lrc = lrc .or. (array(i) .ge. 5) end do !$acc end parallel @@ -183,17 +442,46 @@ program reduction_1 lvresult = lvresult .or. (array(i) .ge. 5) end do - if (result.ne.vresult) call abort - - lresult = .false. - lvresult = .false. + 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 vector_length(vl) num_gangs(1) copy(lresult) - !$acc loop reduction(.eqv.:lresult) + !$acc parallel num_workers(nw) vector_length(vl) copy(lrc) + !$acc loop reduction(.eqv.:lrc) gang worker vector do i = 1, n - lresult = lresult .eqv. (array(i) .ge. 5) + lrc = lrc .eqv. (array(i) .ge. 5) end do !$acc end parallel @@ -202,17 +490,46 @@ program reduction_1 lvresult = lvresult .eqv. (array(i) .ge. 5) end do - if (result.ne.vresult) call abort - - lresult = .false. - lvresult = .false. + 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 vector_length(vl) num_gangs(1) copy(lresult) - !$acc loop reduction(.neqv.:lresult) + !$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 - lresult = lresult .neqv. (array(i) .ge. 5) + lrc = lrc .neqv. (array(i) .ge. 5) end do !$acc end parallel @@ -221,5 +538,8 @@ program reduction_1 lvresult = lvresult .neqv. (array(i) .ge. 5) end do - if (result.ne.vresult) call abort + 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_1 diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-2.f90 index 96955ce71ba..b828feb60de 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/reduction-2.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-2.f90 @@ -5,26 +5,52 @@ program reduction_2 implicit none - integer, parameter :: n = 10, vl = 32 + integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32 integer :: i - real, parameter :: e = .001 - real :: vresult, result - logical :: lresult, lvresult - real, dimension (n) :: array + real :: vresult, rg, rw, rv, rc + real, parameter :: e = 0.001 + logical :: lrg, lrw, lrv, lrc, lvresult + real, dimension (n) :: array do i = 1, n array(i) = i end do - result = 0 + ! + ! '+' reductions + ! + + rg = 0 + rw = 0 + rv = 0 + rc = 0 vresult = 0 - ! '+' reductions + !$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 vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(+:result) + !$acc parallel num_workers(nw) copy(rw) + !$acc loop reduction(+:rw) worker do i = 1, n - result = result + array(i) + 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 @@ -33,17 +59,46 @@ program reduction_2 vresult = vresult + array(i) end do - if (abs (result - vresult) .ge. e) call abort + if (rg .ne. vresult) call abort + if (rw .ne. vresult) call abort + if (rv .ne. vresult) call abort + if (rc .ne. vresult) call abort + + ! + ! '*' reductions + ! - result = 1 + rg = 1 + rw = 1 + rv = 1 + rc = 1 vresult = 1 - ! '*' reductions + !$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 vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(*:result) + !$acc parallel num_workers(nw) copy(rw) + !$acc loop reduction(*:rw) worker do i = 1, n - result = result * array(i) + 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 @@ -52,17 +107,46 @@ program reduction_2 vresult = vresult * array(i) end do - if (result.ne.vresult) call abort + 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 + ! - result = 0 + rg = 0 + rw = 0 + rg = 0 + rc = 0 vresult = 0 - ! 'max' reductions + !$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) num_gangs(1) copy(result) - !$acc loop reduction(max:result) + !$acc parallel vector_length(vl) copy(rv) + !$acc loop reduction(max:rv) vector do i = 1, n - result = max (result, array(i)) + 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 @@ -71,17 +155,46 @@ program reduction_2 vresult = max (vresult, array(i)) end do - if (result.ne.vresult) call abort - - result = 1 - vresult = 1 + if (abs (rg - vresult) .ge. e) call abort + if (abs (rw - vresult) .ge. e) call abort + if (abs (rg - vresult) .ge. e) call abort + if (abs (rc - vresult) .ge. e) call abort + ! ! 'min' reductions + ! - !$acc parallel vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(min:result) + 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 - result = min (result, array(i)) + 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 @@ -90,17 +203,46 @@ program reduction_2 vresult = min (vresult, array(i)) end do - if (result.ne.vresult) call abort + if (rg .ne. vresult) call abort + if (rv .ne. vresult) call abort + if (rw .ne. vresult) call abort + if (rc .ne. vresult) call abort + + ! + ! '.and.' reductions + ! - lresult = .true. + lrg = .true. + lrw = .true. + lrv = .true. + lrc = .true. lvresult = .true. - ! '.and.' reductions + !$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 vector_length(vl) num_gangs(1) copy(lresult) - !$acc loop reduction(.and.:lresult) + !$acc parallel num_workers(nw) copy(lrw) + !$acc loop reduction(.and.:lrw) worker do i = 1, n - lresult = lresult .and. (array(i) .ge. 5) + 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 @@ -109,17 +251,46 @@ program reduction_2 lvresult = lvresult .and. (array(i) .ge. 5) end do - if (result.ne.vresult) call abort + 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 + ! - lresult = .false. + lrg = .false. + lrw = .false. + lrv = .false. + lrc = .false. lvresult = .false. - ! '.or.' reductions + !$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) num_gangs(1) copy(lresult) - !$acc loop reduction(.or.:lresult) + !$acc parallel vector_length(vl) copy(lrv) + !$acc loop reduction(.or.:lrv) vector do i = 1, n - lresult = lresult .or. (array(i) .ge. 5) + 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 @@ -128,17 +299,46 @@ program reduction_2 lvresult = lvresult .or. (array(i) .ge. 5) end do - if (result.ne.vresult) call abort - - lresult = .false. - lvresult = .false. + 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 + ! - !$acc parallel vector_length(vl) num_gangs(1) copy(lresult) - !$acc loop reduction(.eqv.:lresult) + 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 - lresult = lresult .eqv. (array(i) .ge. 5) + 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 @@ -147,17 +347,46 @@ program reduction_2 lvresult = lvresult .eqv. (array(i) .ge. 5) end do - if (result.ne.vresult) call abort - - lresult = .false. - lvresult = .false. + 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 vector_length(vl) num_gangs(1) copy(lresult) - !$acc loop reduction(.neqv.:lresult) + !$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 - lresult = lresult .neqv. (array(i) .ge. 5) + lrc = lrc .neqv. (array(i) .ge. 5) end do !$acc end parallel @@ -166,5 +395,8 @@ program reduction_2 lvresult = lvresult .neqv. (array(i) .ge. 5) end do - if (result.ne.vresult) call abort + 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_2 diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-3.f90 index ecf7fbea3b8..3d8d753cfed 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/reduction-3.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-3.f90 @@ -5,26 +5,52 @@ program reduction_3 implicit none - integer, parameter :: n = 10, vl = 32 + integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32 integer :: i - double precision, parameter :: e = .001 - double precision :: vresult, result - logical :: lresult, lvresult + 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 - result = 0 + ! + ! '+' reductions + ! + + rg = 0 + rw = 0 + rv = 0 + rc = 0 vresult = 0 - ! '+' reductions + !$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 vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(+:result) + !$acc parallel num_workers(nw) copy(rw) + !$acc loop reduction(+:rw) worker do i = 1, n - result = result + array(i) + 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 @@ -33,17 +59,46 @@ program reduction_3 vresult = vresult + array(i) end do - if (abs (result - vresult) .ge. e) call abort + 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 + ! - result = 1 + rg = 1 + rw = 1 + rv = 1 + rc = 1 vresult = 1 - ! '*' reductions + !$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 vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(*:result) + !$acc parallel num_workers(nw) copy(rw) + !$acc loop reduction(*:rw) worker do i = 1, n - result = result * array(i) + 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 @@ -52,17 +107,46 @@ program reduction_3 vresult = vresult * array(i) end do - if (result.ne.vresult) call abort + 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 + ! - result = 0 + rg = 0 + rw = 0 + rv = 0 + rc = 0 vresult = 0 - ! 'max' reductions + !$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) num_gangs(1) copy(result) - !$acc loop reduction(max:result) + !$acc parallel vector_length(vl) copy(rv) + !$acc loop reduction(max:rv) vector do i = 1, n - result = max (result, array(i)) + 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 @@ -71,17 +155,46 @@ program reduction_3 vresult = max (vresult, array(i)) end do - if (result.ne.vresult) call abort - - result = 1 - vresult = 1 + 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 + ! - !$acc parallel vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(min:result) + 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 - result = min (result, array(i)) + 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 @@ -90,17 +203,46 @@ program reduction_3 vresult = min (vresult, array(i)) end do - if (result.ne.vresult) call abort + 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 + ! - lresult = .true. + lrg = .true. + lrw = .true. + lrv = .true. + lrc = .true. lvresult = .true. - ! '.and.' reductions + !$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 vector_length(vl) num_gangs(1) copy(lresult) - !$acc loop reduction(.and.:lresult) + !$acc parallel num_workers(nw) copy(lrw) + !$acc loop reduction(.and.:lrw) worker do i = 1, n - lresult = lresult .and. (array(i) .ge. 5) + 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 @@ -109,17 +251,46 @@ program reduction_3 lvresult = lvresult .and. (array(i) .ge. 5) end do - if (result.ne.vresult) call abort + 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 + ! - lresult = .false. + lrg = .false. + lrw = .false. + lrv = .false. + lrc = .false. lvresult = .false. - ! '.or.' reductions + !$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) num_gangs(1) copy(lresult) - !$acc loop reduction(.or.:lresult) + !$acc parallel vector_length(vl) copy(lrv) + !$acc loop reduction(.or.:lrv) vector do i = 1, n - lresult = lresult .or. (array(i) .ge. 5) + 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 @@ -128,17 +299,46 @@ program reduction_3 lvresult = lvresult .or. (array(i) .ge. 5) end do - if (result.ne.vresult) call abort - - lresult = .false. - lvresult = .false. + 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 + ! - !$acc parallel vector_length(vl) num_gangs(1) copy(lresult) - !$acc loop reduction(.eqv.:lresult) + 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 - lresult = lresult .eqv. (array(i) .ge. 5) + 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 @@ -147,17 +347,46 @@ program reduction_3 lvresult = lvresult .eqv. (array(i) .ge. 5) end do - if (result.ne.vresult) call abort - - lresult = .false. - lvresult = .false. + 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 vector_length(vl) num_gangs(1) copy(lresult) - !$acc loop reduction(.neqv.:lresult) + !$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 - lresult = lresult .neqv. (array(i) .ge. 5) + lrc = lrc .neqv. (array(i) .ge. 5) end do !$acc end parallel @@ -166,5 +395,8 @@ program reduction_3 lvresult = lvresult .neqv. (array(i) .ge. 5) end do - if (result.ne.vresult) call abort + 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 diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-4.f90 index 8c99fdb32bf..c3bdaf610a1 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/reduction-4.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-4.f90 @@ -5,50 +5,108 @@ program reduction_4 implicit none - integer, parameter :: n = 10, vl = 32 + integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32 integer :: i - complex :: vresult, result + real :: vresult, rg, rw, rv, rc complex, dimension (n) :: array do i = 1, n array(i) = i end do - result = 0 + ! + ! '+' reductions + ! + + rg = 0 + rw = 0 + rv = 0 + rc = 0 vresult = 0 - ! '+' reductions + !$acc parallel num_gangs(ng) copy(rg) + !$acc loop reduction(+:rg) gang + do i = 1, n + rg = rg + REAL(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 + REAL(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 + REAL(array(i)) + end do + !$acc end parallel - !$acc parallel vector_length(vl) num_gangs(1) copy(result) - !$acc loop reduction(+:result) + !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc) + !$acc loop reduction(+:rc) gang worker vector do i = 1, n - result = result + array(i) + rc = rc + REAL(array(i)) end do !$acc end parallel ! Verify the results do i = 1, n - vresult = vresult + array(i) + vresult = vresult + REAL(array(i)) end do - if (result .ne. vresult) call abort + if (rg .ne. vresult) call abort + if (rw .ne. vresult) call abort + if (rv .ne. vresult) call abort + if (rc .ne. vresult) call abort - result = 1 + ! + ! '*' reductions + ! + + rg = 1 + rw = 1 + rv = 1 + rc = 1 vresult = 1 -! ! '*' reductions -! -! !$acc parallel vector_length(vl) -! !$acc loop reduction(*:result) -! do i = 1, n -! result = result * array(i) -! end do -! !$acc end parallel -! -! ! Verify the results -! do i = 1, n -! vresult = vresult * array(i) -! end do -! -! if (result.ne.vresult) call abort + !$acc parallel num_gangs(ng) copy(rg) + !$acc loop reduction(*:rg) gang + do i = 1, n + rg = rg * REAL(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 * REAL(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 * REAL(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 * REAL(array(i)) + end do + !$acc end parallel + + ! Verify the results + do i = 1, n + vresult = vresult * REAL(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 end program reduction_4 diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-5.f90 index ec13e4e6c07..42106480c81 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/reduction-5.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-5.f90 @@ -1,12 +1,17 @@ ! { dg-do run } +! { dg-additional-options "-w" } ! subroutine reduction program reduction integer, parameter :: n = 40, c = 10 - integer :: i, vsum, sum + integer :: i, vsum, gs, ws, vs, cs, ns - call redsub (sum, n, c) + 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 @@ -15,21 +20,80 @@ program reduction vsum = vsum + c end do - if (sum.ne.vsum) call abort () + 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(sum, n, c) +subroutine redsub_gang(sum, n, c) integer :: sum, n, c - integer :: s - s = 0 + sum = 0 - !$acc parallel vector_length(32) copyin (n, c) copy (s) num_gangs(1) - !$acc loop reduction(+:s) + !$acc parallel copyin (n, c) num_gangs(n) copy(sum) + !$acc loop reduction(+:sum) gang do i = 1, n - s = s + c + sum = sum + c end do !$acc end parallel +end subroutine redsub_gang - sum = s -end subroutine redsub +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 diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-6.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-6.f90 index 2ff6f5fd17d..f3ed27527f5 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/reduction-6.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-6.f90 @@ -1,30 +1,94 @@ ! { dg-do run } +! { dg-additional-options "-cpp -w" } program reduction implicit none - integer, parameter :: n = 100 - integer :: i, s1, s2, vs1, vs2 + integer, parameter :: n = 100, n2 = 1000, chunksize = 10 + integer :: i, gs1, gs2, ws1, ws2, vs1, vs2, cs1, cs2, hs1, hs2 + integer :: j, red, vred - s1 = 0 - s2 = 0 + gs1 = 0 + gs2 = 0 + ws1 = 0 + ws2 = 0 vs1 = 0 vs2 = 0 + cs1 = 0 + cs2 = 0 + hs1 = 0 + hs2 = 0 - !$acc parallel vector_length (32) copy(s1, s2) - !$acc loop reduction(+:s1, s2) + !$acc parallel num_gangs (1000) copy(gs1, gs2) + !$acc loop reduction(+:gs1, gs2) gang do i = 1, n - s1 = s1 + 1 - s2 = s2 + 2 + gs1 = gs1 + 1 + gs2 = gs2 + 2 end do !$acc end parallel - ! Verify the results + !$acc parallel num_workers (4) vector_length (32) copy(ws1, ws2) + !$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) copy(vs1, vs2) + !$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) copy(cs1, cs2) + !$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) copy(red) + !$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 (s1.ne.vs1) call abort () - if (s2.ne.vs2) call abort () + if (red .ne. vred) call abort () end program reduction diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-7.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-7.f90 new file mode 100644 index 00000000000..8ec36adf1e3 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-7.f90 @@ -0,0 +1,88 @@ +! { dg-do run } +! { dg-additional-options "-w" } + +! subroutine reduction with private and firstprivate variables + +program reduction + integer, parameter :: n = 100 + integer :: i, j, vsum, cs, arr(n) + + call redsub_private (cs, n, arr) + call redsub_bogus (cs, n) + call redsub_combined (cs, n, arr) + + vsum = 0 + + ! Verify the results + do i = 1, n + vsum = i + do j = 1, n + vsum = vsum + 1; + end do + if (vsum .ne. arr(i)) call abort () + end do +end program reduction + +! This subroutine tests a reduction with an explicit private variable. + +subroutine redsub_private(sum, n, arr) + integer :: sum, n, arr(n) + integer :: i, j, v + + !$acc parallel copyout (arr) + !$acc loop gang private (v) + do j = 1, n + v = j + + !$acc loop vector reduction (+:v) + do i = 1, 100 + v = v + 1 + end do + + arr(j) = v + end do + !$acc end parallel + + ! verify the results + do i = 1, 10 + if (arr(i) .ne. 100+i) call abort () + end do +end subroutine redsub_private + + +! Bogus reduction on an impliclitly firstprivate variable. The results do +! survive the parallel region. The goal here is to ensure that gfortran +! doesn't ICE. + +subroutine redsub_bogus(sum, n) + integer :: sum, n, arr(n) + integer :: i + + !$acc parallel + !$acc loop gang worker vector reduction (+:sum) + do i = 1, n + sum = sum + 1 + end do + !$acc end parallel +end subroutine redsub_bogus + +! This reduction involving a firstprivate variable yields legitimate results. + +subroutine redsub_combined(sum, n, arr) + integer :: sum, n, arr(n) + integer :: i, j + + !$acc parallel copy (arr) + !$acc loop gang + do i = 1, n + sum = i; + + !$acc loop reduction(+:sum) + do j = 1, n + sum = sum + 1 + end do + + arr(i) = sum + end do + !$acc end parallel +end subroutine redsub_combined |