1! { dg-do run } 2! 3! Test data located inside common blocks. This test does not exercise 4! ACC DECLARE. All data clauses are explicit. 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 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 pcopy(/BLOCK/) 32 do i = 1, n 33 x(i) = x(i) + z 34 end do 35 !$acc end parallel loop 36end subroutine incr 37 38program main 39 use consts 40 41 implicit none 42 integer i, j 43 real*4 a(n), b(n), c 44 common /BLOCK/ a, b, c, j 45 46 ! Test copyout, pcopy, device 47 48 !$acc data copyout(a, c) 49 50 c = 1.0 51 52 !$acc update device(c) 53 54 !$acc parallel loop pcopy(a) 55 do i = 1, n 56 a(i) = i 57 end do 58 !$acc end parallel loop 59 60 call incr 61 call incr 62 call incr 63 !$acc end data 64 65 c = 3.0 66 call validate 67 68 ! Test pcopy without copyout 69 70 c = 2.0 71 call incr 72 c = 5.0 73 call validate 74 75 ! Test create, delete, host, copyout, copyin 76 77 !$acc enter data create(b) 78 79 !$acc parallel loop pcopy(b) 80 do i = 1, n 81 b(i) = i 82 end do 83 !$acc end parallel loop 84 85 !$acc update host (b) 86 87 !$acc parallel loop pcopy(b) copyout(a) copyin(c) 88 do i = 1, n 89 a(i) = b(i) + c 90 end do 91 !$acc end parallel loop 92 93 !$acc exit data delete(b) 94 95 call validate 96 97 a(:) = b(:) 98 c = 0.0 99 call validate 100 101 ! Test copy 102 103 c = 1.0 104 !$acc parallel loop copy(/BLOCK/) 105 do i = 1, n 106 a(i) = b(i) + c 107 end do 108 !$acc end parallel loop 109 110 call validate 111 112 ! Test pcopyin, pcopyout FIXME 113 114 c = 2.0 115 !$acc data copyin(b, c) copyout(a) 116 117 !$acc parallel loop pcopyin(b, c) pcopyout(a) 118 do i = 1, n 119 a(i) = b(i) + c 120 end do 121 !$acc end parallel loop 122 123 !$acc end data 124 125 call validate 126 127 ! Test reduction, private 128 129 j = 0 130 131 !$acc parallel private(i) copy(j) 132 !$acc loop reduction(+:j) 133 do i = 1, n 134 j = j + 1 135 end do 136 !$acc end parallel 137 138 if (j .ne. n) stop 2 139 140 ! Test firstprivate, copy 141 142 a(:) = 0 143 c = j 144 145 !$acc parallel loop firstprivate(c) copyout(a) 146 do i = 1, n 147 a(i) = i + c 148 end do 149 !$acc end parallel loop 150 151 call validate 152end program main 153