1!     Test of reduction on parallel directive (with async).
2!     Variant of "../libgomp.oacc-c-c++-common/par-reduction-2.c".
3!     Variant using the "openacc" module.
4
5!     { dg-do run }
6
7!     { dg-additional-options "-Wopenacc-parallelism" } for
8!     testing/documenting aspects of that functionality.
9
10      PROGRAM MAIN
11      USE OPENACC
12      IMPLICIT NONE
13
14      INTEGER RES, RES1, RES2
15
16      RES1 = 0
17      RES2 = 0
18
19!$ACC PARALLEL NUM_GANGS(256) NUM_WORKERS(32) VECTOR_LENGTH(32)
20!$ACC& REDUCTION(+:RES1) COPY(RES1, RES2) ASYNC(1)
21!     { dg-bogus "\[Ww\]arning: region is gang partitioned but does not contain gang partitioned code" "TODO 'reduction', 'atomic'" { xfail *-*-* } .-1 }
22!     { dg-warning "region is worker partitioned but does not contain worker partitioned code" "" { target *-*-* } .-2 }
23!     { dg-warning "region is vector partitioned but does not contain vector partitioned code" "" { target *-*-* } .-3 }
24      res1 = res1 + 5
25
26!$ACC ATOMIC
27      res2 = res2 + 5
28!$ACC END PARALLEL
29
30      IF (ACC_GET_DEVICE_TYPE () .EQ. ACC_DEVICE_HOST) THEN
31         RES = 1 * 5
32      ELSE
33         RES = 256 * 5
34      END IF
35
36      CALL ACC_ASYNC_WAIT (1)
37
38      IF (RES .NE. RES1) STOP 1
39      IF (RES .NE. RES2) STOP 2
40
41      RES1 = 1
42      RES2 = 1
43
44!$ACC PARALLEL NUM_GANGS(8) NUM_WORKERS(32) VECTOR_LENGTH(32)
45!$ACC& REDUCTION(*:RES1) COPY(RES1, RES2) ASYNC(1)
46!     { dg-bogus "\[Ww\]arning: region is gang partitioned but does not contain gang partitioned code" "TODO 'reduction', 'atomic'" { xfail *-*-* } .-1 }
47!     { dg-warning "region is worker partitioned but does not contain worker partitioned code" "" { target *-*-* } .-2 }
48!     { dg-warning "region is vector partitioned but does not contain vector partitioned code" "" { target *-*-* } .-3 }
49      res1 = res1 * 5
50
51!$ACC ATOMIC
52      res2 = res2 * 5
53!$ACC END PARALLEL
54
55      IF (ACC_GET_DEVICE_TYPE () .EQ. ACC_DEVICE_HOST) THEN
56         RES = 5 ** 1
57      ELSE
58         RES = 5 ** 8
59      END IF
60
61      CALL ACC_ASYNC_WAIT_ALL
62
63      IF (RES .NE. RES1) STOP 3
64      IF (RES .NE. RES2) STOP 4
65
66      END PROGRAM
67