1! { dg-do run } 2! 3! Test data located inside common blocks. This test does not exercise 4! ACC DECLARE. Most of the data clauses are implicit. 5 6module consts 7 integer, parameter :: n = 100 8end module consts 9 10subroutine validate 11 use consts 12 13 implicit none 14 integer i, j 15 real*4 x(n), y(n), z 16 common /BLOCK/ x, y, z, j 17 18 do i = 1, n 19 if (abs(x(i) - i - z) .ge. 0.0001) stop 1 20 end do 21end subroutine validate 22 23subroutine incr_parallel 24 use consts 25 26 implicit none 27 integer i, j 28 real*4 x(n), y(n), z 29 common /BLOCK/ x, y, z, j 30 31 !$acc parallel loop 32 do i = 1, n 33 x(i) = x(i) + z 34 end do 35 !$acc end parallel loop 36end subroutine incr_parallel 37 38subroutine incr_kernels 39 use consts 40 41 implicit none 42 integer i, j 43 real*4 x(n), y(n), z 44 common /BLOCK/ x, y, z, j 45 46 !$acc kernels 47 do i = 1, n 48 x(i) = x(i) + z 49 end do 50 !$acc end kernels 51end subroutine incr_kernels 52 53program main 54 use consts 55 56 implicit none 57 integer i, j 58 real*4 a(n), b(n), c 59 common /BLOCK/ a, b, c, j 60 61 !$acc data copyout(a, c) 62 63 c = 1.0 64 65 !$acc update device(c) 66 67 !$acc parallel loop 68 do i = 1, n 69 a(i) = i 70 end do 71 !$acc end parallel loop 72 73 call incr_parallel 74 call incr_parallel 75 call incr_parallel 76 !$acc end data 77 78 c = 3.0 79 call validate 80 81 ! Test pcopy without copyout 82 83 c = 2.0 84 call incr_kernels 85 c = 5.0 86 call validate 87 88 !$acc kernels 89 do i = 1, n 90 b(i) = i 91 end do 92 !$acc end kernels 93 94 !$acc parallel loop 95 do i = 1, n 96 a(i) = b(i) + c 97 end do 98 !$acc end parallel loop 99 100 call validate 101 102 a(:) = b(:) 103 c = 0.0 104 call validate 105 106 ! Test copy 107 108 c = 1.0 109 !$acc parallel loop 110 do i = 1, n 111 a(i) = b(i) + c 112 end do 113 !$acc end parallel loop 114 115 call validate 116 117 c = 2.0 118 !$acc data copyin(b, c) copyout(a) 119 120 !$acc kernels 121 do i = 1, n 122 a(i) = b(i) + c 123 end do 124 !$acc end kernels 125 126 !$acc end data 127 128 call validate 129 130 j = 0 131 132 !$acc parallel loop reduction(+:j) 133 do i = 1, n 134 j = j + 1 135 end do 136 !$acc end parallel loop 137 138 if (j .ne. n) stop 2 139end program main 140