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

   1 ! { dg-do run }
   2 ! { dg-additional-options "-w" }
   3
   4 program reduction
   5   implicit none
   6   integer, parameter :: n = 10
   7   integer s1, s2
   8   include "openacc_lib.h"
   9
  10   s1 = 0
  11   s2 = 0
  12
  13   !$acc parallel reduction(+:s1,s2) num_gangs (n) copy(s1)
  14   s1 = s1 + 1
  15   s2 = s2 + 1
  16   !$acc end parallel
  17
  18   if (acc_get_device_type () .ne. acc_device_host) then
  19      if (s1 .ne. n) call abort
  20      if (s2 .ne. n) call abort
  21   else
  22      if (s1 .ne. 1) call abort
  23      if (s2 .ne. 1) call abort
  24   end if
  25
  26   ! Test reductions inside subroutines
  27
  28   s1 = 0
  29   s2 = 0
  30   call redsub (s1, s2, n)
  31
  32   if (acc_get_device_type () .ne. acc_device_host) then
  33      if (s1 .ne. n) call abort
  34   else
  35      if (s2 .ne. 1) call abort
  36   end if
  37 end program reduction
  38
  39 subroutine redsub(s1, s2, n)
  40   implicit none
  41   integer :: s1, s2, n
  42
  43   !$acc parallel reduction(+:s1,s2) num_gangs (10)  copy(s1)
  44   s1 = s1 + 1
  45   s2 = s2 + 1
  46   !$acc end parallel
  47 end subroutine redsub