1! Test OpenACC update to device with an optional argument. 2 3! { dg-do run } 4 5program optional_update_device 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 a_int = 5 15 b_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 res_arr(:) = 0 24 do i = 1, n 25 a_arr(i) = i 26 b_arr(i) = n - i + 1 27 end do 28 29 call test_array(res_arr, a_arr) 30 do i = 1, n 31 if (res_arr(i) .ne. a_arr(i)) stop 3 32 end do 33 34 call test_array(res_arr, a_arr, b_arr) 35 do i = 1, n 36 if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 4 37 end do 38 39 allocate (a_alloc(n)) 40 allocate (b_alloc(n)) 41 allocate (res_alloc(n)) 42 43 res_alloc(:) = 0 44 do i = 1, n 45 a_alloc(i) = i 46 b_alloc(i) = n - i + 1 47 end do 48 49 call test_allocatable(res_alloc, a_alloc) 50 do i = 1, n 51 if (res_alloc(i) .ne. a_alloc(i)) stop 5 52 end do 53 54 call test_allocatable(res_alloc, a_alloc, b_alloc) 55 do i = 1, n 56 if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 6 57 end do 58 59 deallocate (a_alloc) 60 deallocate (b_alloc) 61 deallocate (res_alloc) 62contains 63 subroutine test_int(res, a, b) 64 integer :: res 65 integer :: a 66 integer, optional :: b 67 68 !$acc data create(a, b, res) 69 !$acc update device(a, b) 70 !$acc parallel 71 res = a 72 if (present(b)) res = res * b 73 !$acc end parallel 74 !$acc update self(res) 75 !$acc end data 76 end subroutine test_int 77 78 subroutine test_array(res, a, b) 79 integer :: res(n) 80 integer :: a(n) 81 integer, optional :: b(n) 82 83 !$acc data create(a, b, res) 84 !$acc update device(a, b) 85 !$acc parallel loop 86 do i = 1, n 87 res(i) = a(i) 88 end do 89 90 !$acc parallel loop 91 do i = 1, n 92 if (present(b)) then 93 res(i) = res(i) * b(i) 94 end if 95 end do 96 !$acc update self(res) 97 !$acc end data 98 end subroutine test_array 99 100 subroutine test_allocatable(res, a, b) 101 integer, allocatable :: res(:) 102 integer, allocatable :: a(:) 103 integer, allocatable, optional :: b(:) 104 105 !$acc data create(a, b, res) 106 !$acc update device(a, b) 107 !$acc parallel loop 108 do i = 1, n 109 res(i) = a(i) 110 end do 111 112 !$acc parallel loop 113 do i = 1, n 114 if (present(b)) then 115 res(i) = res(i) * b(i) 116 end if 117 end do 118 !$acc update self(res) 119 !$acc end data 120 end subroutine test_allocatable 121end program optional_update_device 122