1! Test propagation of optional arguments from within an OpenACC parallel region.
2
3! { dg-do run }
4
5program test
6  implicit none
7
8  integer, parameter :: n = 64
9  integer :: i
10  integer :: res_int
11  integer :: a_arr(n), b_arr(n), res_arr(n)
12  integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:)
13
14  call test_int_caller(res_int, 5)
15  if (res_int .ne. 10) stop 1
16
17  call test_int_caller(res_int, 2, 3)
18  if (res_int .ne. 11) stop 2
19
20  do i = 1, n
21    a_arr(i) = i
22    b_arr(i) = n - i + 1
23  end do
24
25  call test_array_caller(res_arr, a_arr)
26  do i = 1, n
27    if (res_arr(i) .ne. 2 * a_arr(i)) stop 3
28  end do
29
30  call test_array_caller(res_arr, a_arr, b_arr)
31  do i = 1, n
32    if (res_arr(i) .ne. a_arr(i) * b_arr(i) + a_arr(i) + b_arr(i)) stop 4
33  end do
34
35  allocate(a_alloc(n))
36  allocate(b_alloc(n))
37  allocate(res_alloc(n))
38
39  do i = 1, n
40    a_alloc(i) = i
41    b_alloc(i) = n - i + 1
42  end do
43
44  call test_array_caller(res_arr, a_arr)
45  do i = 1, n
46    if (res_arr(i) .ne. 2 * a_alloc(i)) stop 5
47  end do
48
49  call test_array_caller(res_arr, a_arr, b_arr)
50  do i = 1, n
51    if (res_arr(i) .ne. a_arr(i) * b_alloc(i) + a_alloc(i) + b_alloc(i)) stop 6
52  end do
53
54  deallocate(a_alloc)
55  deallocate(b_alloc)
56  deallocate(res_alloc)
57contains
58  subroutine test_int_caller(res, a, b)
59    integer :: res, a
60    integer, optional :: b
61
62    !$acc data copyin(a, b) copyout (res)
63    !$acc parallel
64    res = a
65    if (present(b)) res = res * b
66    call test_int_callee(res, a, b)
67    !$acc end parallel
68    !$acc end data
69  end subroutine test_int_caller
70
71  subroutine test_int_callee(res, a, b)
72    !$acc routine seq
73    integer :: res, a
74    integer, optional :: b
75
76    res = res + a
77    if (present(b)) res = res + b
78  end subroutine test_int_callee
79
80  subroutine test_array_caller(res, a, b)
81    integer :: res(n), a(n), i
82    integer, optional :: b(n)
83
84    !$acc data copyin(a, b) copyout(res)
85    !$acc parallel
86    !$acc loop seq
87    do i = 1, n
88      res(i) = a(i)
89      if (present(b)) res(i) = res(i) * b(i)
90    end do
91    call test_array_callee(res, a, b)
92    !$acc end parallel
93    !$acc end data
94  end subroutine test_array_caller
95
96  subroutine test_array_callee(res, a, b)
97    !$acc routine seq
98    integer :: res(n), a(n), i
99    integer, optional :: b(n)
100
101    do i = 1, n
102      res(i) = res(i) + a(i)
103      if (present(b)) res(i) = res(i) + b(i)
104    end do
105  end subroutine test_array_callee
106
107  subroutine test_allocatable_caller(res, a, b)
108    integer :: i
109    integer, allocatable :: res(:), a(:)
110    integer, allocatable, optional :: b(:)
111
112    !$acc data copyin(a, b) copyout(res)
113    !$acc parallel
114    !$acc loop seq
115    do i = 1, n
116      res(i) = a(i)
117      if (present(b)) res(i) = res(i) * b(i)
118    end do
119    call test_array_callee(res, a, b)
120    !$acc end parallel
121    !$acc end data
122  end subroutine test_allocatable_caller
123
124  subroutine test_allocatable_callee(res, a, b)
125    !$acc routine seq
126    integer :: i
127    integer, allocatable :: res(:), a(:)
128    integer, allocatable, optional :: b(:)
129
130    do i = 1, n
131      res(i) = res(i) + a(i)
132      if (present(b)) res(i) = res(i) + b(i)
133    end do
134  end subroutine test_allocatable_callee
135end program test
136