gcc/testsuite/gfortran.dg/gomp/proc_ptr_1.f90

   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
   7 program 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)
  22 contains
  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
  28 end