1! tests FORALL statements with a mask
2program 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) STOP 1
81	  if (c (i, j, k, l) /= s) STOP 2
82	end do
83      end do
84    end do
85  end do
86
87  if (any (a /= b .or. c /= d)) STOP 3
88end
89