1! { dg-do run }
2
3program udr7
4  implicit none
5  interface
6    elemental subroutine omp_priv (x, y, z)
7      real, intent (in) :: x
8      real, intent (inout) :: y
9      real, intent (in) :: z
10    end subroutine omp_priv
11    elemental real function omp_orig (x)
12      real, intent (in) :: x
13    end function omp_orig
14  end interface
15!$omp declare reduction (omp_priv : real : &
16!$omp & omp_priv (omp_orig (omp_in), omp_out, 1.0)) &
17!$omp & initializer (omp_out (omp_priv, omp_in (omp_orig)))
18  real :: x (2:4, 1:1, -2:0)
19  integer :: i
20  x = 0
21!$omp parallel do reduction (omp_priv : x)
22  do i = 1, 64
23    x = x + i
24  end do
25  if (any (x /= 2080.0)) call abort
26contains
27  elemental subroutine omp_out (x, y)
28    real, intent (out) :: x
29    real, intent (in) :: y
30    x = y - 4.0
31  end subroutine omp_out
32  elemental real function omp_in (x)
33    real, intent (in) :: x
34    omp_in = x + 4.0
35  end function omp_in
36end program udr7
37elemental subroutine omp_priv (x, y, z)
38  real, intent (in) :: x
39  real, intent (inout) :: y
40  real, intent (in) :: z
41  y = y + (x - 4.0) + (z - 1.0)
42end subroutine omp_priv
43elemental real function omp_orig (x)
44  real, intent (in) :: x
45  omp_orig = x + 4.0
46end function omp_orig
47