123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402 |
- ! { dg-do run }
- ! real reductions
- program reduction_2
- implicit none
- integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32
- integer :: i
- 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
- !
- ! '+' 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 (rg .ne. vresult) STOP 1
- if (rw .ne. vresult) STOP 2
- if (rv .ne. vresult) STOP 3
- if (rc .ne. vresult) STOP 4
- !
- ! '*' 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) STOP 5
- if (abs (rw - vresult) .ge. e) STOP 6
- if (abs (rv - vresult) .ge. e) STOP 7
- if (abs (rc - vresult) .ge. e) STOP 8
- !
- ! 'max' reductions
- !
- rg = 0
- rw = 0
- rg = 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) STOP 9
- if (abs (rw - vresult) .ge. e) STOP 10
- if (abs (rg - vresult) .ge. e) STOP 11
- if (abs (rc - vresult) .ge. e) STOP 12
- !
- ! '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) STOP 13
- if (rv .ne. vresult) STOP 14
- if (rw .ne. vresult) STOP 15
- if (rc .ne. vresult) STOP 16
- !
- ! '.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) STOP 17
- if (lrw .neqv. lvresult) STOP 18
- if (lrv .neqv. lvresult) STOP 19
- if (lrc .neqv. lvresult) STOP 20
- !
- ! '.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) STOP 21
- if (lrw .neqv. lvresult) STOP 22
- if (lrv .neqv. lvresult) STOP 23
- if (lrc .neqv. lvresult) STOP 24
- !
- ! '.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) STOP 25
- if (lrw .neqv. lvresult) STOP 26
- if (lrv .neqv. lvresult) STOP 27
- if (lrc .neqv. lvresult) STOP 28
- !
- ! '.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) STOP 29
- if (lrw .neqv. lvresult) STOP 30
- if (lrv .neqv. lvresult) STOP 31
- if (lrc .neqv. lvresult) STOP 32
- end program reduction_2
|