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

   1 ! { dg-do run }
   2
   3 ! double precision reductions
   4
   5 program reduction_3
   6   implicit none
   7
   8   integer, parameter    :: n = 10, vl = 2
   9   integer               :: i
  10   double precision, parameter :: e = .001
  11   double precision      :: vresult, result
  12   logical               :: lresult, lvresult
  13   double precision, dimension (n) :: array
  14
  15   do i = 1, n
  16      array(i) = i
  17   end do
  18
  19   result = 0
  20   vresult = 0
  21
  22   ! '+' reductions
  23
  24   !$acc parallel vector_length(vl) num_gangs(1)
  25   !$acc loop reduction(+:result)
  26   do i = 1, n
  27      result = result + array(i)
  28   end do
  29   !$acc end parallel
  30
  31   ! Verify the results
  32   do i = 1, n
  33      vresult = vresult + array(i)
  34   end do
  35
  36   if (abs (result - vresult) .ge. e) call abort
  37
  38   result = 1
  39   vresult = 1
  40
  41   ! '*' reductions
  42
  43   !$acc parallel vector_length(vl) num_gangs(1)
  44   !$acc loop reduction(*:result)
  45   do i = 1, n
  46      result = result * array(i)
  47   end do
  48   !$acc end parallel
  49
  50   ! Verify the results
  51   do i = 1, n
  52      vresult = vresult * array(i)
  53   end do
  54
  55   if (result.ne.vresult) call abort
  56
  57   result = 0
  58   vresult = 0
  59
  60   ! 'max' reductions
  61
  62   !$acc parallel vector_length(vl) num_gangs(1)
  63   !$acc loop reduction(max:result)
  64   do i = 1, n
  65      result = max (result, array(i))
  66   end do
  67   !$acc end parallel
  68
  69   ! Verify the results
  70   do i = 1, n
  71      vresult = max (vresult, array(i))
  72   end do
  73
  74   if (result.ne.vresult) call abort
  75
  76   result = 1
  77   vresult = 1
  78
  79   ! 'min' reductions
  80
  81   !$acc parallel vector_length(vl) num_gangs(1)
  82   !$acc loop reduction(min:result)
  83   do i = 1, n
  84      result = min (result, array(i))
  85   end do
  86   !$acc end parallel
  87
  88   ! Verify the results
  89   do i = 1, n
  90      vresult = min (vresult, array(i))
  91   end do
  92
  93   if (result.ne.vresult) call abort
  94
  95   result = 1
  96   vresult = 1
  97
  98   ! '.and.' reductions
  99
 100   !$acc parallel vector_length(vl) num_gangs(1)
 101   !$acc loop reduction(.and.:lresult)
 102   do i = 1, n
 103      lresult = lresult .and. (array(i) .ge. 5)
 104   end do
 105   !$acc end parallel
 106
 107   ! Verify the results
 108   do i = 1, n
 109      lvresult = lvresult .and. (array(i) .ge. 5)
 110   end do
 111
 112   if (result.ne.vresult) call abort
 113
 114   lresult = .false.
 115   lvresult = .false.
 116
 117   ! '.or.' reductions
 118
 119   !$acc parallel vector_length(vl) num_gangs(1)
 120   !$acc loop reduction(.or.:lresult)
 121   do i = 1, n
 122      lresult = lresult .or. (array(i) .ge. 5)
 123   end do
 124   !$acc end parallel
 125
 126   ! Verify the results
 127   do i = 1, n
 128      lvresult = lvresult .or. (array(i) .ge. 5)
 129   end do
 130
 131   if (result.ne.vresult) call abort
 132
 133   lresult = .false.
 134   lvresult = .false.
 135
 136   ! '.eqv.' reductions
 137
 138   !$acc parallel vector_length(vl) num_gangs(1)
 139   !$acc loop reduction(.eqv.:lresult)
 140   do i = 1, n
 141      lresult = lresult .eqv. (array(i) .ge. 5)
 142   end do
 143   !$acc end parallel
 144
 145   ! Verify the results
 146   do i = 1, n
 147      lvresult = lvresult .eqv. (array(i) .ge. 5)
 148   end do
 149
 150   if (result.ne.vresult) call abort
 151
 152   lresult = .false.
 153   lvresult = .false.
 154
 155   ! '.neqv.' reductions
 156
 157   !$acc parallel vector_length(vl) num_gangs(1)
 158   !$acc loop reduction(.neqv.:lresult)
 159   do i = 1, n
 160      lresult = lresult .neqv. (array(i) .ge. 5)
 161   end do
 162   !$acc end parallel
 163
 164   ! Verify the results
 165   do i = 1, n
 166      lvresult = lvresult .neqv. (array(i) .ge. 5)
 167   end do
 168
 169   if (result.ne.vresult) call abort
 170 end program reduction_3