1! { dg-do run }
2!
3module m
4  implicit none
5contains
6  pure subroutine add_ps_routine(a, b, c)
7    implicit none
8    !$acc routine seq
9    integer, intent(in)  :: a, b
10    integer, intent(out) :: c
11    integer, parameter :: n = 10
12    integer :: i
13
14    do i = 1, n
15       if (i .eq. 5) then
16          c = a + b
17       end if
18    end do
19  end subroutine add_ps_routine
20
21  elemental impure function add_ef(a, b) result(c)
22    implicit none
23    !$acc routine
24    integer, intent(in)  :: a, b
25    integer :: c
26
27    call add_ps_routine(a, b, c)
28  end function add_ef
29end module m
30
31program main
32  use m
33  implicit none
34  integer, parameter :: n = 10
35  integer, dimension(n) :: a_a
36  integer, dimension(n) :: b_a
37  integer, dimension(n) :: c_a
38  integer :: i
39
40  a_a = [(3 * i, i = 1, n)]
41  b_a = [(-2 * i, i = 1, n)]
42  !$acc parallel copyin(a_a, b_a) copyout(c_a)
43  !$acc loop gang
44  do i = 1, n
45     if (i .eq. 4) then
46        c_a = add_ef(a_a, b_a)
47     end if
48  end do
49  !$acc end parallel
50  if (any (c_a /= [(i, i=1, 10)])) stop 1
51  !print *, a
52end program main
53