1 SUBROUTINE DLAFTS( TYPE, M, N, IMAT, NTESTS, RESULT, ISEED,
2 $ THRESH, IOUNIT, IE )
3 *
4 * -- LAPACK auxiliary test routine (version 3.1.2) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * April 2009
7 *
8 * .. Scalar Arguments ..
9 CHARACTER*3 TYPE
10 INTEGER IE, IMAT, IOUNIT, M, N, NTESTS
11 DOUBLE PRECISION THRESH
12 * ..
13 * .. Array Arguments ..
14 INTEGER ISEED( 4 )
15 DOUBLE PRECISION RESULT( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * DLAFTS tests the result vector against the threshold value to
22 * see which tests for this matrix type failed to pass the threshold.
23 * Output is to the file given by unit IOUNIT.
24 *
25 * Arguments
26 * =========
27 *
28 * TYPE - CHARACTER*3
29 * On entry, TYPE specifies the matrix type to be used in the
30 * printed messages.
31 * Not modified.
32 *
33 * N - INTEGER
34 * On entry, N specifies the order of the test matrix.
35 * Not modified.
36 *
37 * IMAT - INTEGER
38 * On entry, IMAT specifies the type of the test matrix.
39 * A listing of the different types is printed by DLAHD2
40 * to the output file if a test fails to pass the threshold.
41 * Not modified.
42 *
43 * NTESTS - INTEGER
44 * On entry, NTESTS is the number of tests performed on the
45 * subroutines in the path given by TYPE.
46 * Not modified.
47 *
48 * RESULT - DOUBLE PRECISION array of dimension( NTESTS )
49 * On entry, RESULT contains the test ratios from the tests
50 * performed in the calling program.
51 * Not modified.
52 *
53 * ISEED - INTEGER array of dimension( 4 )
54 * Contains the random seed that generated the matrix used
55 * for the tests whose ratios are in RESULT.
56 * Not modified.
57 *
58 * THRESH - DOUBLE PRECISION
59 * On entry, THRESH specifies the acceptable threshold of the
60 * test ratios. If RESULT( K ) > THRESH, then the K-th test
61 * did not pass the threshold and a message will be printed.
62 * Not modified.
63 *
64 * IOUNIT - INTEGER
65 * On entry, IOUNIT specifies the unit number of the file
66 * to which the messages are printed.
67 * Not modified.
68 *
69 * IE - INTEGER
70 * On entry, IE contains the number of tests which have
71 * failed to pass the threshold so far.
72 * Updated on exit if any of the ratios in RESULT also fail.
73 *
74 * =====================================================================
75 *
76 * .. Local Scalars ..
77 INTEGER K
78 * ..
79 * .. External Subroutines ..
80 EXTERNAL DLAHD2
81 * ..
82 * .. Executable Statements ..
83 *
84 IF( M.EQ.N ) THEN
85 *
86 * Output for square matrices:
87 *
88 DO 10 K = 1, NTESTS
89 IF( RESULT( K ).GE.THRESH ) THEN
90 *
91 * If this is the first test to fail, call DLAHD2
92 * to print a header to the data file.
93 *
94 IF( IE.EQ.0 )
95 $ CALL DLAHD2( IOUNIT, TYPE )
96 IE = IE + 1
97 IF( RESULT( K ).LT.10000.0D0 ) THEN
98 WRITE( IOUNIT, FMT = 9999 )N, IMAT, ISEED, K,
99 $ RESULT( K )
100 9999 FORMAT( ' Matrix order=', I5, ', type=', I2,
101 $ ', seed=', 4( I4, ',' ), ' result ', I3, ' is',
102 $ 0P, F8.2 )
103 ELSE
104 WRITE( IOUNIT, FMT = 9998 )N, IMAT, ISEED, K,
105 $ RESULT( K )
106 9998 FORMAT( ' Matrix order=', I5, ', type=', I2,
107 $ ', seed=', 4( I4, ',' ), ' result ', I3, ' is',
108 $ 1P, D10.3 )
109 END IF
110 END IF
111 10 CONTINUE
112 ELSE
113 *
114 * Output for rectangular matrices
115 *
116 DO 20 K = 1, NTESTS
117 IF( RESULT( K ).GE.THRESH ) THEN
118 *
119 * If this is the first test to fail, call DLAHD2
120 * to print a header to the data file.
121 *
122 IF( IE.EQ.0 )
123 $ CALL DLAHD2( IOUNIT, TYPE )
124 IE = IE + 1
125 IF( RESULT( K ).LT.10000.0D0 ) THEN
126 WRITE( IOUNIT, FMT = 9997 )M, N, IMAT, ISEED, K,
127 $ RESULT( K )
128 9997 FORMAT( 1X, I5, ' x', I5, ' matrix, type=', I2, ', s',
129 $ 'eed=', 3( I4, ',' ), I4, ': result ', I3,
130 $ ' is', 0P, F8.2 )
131 ELSE
132 WRITE( IOUNIT, FMT = 9996 )M, N, IMAT, ISEED, K,
133 $ RESULT( K )
134 9996 FORMAT( 1X, I5, ' x', I5, ' matrix, type=', I2, ', s',
135 $ 'eed=', 3( I4, ',' ), I4, ': result ', I3,
136 $ ' is', 1P, D10.3 )
137 END IF
138 END IF
139 20 CONTINUE
140 *
141 END IF
142 RETURN
143 *
144 * End of DLAFTS
145 *
146 END
2 $ THRESH, IOUNIT, IE )
3 *
4 * -- LAPACK auxiliary test routine (version 3.1.2) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * April 2009
7 *
8 * .. Scalar Arguments ..
9 CHARACTER*3 TYPE
10 INTEGER IE, IMAT, IOUNIT, M, N, NTESTS
11 DOUBLE PRECISION THRESH
12 * ..
13 * .. Array Arguments ..
14 INTEGER ISEED( 4 )
15 DOUBLE PRECISION RESULT( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * DLAFTS tests the result vector against the threshold value to
22 * see which tests for this matrix type failed to pass the threshold.
23 * Output is to the file given by unit IOUNIT.
24 *
25 * Arguments
26 * =========
27 *
28 * TYPE - CHARACTER*3
29 * On entry, TYPE specifies the matrix type to be used in the
30 * printed messages.
31 * Not modified.
32 *
33 * N - INTEGER
34 * On entry, N specifies the order of the test matrix.
35 * Not modified.
36 *
37 * IMAT - INTEGER
38 * On entry, IMAT specifies the type of the test matrix.
39 * A listing of the different types is printed by DLAHD2
40 * to the output file if a test fails to pass the threshold.
41 * Not modified.
42 *
43 * NTESTS - INTEGER
44 * On entry, NTESTS is the number of tests performed on the
45 * subroutines in the path given by TYPE.
46 * Not modified.
47 *
48 * RESULT - DOUBLE PRECISION array of dimension( NTESTS )
49 * On entry, RESULT contains the test ratios from the tests
50 * performed in the calling program.
51 * Not modified.
52 *
53 * ISEED - INTEGER array of dimension( 4 )
54 * Contains the random seed that generated the matrix used
55 * for the tests whose ratios are in RESULT.
56 * Not modified.
57 *
58 * THRESH - DOUBLE PRECISION
59 * On entry, THRESH specifies the acceptable threshold of the
60 * test ratios. If RESULT( K ) > THRESH, then the K-th test
61 * did not pass the threshold and a message will be printed.
62 * Not modified.
63 *
64 * IOUNIT - INTEGER
65 * On entry, IOUNIT specifies the unit number of the file
66 * to which the messages are printed.
67 * Not modified.
68 *
69 * IE - INTEGER
70 * On entry, IE contains the number of tests which have
71 * failed to pass the threshold so far.
72 * Updated on exit if any of the ratios in RESULT also fail.
73 *
74 * =====================================================================
75 *
76 * .. Local Scalars ..
77 INTEGER K
78 * ..
79 * .. External Subroutines ..
80 EXTERNAL DLAHD2
81 * ..
82 * .. Executable Statements ..
83 *
84 IF( M.EQ.N ) THEN
85 *
86 * Output for square matrices:
87 *
88 DO 10 K = 1, NTESTS
89 IF( RESULT( K ).GE.THRESH ) THEN
90 *
91 * If this is the first test to fail, call DLAHD2
92 * to print a header to the data file.
93 *
94 IF( IE.EQ.0 )
95 $ CALL DLAHD2( IOUNIT, TYPE )
96 IE = IE + 1
97 IF( RESULT( K ).LT.10000.0D0 ) THEN
98 WRITE( IOUNIT, FMT = 9999 )N, IMAT, ISEED, K,
99 $ RESULT( K )
100 9999 FORMAT( ' Matrix order=', I5, ', type=', I2,
101 $ ', seed=', 4( I4, ',' ), ' result ', I3, ' is',
102 $ 0P, F8.2 )
103 ELSE
104 WRITE( IOUNIT, FMT = 9998 )N, IMAT, ISEED, K,
105 $ RESULT( K )
106 9998 FORMAT( ' Matrix order=', I5, ', type=', I2,
107 $ ', seed=', 4( I4, ',' ), ' result ', I3, ' is',
108 $ 1P, D10.3 )
109 END IF
110 END IF
111 10 CONTINUE
112 ELSE
113 *
114 * Output for rectangular matrices
115 *
116 DO 20 K = 1, NTESTS
117 IF( RESULT( K ).GE.THRESH ) THEN
118 *
119 * If this is the first test to fail, call DLAHD2
120 * to print a header to the data file.
121 *
122 IF( IE.EQ.0 )
123 $ CALL DLAHD2( IOUNIT, TYPE )
124 IE = IE + 1
125 IF( RESULT( K ).LT.10000.0D0 ) THEN
126 WRITE( IOUNIT, FMT = 9997 )M, N, IMAT, ISEED, K,
127 $ RESULT( K )
128 9997 FORMAT( 1X, I5, ' x', I5, ' matrix, type=', I2, ', s',
129 $ 'eed=', 3( I4, ',' ), I4, ': result ', I3,
130 $ ' is', 0P, F8.2 )
131 ELSE
132 WRITE( IOUNIT, FMT = 9996 )M, N, IMAT, ISEED, K,
133 $ RESULT( K )
134 9996 FORMAT( 1X, I5, ' x', I5, ' matrix, type=', I2, ', s',
135 $ 'eed=', 3( I4, ',' ), I4, ': result ', I3,
136 $ ' is', 1P, D10.3 )
137 END IF
138 END IF
139 20 CONTINUE
140 *
141 END IF
142 RETURN
143 *
144 * End of DLAFTS
145 *
146 END