1 SUBROUTINE DCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
2 $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC,
3 $ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.3.0) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2010
8 *
9 * .. Scalar Arguments ..
10 LOGICAL TSTERR
11 INTEGER NM, NMAX, NN, NNB, NOUT, NRHS
12 DOUBLE PRECISION THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
17 $ NXVAL( * )
18 DOUBLE PRECISION A( * ), AC( * ), AF( * ), AQ( * ), AR( * ),
19 $ B( * ), RWORK( * ), TAU( * ), WORK( * ),
20 $ X( * ), XACT( * )
21 * ..
22 *
23 * Purpose
24 * =======
25 *
26 * DCHKQR tests DGEQRF, DORGQR and DORMQR.
27 *
28 * Arguments
29 * =========
30 *
31 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
32 * The matrix types to be used for testing. Matrices of type j
33 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
34 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
35 *
36 * NM (input) INTEGER
37 * The number of values of M contained in the vector MVAL.
38 *
39 * MVAL (input) INTEGER array, dimension (NM)
40 * The values of the matrix row dimension M.
41 *
42 * NN (input) INTEGER
43 * The number of values of N contained in the vector NVAL.
44 *
45 * NVAL (input) INTEGER array, dimension (NN)
46 * The values of the matrix column dimension N.
47 *
48 * NNB (input) INTEGER
49 * The number of values of NB and NX contained in the
50 * vectors NBVAL and NXVAL. The blocking parameters are used
51 * in pairs (NB,NX).
52 *
53 * NBVAL (input) INTEGER array, dimension (NNB)
54 * The values of the blocksize NB.
55 *
56 * NXVAL (input) INTEGER array, dimension (NNB)
57 * The values of the crossover point NX.
58 *
59 * NRHS (input) INTEGER
60 * The number of right hand side vectors to be generated for
61 * each linear system.
62 *
63 * THRESH (input) DOUBLE PRECISION
64 * The threshold value for the test ratios. A result is
65 * included in the output file if RESULT >= THRESH. To have
66 * every test ratio printed, use THRESH = 0.
67 *
68 * TSTERR (input) LOGICAL
69 * Flag that indicates whether error exits are to be tested.
70 *
71 * NMAX (input) INTEGER
72 * The maximum value permitted for M or N, used in dimensioning
73 * the work arrays.
74 *
75 * A (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
76 *
77 * AF (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
78 *
79 * AQ (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
80 *
81 * AR (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
82 *
83 * AC (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
84 *
85 * B (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS)
86 *
87 * X (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS)
88 *
89 * XACT (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS)
90 *
91 * TAU (workspace) DOUBLE PRECISION array, dimension (NMAX)
92 *
93 * WORK (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
94 *
95 * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX)
96 *
97 * IWORK (workspace) INTEGER array, dimension (NMAX)
98 *
99 * NOUT (input) INTEGER
100 * The unit number for output.
101 *
102 * =====================================================================
103 *
104 * .. Parameters ..
105 INTEGER NTESTS
106 PARAMETER ( NTESTS = 9 )
107 INTEGER NTYPES
108 PARAMETER ( NTYPES = 8 )
109 DOUBLE PRECISION ZERO
110 PARAMETER ( ZERO = 0.0D0 )
111 * ..
112 * .. Local Scalars ..
113 CHARACTER DIST, TYPE
114 CHARACTER*3 PATH
115 INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA,
116 $ LWORK, M, MINMN, MODE, N, NB, NERRS, NFAIL, NK,
117 $ NRUN, NT, NX
118 DOUBLE PRECISION ANORM, CNDNUM
119 * ..
120 * .. Local Arrays ..
121 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
122 DOUBLE PRECISION RESULT( NTESTS )
123 * ..
124 * .. External Functions ..
125 LOGICAL DGENND
126 EXTERNAL DGENND
127 * ..
128 * .. External Subroutines ..
129 EXTERNAL ALAERH, ALAHD, ALASUM, DERRQR, DGEQRS, DGET02,
130 $ DLACPY, DLARHS, DLATB4, DLATMS, DQRT01,
131 $ DQRT01P, DQRT02, DQRT03, XLAENV
132 * ..
133 * .. Intrinsic Functions ..
134 INTRINSIC MAX, MIN
135 * ..
136 * .. Scalars in Common ..
137 LOGICAL LERR, OK
138 CHARACTER*32 SRNAMT
139 INTEGER INFOT, NUNIT
140 * ..
141 * .. Common blocks ..
142 COMMON / INFOC / INFOT, NUNIT, OK, LERR
143 COMMON / SRNAMC / SRNAMT
144 * ..
145 * .. Data statements ..
146 DATA ISEEDY / 1988, 1989, 1990, 1991 /
147 * ..
148 * .. Executable Statements ..
149 *
150 * Initialize constants and the random number seed.
151 *
152 PATH( 1: 1 ) = 'Double precision'
153 PATH( 2: 3 ) = 'QR'
154 NRUN = 0
155 NFAIL = 0
156 NERRS = 0
157 DO 10 I = 1, 4
158 ISEED( I ) = ISEEDY( I )
159 10 CONTINUE
160 *
161 * Test the error exits
162 *
163 IF( TSTERR )
164 $ CALL DERRQR( PATH, NOUT )
165 INFOT = 0
166 CALL XLAENV( 2, 2 )
167 *
168 LDA = NMAX
169 LWORK = NMAX*MAX( NMAX, NRHS )
170 *
171 * Do for each value of M in MVAL.
172 *
173 DO 70 IM = 1, NM
174 M = MVAL( IM )
175 *
176 * Do for each value of N in NVAL.
177 *
178 DO 60 IN = 1, NN
179 N = NVAL( IN )
180 MINMN = MIN( M, N )
181 DO 50 IMAT = 1, NTYPES
182 *
183 * Do the tests only if DOTYPE( IMAT ) is true.
184 *
185 IF( .NOT.DOTYPE( IMAT ) )
186 $ GO TO 50
187 *
188 * Set up parameters with DLATB4 and generate a test matrix
189 * with DLATMS.
190 *
191 CALL DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
192 $ CNDNUM, DIST )
193 *
194 SRNAMT = 'DLATMS'
195 CALL DLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE,
196 $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA,
197 $ WORK, INFO )
198 *
199 * Check error code from DLATMS.
200 *
201 IF( INFO.NE.0 ) THEN
202 CALL ALAERH( PATH, 'DLATMS', INFO, 0, ' ', M, N, -1,
203 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
204 GO TO 50
205 END IF
206 *
207 * Set some values for K: the first value must be MINMN,
208 * corresponding to the call of DQRT01; other values are
209 * used in the calls of DQRT02, and must not exceed MINMN.
210 *
211 KVAL( 1 ) = MINMN
212 KVAL( 2 ) = 0
213 KVAL( 3 ) = 1
214 KVAL( 4 ) = MINMN / 2
215 IF( MINMN.EQ.0 ) THEN
216 NK = 1
217 ELSE IF( MINMN.EQ.1 ) THEN
218 NK = 2
219 ELSE IF( MINMN.LE.3 ) THEN
220 NK = 3
221 ELSE
222 NK = 4
223 END IF
224 *
225 * Do for each value of K in KVAL
226 *
227 DO 40 IK = 1, NK
228 K = KVAL( IK )
229 *
230 * Do for each pair of values (NB,NX) in NBVAL and NXVAL.
231 *
232 DO 30 INB = 1, NNB
233 NB = NBVAL( INB )
234 CALL XLAENV( 1, NB )
235 NX = NXVAL( INB )
236 CALL XLAENV( 3, NX )
237 DO I = 1, NTESTS
238 RESULT( I ) = ZERO
239 END DO
240 NT = 2
241 IF( IK.EQ.1 ) THEN
242 *
243 * Test DGEQRF
244 *
245 CALL DQRT01( M, N, A, AF, AQ, AR, LDA, TAU,
246 $ WORK, LWORK, RWORK, RESULT( 1 ) )
247
248 *
249 * Test DGEQRFP
250 *
251 CALL DQRT01P( M, N, A, AF, AQ, AR, LDA, TAU,
252 $ WORK, LWORK, RWORK, RESULT( 8 ) )
253
254 IF( .NOT. DGENND( M, N, AF, LDA ) )
255 $ RESULT( 9 ) = 2*THRESH
256 NT = NT + 1
257 ELSE IF( M.GE.N ) THEN
258 *
259 * Test DORGQR, using factorization
260 * returned by DQRT01
261 *
262 CALL DQRT02( M, N, K, A, AF, AQ, AR, LDA, TAU,
263 $ WORK, LWORK, RWORK, RESULT( 1 ) )
264 END IF
265 IF( M.GE.K ) THEN
266 *
267 * Test DORMQR, using factorization returned
268 * by DQRT01
269 *
270 CALL DQRT03( M, N, K, AF, AC, AR, AQ, LDA, TAU,
271 $ WORK, LWORK, RWORK, RESULT( 3 ) )
272 NT = NT + 4
273 *
274 * If M>=N and K=N, call DGEQRS to solve a system
275 * with NRHS right hand sides and compute the
276 * residual.
277 *
278 IF( K.EQ.N .AND. INB.EQ.1 ) THEN
279 *
280 * Generate a solution and set the right
281 * hand side.
282 *
283 SRNAMT = 'DLARHS'
284 CALL DLARHS( PATH, 'New', 'Full',
285 $ 'No transpose', M, N, 0, 0,
286 $ NRHS, A, LDA, XACT, LDA, B, LDA,
287 $ ISEED, INFO )
288 *
289 CALL DLACPY( 'Full', M, NRHS, B, LDA, X,
290 $ LDA )
291 SRNAMT = 'DGEQRS'
292 CALL DGEQRS( M, N, NRHS, AF, LDA, TAU, X,
293 $ LDA, WORK, LWORK, INFO )
294 *
295 * Check error code from DGEQRS.
296 *
297 IF( INFO.NE.0 )
298 $ CALL ALAERH( PATH, 'DGEQRS', INFO, 0, ' ',
299 $ M, N, NRHS, -1, NB, IMAT,
300 $ NFAIL, NERRS, NOUT )
301 *
302 CALL DGET02( 'No transpose', M, N, NRHS, A,
303 $ LDA, X, LDA, B, LDA, RWORK,
304 $ RESULT( 7 ) )
305 NT = NT + 1
306 END IF
307 END IF
308 *
309 * Print information about the tests that did not
310 * pass the threshold.
311 *
312 DO 20 I = 1, NTESTS
313 IF( RESULT( I ).GE.THRESH ) THEN
314 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
315 $ CALL ALAHD( NOUT, PATH )
316 WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX,
317 $ IMAT, I, RESULT( I )
318 NFAIL = NFAIL + 1
319 END IF
320 20 CONTINUE
321 NRUN = NRUN + NT
322 30 CONTINUE
323 40 CONTINUE
324 50 CONTINUE
325 60 CONTINUE
326 70 CONTINUE
327 *
328 * Print a summary of the results.
329 *
330 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
331 *
332 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=',
333 $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 )
334 RETURN
335 *
336 * End of DCHKQR
337 *
338 END
2 $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC,
3 $ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.3.0) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2010
8 *
9 * .. Scalar Arguments ..
10 LOGICAL TSTERR
11 INTEGER NM, NMAX, NN, NNB, NOUT, NRHS
12 DOUBLE PRECISION THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
17 $ NXVAL( * )
18 DOUBLE PRECISION A( * ), AC( * ), AF( * ), AQ( * ), AR( * ),
19 $ B( * ), RWORK( * ), TAU( * ), WORK( * ),
20 $ X( * ), XACT( * )
21 * ..
22 *
23 * Purpose
24 * =======
25 *
26 * DCHKQR tests DGEQRF, DORGQR and DORMQR.
27 *
28 * Arguments
29 * =========
30 *
31 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
32 * The matrix types to be used for testing. Matrices of type j
33 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
34 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
35 *
36 * NM (input) INTEGER
37 * The number of values of M contained in the vector MVAL.
38 *
39 * MVAL (input) INTEGER array, dimension (NM)
40 * The values of the matrix row dimension M.
41 *
42 * NN (input) INTEGER
43 * The number of values of N contained in the vector NVAL.
44 *
45 * NVAL (input) INTEGER array, dimension (NN)
46 * The values of the matrix column dimension N.
47 *
48 * NNB (input) INTEGER
49 * The number of values of NB and NX contained in the
50 * vectors NBVAL and NXVAL. The blocking parameters are used
51 * in pairs (NB,NX).
52 *
53 * NBVAL (input) INTEGER array, dimension (NNB)
54 * The values of the blocksize NB.
55 *
56 * NXVAL (input) INTEGER array, dimension (NNB)
57 * The values of the crossover point NX.
58 *
59 * NRHS (input) INTEGER
60 * The number of right hand side vectors to be generated for
61 * each linear system.
62 *
63 * THRESH (input) DOUBLE PRECISION
64 * The threshold value for the test ratios. A result is
65 * included in the output file if RESULT >= THRESH. To have
66 * every test ratio printed, use THRESH = 0.
67 *
68 * TSTERR (input) LOGICAL
69 * Flag that indicates whether error exits are to be tested.
70 *
71 * NMAX (input) INTEGER
72 * The maximum value permitted for M or N, used in dimensioning
73 * the work arrays.
74 *
75 * A (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
76 *
77 * AF (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
78 *
79 * AQ (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
80 *
81 * AR (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
82 *
83 * AC (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
84 *
85 * B (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS)
86 *
87 * X (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS)
88 *
89 * XACT (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS)
90 *
91 * TAU (workspace) DOUBLE PRECISION array, dimension (NMAX)
92 *
93 * WORK (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
94 *
95 * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX)
96 *
97 * IWORK (workspace) INTEGER array, dimension (NMAX)
98 *
99 * NOUT (input) INTEGER
100 * The unit number for output.
101 *
102 * =====================================================================
103 *
104 * .. Parameters ..
105 INTEGER NTESTS
106 PARAMETER ( NTESTS = 9 )
107 INTEGER NTYPES
108 PARAMETER ( NTYPES = 8 )
109 DOUBLE PRECISION ZERO
110 PARAMETER ( ZERO = 0.0D0 )
111 * ..
112 * .. Local Scalars ..
113 CHARACTER DIST, TYPE
114 CHARACTER*3 PATH
115 INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA,
116 $ LWORK, M, MINMN, MODE, N, NB, NERRS, NFAIL, NK,
117 $ NRUN, NT, NX
118 DOUBLE PRECISION ANORM, CNDNUM
119 * ..
120 * .. Local Arrays ..
121 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
122 DOUBLE PRECISION RESULT( NTESTS )
123 * ..
124 * .. External Functions ..
125 LOGICAL DGENND
126 EXTERNAL DGENND
127 * ..
128 * .. External Subroutines ..
129 EXTERNAL ALAERH, ALAHD, ALASUM, DERRQR, DGEQRS, DGET02,
130 $ DLACPY, DLARHS, DLATB4, DLATMS, DQRT01,
131 $ DQRT01P, DQRT02, DQRT03, XLAENV
132 * ..
133 * .. Intrinsic Functions ..
134 INTRINSIC MAX, MIN
135 * ..
136 * .. Scalars in Common ..
137 LOGICAL LERR, OK
138 CHARACTER*32 SRNAMT
139 INTEGER INFOT, NUNIT
140 * ..
141 * .. Common blocks ..
142 COMMON / INFOC / INFOT, NUNIT, OK, LERR
143 COMMON / SRNAMC / SRNAMT
144 * ..
145 * .. Data statements ..
146 DATA ISEEDY / 1988, 1989, 1990, 1991 /
147 * ..
148 * .. Executable Statements ..
149 *
150 * Initialize constants and the random number seed.
151 *
152 PATH( 1: 1 ) = 'Double precision'
153 PATH( 2: 3 ) = 'QR'
154 NRUN = 0
155 NFAIL = 0
156 NERRS = 0
157 DO 10 I = 1, 4
158 ISEED( I ) = ISEEDY( I )
159 10 CONTINUE
160 *
161 * Test the error exits
162 *
163 IF( TSTERR )
164 $ CALL DERRQR( PATH, NOUT )
165 INFOT = 0
166 CALL XLAENV( 2, 2 )
167 *
168 LDA = NMAX
169 LWORK = NMAX*MAX( NMAX, NRHS )
170 *
171 * Do for each value of M in MVAL.
172 *
173 DO 70 IM = 1, NM
174 M = MVAL( IM )
175 *
176 * Do for each value of N in NVAL.
177 *
178 DO 60 IN = 1, NN
179 N = NVAL( IN )
180 MINMN = MIN( M, N )
181 DO 50 IMAT = 1, NTYPES
182 *
183 * Do the tests only if DOTYPE( IMAT ) is true.
184 *
185 IF( .NOT.DOTYPE( IMAT ) )
186 $ GO TO 50
187 *
188 * Set up parameters with DLATB4 and generate a test matrix
189 * with DLATMS.
190 *
191 CALL DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
192 $ CNDNUM, DIST )
193 *
194 SRNAMT = 'DLATMS'
195 CALL DLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE,
196 $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA,
197 $ WORK, INFO )
198 *
199 * Check error code from DLATMS.
200 *
201 IF( INFO.NE.0 ) THEN
202 CALL ALAERH( PATH, 'DLATMS', INFO, 0, ' ', M, N, -1,
203 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
204 GO TO 50
205 END IF
206 *
207 * Set some values for K: the first value must be MINMN,
208 * corresponding to the call of DQRT01; other values are
209 * used in the calls of DQRT02, and must not exceed MINMN.
210 *
211 KVAL( 1 ) = MINMN
212 KVAL( 2 ) = 0
213 KVAL( 3 ) = 1
214 KVAL( 4 ) = MINMN / 2
215 IF( MINMN.EQ.0 ) THEN
216 NK = 1
217 ELSE IF( MINMN.EQ.1 ) THEN
218 NK = 2
219 ELSE IF( MINMN.LE.3 ) THEN
220 NK = 3
221 ELSE
222 NK = 4
223 END IF
224 *
225 * Do for each value of K in KVAL
226 *
227 DO 40 IK = 1, NK
228 K = KVAL( IK )
229 *
230 * Do for each pair of values (NB,NX) in NBVAL and NXVAL.
231 *
232 DO 30 INB = 1, NNB
233 NB = NBVAL( INB )
234 CALL XLAENV( 1, NB )
235 NX = NXVAL( INB )
236 CALL XLAENV( 3, NX )
237 DO I = 1, NTESTS
238 RESULT( I ) = ZERO
239 END DO
240 NT = 2
241 IF( IK.EQ.1 ) THEN
242 *
243 * Test DGEQRF
244 *
245 CALL DQRT01( M, N, A, AF, AQ, AR, LDA, TAU,
246 $ WORK, LWORK, RWORK, RESULT( 1 ) )
247
248 *
249 * Test DGEQRFP
250 *
251 CALL DQRT01P( M, N, A, AF, AQ, AR, LDA, TAU,
252 $ WORK, LWORK, RWORK, RESULT( 8 ) )
253
254 IF( .NOT. DGENND( M, N, AF, LDA ) )
255 $ RESULT( 9 ) = 2*THRESH
256 NT = NT + 1
257 ELSE IF( M.GE.N ) THEN
258 *
259 * Test DORGQR, using factorization
260 * returned by DQRT01
261 *
262 CALL DQRT02( M, N, K, A, AF, AQ, AR, LDA, TAU,
263 $ WORK, LWORK, RWORK, RESULT( 1 ) )
264 END IF
265 IF( M.GE.K ) THEN
266 *
267 * Test DORMQR, using factorization returned
268 * by DQRT01
269 *
270 CALL DQRT03( M, N, K, AF, AC, AR, AQ, LDA, TAU,
271 $ WORK, LWORK, RWORK, RESULT( 3 ) )
272 NT = NT + 4
273 *
274 * If M>=N and K=N, call DGEQRS to solve a system
275 * with NRHS right hand sides and compute the
276 * residual.
277 *
278 IF( K.EQ.N .AND. INB.EQ.1 ) THEN
279 *
280 * Generate a solution and set the right
281 * hand side.
282 *
283 SRNAMT = 'DLARHS'
284 CALL DLARHS( PATH, 'New', 'Full',
285 $ 'No transpose', M, N, 0, 0,
286 $ NRHS, A, LDA, XACT, LDA, B, LDA,
287 $ ISEED, INFO )
288 *
289 CALL DLACPY( 'Full', M, NRHS, B, LDA, X,
290 $ LDA )
291 SRNAMT = 'DGEQRS'
292 CALL DGEQRS( M, N, NRHS, AF, LDA, TAU, X,
293 $ LDA, WORK, LWORK, INFO )
294 *
295 * Check error code from DGEQRS.
296 *
297 IF( INFO.NE.0 )
298 $ CALL ALAERH( PATH, 'DGEQRS', INFO, 0, ' ',
299 $ M, N, NRHS, -1, NB, IMAT,
300 $ NFAIL, NERRS, NOUT )
301 *
302 CALL DGET02( 'No transpose', M, N, NRHS, A,
303 $ LDA, X, LDA, B, LDA, RWORK,
304 $ RESULT( 7 ) )
305 NT = NT + 1
306 END IF
307 END IF
308 *
309 * Print information about the tests that did not
310 * pass the threshold.
311 *
312 DO 20 I = 1, NTESTS
313 IF( RESULT( I ).GE.THRESH ) THEN
314 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
315 $ CALL ALAHD( NOUT, PATH )
316 WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX,
317 $ IMAT, I, RESULT( I )
318 NFAIL = NFAIL + 1
319 END IF
320 20 CONTINUE
321 NRUN = NRUN + NT
322 30 CONTINUE
323 40 CONTINUE
324 50 CONTINUE
325 60 CONTINUE
326 70 CONTINUE
327 *
328 * Print a summary of the results.
329 *
330 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
331 *
332 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=',
333 $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 )
334 RETURN
335 *
336 * End of DCHKQR
337 *
338 END