1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
! Test optional arguments in reduction clauses. The effect of
! non-present arguments in reduction clauses is undefined, and is not tested
! for. The tests are based on those in reduction-1.f90.
! { dg-do run }
program optional_reduction
implicit none
integer :: rg, rw, rv, rc
rg = 0
rw = 0
rv = 0
rc = 0
call do_test(rg, rw, rv, rc)
contains
subroutine do_test(rg, rw, rv, rc)
integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32
integer, optional :: rg, rw, rv, rc
integer :: i, vresult
integer, dimension (n) :: array
vresult = 0
do i = 1, n
array(i) = i
end do
!$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
end subroutine do_test
end program optional_reduction
|
