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