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

   1 ! { dg-do run }
   2 ! { dg-additional-options "-w" }
   3
   4 ! subroutine reduction
   5
   6 program reduction
   7   integer, parameter    :: n = 40, c = 10
   8   integer               :: i, vsum, gs, ws, vs, cs, ns
   9
  10   call redsub_gang (gs, n, c)
  11   call redsub_worker (ws, n, c)
  12   call redsub_vector (vs, n, c)
  13   call redsub_combined (cs, n, c)
  14   call redsub_nested (ns, n, c)
  15
  16   vsum = 0
  17
  18   ! Verify the results
  19   do i = 1, n
  20      vsum = vsum + c
  21   end do
  22
  23   if (gs .ne. vsum) call abort ()
  24   if (ws .ne. vsum) call abort ()
  25   if (vs .ne. vsum) call abort ()
  26   if (cs .ne. vsum) call abort ()
  27   if (ns .ne. vsum) call abort ()
  28 end program reduction
  29
  30 subroutine redsub_gang(sum, n, c)
  31   integer :: sum, n, c
  32
  33   sum = 0
  34
  35   !$acc parallel copyin (n, c) num_gangs(n) copy(sum)
  36   !$acc loop reduction(+:sum) gang
  37   do i = 1, n
  38      sum = sum + c
  39   end do
  40   !$acc end parallel
  41 end subroutine redsub_gang
  42
  43 subroutine redsub_worker(sum, n, c)
  44   integer :: sum, n, c
  45
  46   sum = 0
  47
  48   !$acc parallel copyin (n, c) num_workers(4) vector_length (32) copy(sum)
  49   !$acc loop reduction(+:sum) worker
  50   do i = 1, n
  51      sum = sum + c
  52   end do
  53   !$acc end parallel
  54 end subroutine redsub_worker
  55
  56 subroutine redsub_vector(sum, n, c)
  57   integer :: sum, n, c
  58
  59   sum = 0
  60
  61   !$acc parallel copyin (n, c) vector_length(32) copy(sum)
  62   !$acc loop reduction(+:sum) vector
  63   do i = 1, n
  64      sum = sum + c
  65   end do
  66   !$acc end parallel
  67 end subroutine redsub_vector
  68
  69 subroutine redsub_combined(sum, n, c)
  70   integer :: sum, n, c
  71
  72   sum = 0
  73
  74   !$acc parallel num_gangs (8) num_workers (4) vector_length(32) copy(sum)
  75   !$acc loop reduction(+:sum) gang worker vector
  76   do i = 1, n
  77      sum = sum + c
  78   end do
  79   !$acc end parallel
  80 end subroutine redsub_combined
  81
  82 subroutine redsub_nested(sum, n, c)
  83   integer :: sum, n, c
  84   integer :: ii, jj
  85
  86   ii = n / 10;
  87   jj = 10;
  88   sum = 0
  89
  90   !$acc parallel num_gangs (8) copy(sum)
  91   !$acc loop reduction(+:sum) gang
  92   do i = 1, ii
  93      !$acc loop reduction(+:sum) vector
  94      do j = 1, jj
  95         sum = sum + c
  96      end do
  97   end do
  98   !$acc end parallel
  99 end subroutine redsub_nested