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