1! { dg-do run } 2 3 type dt 4 integer :: g 5 integer, allocatable :: h(:) 6 end type 7!$omp declare reduction (baz : dt : bar (omp_out, omp_in)) & 8!$omp & initializer (foo (omp_priv, omp_orig)) 9 integer :: r 10 type (dt), allocatable :: a(:) 11 allocate (a(7:8)) 12 a(:)%g = 0 13 a(7)%h = (/ 0, 0, 0 /) 14 r = 0 15!$omp parallel reduction(+:r) reduction (baz:a) 16 if (.not.allocated (a)) STOP 1 17 if (lbound (a, 1) /= 7 .or. ubound (a, 1) /= 8) STOP 2 18 if (.not.allocated (a(7)%h)) STOP 3 19 if (allocated (a(8)%h)) STOP 4 20 if (lbound (a(7)%h, 1) /= 1 .or. ubound (a(7)%h, 1) /= 3) STOP 5 21 a(:)%g = a(:)%g + 2 22 a(7)%h = a(7)%h + 3 23 r = r + 1 24!$omp end parallel 25 if (.not.allocated (a)) STOP 6 26 if (lbound (a, 1) /= 7 .or. ubound (a, 1) /= 8) STOP 7 27 if (.not.allocated (a(7)%h)) STOP 8 28 if (allocated (a(8)%h)) STOP 9 29 if (lbound (a(7)%h, 1) /= 1 .or. ubound (a(7)%h, 1) /= 3) STOP 10 30 if (any (a(:)%g /= 2 * r) .or. any (a(7)%h(:) /= 3 * r)) STOP 11 31contains 32 subroutine foo (x, y) 33 type (dt), allocatable :: x(:), y(:) 34 if (allocated (x) .neqv. allocated (y)) STOP 12 35 if (lbound (x, 1) /= lbound (y, 1)) STOP 13 36 if (ubound (x, 1) /= ubound (y, 1)) STOP 14 37 if (allocated (x(7)%h) .neqv. allocated (y(7)%h)) STOP 15 38 if (allocated (x(8)%h) .neqv. allocated (y(8)%h)) STOP 16 39 if (lbound (x(7)%h, 1) /= lbound (y(7)%h, 1)) STOP 17 40 if (ubound (x(7)%h, 1) /= ubound (y(7)%h, 1)) STOP 18 41 x(7)%g = 0 42 x(7)%h = 0 43 x(8)%g = 0 44 end subroutine 45 subroutine bar (x, y) 46 type (dt), allocatable :: x(:), y(:) 47 x(:)%g = x(:)%g + y(:)%g 48 x(7)%h(:) = x(7)%h(:) + y(7)%h(:) 49 end subroutine 50end 51