libgomp/testsuite/libgomp.oacc-fortran/par-reduction-2-2.f

   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       PROGRAM MAIN
   8       USE OPENACC
   9       IMPLICIT NONE
  10
  11       INTEGER RES, RES1, RES2
  12
  13       RES1 = 0
  14       RES2 = 0
  15
  16 !$ACC PARALLEL NUM_GANGS(256) NUM_WORKERS(32) VECTOR_LENGTH(32)
  17 !$ACC& REDUCTION(+:RES1) COPY(RES1, RES2) ASYNC(1)
  18       res1 = res1 + 5
  19
  20 !$ACC ATOMIC
  21       res2 = res2 + 5
  22 !$ACC END PARALLEL
  23
  24       IF (ACC_GET_DEVICE_TYPE () .EQ. ACC_DEVICE_HOST) THEN
  25          RES = 1 * 5
  26       ELSE
  27          RES = 256 * 5
  28       END IF
  29
  30       CALL ACC_ASYNC_WAIT (1)
  31
  32       IF (RES .NE. RES1) STOP 1
  33       IF (RES .NE. RES2) STOP 2
  34
  35       RES1 = 1
  36       RES2 = 1
  37
  38 !$ACC PARALLEL NUM_GANGS(8) NUM_WORKERS(32) VECTOR_LENGTH(32)
  39 !$ACC& REDUCTION(*:RES1) COPY(RES1, RES2) ASYNC(1)
  40       res1 = res1 * 5
  41
  42 !$ACC ATOMIC
  43       res2 = res2 * 5
  44 !$ACC END PARALLEL
  45
  46       IF (ACC_GET_DEVICE_TYPE () .EQ. ACC_DEVICE_HOST) THEN
  47          RES = 5 ** 1
  48       ELSE
  49          RES = 5 ** 8
  50       END IF
  51
  52       CALL ACC_ASYNC_WAIT_ALL
  53
  54       IF (RES .NE. RES1) STOP 3
  55       IF (RES .NE. RES2) STOP 4
  56
  57       END PROGRAM