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

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [forall_7.f90] - Blame information for rev 12

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner 
! 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

powered by: WebSVN 2.1.0

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