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*> \ingroup double_eig
95*
96*  =====================================================================
97      SUBROUTINE DLAFTS( 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      DOUBLE PRECISION   THRESH
108*     ..
109*     .. Array Arguments ..
110      INTEGER            ISEED( 4 )
111      DOUBLE PRECISION   RESULT( * )
112*     ..
113*
114*  =====================================================================
115*
116*     .. Local Scalars ..
117      INTEGER            K
118*     ..
119*     .. External Subroutines ..
120      EXTERNAL           DLAHD2
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 DLAHD2
132*           to print a header to the data file.
133*
134               IF( IE.EQ.0 )
135     $            CALL DLAHD2( IOUNIT, TYPE )
136               IE = IE + 1
137               IF( RESULT( K ).LT.10000.0D0 ) 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, D10.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 DLAHD2
160*              to print a header to the data file.
161*
162               IF( IE.EQ.0 )
163     $            CALL DLAHD2( IOUNIT, TYPE )
164               IE = IE + 1
165               IF( RESULT( K ).LT.10000.0D0 ) 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, D10.3 )
177               END IF
178            END IF
179   20    CONTINUE
180*
181      END IF
182      RETURN
183*
184*     End of DLAFTS
185*
186      END
187