libgomp/testsuite/libgomp.oacc-fortran/reduction-4.f90

   1 ! { dg-do run }
   2
   3 ! complex reductions
   4
   5 program reduction_4
   6   implicit none
   7
   8   integer, parameter    :: n = 10, ng = 8, nw = 4, vl = 32
   9   integer               :: i
  10   real                  :: vresult, rg, rw, rv, rc
  11   complex, dimension (n) :: array
  12
  13   do i = 1, n
  14      array(i) = i
  15   end do
  16
  17   !
  18   ! '+' reductions
  19   !
  20
  21   rg = 0
  22   rw = 0
  23   rv = 0
  24   rc = 0
  25   vresult = 0
  26
  27   !$acc parallel num_gangs(ng) copy(rg)
  28   !$acc loop reduction(+:rg) gang
  29   do i = 1, n
  30      rg = rg + REAL(array(i))
  31   end do
  32   !$acc end parallel
  33
  34   !$acc parallel num_workers(nw) copy(rw)
  35   !$acc loop reduction(+:rw) worker
  36   do i = 1, n
  37      rw = rw + REAL(array(i))
  38   end do
  39   !$acc end parallel
  40
  41   !$acc parallel vector_length(vl) copy(rv)
  42   !$acc loop reduction(+:rv) vector
  43   do i = 1, n
  44      rv = rv + REAL(array(i))
  45   end do
  46   !$acc end parallel
  47
  48   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
  49   !$acc loop reduction(+:rc) gang worker vector
  50   do i = 1, n
  51      rc = rc + REAL(array(i))
  52   end do
  53   !$acc end parallel
  54
  55   ! Verify the results
  56   do i = 1, n
  57      vresult = vresult + REAL(array(i))
  58   end do
  59
  60   if (rg .ne. vresult) STOP 1
  61   if (rw .ne. vresult) STOP 2
  62   if (rv .ne. vresult) STOP 3
  63   if (rc .ne. vresult) STOP 4
  64
  65   !
  66   ! '*' reductions
  67   !
  68
  69   rg = 1
  70   rw = 1
  71   rv = 1
  72   rc = 1
  73   vresult = 1
  74
  75   !$acc parallel num_gangs(ng) copy(rg)
  76   !$acc loop reduction(*:rg) gang
  77   do i = 1, n
  78      rg = rg * REAL(array(i))
  79   end do
  80   !$acc end parallel
  81
  82   !$acc parallel num_workers(nw) copy(rw)
  83   !$acc loop reduction(*:rw) worker
  84   do i = 1, n
  85      rw = rw * REAL(array(i))
  86   end do
  87   !$acc end parallel
  88
  89   !$acc parallel vector_length(vl) copy(rv)
  90   !$acc loop reduction(*:rv) vector
  91   do i = 1, n
  92      rv = rv * REAL(array(i))
  93   end do
  94   !$acc end parallel
  95
  96   !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
  97   !$acc loop reduction(*:rc) gang worker vector
  98   do i = 1, n
  99      rc = rc * REAL(array(i))
 100   end do
 101   !$acc end parallel
 102
 103   ! Verify the results
 104   do i = 1, n
 105      vresult = vresult * REAL(array(i))
 106   end do
 107
 108   if (rg .ne. vresult) STOP 5
 109   if (rw .ne. vresult) STOP 6
 110   if (rv .ne. vresult) STOP 7
 111   if (rc .ne. vresult) STOP 8
 112 end program reduction_4