gcc/testsuite/gfortran.dg/coarray/send_array.f90

   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 !
   6 program 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()
  20 contains
  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            call abort()
  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            call abort()
  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            call abort()
  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                         call abort()
 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            call abort()
 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            call abort()
 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            call abort()
 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                         call abort()
 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            call abort()
 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            call abort()
 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            call abort()
 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                         call abort()
 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
 407 end program main