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