LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
dlafts.f
Go to the documentation of this file.
1 *> \brief \b DLAFTS
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 DLAFTS( 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 * DOUBLE PRECISION THRESH
18 * ..
19 * .. Array Arguments ..
20 * INTEGER ISEED( 4 )
21 * DOUBLE PRECISION RESULT( * )
22 * ..
23 *
24 *
25 *> \par Purpose:
26 * =============
27 *>
28 *> \verbatim
29 *>
30 *> DLAFTS 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 DLAHD2
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 - DOUBLE PRECISION 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 - DOUBLE PRECISION
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 *> \date November 2011
95 *
96 *> \ingroup double_eig
97 *
98 * =====================================================================
99  SUBROUTINE dlafts( TYPE, M, N, IMAT, NTESTS, RESULT, ISEED,
100  $ thresh, iounit, ie )
101 *
102 * -- LAPACK test routine (version 3.4.0) --
103 * -- LAPACK is a software package provided by Univ. of Tennessee, --
104 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
105 * November 2011
106 *
107 * .. Scalar Arguments ..
108  CHARACTER*3 type
109  INTEGER ie, imat, iounit, m, n, ntests
110  DOUBLE PRECISION thresh
111 * ..
112 * .. Array Arguments ..
113  INTEGER iseed( 4 )
114  DOUBLE PRECISION result( * )
115 * ..
116 *
117 * =====================================================================
118 *
119 * .. Local Scalars ..
120  INTEGER k
121 * ..
122 * .. External Subroutines ..
123  EXTERNAL dlahd2
124 * ..
125 * .. Executable Statements ..
126 *
127  IF( m.EQ.n ) THEN
128 *
129 * Output for square matrices:
130 *
131  DO 10 k = 1, ntests
132  IF( result( k ).GE.thresh ) THEN
133 *
134 * If this is the first test to fail, call DLAHD2
135 * to print a header to the data file.
136 *
137  IF( ie.EQ.0 )
138  $ CALL dlahd2( iounit, TYPE )
139  ie = ie + 1
140  IF( result( k ).LT.10000.0d0 ) THEN
141  WRITE( iounit, fmt = 9999 )n, imat, iseed, k,
142  $ result( k )
143  9999 format( ' Matrix order=', i5, ', type=', i2,
144  $ ', seed=', 4( i4, ',' ), ' result ', i3, ' is',
145  $ 0p, f8.2 )
146  ELSE
147  WRITE( iounit, fmt = 9998 )n, imat, iseed, k,
148  $ result( k )
149  9998 format( ' Matrix order=', i5, ', type=', i2,
150  $ ', seed=', 4( i4, ',' ), ' result ', i3, ' is',
151  $ 1p, d10.3 )
152  END IF
153  END IF
154  10 continue
155  ELSE
156 *
157 * Output for rectangular matrices
158 *
159  DO 20 k = 1, ntests
160  IF( result( k ).GE.thresh ) THEN
161 *
162 * If this is the first test to fail, call DLAHD2
163 * to print a header to the data file.
164 *
165  IF( ie.EQ.0 )
166  $ CALL dlahd2( iounit, TYPE )
167  ie = ie + 1
168  IF( result( k ).LT.10000.0d0 ) THEN
169  WRITE( iounit, fmt = 9997 )m, n, imat, iseed, k,
170  $ result( k )
171  9997 format( 1x, i5, ' x', i5, ' matrix, type=', i2, ', s',
172  $ 'eed=', 3( i4, ',' ), i4, ': result ', i3,
173  $ ' is', 0p, f8.2 )
174  ELSE
175  WRITE( iounit, fmt = 9996 )m, n, imat, iseed, k,
176  $ result( k )
177  9996 format( 1x, i5, ' x', i5, ' matrix, type=', i2, ', s',
178  $ 'eed=', 3( i4, ',' ), i4, ': result ', i3,
179  $ ' is', 1p, d10.3 )
180  END IF
181  END IF
182  20 continue
183 *
184  END IF
185  return
186 *
187 * End of DLAFTS
188 *
189  END