1 SUBROUTINE DCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
2 $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC,
3 $ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * June 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( * ), AL( * ), AQ( * ),
19 $ B( * ), RWORK( * ), TAU( * ), WORK( * ),
20 $ X( * ), XACT( * )
21 * ..
22 *
23 * Purpose
24 * =======
25 *
26 * DCHKLQ tests DGELQF, DORGLQ and DORMLQ.
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 * AL (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 = 7 )
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 Subroutines ..
125 EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQ, DGELQS, DGET02,
126 $ DLACPY, DLARHS, DLATB4, DLATMS, DLQT01, DLQT02,
127 $ DLQT03, XLAENV
128 * ..
129 * .. Intrinsic Functions ..
130 INTRINSIC MAX, MIN
131 * ..
132 * .. Scalars in Common ..
133 LOGICAL LERR, OK
134 CHARACTER*32 SRNAMT
135 INTEGER INFOT, NUNIT
136 * ..
137 * .. Common blocks ..
138 COMMON / INFOC / INFOT, NUNIT, OK, LERR
139 COMMON / SRNAMC / SRNAMT
140 * ..
141 * .. Data statements ..
142 DATA ISEEDY / 1988, 1989, 1990, 1991 /
143 * ..
144 * .. Executable Statements ..
145 *
146 * Initialize constants and the random number seed.
147 *
148 PATH( 1: 1 ) = 'Double precision'
149 PATH( 2: 3 ) = 'LQ'
150 NRUN = 0
151 NFAIL = 0
152 NERRS = 0
153 DO 10 I = 1, 4
154 ISEED( I ) = ISEEDY( I )
155 10 CONTINUE
156 *
157 * Test the error exits
158 *
159 IF( TSTERR )
160 $ CALL DERRLQ( PATH, NOUT )
161 INFOT = 0
162 CALL XLAENV( 2, 2 )
163 *
164 LDA = NMAX
165 LWORK = NMAX*MAX( NMAX, NRHS )
166 *
167 * Do for each value of M in MVAL.
168 *
169 DO 70 IM = 1, NM
170 M = MVAL( IM )
171 *
172 * Do for each value of N in NVAL.
173 *
174 DO 60 IN = 1, NN
175 N = NVAL( IN )
176 MINMN = MIN( M, N )
177 DO 50 IMAT = 1, NTYPES
178 *
179 * Do the tests only if DOTYPE( IMAT ) is true.
180 *
181 IF( .NOT.DOTYPE( IMAT ) )
182 $ GO TO 50
183 *
184 * Set up parameters with DLATB4 and generate a test matrix
185 * with DLATMS.
186 *
187 CALL DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
188 $ CNDNUM, DIST )
189 *
190 SRNAMT = 'DLATMS'
191 CALL DLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE,
192 $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA,
193 $ WORK, INFO )
194 *
195 * Check error code from DLATMS.
196 *
197 IF( INFO.NE.0 ) THEN
198 CALL ALAERH( PATH, 'DLATMS', INFO, 0, ' ', M, N, -1,
199 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
200 GO TO 50
201 END IF
202 *
203 * Set some values for K: the first value must be MINMN,
204 * corresponding to the call of DLQT01; other values are
205 * used in the calls of DLQT02, and must not exceed MINMN.
206 *
207 KVAL( 1 ) = MINMN
208 KVAL( 2 ) = 0
209 KVAL( 3 ) = 1
210 KVAL( 4 ) = MINMN / 2
211 IF( MINMN.EQ.0 ) THEN
212 NK = 1
213 ELSE IF( MINMN.EQ.1 ) THEN
214 NK = 2
215 ELSE IF( MINMN.LE.3 ) THEN
216 NK = 3
217 ELSE
218 NK = 4
219 END IF
220 *
221 * Do for each value of K in KVAL
222 *
223 DO 40 IK = 1, NK
224 K = KVAL( IK )
225 *
226 * Do for each pair of values (NB,NX) in NBVAL and NXVAL.
227 *
228 DO 30 INB = 1, NNB
229 NB = NBVAL( INB )
230 CALL XLAENV( 1, NB )
231 NX = NXVAL( INB )
232 CALL XLAENV( 3, NX )
233 DO I = 1, NTESTS
234 RESULT( I ) = ZERO
235 END DO
236 NT = 2
237 IF( IK.EQ.1 ) THEN
238 *
239 * Test DGELQF
240 *
241 CALL DLQT01( M, N, A, AF, AQ, AL, LDA, TAU,
242 $ WORK, LWORK, RWORK, RESULT( 1 ) )
243 ELSE IF( M.LE.N ) THEN
244 *
245 * Test DORGLQ, using factorization
246 * returned by DLQT01
247 *
248 CALL DLQT02( M, N, K, A, AF, AQ, AL, LDA, TAU,
249 $ WORK, LWORK, RWORK, RESULT( 1 ) )
250 ELSE
251 RESULT( 1 ) = ZERO
252 RESULT( 2 ) = ZERO
253 END IF
254 IF( M.GE.K ) THEN
255 *
256 * Test DORMLQ, using factorization returned
257 * by DLQT01
258 *
259 CALL DLQT03( M, N, K, AF, AC, AL, AQ, LDA, TAU,
260 $ WORK, LWORK, RWORK, RESULT( 3 ) )
261 NT = NT + 4
262 *
263 * If M>=N and K=N, call DGELQS to solve a system
264 * with NRHS right hand sides and compute the
265 * residual.
266 *
267 IF( K.EQ.M .AND. INB.EQ.1 ) THEN
268 *
269 * Generate a solution and set the right
270 * hand side.
271 *
272 SRNAMT = 'DLARHS'
273 CALL DLARHS( PATH, 'New', 'Full',
274 $ 'No transpose', M, N, 0, 0,
275 $ NRHS, A, LDA, XACT, LDA, B, LDA,
276 $ ISEED, INFO )
277 *
278 CALL DLACPY( 'Full', M, NRHS, B, LDA, X,
279 $ LDA )
280 SRNAMT = 'DGELQS'
281 CALL DGELQS( M, N, NRHS, AF, LDA, TAU, X,
282 $ LDA, WORK, LWORK, INFO )
283 *
284 * Check error code from DGELQS.
285 *
286 IF( INFO.NE.0 )
287 $ CALL ALAERH( PATH, 'DGELQS', INFO, 0, ' ',
288 $ M, N, NRHS, -1, NB, IMAT,
289 $ NFAIL, NERRS, NOUT )
290 *
291 CALL DGET02( 'No transpose', M, N, NRHS, A,
292 $ LDA, X, LDA, B, LDA, RWORK,
293 $ RESULT( 7 ) )
294 NT = NT + 1
295 ELSE
296 RESULT( 7 ) = ZERO
297 END IF
298 ELSE
299 RESULT( 3 ) = ZERO
300 RESULT( 4 ) = ZERO
301 RESULT( 5 ) = ZERO
302 RESULT( 6 ) = ZERO
303 END IF
304 *
305 * Print information about the tests that did not
306 * pass the threshold.
307 *
308 DO 20 I = 1, NT
309 IF( RESULT( I ).GE.THRESH ) THEN
310 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
311 $ CALL ALAHD( NOUT, PATH )
312 WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX,
313 $ IMAT, I, RESULT( I )
314 NFAIL = NFAIL + 1
315 END IF
316 20 CONTINUE
317 NRUN = NRUN + NT
318 30 CONTINUE
319 40 CONTINUE
320 50 CONTINUE
321 60 CONTINUE
322 70 CONTINUE
323 *
324 * Print a summary of the results.
325 *
326 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
327 *
328 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=',
329 $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 )
330 RETURN
331 *
332 * End of DCHKLQ
333 *
334 END
2 $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC,
3 $ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * June 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( * ), AL( * ), AQ( * ),
19 $ B( * ), RWORK( * ), TAU( * ), WORK( * ),
20 $ X( * ), XACT( * )
21 * ..
22 *
23 * Purpose
24 * =======
25 *
26 * DCHKLQ tests DGELQF, DORGLQ and DORMLQ.
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 * AL (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 = 7 )
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 Subroutines ..
125 EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQ, DGELQS, DGET02,
126 $ DLACPY, DLARHS, DLATB4, DLATMS, DLQT01, DLQT02,
127 $ DLQT03, XLAENV
128 * ..
129 * .. Intrinsic Functions ..
130 INTRINSIC MAX, MIN
131 * ..
132 * .. Scalars in Common ..
133 LOGICAL LERR, OK
134 CHARACTER*32 SRNAMT
135 INTEGER INFOT, NUNIT
136 * ..
137 * .. Common blocks ..
138 COMMON / INFOC / INFOT, NUNIT, OK, LERR
139 COMMON / SRNAMC / SRNAMT
140 * ..
141 * .. Data statements ..
142 DATA ISEEDY / 1988, 1989, 1990, 1991 /
143 * ..
144 * .. Executable Statements ..
145 *
146 * Initialize constants and the random number seed.
147 *
148 PATH( 1: 1 ) = 'Double precision'
149 PATH( 2: 3 ) = 'LQ'
150 NRUN = 0
151 NFAIL = 0
152 NERRS = 0
153 DO 10 I = 1, 4
154 ISEED( I ) = ISEEDY( I )
155 10 CONTINUE
156 *
157 * Test the error exits
158 *
159 IF( TSTERR )
160 $ CALL DERRLQ( PATH, NOUT )
161 INFOT = 0
162 CALL XLAENV( 2, 2 )
163 *
164 LDA = NMAX
165 LWORK = NMAX*MAX( NMAX, NRHS )
166 *
167 * Do for each value of M in MVAL.
168 *
169 DO 70 IM = 1, NM
170 M = MVAL( IM )
171 *
172 * Do for each value of N in NVAL.
173 *
174 DO 60 IN = 1, NN
175 N = NVAL( IN )
176 MINMN = MIN( M, N )
177 DO 50 IMAT = 1, NTYPES
178 *
179 * Do the tests only if DOTYPE( IMAT ) is true.
180 *
181 IF( .NOT.DOTYPE( IMAT ) )
182 $ GO TO 50
183 *
184 * Set up parameters with DLATB4 and generate a test matrix
185 * with DLATMS.
186 *
187 CALL DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
188 $ CNDNUM, DIST )
189 *
190 SRNAMT = 'DLATMS'
191 CALL DLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE,
192 $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA,
193 $ WORK, INFO )
194 *
195 * Check error code from DLATMS.
196 *
197 IF( INFO.NE.0 ) THEN
198 CALL ALAERH( PATH, 'DLATMS', INFO, 0, ' ', M, N, -1,
199 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
200 GO TO 50
201 END IF
202 *
203 * Set some values for K: the first value must be MINMN,
204 * corresponding to the call of DLQT01; other values are
205 * used in the calls of DLQT02, and must not exceed MINMN.
206 *
207 KVAL( 1 ) = MINMN
208 KVAL( 2 ) = 0
209 KVAL( 3 ) = 1
210 KVAL( 4 ) = MINMN / 2
211 IF( MINMN.EQ.0 ) THEN
212 NK = 1
213 ELSE IF( MINMN.EQ.1 ) THEN
214 NK = 2
215 ELSE IF( MINMN.LE.3 ) THEN
216 NK = 3
217 ELSE
218 NK = 4
219 END IF
220 *
221 * Do for each value of K in KVAL
222 *
223 DO 40 IK = 1, NK
224 K = KVAL( IK )
225 *
226 * Do for each pair of values (NB,NX) in NBVAL and NXVAL.
227 *
228 DO 30 INB = 1, NNB
229 NB = NBVAL( INB )
230 CALL XLAENV( 1, NB )
231 NX = NXVAL( INB )
232 CALL XLAENV( 3, NX )
233 DO I = 1, NTESTS
234 RESULT( I ) = ZERO
235 END DO
236 NT = 2
237 IF( IK.EQ.1 ) THEN
238 *
239 * Test DGELQF
240 *
241 CALL DLQT01( M, N, A, AF, AQ, AL, LDA, TAU,
242 $ WORK, LWORK, RWORK, RESULT( 1 ) )
243 ELSE IF( M.LE.N ) THEN
244 *
245 * Test DORGLQ, using factorization
246 * returned by DLQT01
247 *
248 CALL DLQT02( M, N, K, A, AF, AQ, AL, LDA, TAU,
249 $ WORK, LWORK, RWORK, RESULT( 1 ) )
250 ELSE
251 RESULT( 1 ) = ZERO
252 RESULT( 2 ) = ZERO
253 END IF
254 IF( M.GE.K ) THEN
255 *
256 * Test DORMLQ, using factorization returned
257 * by DLQT01
258 *
259 CALL DLQT03( M, N, K, AF, AC, AL, AQ, LDA, TAU,
260 $ WORK, LWORK, RWORK, RESULT( 3 ) )
261 NT = NT + 4
262 *
263 * If M>=N and K=N, call DGELQS to solve a system
264 * with NRHS right hand sides and compute the
265 * residual.
266 *
267 IF( K.EQ.M .AND. INB.EQ.1 ) THEN
268 *
269 * Generate a solution and set the right
270 * hand side.
271 *
272 SRNAMT = 'DLARHS'
273 CALL DLARHS( PATH, 'New', 'Full',
274 $ 'No transpose', M, N, 0, 0,
275 $ NRHS, A, LDA, XACT, LDA, B, LDA,
276 $ ISEED, INFO )
277 *
278 CALL DLACPY( 'Full', M, NRHS, B, LDA, X,
279 $ LDA )
280 SRNAMT = 'DGELQS'
281 CALL DGELQS( M, N, NRHS, AF, LDA, TAU, X,
282 $ LDA, WORK, LWORK, INFO )
283 *
284 * Check error code from DGELQS.
285 *
286 IF( INFO.NE.0 )
287 $ CALL ALAERH( PATH, 'DGELQS', INFO, 0, ' ',
288 $ M, N, NRHS, -1, NB, IMAT,
289 $ NFAIL, NERRS, NOUT )
290 *
291 CALL DGET02( 'No transpose', M, N, NRHS, A,
292 $ LDA, X, LDA, B, LDA, RWORK,
293 $ RESULT( 7 ) )
294 NT = NT + 1
295 ELSE
296 RESULT( 7 ) = ZERO
297 END IF
298 ELSE
299 RESULT( 3 ) = ZERO
300 RESULT( 4 ) = ZERO
301 RESULT( 5 ) = ZERO
302 RESULT( 6 ) = ZERO
303 END IF
304 *
305 * Print information about the tests that did not
306 * pass the threshold.
307 *
308 DO 20 I = 1, NT
309 IF( RESULT( I ).GE.THRESH ) THEN
310 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
311 $ CALL ALAHD( NOUT, PATH )
312 WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX,
313 $ IMAT, I, RESULT( I )
314 NFAIL = NFAIL + 1
315 END IF
316 20 CONTINUE
317 NRUN = NRUN + NT
318 30 CONTINUE
319 40 CONTINUE
320 50 CONTINUE
321 60 CONTINUE
322 70 CONTINUE
323 *
324 * Print a summary of the results.
325 *
326 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
327 *
328 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=',
329 $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 )
330 RETURN
331 *
332 * End of DCHKLQ
333 *
334 END