1! { dg-do run } 2 3module m 4 interface operator(.add.) 5 module procedure do_add 6 end interface 7 type dt 8 real :: r = 0.0 9 end type 10contains 11 elemental function do_add(x, y) 12 type (dt), intent (in) :: x, y 13 type (dt) :: do_add 14 do_add%r = x%r + y%r 15 end function 16 elemental subroutine dp_add(x, y) 17 double precision, intent (inout) :: x 18 double precision, intent (in) :: y 19 x = x + y 20 end subroutine 21 elemental subroutine dp_init(x) 22 double precision, intent (out) :: x 23 x = 0.0 24 end subroutine 25end module 26 27program udr6 28 use m, only : operator(.add.), dt, dp_add, dp_init 29 type(dt), allocatable :: xdt(:) 30 type(dt) :: one 31 real :: r 32 integer (kind = 4), allocatable, dimension(:) :: i4 33 integer (kind = 8), allocatable, dimension(:,:) :: i8 34 integer :: i 35 real (kind = 4), allocatable :: r4(:,:) 36 double precision, allocatable :: dp(:) 37!$omp declare reduction(.add.:dt:omp_out=omp_out.add.omp_in) 38!$omp declare reduction(foo:integer(4),integer(kind=8),real (kind = 4) & 39!$omp & :omp_out = omp_out + omp_in) initializer (omp_priv = 0) 40!$omp declare reduction(foo:double precision:dp_add (omp_out, omp_in)) & 41!$omp & initializer (dp_init (omp_priv)) 42 43 one%r = 1.0 44 allocate (xdt(4), i4 (3), i8(-5:-2,2:3), r4(2:5,1:1), dp(7)) 45 r = 0.0 46 i4 = 0 47 i8 = 0 48 r4 = 0.0 49 do i = 1, 7 50 call dp_init (dp(i)) 51 end do 52!$omp parallel reduction(.add.: xdt) reduction(+: r) & 53!$omp & reduction(foo: i4, i8, r4, dp) private(i) 54 do i = 1, 4 55 xdt(i) = xdt(i).add.one 56 end do 57 r = r + 1.0 58 i4 = i4 + 1 59 i8 = i8 + 1 60 r4 = r4 + 1.0 61 do i = 1, 7 62 call dp_add (dp(i), 1.0d0) 63 end do 64!$omp end parallel 65 if (any (xdt%r .ne. r)) call abort 66 if (any (i4.ne.r).or.any(i8.ne.r)) call abort 67 if (any(r4.ne.r).or.any(dp.ne.r)) call abort 68 deallocate (xdt, i4, i8, r4, dp) 69end program udr6 70