OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [forall_1.f90] - Blame information for rev 867

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
! Program to test FORALL construct
2
program forall_1
3
 
4
   call actual_variable ()
5
   call negative_stride ()
6
   call forall_index ()
7
 
8
contains
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/)))) call abort
19
      if ((x.ne.-1).or.(j.ne.100)) call abort
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/)))) call abort
35
      if (any (b.ne.reshape ((/1,1,1,2,2,2,3,3,3,4,4,4/), (/3,4/)))) call abort
36
      if ((x.ne.-1).or.(j.ne.100)) call abort
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/)))) call abort
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)) call abort
59
   end subroutine
60
 
61
end

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.