1! Program to test FORALL construct
2program forall_1
3
4   call actual_variable ()
5   call negative_stride ()
6   call forall_index ()
7
8contains
9   subroutine actual_variable ()
10      integer:: x = -1
11      integer a(3,4)
12      j = 100
13
14      ! Actual variable 'x' and 'j' used as FORALL index
15      forall (x = 1:3, j = 1:4)
16         a (x,j) = j
17      end forall
18      if (any (a.ne.reshape ((/1,1,1,2,2,2,3,3,3,4,4,4/), (/3,4/)))) STOP 1
19      if ((x.ne.-1).or.(j.ne.100)) STOP 2
20
21      call actual_variable_2 (x, j, a)
22   end subroutine
23
24   subroutine actual_variable_2(x, j, a)
25      integer x,j,x1,j1
26      integer a(3,4), b(3,4)
27
28      ! Actual variable 'x' and 'j' used as FORALL index.
29      forall (x=3:1:-1, j=4:1:-1)
30         a(x,j) = j
31         b(x,j) = j
32      end forall
33
34      if (any (a.ne.reshape ((/1,1,1,2,2,2,3,3,3,4,4,4/), (/3,4/)))) STOP 3
35      if (any (b.ne.reshape ((/1,1,1,2,2,2,3,3,3,4,4,4/), (/3,4/)))) STOP 4
36      if ((x.ne.-1).or.(j.ne.100)) STOP 5
37   end subroutine
38
39   subroutine negative_stride ()
40      integer a(3,4)
41      integer x, j
42
43      ! FORALL with negative stride
44      forall (x = 3:1:-1, j = 4:1:-1)
45         a(x,j) = j + x
46      end forall
47      if (any (a.ne.reshape ((/2,3,4,3,4,5,4,5,6,5,6,7/), (/3,4/)))) STOP 6
48   end subroutine
49
50   subroutine forall_index
51      integer a(32,32)
52
53      ! FORALL with arbitrary number indexes
54      forall (i1=1:2,i2=1:2,i3=1:2,i4=1:2,i5=1:2,i6=1:2,i7=1:2,i8=1:2,i9=1:2,&
55              i10=1:2)
56         a(i1+2*i3+4*i5+8*i7+16*i9-30,i2+2*i4+4*i6+8*i8+16*i10-30) = 1
57      end forall
58      if ((a(5,5).ne.1).or. (a(32,32).ne.1)) STOP 7
59   end subroutine
60
61end
62