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

   1 ! { dg-do run }
   2 ! { dg-additional-options "-w" }
   3
   4 ! subroutine reduction with private and firstprivate variables
   5
   6 program reduction
   7   integer, parameter    :: n = 100
   8   integer               :: i, j, vsum, cs, arr(n)
   9
  10   call redsub_private (cs, n, arr)
  11   call redsub_bogus (cs, n)
  12   call redsub_combined (cs, n, arr)
  13
  14   vsum = 0
  15
  16   ! Verify the results
  17   do i = 1, n
  18      vsum = i
  19      do j = 1, n
  20         vsum = vsum + 1;
  21      end do
  22      if (vsum .ne. arr(i)) STOP 1
  23   end do
  24 end program reduction
  25
  26 ! This subroutine tests a reduction with an explicit private variable.
  27
  28 subroutine redsub_private(sum, n, arr)
  29   integer :: sum, n, arr(n)
  30   integer :: i, j, v
  31
  32   !$acc parallel copyout (arr)
  33   !$acc loop gang private (v)
  34   do j = 1, n
  35      v = j
  36
  37      !$acc loop vector reduction (+:v)
  38      do i = 1, 100
  39         v = v + 1
  40      end do
  41
  42      arr(j) = v
  43   end do
  44   !$acc end parallel
  45
  46   ! verify the results
  47   do i = 1, 10
  48      if (arr(i) .ne. 100+i) STOP 2
  49   end do
  50 end subroutine redsub_private
  51
  52
  53 ! Bogus reduction on a firstprivate variable.  The results do
  54 ! survive the parallel region.  The goal here is to ensure that gfortran
  55 ! doesn't ICE.
  56
  57 subroutine redsub_bogus(sum, n)
  58   integer :: sum, n, arr(n)
  59   integer :: i
  60
  61   !$acc parallel firstprivate(sum)
  62   !$acc loop gang worker vector reduction (+:sum)
  63   do i = 1, n
  64      sum = sum + 1
  65   end do
  66   !$acc end parallel
  67 end subroutine redsub_bogus
  68
  69 ! This reduction involving a firstprivate variable yields legitimate results.
  70
  71 subroutine redsub_combined(sum, n, arr)
  72   integer :: sum, n, arr(n)
  73   integer :: i, j
  74
  75   !$acc parallel copy (arr) firstprivate(sum)
  76   !$acc loop gang
  77   do i = 1, n
  78      sum = i;
  79
  80      !$acc loop reduction(+:sum)
  81      do j = 1, n
  82         sum = sum + 1
  83      end do
  84
  85      arr(i) = sum
  86   end do
  87   !$acc end parallel
  88 end subroutine redsub_combined