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