1! Test OpenACC data regions with a copy-out of optional arguments.
2
3! { dg-do run }
4
5program test
6  implicit none
7
8  integer, parameter :: n = 64
9  integer :: i
10  integer :: a_int, b_int, res_int
11  integer :: a_arr(n), b_arr(n), res_arr(n)
12  integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:)
13
14  res_int = 0
15
16  call test_int(a_int, b_int)
17  if (res_int .ne. 0) stop 1
18
19  call test_int(a_int, b_int, res_int)
20  if (res_int .ne. a_int * b_int) stop 2
21
22  res_arr(:) = 0
23  do i = 1, n
24    a_arr(i) = i
25    b_arr(i) = n - i + 1
26  end do
27
28  call test_array(a_arr, b_arr)
29  do i = 1, n
30    if (res_arr(i) .ne. 0) stop 3
31  end do
32
33  call test_array(a_arr, b_arr, res_arr)
34  do i = 1, n
35    if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 4
36  end do
37
38  allocate (a_alloc(n))
39  allocate (b_alloc(n))
40  allocate (res_alloc(n))
41
42  res_alloc(:) = 0
43  do i = 1, n
44    a_alloc(i) = i
45    b_alloc(i) = n - i + 1
46  end do
47
48  call test_allocatable(a_alloc, b_alloc)
49  do i = 1, n
50    if (res_alloc(i) .ne. 0) stop 5
51  end do
52
53  call test_allocatable(a_alloc, b_alloc, res_alloc)
54  do i = 1, n
55    if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 6
56  end do
57
58  deallocate (a_alloc)
59  deallocate (b_alloc)
60  deallocate (res_alloc)
61contains
62  subroutine test_int(a, b, res)
63    integer :: a, b
64    integer, optional :: res
65
66    !$acc data copyin(a, b) copyout(res)
67    !$acc parallel
68    if (present(res)) res = a * b
69    !$acc end parallel
70    !$acc end data
71  end subroutine test_int
72
73  subroutine test_array(a, b, res)
74    integer :: a(n), b(n)
75    integer, optional :: res(n)
76
77    !$acc data copyin(a, b) copyout(res)
78    !$acc parallel loop
79    do i = 1, n
80      if (present(res)) res(i) = a(i) * b(i)
81    end do
82    !$acc end data
83  end subroutine test_array
84
85  subroutine test_allocatable(a, b, res)
86    integer, allocatable :: a(:), b(:)
87    integer, allocatable, optional :: res(:)
88
89    !$acc data copyin(a, b) copyout(res)
90    !$acc parallel loop
91    do i = 1, n
92      if (present(res)) res(i) = a(i) * b(i)
93    end do
94    !$acc end data
95  end subroutine test_allocatable
96end program test
97