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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [intrinsic_mmloc.f90] - Blame information for rev 695

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 695 jeremybenn 
! Program to test the MINLOC and MAXLOC intrinsics
2 
program testmmloc
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=10) line
9 
 
10 
   a = reshape ((/1, 2, 3, 5, 4, 6, 9, 8, 7/), (/3, 3/));
11 
   tr = .true.
12 
 
13 
   b = minloc (a, 1)
14 
   if (b(1) .ne. 1) call abort
15 
   if (b(2) .ne. 2) call abort
16 
   if (b(3) .ne. 3) call abort
17 
   b = -1
18 
   write (line, 9000) minloc(a,1)
19 
   read (line, 9000) b
20 
   if (b(1) .ne. 1) call abort
21 
   if (b(2) .ne. 2) call abort
22 
   if (b(3) .ne. 3) call abort
23 
 
24 
   m = .true.
25 
   m(1, 1) = .false.
26 
   m(1, 2) = .false.
27 
   b = minloc (a, 1, m)
28 
   if (b(1) .ne. 2) call abort
29 
   if (b(2) .ne. 2) call abort
30 
   if (b(3) .ne. 3) call abort
31 
   b = minloc (a, 1, m .and. tr)
32 
   if (b(1) .ne. 2) call abort
33 
   if (b(2) .ne. 2) call abort
34 
   if (b(3) .ne. 3) call abort
35 
   b = -1
36 
   write (line, 9000) minloc(a, 1, m)
37 
   read (line, 9000) b
38 
   if (b(1) .ne. 2) call abort
39 
   if (b(2) .ne. 2) call abort
40 
   if (b(3) .ne. 3) call abort
41 
 
42 
   b(1:2) = minloc(a)
43 
   if (b(1) .ne. 1) call abort
44 
   if (b(2) .ne. 1) call abort
45 
   b = -1
46 
   write (line, 9000) minloc(a)
47 
   read (line, 9000) b
48 
   if (b(1) .ne. 1) call abort
49 
   if (b(2) .ne. 1) call abort
50 
   if (b(3) .ne. 0) call abort
51 
 
52 
   b(1:2) = minloc(a, mask=m)
53 
   if (b(1) .ne. 2) call abort
54 
   if (b(2) .ne. 1) call abort
55 
   b(1:2) = minloc(a, mask=m .and. tr)
56 
   if (b(1) .ne. 2) call abort
57 
   if (b(2) .ne. 1) call abort
58 
   b = -1
59 
   write (line, 9000) minloc(a, mask=m)
60 
   read (line, 9000) b
61 
   if (b(1) .ne. 2) call abort
62 
   if (b(2) .ne. 1) call abort
63 
   if (b(3) .ne. 0) call abort
64 
 
65 
   b = maxloc (a, 1)
66 
   if (b(1) .ne. 3) call abort
67 
   if (b(2) .ne. 3) call abort
68 
   if (b(3) .ne. 1) call abort
69 
   b = -1
70 
   write (line, 9000) maxloc(a, 1)
71 
   read (line, 9000) b
72 
   if (b(1) .ne. 3) call abort
73 
   if (b(2) .ne. 3) call abort
74 
   if (b(3) .ne. 1) call abort
75 
 
76 
   m = .true.
77 
   m(1, 2) = .false.
78 
   m(1, 3) = .false.
79 
   b = maxloc (a, 1, m)
80 
   if (b(1) .ne. 3) call abort
81 
   if (b(2) .ne. 3) call abort
82 
   if (b(3) .ne. 2) call abort
83 
   b = maxloc (a, 1, m .and. tr)
84 
   if (b(1) .ne. 3) call abort
85 
   if (b(2) .ne. 3) call abort
86 
   if (b(3) .ne. 2) call abort
87 
   b = -1
88 
   write (line, 9000) maxloc(a, 1, m)
89 
   read (line, 9000) b
90 
   if (b(1) .ne. 3) call abort
91 
   if (b(2) .ne. 3) call abort
92 
   if (b(3) .ne. 2) call abort
93 
 
94 
   b(1:2) = maxloc(a)
95 
   if (b(1) .ne. 1) call abort
96 
   if (b(2) .ne. 3) call abort
97 
   b = -1
98 
   write (line, 9000) maxloc(a)
99 
   read (line, 9000) b
100 
   if (b(1) .ne. 1) call abort
101 
   if (b(2) .ne. 3) call abort
102 
 
103 
   b(1:2) = maxloc(a, mask=m)
104 
   if (b(1) .ne. 2) call abort
105 
   if (b(2) .ne. 3) call abort
106 
   b(1:2) = maxloc(a, mask=m .and. tr)
107 
   if (b(1) .ne. 2) call abort
108 
   if (b(2) .ne. 3) call abort
109 
   b = -1
110 
   write (line, 9000) maxloc(a, mask=m)
111 
   read (line, 9000) b
112 
   if (b(1) .ne. 2) call abort
113 
   if (b(2) .ne. 3) call abort
114 
   if (b(3) .ne. 0) call abort
115 
 
116 
9000 format (3I3)
117 
end program

powered by: WebSVN 2.1.0

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