libgomp/testsuite/libgomp.fortran/udr12.f90

   1 ! { dg-do run }
   2
   3   interface
   4     elemental subroutine sub1 (x, y)
   5       integer, intent(in) :: y
   6       integer, intent(out) :: x
   7     end subroutine
   8     elemental function fn2 (x)
   9       integer, intent(in) :: x
  10       integer :: fn2
  11     end function
  12   end interface
  13 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
  14 !$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) &
  15 !$omp & initializer (sub1 (omp_priv, omp_orig))
  16 !$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) &
  17 !$omp initializer (omp_priv = fn2 (omp_orig))
  18   interface
  19     elemental function fn1 (x, y)
  20       integer, intent(in) :: x, y
  21       integer :: fn1
  22     end function
  23     elemental subroutine sub2 (x, y)
  24       integer, intent(in) :: y
  25       integer, intent(inout) :: x
  26     end subroutine
  27   end interface
  28   integer :: a(10), b, r
  29   a(:) = 0
  30   b = 0
  31   r = 0
  32 !$omp parallel reduction (foo : a, b) reduction (+: r)
  33   a = a + 2
  34   b = b + 3
  35   r = r + 1
  36 !$omp end parallel
  37   if (any (a /= 2 * r) .or. b /= 3 * r) stop 1
  38   a(:) = 0
  39   b = 0
  40   r = 0
  41 !$omp parallel reduction (bar : a, b) reduction (+: r)
  42   a = a + 2
  43   b = b + 3
  44   r = r + 1
  45 !$omp end parallel
  46   if (any (a /= 4 * r) .or. b /= 6 * r) stop 2
  47   a(:) = 0
  48   b = 0
  49   r = 0
  50 !$omp parallel reduction (baz : a, b) reduction (+: r)
  51   a = a + 2
  52   b = b + 3
  53   r = r + 1
  54 !$omp end parallel
  55   if (any (a /= 2 * r) .or. b /= 3 * r) stop 3
  56 end
  57 elemental function fn1 (x, y)
  58   integer, intent(in) :: x, y
  59   integer :: fn1
  60   fn1 = x + 2 * y
  61 end function
  62 elemental subroutine sub1 (x, y)
  63   integer, intent(in) :: y
  64   integer, intent(out) :: x
  65   x = 0
  66 end subroutine
  67 elemental function fn2 (x)
  68   integer, intent(in) :: x
  69   integer :: fn2
  70   fn2 = x
  71 end function
  72 elemental subroutine sub2 (x, y)
  73   integer, intent(inout) :: x
  74   integer, intent(in) :: y
  75   x = x + y
  76 end subroutine