1! Test OpenACC update to device with an optional argument.
2
3! { dg-do run }
4
5program optional_update_device
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  a_int = 5
15  b_int = 11
16
17  call test_int(res_int, a_int)
18  if (res_int .ne. a_int) stop 1
19
20  call test_int(res_int, a_int, b_int)
21  if (res_int .ne. a_int * b_int) stop 2
22
23  res_arr(:) = 0
24  do i = 1, n
25    a_arr(i) = i
26    b_arr(i) = n - i + 1
27  end do
28
29  call test_array(res_arr, a_arr)
30  do i = 1, n
31    if (res_arr(i) .ne. a_arr(i)) stop 3
32  end do
33
34  call test_array(res_arr, a_arr, b_arr)
35  do i = 1, n
36    if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 4
37  end do
38
39  allocate (a_alloc(n))
40  allocate (b_alloc(n))
41  allocate (res_alloc(n))
42
43  res_alloc(:) = 0
44  do i = 1, n
45    a_alloc(i) = i
46    b_alloc(i) = n - i + 1
47  end do
48
49  call test_allocatable(res_alloc, a_alloc)
50  do i = 1, n
51    if (res_alloc(i) .ne. a_alloc(i)) stop 5
52  end do
53
54  call test_allocatable(res_alloc, a_alloc, b_alloc)
55  do i = 1, n
56    if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 6
57  end do
58
59  deallocate (a_alloc)
60  deallocate (b_alloc)
61  deallocate (res_alloc)
62contains
63  subroutine test_int(res, a, b)
64    integer :: res
65    integer :: a
66    integer, optional :: b
67
68    !$acc data create(a, b, res)
69    !$acc update device(a, b)
70    !$acc parallel
71    res = a
72    if (present(b)) res = res * b
73    !$acc end parallel
74    !$acc update self(res)
75    !$acc end data
76  end subroutine test_int
77
78  subroutine test_array(res, a, b)
79    integer :: res(n)
80    integer :: a(n)
81    integer, optional :: b(n)
82
83    !$acc data create(a, b, res)
84    !$acc update device(a, b)
85    !$acc parallel loop
86    do i = 1, n
87      res(i) = a(i)
88    end do
89
90    !$acc parallel loop
91    do i = 1, n
92      if (present(b)) then
93        res(i) = res(i) * b(i)
94      end if
95    end do
96    !$acc update self(res)
97    !$acc end data
98  end subroutine test_array
99
100  subroutine test_allocatable(res, a, b)
101    integer, allocatable :: res(:)
102    integer, allocatable :: a(:)
103    integer, allocatable, optional :: b(:)
104
105    !$acc data create(a, b, res)
106    !$acc update device(a, b)
107    !$acc parallel loop
108    do i = 1, n
109      res(i) = a(i)
110    end do
111
112    !$acc parallel loop
113    do i = 1, n
114      if (present(b)) then
115        res(i) = res(i) * b(i)
116      end if
117    end do
118    !$acc update self(res)
119    !$acc end data
120  end subroutine test_allocatable
121end program optional_update_device
122