gomp-20050608-branch/gcc/testsuite/gfortran.fortran-torture/execute/forall_7.f90

   1 ! tests FORALL statements with a mask
   2 program forall_7
   3   real, dimension (5, 5, 5, 5) :: a, b, c, d
   4
   5   a (:, :, :, :) = 4
   6   forall (i = 1:5)
   7     a (i, i, 6 - i, i) = 7
   8   end forall
   9   forall (i = 1:5)
  10     a (i, 6 - i, i, i) = 7
  11   end forall
  12   forall (i = 1:5)
  13     a (6 - i, i, i, i) = 7
  14   end forall
  15   forall (i = 1:5:2)
  16     a (1, 2, 3, i) = 0
  17   end forall
  18
  19   b = a
  20   c = a
  21   d = a
  22
  23   forall (i = 1:5, j = 1:5, k = 1:5, ((a (i, j, k, i) .gt. 6) .or. (a (i, j, k, j) .gt. 6)))
  24     forall (l = 1:5, a (1, 2, 3, l) .lt. 2)
  25       a (i, j, k, l) = i - j + k - l + 0.5
  26     end forall
  27   end forall
  28
  29   forall (l = 1:5, b (1, 2, 3, l) .lt. 2)
  30     forall (i = 1:5, j = 1:5, k = 1:5, ((b (i, j, k, i) .gt. 6) .or. (b (i, j, k, j) .gt. 6)))
  31       b (i, j, k, l) = i - j + k - l + 0.5
  32     end forall
  33   end forall
  34
  35   forall (i = 1:5, j = 1:5, k = 1:5, ((c (i, j, k, i) .gt. 6) .or. (c (i, j, k, j) .gt. 6)))
  36     forall (l = 1:5, c (1, 2, 3, l) .lt. 2)
  37       c (i, j, k, l) = i - j + k - l + 0.5 + c (l, k, j, i)
  38     end forall
  39   end forall
  40
  41   forall (l = 1:5, d (1, 2, 3, l) .lt. 2)
  42     forall (i = 1:5, j = 1:5, k = 1:5, ((d (i, j, k, i) .gt. 6) .or. (d (i, j, k, j) .gt. 6)))
  43       d (i, j, k, l) = i - j + k - l + 0.5 + d (l, k, j, i)
  44     end forall
  45   end forall
  46
  47   do i = 1, 5
  48     do j = 1, 5
  49       do k = 1, 5
  50         do l = 1, 5
  51           r = 4
  52           if ((i == j .and. k == 6 - i) .or. (i == k .and. j == 6 - i)) then
  53             if (l /= 2 .and. l /= 4) then
  54               r = 1
  55             elseif (l == i) then
  56               r = 7
  57             end if
  58           elseif (j == k .and. i == 6 - j) then
  59             if (l /= 2 .and. l /= 4) then
  60               r = 1
  61             elseif (l == j) then
  62               r = 7
  63             end if
  64           elseif (i == 1 .and. j == 2 .and. k == 3 .and. l /= 2 .and. l /= 4) then
  65             r = 0
  66           end if
  67           s = r
  68           if (r == 1) then
  69             r = i - j + k - l + 0.5
  70             if (((l == k .and. j == 6 - l) .or. (l == j .and. k == 6 - l)) .and. (i == l)) then
  71               s = r + 7
  72             elseif (k == j .and. l == 6 - k .and. i == k) then
  73               s = r + 7
  74             elseif (l /= 1 .or. k /= 2 .or. j /= 3 .or. i == 2 .or. i == 4) then
  75               s = r + 4
  76             else
  77               s = r
  78             end if
  79           end if
  80           if (a (i, j, k, l) /= r) call abort ()
  81           if (c (i, j, k, l) /= s) call abort ()
  82         end do
  83       end do
  84     end do
  85   end do
  86
  87   if (any (a /= b .or. c /= d)) call abort ()
  88 end