1 SUBROUTINE SCHKQR( 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 REAL THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
17 $ NXVAL( * )
18 REAL A( * ), AC( * ), AF( * ), AQ( * ), AR( * ),
19 $ B( * ), RWORK( * ), TAU( * ), WORK( * ),
20 $ X( * ), XACT( * )
21 * ..
22 *
23 * Purpose
24 * =======
25 *
26 * SCHKQR tests SGEQRF, SORGQR and SORMQR.
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) REAL
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) REAL array, dimension (NMAX*NMAX)
76 *
77 * AF (workspace) REAL array, dimension (NMAX*NMAX)
78 *
79 * AQ (workspace) REAL array, dimension (NMAX*NMAX)
80 *
81 * AR (workspace) REAL array, dimension (NMAX*NMAX)
82 *
83 * AC (workspace) REAL array, dimension (NMAX*NMAX)
84 *
85 * B (workspace) REAL array, dimension (NMAX*NRHS)
86 *
87 * X (workspace) REAL array, dimension (NMAX*NRHS)
88 *
89 * XACT (workspace) REAL array, dimension (NMAX*NRHS)
90 *
91 * TAU (workspace) REAL array, dimension (NMAX)
92 *
93 * WORK (workspace) REAL array, dimension (NMAX*NMAX)
94 *
95 * RWORK (workspace) REAL 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 REAL ZERO
110 PARAMETER ( ZERO = 0.0E0 )
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 REAL ANORM, CNDNUM
119 * ..
120 * .. Local Arrays ..
121 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
122 REAL RESULT( NTESTS )
123 * ..
124 * .. External Functions ..
125 LOGICAL SGENND
126 EXTERNAL SGENND
127 * ..
128 * .. External Subroutines ..
129 EXTERNAL ALAERH, ALAHD, ALASUM, SERRQR, SGEQRS, SGET02,
130 $ SLACPY, SLARHS, SLATB4, SLATMS, SQRT01,
131 $ SQRT01P, SQRT02, SQRT03, 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 ) = 'Single 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 SERRQR( 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 SLATB4 and generate a test matrix
189 * with SLATMS.
190 *
191 CALL SLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
192 $ CNDNUM, DIST )
193 *
194 SRNAMT = 'SLATMS'
195 CALL SLATMS( 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 SLATMS.
200 *
201 IF( INFO.NE.0 ) THEN
202 CALL ALAERH( PATH, 'SLATMS', 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 SQRT01; other values are
209 * used in the calls of SQRT02, 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 SGEQRF
244 *
245 CALL SQRT01( M, N, A, AF, AQ, AR, LDA, TAU,
246 $ WORK, LWORK, RWORK, RESULT( 1 ) )
247 *
248 * Test SGEQRFP
249 *
250 CALL SQRT01P( M, N, A, AF, AQ, AR, LDA, TAU,
251 $ WORK, LWORK, RWORK, RESULT( 8 ) )
252
253 IF( .NOT. SGENND( M, N, AF, LDA ) )
254 $ RESULT( 9 ) = 2*THRESH
255 NT = NT + 1
256 ELSE IF( M.GE.N ) THEN
257 *
258 * Test SORGQR, using factorization
259 * returned by SQRT01
260 *
261 CALL SQRT02( M, N, K, A, AF, AQ, AR, LDA, TAU,
262 $ WORK, LWORK, RWORK, RESULT( 1 ) )
263 END IF
264 IF( M.GE.K ) THEN
265 *
266 * Test SORMQR, using factorization returned
267 * by SQRT01
268 *
269 CALL SQRT03( M, N, K, AF, AC, AR, AQ, LDA, TAU,
270 $ WORK, LWORK, RWORK, RESULT( 3 ) )
271 NT = NT + 4
272 *
273 * If M>=N and K=N, call SGEQRS to solve a system
274 * with NRHS right hand sides and compute the
275 * residual.
276 *
277 IF( K.EQ.N .AND. INB.EQ.1 ) THEN
278 *
279 * Generate a solution and set the right
280 * hand side.
281 *
282 SRNAMT = 'SLARHS'
283 CALL SLARHS( PATH, 'New', 'Full',
284 $ 'No transpose', M, N, 0, 0,
285 $ NRHS, A, LDA, XACT, LDA, B, LDA,
286 $ ISEED, INFO )
287 *
288 CALL SLACPY( 'Full', M, NRHS, B, LDA, X,
289 $ LDA )
290 SRNAMT = 'SGEQRS'
291 CALL SGEQRS( M, N, NRHS, AF, LDA, TAU, X,
292 $ LDA, WORK, LWORK, INFO )
293 *
294 * Check error code from SGEQRS.
295 *
296 IF( INFO.NE.0 )
297 $ CALL ALAERH( PATH, 'SGEQRS', INFO, 0, ' ',
298 $ M, N, NRHS, -1, NB, IMAT,
299 $ NFAIL, NERRS, NOUT )
300 *
301 CALL SGET02( 'No transpose', M, N, NRHS, A,
302 $ LDA, X, LDA, B, LDA, RWORK,
303 $ RESULT( 7 ) )
304 NT = NT + 1
305 END IF
306 END IF
307 *
308 * Print information about the tests that did not
309 * pass the threshold.
310 *
311 DO 20 I = 1, NTESTS
312 IF( RESULT( I ).GE.THRESH ) THEN
313 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
314 $ CALL ALAHD( NOUT, PATH )
315 WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX,
316 $ IMAT, I, RESULT( I )
317 NFAIL = NFAIL + 1
318 END IF
319 20 CONTINUE
320 NRUN = NRUN + NT
321 30 CONTINUE
322 40 CONTINUE
323 50 CONTINUE
324 60 CONTINUE
325 70 CONTINUE
326 *
327 * Print a summary of the results.
328 *
329 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
330 *
331 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=',
332 $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 )
333 RETURN
334 *
335 * End of SCHKQR
336 *
337 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 REAL THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
17 $ NXVAL( * )
18 REAL A( * ), AC( * ), AF( * ), AQ( * ), AR( * ),
19 $ B( * ), RWORK( * ), TAU( * ), WORK( * ),
20 $ X( * ), XACT( * )
21 * ..
22 *
23 * Purpose
24 * =======
25 *
26 * SCHKQR tests SGEQRF, SORGQR and SORMQR.
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) REAL
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) REAL array, dimension (NMAX*NMAX)
76 *
77 * AF (workspace) REAL array, dimension (NMAX*NMAX)
78 *
79 * AQ (workspace) REAL array, dimension (NMAX*NMAX)
80 *
81 * AR (workspace) REAL array, dimension (NMAX*NMAX)
82 *
83 * AC (workspace) REAL array, dimension (NMAX*NMAX)
84 *
85 * B (workspace) REAL array, dimension (NMAX*NRHS)
86 *
87 * X (workspace) REAL array, dimension (NMAX*NRHS)
88 *
89 * XACT (workspace) REAL array, dimension (NMAX*NRHS)
90 *
91 * TAU (workspace) REAL array, dimension (NMAX)
92 *
93 * WORK (workspace) REAL array, dimension (NMAX*NMAX)
94 *
95 * RWORK (workspace) REAL 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 REAL ZERO
110 PARAMETER ( ZERO = 0.0E0 )
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 REAL ANORM, CNDNUM
119 * ..
120 * .. Local Arrays ..
121 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
122 REAL RESULT( NTESTS )
123 * ..
124 * .. External Functions ..
125 LOGICAL SGENND
126 EXTERNAL SGENND
127 * ..
128 * .. External Subroutines ..
129 EXTERNAL ALAERH, ALAHD, ALASUM, SERRQR, SGEQRS, SGET02,
130 $ SLACPY, SLARHS, SLATB4, SLATMS, SQRT01,
131 $ SQRT01P, SQRT02, SQRT03, 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 ) = 'Single 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 SERRQR( 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 SLATB4 and generate a test matrix
189 * with SLATMS.
190 *
191 CALL SLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
192 $ CNDNUM, DIST )
193 *
194 SRNAMT = 'SLATMS'
195 CALL SLATMS( 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 SLATMS.
200 *
201 IF( INFO.NE.0 ) THEN
202 CALL ALAERH( PATH, 'SLATMS', 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 SQRT01; other values are
209 * used in the calls of SQRT02, 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 SGEQRF
244 *
245 CALL SQRT01( M, N, A, AF, AQ, AR, LDA, TAU,
246 $ WORK, LWORK, RWORK, RESULT( 1 ) )
247 *
248 * Test SGEQRFP
249 *
250 CALL SQRT01P( M, N, A, AF, AQ, AR, LDA, TAU,
251 $ WORK, LWORK, RWORK, RESULT( 8 ) )
252
253 IF( .NOT. SGENND( M, N, AF, LDA ) )
254 $ RESULT( 9 ) = 2*THRESH
255 NT = NT + 1
256 ELSE IF( M.GE.N ) THEN
257 *
258 * Test SORGQR, using factorization
259 * returned by SQRT01
260 *
261 CALL SQRT02( M, N, K, A, AF, AQ, AR, LDA, TAU,
262 $ WORK, LWORK, RWORK, RESULT( 1 ) )
263 END IF
264 IF( M.GE.K ) THEN
265 *
266 * Test SORMQR, using factorization returned
267 * by SQRT01
268 *
269 CALL SQRT03( M, N, K, AF, AC, AR, AQ, LDA, TAU,
270 $ WORK, LWORK, RWORK, RESULT( 3 ) )
271 NT = NT + 4
272 *
273 * If M>=N and K=N, call SGEQRS to solve a system
274 * with NRHS right hand sides and compute the
275 * residual.
276 *
277 IF( K.EQ.N .AND. INB.EQ.1 ) THEN
278 *
279 * Generate a solution and set the right
280 * hand side.
281 *
282 SRNAMT = 'SLARHS'
283 CALL SLARHS( PATH, 'New', 'Full',
284 $ 'No transpose', M, N, 0, 0,
285 $ NRHS, A, LDA, XACT, LDA, B, LDA,
286 $ ISEED, INFO )
287 *
288 CALL SLACPY( 'Full', M, NRHS, B, LDA, X,
289 $ LDA )
290 SRNAMT = 'SGEQRS'
291 CALL SGEQRS( M, N, NRHS, AF, LDA, TAU, X,
292 $ LDA, WORK, LWORK, INFO )
293 *
294 * Check error code from SGEQRS.
295 *
296 IF( INFO.NE.0 )
297 $ CALL ALAERH( PATH, 'SGEQRS', INFO, 0, ' ',
298 $ M, N, NRHS, -1, NB, IMAT,
299 $ NFAIL, NERRS, NOUT )
300 *
301 CALL SGET02( 'No transpose', M, N, NRHS, A,
302 $ LDA, X, LDA, B, LDA, RWORK,
303 $ RESULT( 7 ) )
304 NT = NT + 1
305 END IF
306 END IF
307 *
308 * Print information about the tests that did not
309 * pass the threshold.
310 *
311 DO 20 I = 1, NTESTS
312 IF( RESULT( I ).GE.THRESH ) THEN
313 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
314 $ CALL ALAHD( NOUT, PATH )
315 WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX,
316 $ IMAT, I, RESULT( I )
317 NFAIL = NFAIL + 1
318 END IF
319 20 CONTINUE
320 NRUN = NRUN + NT
321 30 CONTINUE
322 40 CONTINUE
323 50 CONTINUE
324 60 CONTINUE
325 70 CONTINUE
326 *
327 * Print a summary of the results.
328 *
329 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
330 *
331 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=',
332 $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 )
333 RETURN
334 *
335 * End of SCHKQR
336 *
337 END