1! { dg-do run } 2! 3! This program does a correctness check for 4! ARRAY[idx] = SCALAR, ARRAY[idx] = ARRAY and SCALAR[idx] = SCALAR 5! 6program main 7 implicit none 8 integer, parameter :: n = 3 9 integer, parameter :: m = 4 10 11 ! Allocatable coarrays 12 call one(-5, 1) 13 call one(0, 0) 14 call one(1, -5) 15 call one(0, -11) 16 17 ! Static coarrays 18 call two() 19 call three() 20contains 21 subroutine one(lb1, lb2) 22 integer, value :: lb1, lb2 23 24 integer :: i_sgn1, i_sgn2, i, i_e, i_s, j, j_e, j_s 25 integer, allocatable :: caf(:,:)[:] 26 integer, allocatable :: a(:,:), b(:,:) 27 28 allocate(caf(lb1:n+lb1-1, lb2:m+lb2-1)[*], & 29 a(lb1:n+lb1-1, lb2:m+lb2-1), & 30 b(lb1:n+lb1-1, lb2:m+lb2-1)) 31 32 b = reshape([(i*33, i = 1, size(b))], shape(b)) 33 34 ! Whole array: ARRAY = SCALAR 35 caf = -42 36 a = -42 37 a(:,:) = b(lb1, lb2) 38 sync all 39 if (this_image() == 1) then 40 caf(:,:)[num_images()] = b(lb1, lb2) 41 end if 42 sync all 43 if (this_image() == num_images()) then 44 if (any (a /= caf)) & 45 STOP 1 46 end if 47 sync all 48 49 ! Whole array: ARRAY = ARRAY 50 caf = -42 51 a = -42 52 a(:,:) = b(:, :) 53 sync all 54 if (this_image() == 1) then 55 caf(:,:)[num_images()] = b(:, :) 56 end if 57 sync all 58 if (this_image() == num_images()) then 59 if (any (a /= caf)) & 60 STOP 2 61 end if 62 sync all 63 64 ! Scalar assignment 65 caf = -42 66 a = -42 67 do j = lb2, m+lb2-1 68 do i = n+lb1-1, 1, -2 69 a(i,j) = b(i,j) 70 end do 71 end do 72 do j = lb2, m+lb2-1 73 do i = 1, n+lb1-1, 2 74 a(i,j) = b(i,j) 75 end do 76 end do 77 sync all 78 if (this_image() == 1) then 79 do j = lb2, m+lb2-1 80 do i = n+lb1-1, 1, -2 81 caf(i,j)[num_images()] = b(i, j) 82 end do 83 end do 84 do j = lb2, m+lb2-1 85 do i = 1, n+lb1-1, 2 86 caf(i,j)[num_images()] = b(i, j) 87 end do 88 end do 89 end if 90 sync all 91 if (this_image() == num_images()) then 92 if (any (a /= caf)) & 93 STOP 3 94 end if 95 sync all 96 97 ! Array sections with different ranges and pos/neg strides 98 do i_sgn1 = -1, 1, 2 99 do i_sgn2 = -1, 1, 2 100 do i=lb1, n+lb1-1 101 do i_e=lb1, n+lb1-1 102 do i_s=1, n 103 do j=lb2, m+lb2-1 104 do j_e=lb2, m+lb2-1 105 do j_s=1, m 106 ! ARRAY = SCALAR 107 caf = -42 108 a = -42 109 a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) = b(lb1, lb2) 110 sync all 111 if (this_image() == 1) then 112 caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] & 113 = b(lb1, lb2) 114 end if 115 sync all 116 117 ! ARRAY = ARRAY 118 caf = -42 119 a = -42 120 a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) & 121 = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) 122 sync all 123 if (this_image() == 1) then 124 caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] & 125 = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) 126 end if 127 sync all 128 129 if (this_image() == num_images()) then 130 if (any (a /= caf)) then 131 print '(*(g0))', "bounds: ", lb1,":",n+lb1-1,", ", & 132 lb2,":",m+lb2-1 133 print '(*(g0))', "section: ", i,":",i_e,":",i_s*i_sgn1, & 134 ", ", j,":",j_e,":",j_s*i_sgn2 135 print *, i 136 print *, a 137 print *, caf 138 print *, a-caf 139 STOP 4 140 endif 141 end if 142 sync all 143 end do 144 end do 145 end do 146 end do 147 end do 148 end do 149 end do 150 end do 151 end subroutine one 152 153 subroutine two() 154 integer, parameter :: lb1 = -5, lb2 = 1 155 156 integer :: i_sgn1, i_sgn2, i, i_e, i_s, j, j_e, j_s 157 integer, save :: caf(lb1:n+lb1-1, lb2:m+lb2-1)[*] 158 integer, save :: a(lb1:n+lb1-1, lb2:m+lb2-1) 159 integer, save :: b(lb1:n+lb1-1, lb2:m+lb2-1) 160 161 b = reshape([(i*33, i = 1, size(b))], shape(b)) 162 163 ! Whole array: ARRAY = SCALAR 164 caf = -42 165 a = -42 166 a(:,:) = b(lb1, lb2) 167 sync all 168 if (this_image() == 1) then 169 caf(:,:)[num_images()] = b(lb1, lb2) 170 end if 171 sync all 172 if (this_image() == num_images()) then 173 if (any (a /= caf)) & 174 STOP 5 175 end if 176 177 ! Whole array: ARRAY = ARRAY 178 caf = -42 179 a = -42 180 a(:,:) = b(:, :) 181 sync all 182 if (this_image() == 1) then 183 caf(:,:)[num_images()] = b(:, :) 184 end if 185 sync all 186 if (this_image() == num_images()) then 187 if (any (a /= caf)) & 188 STOP 6 189 end if 190 sync all 191 192 ! Scalar assignment 193 caf = -42 194 a = -42 195 do j = lb2, m+lb2-1 196 do i = n+lb1-1, 1, -2 197 a(i,j) = b(i,j) 198 end do 199 end do 200 do j = lb2, m+lb2-1 201 do i = 1, n+lb1-1, 2 202 a(i,j) = b(i,j) 203 end do 204 end do 205 sync all 206 if (this_image() == 1) then 207 do j = lb2, m+lb2-1 208 do i = n+lb1-1, 1, -2 209 caf(i,j)[num_images()] = b(i, j) 210 end do 211 end do 212 do j = lb2, m+lb2-1 213 do i = 1, n+lb1-1, 2 214 caf(i,j)[num_images()] = b(i, j) 215 end do 216 end do 217 end if 218 sync all 219 if (this_image() == num_images()) then 220 if (any (a /= caf)) & 221 STOP 7 222 end if 223 sync all 224 225 ! Array sections with different ranges and pos/neg strides 226 do i_sgn1 = -1, 1, 2 227 do i_sgn2 = -1, 1, 2 228 do i=lb1, n+lb1-1 229 do i_e=lb1, n+lb1-1 230 do i_s=1, n 231 do j=lb2, m+lb2-1 232 do j_e=lb2, m+lb2-1 233 do j_s=1, m 234 ! ARRAY = SCALAR 235 caf = -42 236 a = -42 237 a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) = b(lb1, lb2) 238 sync all 239 if (this_image() == 1) then 240 caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] & 241 = b(lb1, lb2) 242 end if 243 sync all 244 245 ! ARRAY = ARRAY 246 caf = -42 247 a = -42 248 a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) & 249 = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) 250 sync all 251 if (this_image() == 1) then 252 caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] & 253 = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) 254 end if 255 sync all 256 257 if (this_image() == num_images()) then 258 if (any (a /= caf)) then 259 print '(*(g0))', "bounds: ", lb1,":",n+lb1-1,", ", & 260 lb2,":",m+lb2-1 261 print '(*(g0))', "section: ", i,":",i_e,":",i_s*i_sgn1, & 262 ", ", j,":",j_e,":",j_s*i_sgn2 263 print *, i 264 print *, a 265 print *, caf 266 print *, a-caf 267 STOP 8 268 endif 269 end if 270 sync all 271 end do 272 end do 273 end do 274 end do 275 end do 276 end do 277 end do 278 end do 279 end subroutine two 280 281 subroutine three() 282 integer, parameter :: lb1 = 0, lb2 = 0 283 284 integer :: i_sgn1, i_sgn2, i, i_e, i_s, j, j_e, j_s 285 integer, save :: caf(lb1:n+lb1-1, lb2:m+lb2-1)[*] 286 integer, save :: a(lb1:n+lb1-1, lb2:m+lb2-1) 287 integer, save :: b(lb1:n+lb1-1, lb2:m+lb2-1) 288 289 b = reshape([(i*33, i = 1, size(b))], shape(b)) 290 291 ! Whole array: ARRAY = SCALAR 292 caf = -42 293 a = -42 294 a(:,:) = b(lb1, lb2) 295 sync all 296 if (this_image() == 1) then 297 caf(:,:)[num_images()] = b(lb1, lb2) 298 end if 299 sync all 300 if (this_image() == num_images()) then 301 if (any (a /= caf)) & 302 STOP 9 303 end if 304 305 ! Whole array: ARRAY = ARRAY 306 caf = -42 307 a = -42 308 a(:,:) = b(:, :) 309 sync all 310 if (this_image() == 1) then 311 caf(:,:)[num_images()] = b(:, :) 312 end if 313 sync all 314 if (this_image() == num_images()) then 315 if (any (a /= caf)) & 316 STOP 10 317 end if 318 sync all 319 320 ! Scalar assignment 321 caf = -42 322 a = -42 323 do j = lb2, m+lb2-1 324 do i = n+lb1-1, 1, -2 325 a(i,j) = b(i,j) 326 end do 327 end do 328 do j = lb2, m+lb2-1 329 do i = 1, n+lb1-1, 2 330 a(i,j) = b(i,j) 331 end do 332 end do 333 sync all 334 if (this_image() == 1) then 335 do j = lb2, m+lb2-1 336 do i = n+lb1-1, 1, -2 337 caf(i,j)[num_images()] = b(i, j) 338 end do 339 end do 340 do j = lb2, m+lb2-1 341 do i = 1, n+lb1-1, 2 342 caf(i,j)[num_images()] = b(i, j) 343 end do 344 end do 345 end if 346 sync all 347 if (this_image() == num_images()) then 348 if (any (a /= caf)) & 349 STOP 11 350 end if 351 352 ! Array sections with different ranges and pos/neg strides 353 do i_sgn1 = -1, 1, 2 354 do i_sgn2 = -1, 1, 2 355 do i=lb1, n+lb1-1 356 do i_e=lb1, n+lb1-1 357 do i_s=1, n 358 do j=lb2, m+lb2-1 359 do j_e=lb2, m+lb2-1 360 do j_s=1, m 361 ! ARRAY = SCALAR 362 caf = -42 363 a = -42 364 a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) = b(lb1, lb2) 365 sync all 366 if (this_image() == 1) then 367 caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] & 368 = b(lb1, lb2) 369 end if 370 sync all 371 372 ! ARRAY = ARRAY 373 caf = -42 374 a = -42 375 a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) & 376 = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) 377 sync all 378 if (this_image() == 1) then 379 caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] & 380 = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) 381 end if 382 sync all 383 384 if (this_image() == num_images()) then 385 if (any (a /= caf)) then 386 print '(*(g0))', "bounds: ", lb1,":",n+lb1-1,", ", & 387 lb2,":",m+lb2-1 388 print '(*(g0))', "section: ", i,":",i_e,":",i_s*i_sgn1, & 389 ", ", j,":",j_e,":",j_s*i_sgn2 390 print *, i 391 print *, a 392 print *, caf 393 print *, a-caf 394 STOP 12 395 endif 396 end if 397 sync all 398 end do 399 end do 400 end do 401 end do 402 end do 403 end do 404 end do 405 end do 406 end subroutine three 407end program main 408