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.