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

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/18918
   4 !
   5 ! Version for scalar coarrays
   6 !
   7 ! this_image(coarray) run test,
   8 ! expecially for num_images > 1
   9 !
  10 ! Tested are values up to num_images == 8,
  11 ! higher values are OK, but not tested for
  12 !
  13 implicit none
  14 integer :: a[2:2, 3:4, 7:*]
  15 integer :: i
  16
  17 if (this_image(A, dim=1) /= 2) call abort()
  18 i = 1
  19 if (this_image(A, dim=i) /= 2) call abort()
  20
  21 select case (this_image())
  22   case (1)
  23     if (this_image(A, dim=2) /= 3) call abort()
  24     if (this_image(A, dim=3) /= 7) call abort()
  25     i = 2
  26     if (this_image(A, dim=i) /= 3) call abort()
  27     i = 3
  28     if (this_image(A, dim=i) /= 7) call abort()
  29     if (any (this_image(A) /= [2,3,7])) call abort()
  30
  31   case (2)
  32     if (this_image(A, dim=2) /= 4) call abort()
  33     if (this_image(A, dim=3) /= 7) call abort()
  34     i = 2
  35     if (this_image(A, dim=i) /= 4) call abort()
  36     i = 3
  37     if (this_image(A, dim=i) /= 7) call abort()
  38     if (any (this_image(A) /= [2,4,7])) call abort()
  39
  40   case (3)
  41     if (this_image(A, dim=2) /= 3) call abort()
  42     if (this_image(A, dim=3) /= 8) call abort()
  43     i = 2
  44     if (this_image(A, dim=i) /= 3) call abort()
  45     i = 3
  46     if (this_image(A, dim=i) /= 8) call abort()
  47     if (any (this_image(A) /= [2,3,8])) call abort()
  48
  49   case (4)
  50     if (this_image(A, dim=2) /= 4) call abort()
  51     if (this_image(A, dim=3) /= 8) call abort()
  52     i = 2
  53     if (this_image(A, dim=i) /= 4) call abort()
  54     i = 3
  55     if (this_image(A, dim=i) /= 8) call abort()
  56     if (any (this_image(A) /= [2,4,8])) call abort()
  57
  58   case (5)
  59     if (this_image(A, dim=2) /= 3) call abort()
  60     if (this_image(A, dim=3) /= 9) call abort()
  61     i = 2
  62     if (this_image(A, dim=i) /= 3) call abort()
  63     i = 3
  64     if (this_image(A, dim=i) /= 9) call abort()
  65     if (any (this_image(A) /= [2,3,9])) call abort()
  66
  67   case (6)
  68     if (this_image(A, dim=2) /= 4) call abort()
  69     if (this_image(A, dim=3) /= 9) call abort()
  70     i = 2
  71     if (this_image(A, dim=i) /= 4) call abort()
  72     i = 3
  73     if (this_image(A, dim=i) /= 9) call abort()
  74     if (any (this_image(A) /= [2,4,9])) call abort()
  75
  76   case (7)
  77     if (this_image(A, dim=2) /= 3) call abort()
  78     if (this_image(A, dim=3) /= 10) call abort()
  79     i = 2
  80     if (this_image(A, dim=i) /= 3) call abort()
  81     i = 3
  82     if (this_image(A, dim=i) /= 10) call abort()
  83     if (any (this_image(A) /= [2,3,10])) call abort()
  84
  85   case (8)
  86     if (this_image(A, dim=2) /= 4) call abort()
  87     if (this_image(A, dim=3) /= 10) call abort()
  88     i = 2
  89     if (this_image(A, dim=i) /= 4) call abort()
  90     i = 3
  91     if (this_image(A, dim=i) /= 10) call abort()
  92     if (any (this_image(A) /= [2,4,10])) call abort()
  93 end select
  94
  95 contains
  96
  97 subroutine test_image_index
  98 implicit none
  99 integer :: index1, index2, index3
 100 logical :: one
 101
 102 integer, save :: d(2)[-1:3, *]
 103 integer, save :: e(2)[-1:-1, 3:*]
 104
 105 one = num_images() == 1
 106
 107 index1 = image_index(d, [-1, 1] )
 108 index2 = image_index(d, [0, 1] )
 109
 110 if (one .and. (index1 /= 1 .or. index2 /= 0)) &
 111   call abort()
 112 if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
 113   call abort()
 114
 115 index1 = image_index(e, [-1, 3] )
 116 index2 = image_index(e, [-1, 4] )
 117
 118 if (one .and. (index1 /= 1 .or. index2 /= 0)) &
 119   call abort()
 120 if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
 121   call abort()
 122
 123 end subroutine test_image_index
 124
 125 end