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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [intrinsic_product.f90] - Blame information for rev 303

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

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

powered by: WebSVN 2.1.0

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