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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [intrinsic_sum.f90] - Blame information for rev 304

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

Line No. Rev Author Line
1 303 jeremybenn
! Program to test the FORALL construct
2
program testforall
3
   implicit none
4
   integer, dimension (3, 3) :: a
5
   integer, dimension (3) :: b
6
   logical, dimension (3, 3) :: m, tr
7
   integer i
8
   character(len=9) line
9
 
10
   a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/));
11
 
12
   tr = .true.
13
 
14
   if (sum(a) .ne. 45) call abort
15
   write (line, 9000) sum(a)
16
   if (line .ne. ' 45      ') call abort
17
   b = sum (a, 1)
18
   if (b(1) .ne. 6) call abort
19
   if (b(2) .ne. 15) call abort
20
   if (b(3) .ne. 24) call abort
21
   write (line, 9000) sum (a, 1)
22
   if (line .ne. '  6 15 24') call abort
23
 
24
   m = .true.
25
   m(1, 1) = .false.
26
   m(2, 1) = .false.
27
 
28
   if (sum (a, mask=m) .ne. 42) call abort
29
   if (sum (a, mask=m .and. tr) .ne. 42) call abort
30
 
31
   write(line, 9000) sum (a, mask=m)
32
   if (line .ne. ' 42      ') call abort
33
 
34
   b = sum (a, 2, m)
35
   if (b(1) .ne. 11) call abort
36
   if (b(2) .ne. 13) call abort
37
   if (b(3) .ne. 18) call abort
38
 
39
   b = sum (a, 2, m .and. tr)
40
   if (b(1) .ne. 11) call abort
41
   if (b(2) .ne. 13) call abort
42
   if (b(3) .ne. 18) call abort
43
   write (line, 9000) sum (a, 2, m)
44
   if (line .ne. ' 11 13 18') call abort
45
 
46
9000 format(3I3)
47
end program

powered by: WebSVN 2.1.0

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