! Test that optional arguments work in firstprivate clauses. The effect of ! non-present arguments in firstprivate clauses is undefined, and is not ! tested for. ! { dg-do run } program test_firstprivate implicit none integer, parameter :: n = 64 integer :: i, j integer :: a_int, b_int, c_int, res_int integer :: a_arr(n), b_arr(n), c_arr(n), res_arr(n) integer, allocatable :: a_alloc(:), b_alloc(:), c_alloc(:), res_alloc(:) a_int = 14 b_int = 5 c_int = 12 call test_int(res_int, a_int, b_int, c_int) if (res_int .ne. a_int * b_int + c_int) stop 1 do i = 1, n a_arr(i) = i b_arr(i) = n - i + 1 c_arr(i) = i * 3 end do call test_array(res_arr, a_arr, b_arr, c_arr) do i = 1, n if (res_arr(i) .ne. a_arr(i) * b_arr(i) + c_arr(i)) stop 2 end do allocate(a_alloc(n)) allocate(b_alloc(n)) allocate(c_alloc(n)) allocate(res_alloc(n)) do i = 1, n a_arr(i) = i b_arr(i) = n - i + 1 c_arr(i) = i * 3 end do call test_allocatable(res_alloc, a_alloc, b_alloc, c_alloc) do i = 1, n if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i) + c_alloc(i)) stop 3 end do deallocate(a_alloc) deallocate(b_alloc) deallocate(c_alloc) deallocate(res_alloc) contains subroutine test_int(res, a, b, c) integer :: a integer, optional :: b, c integer :: res !$acc parallel firstprivate(a, b, c) copyout(res) res = a if (present(b)) res = res * b if (present(c)) res = res + c !$acc end parallel end subroutine test_int subroutine test_array(res, a, b, c) integer :: a(n) integer, optional :: b(n), c(n) integer :: res(n) !$acc data copyin(a, b, c) copyout(res) !$acc parallel loop firstprivate(a) do i = 1, n res(i) = a(i) end do !$acc parallel loop firstprivate(b) do i = 1, n if (present(b)) res(i) = res(i) * b(i) end do !$acc parallel loop firstprivate(c) do i = 1, n if (present(c)) res(i) = res(i) + c(i) end do !$acc end data end subroutine test_array subroutine test_allocatable(res, a, b, c) integer, allocatable :: a(:) integer, allocatable, optional :: b(:), c(:) integer, allocatable :: res(:) !$acc data copyin(a, b, c) copyout(res) !$acc parallel loop firstprivate(a) do i = 1, n res(i) = a(i) end do !$acc parallel loop firstprivate(b) do i = 1, n if (present(b)) res(i) = res(i) * b(i) end do !$acc parallel loop firstprivate(c) do i = 1, n if (present(c)) res(i) = res(i) + c(i) end do !$acc end data end subroutine test_allocatable end program test_firstprivate