1! Test that optional arguments work in firstprivate clauses. The effect of 2! non-present arguments in firstprivate clauses is undefined, and is not 3! tested for. 4 5! { dg-do run } 6 7program test_firstprivate 8 implicit none 9 integer, parameter :: n = 64 10 11 integer :: i, j 12 integer :: a_int, b_int, c_int, res_int 13 integer :: a_arr(n), b_arr(n), c_arr(n), res_arr(n) 14 integer, allocatable :: a_alloc(:), b_alloc(:), c_alloc(:), res_alloc(:) 15 16 a_int = 14 17 b_int = 5 18 c_int = 12 19 20 call test_int(res_int, a_int, b_int, c_int) 21 if (res_int .ne. a_int * b_int + c_int) stop 1 22 23 do i = 1, n 24 a_arr(i) = i 25 b_arr(i) = n - i + 1 26 c_arr(i) = i * 3 27 end do 28 29 call test_array(res_arr, a_arr, b_arr, c_arr) 30 do i = 1, n 31 if (res_arr(i) .ne. a_arr(i) * b_arr(i) + c_arr(i)) stop 2 32 end do 33 34 allocate(a_alloc(n)) 35 allocate(b_alloc(n)) 36 allocate(c_alloc(n)) 37 allocate(res_alloc(n)) 38 39 do i = 1, n 40 a_arr(i) = i 41 b_arr(i) = n - i + 1 42 c_arr(i) = i * 3 43 end do 44 45 call test_allocatable(res_alloc, a_alloc, b_alloc, c_alloc) 46 do i = 1, n 47 if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i) + c_alloc(i)) stop 3 48 end do 49 50 deallocate(a_alloc) 51 deallocate(b_alloc) 52 deallocate(c_alloc) 53 deallocate(res_alloc) 54contains 55 subroutine test_int(res, a, b, c) 56 integer :: a 57 integer, optional :: b, c 58 integer :: res 59 60 !$acc parallel firstprivate(a, b, c) copyout(res) 61 res = a 62 if (present(b)) res = res * b 63 if (present(c)) res = res + c 64 !$acc end parallel 65 end subroutine test_int 66 67 subroutine test_array(res, a, b, c) 68 integer :: a(n) 69 integer, optional :: b(n), c(n) 70 integer :: res(n) 71 72 !$acc data copyin(a, b, c) copyout(res) 73 !$acc parallel loop firstprivate(a) 74 do i = 1, n 75 res(i) = a(i) 76 end do 77 78 !$acc parallel loop firstprivate(b) 79 do i = 1, n 80 if (present(b)) res(i) = res(i) * b(i) 81 end do 82 83 !$acc parallel loop firstprivate(c) 84 do i = 1, n 85 if (present(c)) res(i) = res(i) + c(i) 86 end do 87 !$acc end data 88 end subroutine test_array 89 90 subroutine test_allocatable(res, a, b, c) 91 integer, allocatable :: a(:) 92 integer, allocatable, optional :: b(:), c(:) 93 integer, allocatable :: res(:) 94 95 !$acc data copyin(a, b, c) copyout(res) 96 !$acc parallel loop firstprivate(a) 97 do i = 1, n 98 res(i) = a(i) 99 end do 100 101 !$acc parallel loop firstprivate(b) 102 do i = 1, n 103 if (present(b)) res(i) = res(i) * b(i) 104 end do 105 106 !$acc parallel loop firstprivate(c) 107 do i = 1, n 108 if (present(c)) res(i) = res(i) + c(i) 109 end do 110 !$acc end data 111 end subroutine test_allocatable 112end program test_firstprivate 113