1! Test OpenACC declare directives with 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, c_int, res_int 11 integer :: a_arr(n), b_arr(n), c_arr(n), res_arr(n) 12 13 a_int = 7 14 b_int = 3 15 c_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 call test_int(res_int, a_int, b_int, c_int) 24 if (res_int .ne. a_int * b_int + c_int) stop 3 25 26 do i = 1, n 27 a_arr(i) = i 28 b_arr(i) = n - i + 1 29 c_arr(i) = i * 3 30 end do 31 32 call test_array(res_arr, a_arr) 33 do i = 1, n 34 if (res_arr(i) .ne. a_arr(i)) stop 4 35 end do 36 37 call test_array(res_arr, a_arr, b_arr) 38 do i = 1, n 39 if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 5 40 end do 41 42 call test_array(res_arr, a_arr, b_arr, c_arr) 43 do i = 1, n 44 if (res_arr(i) .ne. a_arr(i) * b_arr(i) + c_arr(i)) stop 6 45 end do 46contains 47 subroutine test_int(res, a, b, c) 48 integer :: a 49 integer, optional :: b, c 50 !$acc declare present_or_copyin(a, b, c) 51 integer :: res 52 !$acc declare present_or_copyout(res) 53 54 !$acc parallel 55 res = a 56 if (present(b)) res = res * b 57 if (present(c)) res = res + c 58 !$acc end parallel 59 end subroutine test_int 60 61 subroutine test_array(res, a, b, c) 62 integer :: a(n) 63 integer, optional :: b(n), c(n) 64 !$acc declare present_or_copyin(a, b, c) 65 integer :: res(n) 66 !$acc declare present_or_copyout(res) 67 68 !$acc parallel loop 69 do i = 1, n 70 res(i) = a(i) 71 end do 72 73 !$acc parallel loop 74 do i = 1, n 75 if (present(b)) then 76 res(i) = res(i) * b(i) 77 end if 78 end do 79 80 !$acc parallel loop 81 do i = 1, n 82 if (present(c)) then 83 res(i) = res(i) + c(i) 84 end if 85 end do 86 end subroutine test_array 87end program test 88