1! PR fortran/69128
2! { dg-do compile }
3
4program test
5  implicit none
6  interface
7    subroutine use(b, c)
8      real, allocatable :: b(:), c(:)
9    end subroutine
10  end interface
11  real, allocatable :: a(:,:), b(:), c(:)
12  integer :: dim1, dim2, i,j
13  dim1=10000
14  dim2=500
15  allocate(a(dim1,dim2),b(dim1),c(dim1))
16  call random_number(a)
17
18!$omp parallel workshare
19  b(:) = maxval(a(:,:), dim=2)
20  c(:) = sum(a(:,:), dim=2)
21!$omp end parallel workshare
22  call use(b, c)
23end program
24