1! { dg-do compile }
2!
3! PR 46271: [F03] OpenMP default(none) and procedure pointers
4!
5! Contributed by Marco Restelli <mrestelli@gmail.com>
6
7program test
8  implicit none
9  integer :: i
10  real :: s(1000)
11  procedure(f), pointer :: pf
12
13  pf => f
14
15  !$omp parallel do schedule(static) private(i) shared(s,pf) default(none)
16  do i=1,1000
17    call pf(real(i),s(i))
18  enddo
19  !$omp end parallel do
20
21  write(*,*) 'Sum ',sum(s)
22contains
23  pure subroutine f(x,y)
24    real, intent(in) :: x
25    real, intent(out) :: y
26    y = sin(x)*cos(x)
27  end subroutine
28end
29