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

   1 ! { dg-do run }
   2 !
   3 ! From the HPCTools Group of University of Houston
   4 !
   5 ! For a coindexed object, its cosubscript list determines the image
   6 ! index in the same way that a subscript list determines the subscript
   7 ! order value for an array element
   8
   9 ! Run at least with 3 images for the normal checking code
  10 ! Modified to also accept a single or two images
  11 program cosubscript_test
  12   implicit none
  13
  14   integer, parameter :: X = 3, Y = 2
  15   integer, parameter :: P = 1, Q = -1
  16   integer :: me
  17   integer :: i,j,k
  18
  19   integer :: scalar[0:P, -1:Q, *]
  20
  21   integer :: dim3_max, counter
  22   logical :: is_err
  23
  24   is_err = .false.
  25   me = this_image()
  26   scalar   = me
  27   dim3_max = num_images() / ( (P+1)*(Q+2) )
  28
  29   sync all
  30
  31   if (num_images() == 1) then
  32     k = 1
  33     j = -1
  34     i = 0
  35     if (scalar[i,j,k] /= this_image()) STOP 1
  36     stop "OK"
  37   else if (num_images() == 2) then
  38     k = 1
  39     j = -1
  40     counter = 0
  41     do i = 0,P
  42       counter = counter+1
  43       if (counter /= scalar[i,j,k]) STOP 1
  44     end do
  45     stop "OK"
  46   end if
  47
  48   ! ******* SCALAR ***********
  49   counter = 0
  50   do k = 1, dim3_max
  51      do j = -1,Q
  52         do i = 0,P
  53            counter = counter+1
  54            if (counter /= scalar[i,j,k]) then
  55               print * , "Error in cosubscript translation scalar"
  56               print * , "[", i,",",j,",",k,"] = ",scalar[i,j,k],"/=",counter
  57               is_err = .true.
  58            end if
  59         end do
  60      end do
  61   end do
  62
  63   if (is_err) then
  64     STOP 2
  65   end if
  66 end program cosubscript_test