1! Test OpenACC data regions with a copy-in 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, c_int, res_int
11  integer :: a_arr(n), b_arr(n), c_arr(n), res_arr(n)
12  integer, allocatable :: a_alloc(:), b_alloc(:), c_alloc(:), res_alloc(:)
13
14  a_int = 7
15  b_int = 3
16  c_int = 11
17
18  call test_int(res_int, a_int)
19  if (res_int .ne. a_int) stop 1
20
21  call test_int(res_int, a_int, b_int)
22  if (res_int .ne. a_int * b_int) stop 2
23
24  call test_int(res_int, a_int, b_int, c_int)
25  if (res_int .ne. a_int * b_int + c_int) stop 3
26
27  do i = 1, n
28    a_arr(i) = i
29    b_arr(i) = n - i + 1
30    c_arr(i) = i * 3
31  end do
32
33  call test_array(res_arr, a_arr)
34  do i = 1, n
35    if (res_arr(i) .ne. a_arr(i)) stop 4
36  end do
37
38  call test_array(res_arr, a_arr, b_arr)
39  do i = 1, n
40    if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 5
41  end do
42
43  call test_array(res_arr, a_arr, b_arr, c_arr)
44  do i = 1, n
45    if (res_arr(i) .ne. a_arr(i) * b_arr(i) + c_arr(i)) stop 6
46  end do
47
48  allocate (a_alloc(n))
49  allocate (b_alloc(n))
50  allocate (c_alloc(n))
51  allocate (res_alloc(n))
52
53  do i = 1, n
54    a_alloc(i) = i
55    b_alloc(i) = n - i + 1
56    c_alloc(i) = i * 3
57  end do
58
59  call test_allocatable(res_alloc, a_alloc)
60  do i = 1, n
61    if (res_alloc(i) .ne. a_alloc(i)) stop 7
62  end do
63
64  call test_allocatable(res_alloc, a_alloc, b_alloc)
65  do i = 1, n
66    if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 8
67  end do
68
69  call test_allocatable(res_alloc, a_alloc, b_alloc, c_alloc)
70  do i = 1, n
71    if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i) + c_alloc(i)) stop 9
72  end do
73
74  deallocate (a_alloc)
75  deallocate (b_alloc)
76  deallocate (c_alloc)
77  deallocate (res_alloc)
78contains
79  subroutine test_int(res, a, b, c)
80    integer :: res
81    integer :: a
82    integer, optional :: b, c
83
84    !$acc data copyin(a, b, c) copyout(res)
85    !$acc parallel
86    res = a
87
88    if (present(b)) res = res * b
89
90    if (present(c)) res = res + c
91    !$acc end parallel
92    !$acc end data
93  end subroutine test_int
94
95  subroutine test_array(res, a, b, c)
96    integer :: res(n)
97    integer :: a(n)
98    integer, optional :: b(n), c(n)
99
100    !$acc data copyin(a, b, c) copyout(res)
101    !$acc parallel loop
102    do i = 1, n
103      res(i) = a(i)
104    end do
105
106    !$acc parallel loop
107    do i = 1, n
108      if (present(b)) res(i) = res(i) * b(i)
109    end do
110
111    !$acc parallel loop
112    do i = 1, n
113      if (present(c)) res(i) = res(i) + c(i)
114    end do
115    !$acc end data
116  end subroutine test_array
117
118  subroutine test_allocatable(res, a, b, c)
119    integer, allocatable :: res(:)
120    integer, allocatable  :: a(:)
121    integer, allocatable, optional :: b(:), c(:)
122
123    !$acc data copyin(a, b, c) copyout(res)
124    !$acc parallel loop
125    do i = 1, n
126      res(i) = a(i)
127    end do
128
129    !$acc parallel loop
130    do i = 1, n
131      if (present(b)) res(i) = res(i) * b(i)
132    end do
133
134    !$acc parallel loop
135    do i = 1, n
136      if (present(c)) res(i) = res(i) + c(i)
137    end do
138    !$acc end data
139  end subroutine test_allocatable
140end program test
141