1! Test propagation of optional arguments from within an OpenACC parallel region. 2 3! { dg-do run } 4 5program test 6 implicit none 7 8 integer, parameter :: n = 64 9 integer :: i 10 integer :: res_int 11 integer :: a_arr(n), b_arr(n), res_arr(n) 12 integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:) 13 14 call test_int_caller(res_int, 5) 15 if (res_int .ne. 10) stop 1 16 17 call test_int_caller(res_int, 2, 3) 18 if (res_int .ne. 11) stop 2 19 20 do i = 1, n 21 a_arr(i) = i 22 b_arr(i) = n - i + 1 23 end do 24 25 call test_array_caller(res_arr, a_arr) 26 do i = 1, n 27 if (res_arr(i) .ne. 2 * a_arr(i)) stop 3 28 end do 29 30 call test_array_caller(res_arr, a_arr, b_arr) 31 do i = 1, n 32 if (res_arr(i) .ne. a_arr(i) * b_arr(i) + a_arr(i) + b_arr(i)) stop 4 33 end do 34 35 allocate(a_alloc(n)) 36 allocate(b_alloc(n)) 37 allocate(res_alloc(n)) 38 39 do i = 1, n 40 a_alloc(i) = i 41 b_alloc(i) = n - i + 1 42 end do 43 44 call test_array_caller(res_arr, a_arr) 45 do i = 1, n 46 if (res_arr(i) .ne. 2 * a_alloc(i)) stop 5 47 end do 48 49 call test_array_caller(res_arr, a_arr, b_arr) 50 do i = 1, n 51 if (res_arr(i) .ne. a_arr(i) * b_alloc(i) + a_alloc(i) + b_alloc(i)) stop 6 52 end do 53 54 deallocate(a_alloc) 55 deallocate(b_alloc) 56 deallocate(res_alloc) 57contains 58 subroutine test_int_caller(res, a, b) 59 integer :: res, a 60 integer, optional :: b 61 62 !$acc data copyin(a, b) copyout (res) 63 !$acc parallel 64 res = a 65 if (present(b)) res = res * b 66 call test_int_callee(res, a, b) 67 !$acc end parallel 68 !$acc end data 69 end subroutine test_int_caller 70 71 subroutine test_int_callee(res, a, b) 72 !$acc routine seq 73 integer :: res, a 74 integer, optional :: b 75 76 res = res + a 77 if (present(b)) res = res + b 78 end subroutine test_int_callee 79 80 subroutine test_array_caller(res, a, b) 81 integer :: res(n), a(n), i 82 integer, optional :: b(n) 83 84 !$acc data copyin(a, b) copyout(res) 85 !$acc parallel 86 !$acc loop seq 87 do i = 1, n 88 res(i) = a(i) 89 if (present(b)) res(i) = res(i) * b(i) 90 end do 91 call test_array_callee(res, a, b) 92 !$acc end parallel 93 !$acc end data 94 end subroutine test_array_caller 95 96 subroutine test_array_callee(res, a, b) 97 !$acc routine seq 98 integer :: res(n), a(n), i 99 integer, optional :: b(n) 100 101 do i = 1, n 102 res(i) = res(i) + a(i) 103 if (present(b)) res(i) = res(i) + b(i) 104 end do 105 end subroutine test_array_callee 106 107 subroutine test_allocatable_caller(res, a, b) 108 integer :: i 109 integer, allocatable :: res(:), a(:) 110 integer, allocatable, optional :: b(:) 111 112 !$acc data copyin(a, b) copyout(res) 113 !$acc parallel 114 !$acc loop seq 115 do i = 1, n 116 res(i) = a(i) 117 if (present(b)) res(i) = res(i) * b(i) 118 end do 119 call test_array_callee(res, a, b) 120 !$acc end parallel 121 !$acc end data 122 end subroutine test_allocatable_caller 123 124 subroutine test_allocatable_callee(res, a, b) 125 !$acc routine seq 126 integer :: i 127 integer, allocatable :: res(:), a(:) 128 integer, allocatable, optional :: b(:) 129 130 do i = 1, n 131 res(i) = res(i) + a(i) 132 if (present(b)) res(i) = res(i) + b(i) 133 end do 134 end subroutine test_allocatable_callee 135end program test 136