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