1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
*> \brief \b DLAFTS
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE DLAFTS( TYPE, M, N, IMAT, NTESTS, RESULT, ISEED,
* THRESH, IOUNIT, IE )
*
* .. Scalar Arguments ..
* CHARACTER*3 TYPE
* INTEGER IE, IMAT, IOUNIT, M, N, NTESTS
* DOUBLE PRECISION THRESH
* ..
* .. Array Arguments ..
* INTEGER ISEED( 4 )
* DOUBLE PRECISION RESULT( * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DLAFTS tests the result vector against the threshold value to
*> see which tests for this matrix type failed to pass the threshold.
*> Output is to the file given by unit IOUNIT.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \verbatim
*> TYPE - CHARACTER*3
*> On entry, TYPE specifies the matrix type to be used in the
*> printed messages.
*> Not modified.
*>
*> N - INTEGER
*> On entry, N specifies the order of the test matrix.
*> Not modified.
*>
*> IMAT - INTEGER
*> On entry, IMAT specifies the type of the test matrix.
*> A listing of the different types is printed by DLAHD2
*> to the output file if a test fails to pass the threshold.
*> Not modified.
*>
*> NTESTS - INTEGER
*> On entry, NTESTS is the number of tests performed on the
*> subroutines in the path given by TYPE.
*> Not modified.
*>
*> RESULT - DOUBLE PRECISION array of dimension( NTESTS )
*> On entry, RESULT contains the test ratios from the tests
*> performed in the calling program.
*> Not modified.
*>
*> ISEED - INTEGER array of dimension( 4 )
*> Contains the random seed that generated the matrix used
*> for the tests whose ratios are in RESULT.
*> Not modified.
*>
*> THRESH - DOUBLE PRECISION
*> On entry, THRESH specifies the acceptable threshold of the
*> test ratios. If RESULT( K ) > THRESH, then the K-th test
*> did not pass the threshold and a message will be printed.
*> Not modified.
*>
*> IOUNIT - INTEGER
*> On entry, IOUNIT specifies the unit number of the file
*> to which the messages are printed.
*> Not modified.
*>
*> IE - INTEGER
*> On entry, IE contains the number of tests which have
*> failed to pass the threshold so far.
*> Updated on exit if any of the ratios in RESULT also fail.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup double_eig
*
* =====================================================================
SUBROUTINE DLAFTS( TYPE, M, N, IMAT, NTESTS, RESULT, ISEED,
$ THRESH, IOUNIT, IE )
*
* -- LAPACK test routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
CHARACTER*3 TYPE
INTEGER IE, IMAT, IOUNIT, M, N, NTESTS
DOUBLE PRECISION THRESH
* ..
* .. Array Arguments ..
INTEGER ISEED( 4 )
DOUBLE PRECISION RESULT( * )
* ..
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER K
* ..
* .. External Subroutines ..
EXTERNAL DLAHD2
* ..
* .. Executable Statements ..
*
IF( M.EQ.N ) THEN
*
* Output for square matrices:
*
DO 10 K = 1, NTESTS
IF( RESULT( K ).GE.THRESH ) THEN
*
* If this is the first test to fail, call DLAHD2
* to print a header to the data file.
*
IF( IE.EQ.0 )
$ CALL DLAHD2( IOUNIT, TYPE )
IE = IE + 1
IF( RESULT( K ).LT.10000.0D0 ) THEN
WRITE( IOUNIT, FMT = 9999 )N, IMAT, ISEED, K,
$ RESULT( K )
9999 FORMAT( ' Matrix order=', I5, ', type=', I2,
$ ', seed=', 4( I4, ',' ), ' result ', I3, ' is',
$ 0P, F8.2 )
ELSE
WRITE( IOUNIT, FMT = 9998 )N, IMAT, ISEED, K,
$ RESULT( K )
9998 FORMAT( ' Matrix order=', I5, ', type=', I2,
$ ', seed=', 4( I4, ',' ), ' result ', I3, ' is',
$ 1P, D10.3 )
END IF
END IF
10 CONTINUE
ELSE
*
* Output for rectangular matrices
*
DO 20 K = 1, NTESTS
IF( RESULT( K ).GE.THRESH ) THEN
*
* If this is the first test to fail, call DLAHD2
* to print a header to the data file.
*
IF( IE.EQ.0 )
$ CALL DLAHD2( IOUNIT, TYPE )
IE = IE + 1
IF( RESULT( K ).LT.10000.0D0 ) THEN
WRITE( IOUNIT, FMT = 9997 )M, N, IMAT, ISEED, K,
$ RESULT( K )
9997 FORMAT( 1X, I5, ' x', I5, ' matrix, type=', I2, ', s',
$ 'eed=', 3( I4, ',' ), I4, ': result ', I3,
$ ' is', 0P, F8.2 )
ELSE
WRITE( IOUNIT, FMT = 9996 )M, N, IMAT, ISEED, K,
$ RESULT( K )
9996 FORMAT( 1X, I5, ' x', I5, ' matrix, type=', I2, ', s',
$ 'eed=', 3( I4, ',' ), I4, ': result ', I3,
$ ' is', 1P, D10.3 )
END IF
END IF
20 CONTINUE
*
END IF
RETURN
*
* End of DLAFTS
*
END
|
