blob: feaa31fa4239d47a13e6de106c69095d88cbf2c1 [file] [log] [blame]
! Test OpenACC data regions with a copy-out of optional arguments.
! { dg-do run }
program test
implicit none
integer, parameter :: n = 64
integer :: i
integer :: a_int, b_int, res_int
integer :: a_arr(n), b_arr(n), res_arr(n)
integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:)
res_int = 0
call test_int(a_int, b_int)
if (res_int .ne. 0) stop 1
call test_int(a_int, b_int, res_int)
if (res_int .ne. a_int * b_int) stop 2
res_arr(:) = 0
do i = 1, n
a_arr(i) = i
b_arr(i) = n - i + 1
end do
call test_array(a_arr, b_arr)
do i = 1, n
if (res_arr(i) .ne. 0) stop 3
end do
call test_array(a_arr, b_arr, res_arr)
do i = 1, n
if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 4
end do
allocate (a_alloc(n))
allocate (b_alloc(n))
allocate (res_alloc(n))
res_alloc(:) = 0
do i = 1, n
a_alloc(i) = i
b_alloc(i) = n - i + 1
end do
call test_allocatable(a_alloc, b_alloc)
do i = 1, n
if (res_alloc(i) .ne. 0) stop 5
end do
call test_allocatable(a_alloc, b_alloc, res_alloc)
do i = 1, n
if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 6
end do
deallocate (a_alloc)
deallocate (b_alloc)
deallocate (res_alloc)
contains
subroutine test_int(a, b, res)
integer :: a, b
integer, optional :: res
!$acc data copyin(a, b) copyout(res)
!$acc parallel
if (present(res)) res = a * b
!$acc end parallel
!$acc end data
end subroutine test_int
subroutine test_array(a, b, res)
integer :: a(n), b(n)
integer, optional :: res(n)
!$acc data copyin(a, b) copyout(res)
!$acc parallel loop
do i = 1, n
if (present(res)) res(i) = a(i) * b(i)
end do
!$acc end data
end subroutine test_array
subroutine test_allocatable(a, b, res)
integer, allocatable :: a(:), b(:)
integer, allocatable, optional :: res(:)
!$acc data copyin(a, b) copyout(res)
!$acc parallel loop
do i = 1, n
if (present(res)) res(i) = a(i) * b(i)
end do
!$acc end data
end subroutine test_allocatable
end program test