1 SUBROUTINE CCHKGT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
2 $ A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT )
3 *
4 * -- LAPACK test routine (version 3.1.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * January 2007
7 *
8 * .. Scalar Arguments ..
9 LOGICAL TSTERR
10 INTEGER NN, NNS, NOUT
11 REAL THRESH
12 * ..
13 * .. Array Arguments ..
14 LOGICAL DOTYPE( * )
15 INTEGER IWORK( * ), NSVAL( * ), NVAL( * )
16 REAL RWORK( * )
17 COMPLEX A( * ), AF( * ), B( * ), WORK( * ), X( * ),
18 $ XACT( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * CCHKGT tests CGTTRF, -TRS, -RFS, and -CON
25 *
26 * Arguments
27 * =========
28 *
29 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
30 * The matrix types to be used for testing. Matrices of type j
31 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
32 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
33 *
34 * NN (input) INTEGER
35 * The number of values of N contained in the vector NVAL.
36 *
37 * NVAL (input) INTEGER array, dimension (NN)
38 * The values of the matrix dimension N.
39 *
40 * NNS (input) INTEGER
41 * The number of values of NRHS contained in the vector NSVAL.
42 *
43 * NSVAL (input) INTEGER array, dimension (NNS)
44 * The values of the number of right hand sides NRHS.
45 *
46 * THRESH (input) REAL
47 * The threshold value for the test ratios. A result is
48 * included in the output file if RESULT >= THRESH. To have
49 * every test ratio printed, use THRESH = 0.
50 *
51 * TSTERR (input) LOGICAL
52 * Flag that indicates whether error exits are to be tested.
53 *
54 * A (workspace) COMPLEX array, dimension (NMAX*4)
55 *
56 * AF (workspace) COMPLEX array, dimension (NMAX*4)
57 *
58 * B (workspace) COMPLEX array, dimension (NMAX*NSMAX)
59 * where NSMAX is the largest entry in NSVAL.
60 *
61 * X (workspace) COMPLEX array, dimension (NMAX*NSMAX)
62 *
63 * XACT (workspace) COMPLEX array, dimension (NMAX*NSMAX)
64 *
65 * WORK (workspace) COMPLEX array, dimension
66 * (NMAX*max(3,NSMAX))
67 *
68 * RWORK (workspace) REAL array, dimension
69 * (max(NMAX)+2*NSMAX)
70 *
71 * IWORK (workspace) INTEGER array, dimension (NMAX)
72 *
73 * NOUT (input) INTEGER
74 * The unit number for output.
75 *
76 * =====================================================================
77 *
78 * .. Parameters ..
79 REAL ONE, ZERO
80 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
81 INTEGER NTYPES
82 PARAMETER ( NTYPES = 12 )
83 INTEGER NTESTS
84 PARAMETER ( NTESTS = 7 )
85 * ..
86 * .. Local Scalars ..
87 LOGICAL TRFCON, ZEROT
88 CHARACTER DIST, NORM, TRANS, TYPE
89 CHARACTER*3 PATH
90 INTEGER I, IMAT, IN, INFO, IRHS, ITRAN, IX, IZERO, J,
91 $ K, KL, KOFF, KU, LDA, M, MODE, N, NERRS, NFAIL,
92 $ NIMAT, NRHS, NRUN
93 REAL AINVNM, ANORM, COND, RCOND, RCONDC, RCONDI,
94 $ RCONDO
95 * ..
96 * .. Local Arrays ..
97 CHARACTER TRANSS( 3 )
98 INTEGER ISEED( 4 ), ISEEDY( 4 )
99 REAL RESULT( NTESTS )
100 COMPLEX Z( 3 )
101 * ..
102 * .. External Functions ..
103 REAL CLANGT, SCASUM, SGET06
104 EXTERNAL CLANGT, SCASUM, SGET06
105 * ..
106 * .. External Subroutines ..
107 EXTERNAL ALAERH, ALAHD, ALASUM, CCOPY, CERRGE, CGET04,
108 $ CGTCON, CGTRFS, CGTT01, CGTT02, CGTT05, CGTTRF,
109 $ CGTTRS, CLACPY, CLAGTM, CLARNV, CLATB4, CLATMS,
110 $ CSSCAL
111 * ..
112 * .. Intrinsic Functions ..
113 INTRINSIC MAX
114 * ..
115 * .. Scalars in Common ..
116 LOGICAL LERR, OK
117 CHARACTER*32 SRNAMT
118 INTEGER INFOT, NUNIT
119 * ..
120 * .. Common blocks ..
121 COMMON / INFOC / INFOT, NUNIT, OK, LERR
122 COMMON / SRNAMC / SRNAMT
123 * ..
124 * .. Data statements ..
125 DATA ISEEDY / 0, 0, 0, 1 / , TRANSS / 'N', 'T',
126 $ 'C' /
127 * ..
128 * .. Executable Statements ..
129 *
130 PATH( 1: 1 ) = 'Complex precision'
131 PATH( 2: 3 ) = 'GT'
132 NRUN = 0
133 NFAIL = 0
134 NERRS = 0
135 DO 10 I = 1, 4
136 ISEED( I ) = ISEEDY( I )
137 10 CONTINUE
138 *
139 * Test the error exits
140 *
141 IF( TSTERR )
142 $ CALL CERRGE( PATH, NOUT )
143 INFOT = 0
144 *
145 DO 110 IN = 1, NN
146 *
147 * Do for each value of N in NVAL.
148 *
149 N = NVAL( IN )
150 M = MAX( N-1, 0 )
151 LDA = MAX( 1, N )
152 NIMAT = NTYPES
153 IF( N.LE.0 )
154 $ NIMAT = 1
155 *
156 DO 100 IMAT = 1, NIMAT
157 *
158 * Do the tests only if DOTYPE( IMAT ) is true.
159 *
160 IF( .NOT.DOTYPE( IMAT ) )
161 $ GO TO 100
162 *
163 * Set up parameters with CLATB4.
164 *
165 CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
166 $ COND, DIST )
167 *
168 ZEROT = IMAT.GE.8 .AND. IMAT.LE.10
169 IF( IMAT.LE.6 ) THEN
170 *
171 * Types 1-6: generate matrices of known condition number.
172 *
173 KOFF = MAX( 2-KU, 3-MAX( 1, N ) )
174 SRNAMT = 'CLATMS'
175 CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, COND,
176 $ ANORM, KL, KU, 'Z', AF( KOFF ), 3, WORK,
177 $ INFO )
178 *
179 * Check the error code from CLATMS.
180 *
181 IF( INFO.NE.0 ) THEN
182 CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', N, N, KL,
183 $ KU, -1, IMAT, NFAIL, NERRS, NOUT )
184 GO TO 100
185 END IF
186 IZERO = 0
187 *
188 IF( N.GT.1 ) THEN
189 CALL CCOPY( N-1, AF( 4 ), 3, A, 1 )
190 CALL CCOPY( N-1, AF( 3 ), 3, A( N+M+1 ), 1 )
191 END IF
192 CALL CCOPY( N, AF( 2 ), 3, A( M+1 ), 1 )
193 ELSE
194 *
195 * Types 7-12: generate tridiagonal matrices with
196 * unknown condition numbers.
197 *
198 IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 7 ) ) THEN
199 *
200 * Generate a matrix with elements whose real and
201 * imaginary parts are from [-1,1].
202 *
203 CALL CLARNV( 2, ISEED, N+2*M, A )
204 IF( ANORM.NE.ONE )
205 $ CALL CSSCAL( N+2*M, ANORM, A, 1 )
206 ELSE IF( IZERO.GT.0 ) THEN
207 *
208 * Reuse the last matrix by copying back the zeroed out
209 * elements.
210 *
211 IF( IZERO.EQ.1 ) THEN
212 A( N ) = Z( 2 )
213 IF( N.GT.1 )
214 $ A( 1 ) = Z( 3 )
215 ELSE IF( IZERO.EQ.N ) THEN
216 A( 3*N-2 ) = Z( 1 )
217 A( 2*N-1 ) = Z( 2 )
218 ELSE
219 A( 2*N-2+IZERO ) = Z( 1 )
220 A( N-1+IZERO ) = Z( 2 )
221 A( IZERO ) = Z( 3 )
222 END IF
223 END IF
224 *
225 * If IMAT > 7, set one column of the matrix to 0.
226 *
227 IF( .NOT.ZEROT ) THEN
228 IZERO = 0
229 ELSE IF( IMAT.EQ.8 ) THEN
230 IZERO = 1
231 Z( 2 ) = A( N )
232 A( N ) = ZERO
233 IF( N.GT.1 ) THEN
234 Z( 3 ) = A( 1 )
235 A( 1 ) = ZERO
236 END IF
237 ELSE IF( IMAT.EQ.9 ) THEN
238 IZERO = N
239 Z( 1 ) = A( 3*N-2 )
240 Z( 2 ) = A( 2*N-1 )
241 A( 3*N-2 ) = ZERO
242 A( 2*N-1 ) = ZERO
243 ELSE
244 IZERO = ( N+1 ) / 2
245 DO 20 I = IZERO, N - 1
246 A( 2*N-2+I ) = ZERO
247 A( N-1+I ) = ZERO
248 A( I ) = ZERO
249 20 CONTINUE
250 A( 3*N-2 ) = ZERO
251 A( 2*N-1 ) = ZERO
252 END IF
253 END IF
254 *
255 *+ TEST 1
256 * Factor A as L*U and compute the ratio
257 * norm(L*U - A) / (n * norm(A) * EPS )
258 *
259 CALL CCOPY( N+2*M, A, 1, AF, 1 )
260 SRNAMT = 'CGTTRF'
261 CALL CGTTRF( N, AF, AF( M+1 ), AF( N+M+1 ), AF( N+2*M+1 ),
262 $ IWORK, INFO )
263 *
264 * Check error code from CGTTRF.
265 *
266 IF( INFO.NE.IZERO )
267 $ CALL ALAERH( PATH, 'CGTTRF', INFO, IZERO, ' ', N, N, 1,
268 $ 1, -1, IMAT, NFAIL, NERRS, NOUT )
269 TRFCON = INFO.NE.0
270 *
271 CALL CGTT01( N, A, A( M+1 ), A( N+M+1 ), AF, AF( M+1 ),
272 $ AF( N+M+1 ), AF( N+2*M+1 ), IWORK, WORK, LDA,
273 $ RWORK, RESULT( 1 ) )
274 *
275 * Print the test ratio if it is .GE. THRESH.
276 *
277 IF( RESULT( 1 ).GE.THRESH ) THEN
278 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
279 $ CALL ALAHD( NOUT, PATH )
280 WRITE( NOUT, FMT = 9999 )N, IMAT, 1, RESULT( 1 )
281 NFAIL = NFAIL + 1
282 END IF
283 NRUN = NRUN + 1
284 *
285 DO 50 ITRAN = 1, 2
286 TRANS = TRANSS( ITRAN )
287 IF( ITRAN.EQ.1 ) THEN
288 NORM = 'O'
289 ELSE
290 NORM = 'I'
291 END IF
292 ANORM = CLANGT( NORM, N, A, A( M+1 ), A( N+M+1 ) )
293 *
294 IF( .NOT.TRFCON ) THEN
295 *
296 * Use CGTTRS to solve for one column at a time of
297 * inv(A), computing the maximum column sum as we go.
298 *
299 AINVNM = ZERO
300 DO 40 I = 1, N
301 DO 30 J = 1, N
302 X( J ) = ZERO
303 30 CONTINUE
304 X( I ) = ONE
305 CALL CGTTRS( TRANS, N, 1, AF, AF( M+1 ),
306 $ AF( N+M+1 ), AF( N+2*M+1 ), IWORK, X,
307 $ LDA, INFO )
308 AINVNM = MAX( AINVNM, SCASUM( N, X, 1 ) )
309 40 CONTINUE
310 *
311 * Compute RCONDC = 1 / (norm(A) * norm(inv(A))
312 *
313 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
314 RCONDC = ONE
315 ELSE
316 RCONDC = ( ONE / ANORM ) / AINVNM
317 END IF
318 IF( ITRAN.EQ.1 ) THEN
319 RCONDO = RCONDC
320 ELSE
321 RCONDI = RCONDC
322 END IF
323 ELSE
324 RCONDC = ZERO
325 END IF
326 *
327 *+ TEST 7
328 * Estimate the reciprocal of the condition number of the
329 * matrix.
330 *
331 SRNAMT = 'CGTCON'
332 CALL CGTCON( NORM, N, AF, AF( M+1 ), AF( N+M+1 ),
333 $ AF( N+2*M+1 ), IWORK, ANORM, RCOND, WORK,
334 $ INFO )
335 *
336 * Check error code from CGTCON.
337 *
338 IF( INFO.NE.0 )
339 $ CALL ALAERH( PATH, 'CGTCON', INFO, 0, NORM, N, N, -1,
340 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
341 *
342 RESULT( 7 ) = SGET06( RCOND, RCONDC )
343 *
344 * Print the test ratio if it is .GE. THRESH.
345 *
346 IF( RESULT( 7 ).GE.THRESH ) THEN
347 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
348 $ CALL ALAHD( NOUT, PATH )
349 WRITE( NOUT, FMT = 9997 )NORM, N, IMAT, 7,
350 $ RESULT( 7 )
351 NFAIL = NFAIL + 1
352 END IF
353 NRUN = NRUN + 1
354 50 CONTINUE
355 *
356 * Skip the remaining tests if the matrix is singular.
357 *
358 IF( TRFCON )
359 $ GO TO 100
360 *
361 DO 90 IRHS = 1, NNS
362 NRHS = NSVAL( IRHS )
363 *
364 * Generate NRHS random solution vectors.
365 *
366 IX = 1
367 DO 60 J = 1, NRHS
368 CALL CLARNV( 2, ISEED, N, XACT( IX ) )
369 IX = IX + LDA
370 60 CONTINUE
371 *
372 DO 80 ITRAN = 1, 3
373 TRANS = TRANSS( ITRAN )
374 IF( ITRAN.EQ.1 ) THEN
375 RCONDC = RCONDO
376 ELSE
377 RCONDC = RCONDI
378 END IF
379 *
380 * Set the right hand side.
381 *
382 CALL CLAGTM( TRANS, N, NRHS, ONE, A,
383 $ A( M+1 ), A( N+M+1 ), XACT, LDA,
384 $ ZERO, B, LDA )
385 *
386 *+ TEST 2
387 * Solve op(A) * X = B and compute the residual.
388 *
389 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
390 SRNAMT = 'CGTTRS'
391 CALL CGTTRS( TRANS, N, NRHS, AF, AF( M+1 ),
392 $ AF( N+M+1 ), AF( N+2*M+1 ), IWORK, X,
393 $ LDA, INFO )
394 *
395 * Check error code from CGTTRS.
396 *
397 IF( INFO.NE.0 )
398 $ CALL ALAERH( PATH, 'CGTTRS', INFO, 0, TRANS, N, N,
399 $ -1, -1, NRHS, IMAT, NFAIL, NERRS,
400 $ NOUT )
401 *
402 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
403 CALL CGTT02( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ),
404 $ X, LDA, WORK, LDA, RWORK, RESULT( 2 ) )
405 *
406 *+ TEST 3
407 * Check solution from generated exact solution.
408 *
409 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
410 $ RESULT( 3 ) )
411 *
412 *+ TESTS 4, 5, and 6
413 * Use iterative refinement to improve the solution.
414 *
415 SRNAMT = 'CGTRFS'
416 CALL CGTRFS( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ),
417 $ AF, AF( M+1 ), AF( N+M+1 ),
418 $ AF( N+2*M+1 ), IWORK, B, LDA, X, LDA,
419 $ RWORK, RWORK( NRHS+1 ), WORK,
420 $ RWORK( 2*NRHS+1 ), INFO )
421 *
422 * Check error code from CGTRFS.
423 *
424 IF( INFO.NE.0 )
425 $ CALL ALAERH( PATH, 'CGTRFS', INFO, 0, TRANS, N, N,
426 $ -1, -1, NRHS, IMAT, NFAIL, NERRS,
427 $ NOUT )
428 *
429 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
430 $ RESULT( 4 ) )
431 CALL CGTT05( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ),
432 $ B, LDA, X, LDA, XACT, LDA, RWORK,
433 $ RWORK( NRHS+1 ), RESULT( 5 ) )
434 *
435 * Print information about the tests that did not pass the
436 * threshold.
437 *
438 DO 70 K = 2, 6
439 IF( RESULT( K ).GE.THRESH ) THEN
440 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
441 $ CALL ALAHD( NOUT, PATH )
442 WRITE( NOUT, FMT = 9998 )TRANS, N, NRHS, IMAT,
443 $ K, RESULT( K )
444 NFAIL = NFAIL + 1
445 END IF
446 70 CONTINUE
447 NRUN = NRUN + 5
448 80 CONTINUE
449 90 CONTINUE
450 100 CONTINUE
451 110 CONTINUE
452 *
453 * Print a summary of the results.
454 *
455 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
456 *
457 9999 FORMAT( 12X, 'N =', I5, ',', 10X, ' type ', I2, ', test(', I2,
458 $ ') = ', G12.5 )
459 9998 FORMAT( ' TRANS=''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
460 $ I2, ', test(', I2, ') = ', G12.5 )
461 9997 FORMAT( ' NORM =''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
462 $ ', test(', I2, ') = ', G12.5 )
463 RETURN
464 *
465 * End of CCHKGT
466 *
467 END
2 $ A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT )
3 *
4 * -- LAPACK test routine (version 3.1.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * January 2007
7 *
8 * .. Scalar Arguments ..
9 LOGICAL TSTERR
10 INTEGER NN, NNS, NOUT
11 REAL THRESH
12 * ..
13 * .. Array Arguments ..
14 LOGICAL DOTYPE( * )
15 INTEGER IWORK( * ), NSVAL( * ), NVAL( * )
16 REAL RWORK( * )
17 COMPLEX A( * ), AF( * ), B( * ), WORK( * ), X( * ),
18 $ XACT( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * CCHKGT tests CGTTRF, -TRS, -RFS, and -CON
25 *
26 * Arguments
27 * =========
28 *
29 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
30 * The matrix types to be used for testing. Matrices of type j
31 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
32 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
33 *
34 * NN (input) INTEGER
35 * The number of values of N contained in the vector NVAL.
36 *
37 * NVAL (input) INTEGER array, dimension (NN)
38 * The values of the matrix dimension N.
39 *
40 * NNS (input) INTEGER
41 * The number of values of NRHS contained in the vector NSVAL.
42 *
43 * NSVAL (input) INTEGER array, dimension (NNS)
44 * The values of the number of right hand sides NRHS.
45 *
46 * THRESH (input) REAL
47 * The threshold value for the test ratios. A result is
48 * included in the output file if RESULT >= THRESH. To have
49 * every test ratio printed, use THRESH = 0.
50 *
51 * TSTERR (input) LOGICAL
52 * Flag that indicates whether error exits are to be tested.
53 *
54 * A (workspace) COMPLEX array, dimension (NMAX*4)
55 *
56 * AF (workspace) COMPLEX array, dimension (NMAX*4)
57 *
58 * B (workspace) COMPLEX array, dimension (NMAX*NSMAX)
59 * where NSMAX is the largest entry in NSVAL.
60 *
61 * X (workspace) COMPLEX array, dimension (NMAX*NSMAX)
62 *
63 * XACT (workspace) COMPLEX array, dimension (NMAX*NSMAX)
64 *
65 * WORK (workspace) COMPLEX array, dimension
66 * (NMAX*max(3,NSMAX))
67 *
68 * RWORK (workspace) REAL array, dimension
69 * (max(NMAX)+2*NSMAX)
70 *
71 * IWORK (workspace) INTEGER array, dimension (NMAX)
72 *
73 * NOUT (input) INTEGER
74 * The unit number for output.
75 *
76 * =====================================================================
77 *
78 * .. Parameters ..
79 REAL ONE, ZERO
80 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
81 INTEGER NTYPES
82 PARAMETER ( NTYPES = 12 )
83 INTEGER NTESTS
84 PARAMETER ( NTESTS = 7 )
85 * ..
86 * .. Local Scalars ..
87 LOGICAL TRFCON, ZEROT
88 CHARACTER DIST, NORM, TRANS, TYPE
89 CHARACTER*3 PATH
90 INTEGER I, IMAT, IN, INFO, IRHS, ITRAN, IX, IZERO, J,
91 $ K, KL, KOFF, KU, LDA, M, MODE, N, NERRS, NFAIL,
92 $ NIMAT, NRHS, NRUN
93 REAL AINVNM, ANORM, COND, RCOND, RCONDC, RCONDI,
94 $ RCONDO
95 * ..
96 * .. Local Arrays ..
97 CHARACTER TRANSS( 3 )
98 INTEGER ISEED( 4 ), ISEEDY( 4 )
99 REAL RESULT( NTESTS )
100 COMPLEX Z( 3 )
101 * ..
102 * .. External Functions ..
103 REAL CLANGT, SCASUM, SGET06
104 EXTERNAL CLANGT, SCASUM, SGET06
105 * ..
106 * .. External Subroutines ..
107 EXTERNAL ALAERH, ALAHD, ALASUM, CCOPY, CERRGE, CGET04,
108 $ CGTCON, CGTRFS, CGTT01, CGTT02, CGTT05, CGTTRF,
109 $ CGTTRS, CLACPY, CLAGTM, CLARNV, CLATB4, CLATMS,
110 $ CSSCAL
111 * ..
112 * .. Intrinsic Functions ..
113 INTRINSIC MAX
114 * ..
115 * .. Scalars in Common ..
116 LOGICAL LERR, OK
117 CHARACTER*32 SRNAMT
118 INTEGER INFOT, NUNIT
119 * ..
120 * .. Common blocks ..
121 COMMON / INFOC / INFOT, NUNIT, OK, LERR
122 COMMON / SRNAMC / SRNAMT
123 * ..
124 * .. Data statements ..
125 DATA ISEEDY / 0, 0, 0, 1 / , TRANSS / 'N', 'T',
126 $ 'C' /
127 * ..
128 * .. Executable Statements ..
129 *
130 PATH( 1: 1 ) = 'Complex precision'
131 PATH( 2: 3 ) = 'GT'
132 NRUN = 0
133 NFAIL = 0
134 NERRS = 0
135 DO 10 I = 1, 4
136 ISEED( I ) = ISEEDY( I )
137 10 CONTINUE
138 *
139 * Test the error exits
140 *
141 IF( TSTERR )
142 $ CALL CERRGE( PATH, NOUT )
143 INFOT = 0
144 *
145 DO 110 IN = 1, NN
146 *
147 * Do for each value of N in NVAL.
148 *
149 N = NVAL( IN )
150 M = MAX( N-1, 0 )
151 LDA = MAX( 1, N )
152 NIMAT = NTYPES
153 IF( N.LE.0 )
154 $ NIMAT = 1
155 *
156 DO 100 IMAT = 1, NIMAT
157 *
158 * Do the tests only if DOTYPE( IMAT ) is true.
159 *
160 IF( .NOT.DOTYPE( IMAT ) )
161 $ GO TO 100
162 *
163 * Set up parameters with CLATB4.
164 *
165 CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
166 $ COND, DIST )
167 *
168 ZEROT = IMAT.GE.8 .AND. IMAT.LE.10
169 IF( IMAT.LE.6 ) THEN
170 *
171 * Types 1-6: generate matrices of known condition number.
172 *
173 KOFF = MAX( 2-KU, 3-MAX( 1, N ) )
174 SRNAMT = 'CLATMS'
175 CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, COND,
176 $ ANORM, KL, KU, 'Z', AF( KOFF ), 3, WORK,
177 $ INFO )
178 *
179 * Check the error code from CLATMS.
180 *
181 IF( INFO.NE.0 ) THEN
182 CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', N, N, KL,
183 $ KU, -1, IMAT, NFAIL, NERRS, NOUT )
184 GO TO 100
185 END IF
186 IZERO = 0
187 *
188 IF( N.GT.1 ) THEN
189 CALL CCOPY( N-1, AF( 4 ), 3, A, 1 )
190 CALL CCOPY( N-1, AF( 3 ), 3, A( N+M+1 ), 1 )
191 END IF
192 CALL CCOPY( N, AF( 2 ), 3, A( M+1 ), 1 )
193 ELSE
194 *
195 * Types 7-12: generate tridiagonal matrices with
196 * unknown condition numbers.
197 *
198 IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 7 ) ) THEN
199 *
200 * Generate a matrix with elements whose real and
201 * imaginary parts are from [-1,1].
202 *
203 CALL CLARNV( 2, ISEED, N+2*M, A )
204 IF( ANORM.NE.ONE )
205 $ CALL CSSCAL( N+2*M, ANORM, A, 1 )
206 ELSE IF( IZERO.GT.0 ) THEN
207 *
208 * Reuse the last matrix by copying back the zeroed out
209 * elements.
210 *
211 IF( IZERO.EQ.1 ) THEN
212 A( N ) = Z( 2 )
213 IF( N.GT.1 )
214 $ A( 1 ) = Z( 3 )
215 ELSE IF( IZERO.EQ.N ) THEN
216 A( 3*N-2 ) = Z( 1 )
217 A( 2*N-1 ) = Z( 2 )
218 ELSE
219 A( 2*N-2+IZERO ) = Z( 1 )
220 A( N-1+IZERO ) = Z( 2 )
221 A( IZERO ) = Z( 3 )
222 END IF
223 END IF
224 *
225 * If IMAT > 7, set one column of the matrix to 0.
226 *
227 IF( .NOT.ZEROT ) THEN
228 IZERO = 0
229 ELSE IF( IMAT.EQ.8 ) THEN
230 IZERO = 1
231 Z( 2 ) = A( N )
232 A( N ) = ZERO
233 IF( N.GT.1 ) THEN
234 Z( 3 ) = A( 1 )
235 A( 1 ) = ZERO
236 END IF
237 ELSE IF( IMAT.EQ.9 ) THEN
238 IZERO = N
239 Z( 1 ) = A( 3*N-2 )
240 Z( 2 ) = A( 2*N-1 )
241 A( 3*N-2 ) = ZERO
242 A( 2*N-1 ) = ZERO
243 ELSE
244 IZERO = ( N+1 ) / 2
245 DO 20 I = IZERO, N - 1
246 A( 2*N-2+I ) = ZERO
247 A( N-1+I ) = ZERO
248 A( I ) = ZERO
249 20 CONTINUE
250 A( 3*N-2 ) = ZERO
251 A( 2*N-1 ) = ZERO
252 END IF
253 END IF
254 *
255 *+ TEST 1
256 * Factor A as L*U and compute the ratio
257 * norm(L*U - A) / (n * norm(A) * EPS )
258 *
259 CALL CCOPY( N+2*M, A, 1, AF, 1 )
260 SRNAMT = 'CGTTRF'
261 CALL CGTTRF( N, AF, AF( M+1 ), AF( N+M+1 ), AF( N+2*M+1 ),
262 $ IWORK, INFO )
263 *
264 * Check error code from CGTTRF.
265 *
266 IF( INFO.NE.IZERO )
267 $ CALL ALAERH( PATH, 'CGTTRF', INFO, IZERO, ' ', N, N, 1,
268 $ 1, -1, IMAT, NFAIL, NERRS, NOUT )
269 TRFCON = INFO.NE.0
270 *
271 CALL CGTT01( N, A, A( M+1 ), A( N+M+1 ), AF, AF( M+1 ),
272 $ AF( N+M+1 ), AF( N+2*M+1 ), IWORK, WORK, LDA,
273 $ RWORK, RESULT( 1 ) )
274 *
275 * Print the test ratio if it is .GE. THRESH.
276 *
277 IF( RESULT( 1 ).GE.THRESH ) THEN
278 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
279 $ CALL ALAHD( NOUT, PATH )
280 WRITE( NOUT, FMT = 9999 )N, IMAT, 1, RESULT( 1 )
281 NFAIL = NFAIL + 1
282 END IF
283 NRUN = NRUN + 1
284 *
285 DO 50 ITRAN = 1, 2
286 TRANS = TRANSS( ITRAN )
287 IF( ITRAN.EQ.1 ) THEN
288 NORM = 'O'
289 ELSE
290 NORM = 'I'
291 END IF
292 ANORM = CLANGT( NORM, N, A, A( M+1 ), A( N+M+1 ) )
293 *
294 IF( .NOT.TRFCON ) THEN
295 *
296 * Use CGTTRS to solve for one column at a time of
297 * inv(A), computing the maximum column sum as we go.
298 *
299 AINVNM = ZERO
300 DO 40 I = 1, N
301 DO 30 J = 1, N
302 X( J ) = ZERO
303 30 CONTINUE
304 X( I ) = ONE
305 CALL CGTTRS( TRANS, N, 1, AF, AF( M+1 ),
306 $ AF( N+M+1 ), AF( N+2*M+1 ), IWORK, X,
307 $ LDA, INFO )
308 AINVNM = MAX( AINVNM, SCASUM( N, X, 1 ) )
309 40 CONTINUE
310 *
311 * Compute RCONDC = 1 / (norm(A) * norm(inv(A))
312 *
313 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
314 RCONDC = ONE
315 ELSE
316 RCONDC = ( ONE / ANORM ) / AINVNM
317 END IF
318 IF( ITRAN.EQ.1 ) THEN
319 RCONDO = RCONDC
320 ELSE
321 RCONDI = RCONDC
322 END IF
323 ELSE
324 RCONDC = ZERO
325 END IF
326 *
327 *+ TEST 7
328 * Estimate the reciprocal of the condition number of the
329 * matrix.
330 *
331 SRNAMT = 'CGTCON'
332 CALL CGTCON( NORM, N, AF, AF( M+1 ), AF( N+M+1 ),
333 $ AF( N+2*M+1 ), IWORK, ANORM, RCOND, WORK,
334 $ INFO )
335 *
336 * Check error code from CGTCON.
337 *
338 IF( INFO.NE.0 )
339 $ CALL ALAERH( PATH, 'CGTCON', INFO, 0, NORM, N, N, -1,
340 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
341 *
342 RESULT( 7 ) = SGET06( RCOND, RCONDC )
343 *
344 * Print the test ratio if it is .GE. THRESH.
345 *
346 IF( RESULT( 7 ).GE.THRESH ) THEN
347 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
348 $ CALL ALAHD( NOUT, PATH )
349 WRITE( NOUT, FMT = 9997 )NORM, N, IMAT, 7,
350 $ RESULT( 7 )
351 NFAIL = NFAIL + 1
352 END IF
353 NRUN = NRUN + 1
354 50 CONTINUE
355 *
356 * Skip the remaining tests if the matrix is singular.
357 *
358 IF( TRFCON )
359 $ GO TO 100
360 *
361 DO 90 IRHS = 1, NNS
362 NRHS = NSVAL( IRHS )
363 *
364 * Generate NRHS random solution vectors.
365 *
366 IX = 1
367 DO 60 J = 1, NRHS
368 CALL CLARNV( 2, ISEED, N, XACT( IX ) )
369 IX = IX + LDA
370 60 CONTINUE
371 *
372 DO 80 ITRAN = 1, 3
373 TRANS = TRANSS( ITRAN )
374 IF( ITRAN.EQ.1 ) THEN
375 RCONDC = RCONDO
376 ELSE
377 RCONDC = RCONDI
378 END IF
379 *
380 * Set the right hand side.
381 *
382 CALL CLAGTM( TRANS, N, NRHS, ONE, A,
383 $ A( M+1 ), A( N+M+1 ), XACT, LDA,
384 $ ZERO, B, LDA )
385 *
386 *+ TEST 2
387 * Solve op(A) * X = B and compute the residual.
388 *
389 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
390 SRNAMT = 'CGTTRS'
391 CALL CGTTRS( TRANS, N, NRHS, AF, AF( M+1 ),
392 $ AF( N+M+1 ), AF( N+2*M+1 ), IWORK, X,
393 $ LDA, INFO )
394 *
395 * Check error code from CGTTRS.
396 *
397 IF( INFO.NE.0 )
398 $ CALL ALAERH( PATH, 'CGTTRS', INFO, 0, TRANS, N, N,
399 $ -1, -1, NRHS, IMAT, NFAIL, NERRS,
400 $ NOUT )
401 *
402 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
403 CALL CGTT02( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ),
404 $ X, LDA, WORK, LDA, RWORK, RESULT( 2 ) )
405 *
406 *+ TEST 3
407 * Check solution from generated exact solution.
408 *
409 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
410 $ RESULT( 3 ) )
411 *
412 *+ TESTS 4, 5, and 6
413 * Use iterative refinement to improve the solution.
414 *
415 SRNAMT = 'CGTRFS'
416 CALL CGTRFS( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ),
417 $ AF, AF( M+1 ), AF( N+M+1 ),
418 $ AF( N+2*M+1 ), IWORK, B, LDA, X, LDA,
419 $ RWORK, RWORK( NRHS+1 ), WORK,
420 $ RWORK( 2*NRHS+1 ), INFO )
421 *
422 * Check error code from CGTRFS.
423 *
424 IF( INFO.NE.0 )
425 $ CALL ALAERH( PATH, 'CGTRFS', INFO, 0, TRANS, N, N,
426 $ -1, -1, NRHS, IMAT, NFAIL, NERRS,
427 $ NOUT )
428 *
429 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
430 $ RESULT( 4 ) )
431 CALL CGTT05( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ),
432 $ B, LDA, X, LDA, XACT, LDA, RWORK,
433 $ RWORK( NRHS+1 ), RESULT( 5 ) )
434 *
435 * Print information about the tests that did not pass the
436 * threshold.
437 *
438 DO 70 K = 2, 6
439 IF( RESULT( K ).GE.THRESH ) THEN
440 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
441 $ CALL ALAHD( NOUT, PATH )
442 WRITE( NOUT, FMT = 9998 )TRANS, N, NRHS, IMAT,
443 $ K, RESULT( K )
444 NFAIL = NFAIL + 1
445 END IF
446 70 CONTINUE
447 NRUN = NRUN + 5
448 80 CONTINUE
449 90 CONTINUE
450 100 CONTINUE
451 110 CONTINUE
452 *
453 * Print a summary of the results.
454 *
455 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
456 *
457 9999 FORMAT( 12X, 'N =', I5, ',', 10X, ' type ', I2, ', test(', I2,
458 $ ') = ', G12.5 )
459 9998 FORMAT( ' TRANS=''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
460 $ I2, ', test(', I2, ') = ', G12.5 )
461 9997 FORMAT( ' NORM =''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
462 $ ', test(', I2, ') = ', G12.5 )
463 RETURN
464 *
465 * End of CCHKGT
466 *
467 END