1 SUBROUTINE CCHKSY( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
2 $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
3 $ XACT, 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 NMAX, NN, NNB, NNS, NOUT
12 REAL THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
17 REAL RWORK( * )
18 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
19 $ WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * CCHKSY tests CSYTRF, -TRI2, -TRS, -TRS2, -RFS, and -CON.
26 *
27 * Arguments
28 * =========
29 *
30 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
31 * The matrix types to be used for testing. Matrices of type j
32 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
33 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
34 *
35 * NN (input) INTEGER
36 * The number of values of N contained in the vector NVAL.
37 *
38 * NVAL (input) INTEGER array, dimension (NN)
39 * The values of the matrix dimension N.
40 *
41 * NNB (input) INTEGER
42 * The number of values of NB contained in the vector NBVAL.
43 *
44 * NBVAL (input) INTEGER array, dimension (NBVAL)
45 * The values of the blocksize NB.
46 *
47 * NNS (input) INTEGER
48 * The number of values of NRHS contained in the vector NSVAL.
49 *
50 * NSVAL (input) INTEGER array, dimension (NNS)
51 * The values of the number of right hand sides NRHS.
52 *
53 * THRESH (input) REAL
54 * The threshold value for the test ratios. A result is
55 * included in the output file if RESULT >= THRESH. To have
56 * every test ratio printed, use THRESH = 0.
57 *
58 * TSTERR (input) LOGICAL
59 * Flag that indicates whether error exits are to be tested.
60 *
61 * NMAX (input) INTEGER
62 * The maximum value permitted for N, used in dimensioning the
63 * work arrays.
64 *
65 * A (workspace) COMPLEX array, dimension (NMAX*NMAX)
66 *
67 * AFAC (workspace) COMPLEX array, dimension (NMAX*NMAX)
68 *
69 * AINV (workspace) COMPLEX array, dimension (NMAX*NMAX)
70 *
71 * B (workspace) COMPLEX array, dimension (NMAX*NSMAX)
72 * where NSMAX is the largest entry in NSVAL.
73 *
74 * X (workspace) COMPLEX array, dimension (NMAX*NSMAX)
75 *
76 * XACT (workspace) COMPLEX array, dimension (NMAX*NSMAX)
77 *
78 * WORK (workspace) COMPLEX array, dimension
79 * (NMAX*max(2,NSMAX))
80 *
81 * RWORK (workspace) REAL array,
82 * dimension (NMAX+2*NSMAX)
83 *
84 * IWORK (workspace) INTEGER array, dimension (NMAX)
85 *
86 * NOUT (input) INTEGER
87 * The unit number for output.
88 *
89 * =====================================================================
90 *
91 * .. Parameters ..
92 REAL ZERO
93 PARAMETER ( ZERO = 0.0E+0 )
94 INTEGER NTYPES
95 PARAMETER ( NTYPES = 11 )
96 INTEGER NTESTS
97 PARAMETER ( NTESTS = 9 )
98 * ..
99 * .. Local Scalars ..
100 LOGICAL TRFCON, ZEROT
101 CHARACTER DIST, TYPE, UPLO, XTYPE
102 CHARACTER*3 PATH
103 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
104 $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
105 $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
106 REAL ANORM, CNDNUM, RCOND, RCONDC
107 * ..
108 * .. Local Arrays ..
109 CHARACTER UPLOS( 2 )
110 INTEGER ISEED( 4 ), ISEEDY( 4 )
111 REAL RESULT( NTESTS )
112 * ..
113 * .. External Functions ..
114 REAL CLANSY, SGET06
115 EXTERNAL CLANSY, SGET06
116 * ..
117 * .. External Subroutines ..
118 EXTERNAL ALAERH, ALAHD, ALASUM, CERRSY, CGET04, CLACPY,
119 $ CLARHS, CLATB4, CLATMS, CLATSY, CPOT05, CSYCON,
120 $ CSYRFS, CSYT01, CSYT02, CSYT03, CSYTRF,
121 $ CSYTRI2, CSYTRS, XLAENV
122 * ..
123 * .. Intrinsic Functions ..
124 INTRINSIC MAX, MIN
125 * ..
126 * .. Scalars in Common ..
127 LOGICAL LERR, OK
128 CHARACTER*32 SRNAMT
129 INTEGER INFOT, NUNIT
130 * ..
131 * .. Common blocks ..
132 COMMON / INFOC / INFOT, NUNIT, OK, LERR
133 COMMON / SRNAMC / SRNAMT
134 * ..
135 * .. Data statements ..
136 DATA ISEEDY / 1988, 1989, 1990, 1991 /
137 DATA UPLOS / 'U', 'L' /
138 * ..
139 * .. Executable Statements ..
140 *
141 * Initialize constants and the random number seed.
142 *
143 PATH( 1: 1 ) = 'Complex precision'
144 PATH( 2: 3 ) = 'SY'
145 NRUN = 0
146 NFAIL = 0
147 NERRS = 0
148 DO 10 I = 1, 4
149 ISEED( I ) = ISEEDY( I )
150 10 CONTINUE
151 *
152 * Test the error exits
153 *
154 IF( TSTERR )
155 $ CALL CERRSY( PATH, NOUT )
156 INFOT = 0
157 *
158 * Do for each value of N in NVAL
159 *
160 DO 180 IN = 1, NN
161 N = NVAL( IN )
162 LDA = MAX( N, 1 )
163 XTYPE = 'N'
164 NIMAT = NTYPES
165 IF( N.LE.0 )
166 $ NIMAT = 1
167 *
168 IZERO = 0
169 DO 170 IMAT = 1, NIMAT
170 *
171 * Do the tests only if DOTYPE( IMAT ) is true.
172 *
173 IF( .NOT.DOTYPE( IMAT ) )
174 $ GO TO 170
175 *
176 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
177 *
178 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
179 IF( ZEROT .AND. N.LT.IMAT-2 )
180 $ GO TO 170
181 *
182 * Do first for UPLO = 'U', then for UPLO = 'L'
183 *
184 DO 160 IUPLO = 1, 2
185 UPLO = UPLOS( IUPLO )
186 *
187 IF( IMAT.NE.NTYPES ) THEN
188 *
189 * Set up parameters with CLATB4 and generate a test
190 * matrix with CLATMS.
191 *
192 CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
193 $ MODE, CNDNUM, DIST )
194 *
195 SRNAMT = 'CLATMS'
196 CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
197 $ CNDNUM, ANORM, KL, KU, 'N', A, LDA, WORK,
198 $ INFO )
199 *
200 * Check error code from CLATMS.
201 *
202 IF( INFO.NE.0 ) THEN
203 CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N,
204 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
205 GO TO 160
206 END IF
207 *
208 * For types 3-6, zero one or more rows and columns of
209 * the matrix to test that INFO is returned correctly.
210 *
211 IF( ZEROT ) THEN
212 IF( IMAT.EQ.3 ) THEN
213 IZERO = 1
214 ELSE IF( IMAT.EQ.4 ) THEN
215 IZERO = N
216 ELSE
217 IZERO = N / 2 + 1
218 END IF
219 *
220 IF( IMAT.LT.6 ) THEN
221 *
222 * Set row and column IZERO to zero.
223 *
224 IF( IUPLO.EQ.1 ) THEN
225 IOFF = ( IZERO-1 )*LDA
226 DO 20 I = 1, IZERO - 1
227 A( IOFF+I ) = ZERO
228 20 CONTINUE
229 IOFF = IOFF + IZERO
230 DO 30 I = IZERO, N
231 A( IOFF ) = ZERO
232 IOFF = IOFF + LDA
233 30 CONTINUE
234 ELSE
235 IOFF = IZERO
236 DO 40 I = 1, IZERO - 1
237 A( IOFF ) = ZERO
238 IOFF = IOFF + LDA
239 40 CONTINUE
240 IOFF = IOFF - IZERO
241 DO 50 I = IZERO, N
242 A( IOFF+I ) = ZERO
243 50 CONTINUE
244 END IF
245 ELSE
246 IF( IUPLO.EQ.1 ) THEN
247 *
248 * Set the first IZERO rows to zero.
249 *
250 IOFF = 0
251 DO 70 J = 1, N
252 I2 = MIN( J, IZERO )
253 DO 60 I = 1, I2
254 A( IOFF+I ) = ZERO
255 60 CONTINUE
256 IOFF = IOFF + LDA
257 70 CONTINUE
258 ELSE
259 *
260 * Set the last IZERO rows to zero.
261 *
262 IOFF = 0
263 DO 90 J = 1, N
264 I1 = MAX( J, IZERO )
265 DO 80 I = I1, N
266 A( IOFF+I ) = ZERO
267 80 CONTINUE
268 IOFF = IOFF + LDA
269 90 CONTINUE
270 END IF
271 END IF
272 ELSE
273 IZERO = 0
274 END IF
275 ELSE
276 *
277 * Use a special block diagonal matrix to test alternate
278 * code for the 2 x 2 blocks.
279 *
280 CALL CLATSY( UPLO, N, A, LDA, ISEED )
281 END IF
282 *
283 * Do for each value of NB in NBVAL
284 *
285 DO 150 INB = 1, NNB
286 NB = NBVAL( INB )
287 CALL XLAENV( 1, NB )
288 *
289 * Compute the L*D*L' or U*D*U' factorization of the
290 * matrix.
291 *
292 CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
293 LWORK = MAX( 2, NB )*LDA
294 SRNAMT = 'CSYTRF'
295 CALL CSYTRF( UPLO, N, AFAC, LDA, IWORK, AINV, LWORK,
296 $ INFO )
297 *
298 * Adjust the expected value of INFO to account for
299 * pivoting.
300 *
301 K = IZERO
302 IF( K.GT.0 ) THEN
303 100 CONTINUE
304 IF( IWORK( K ).LT.0 ) THEN
305 IF( IWORK( K ).NE.-K ) THEN
306 K = -IWORK( K )
307 GO TO 100
308 END IF
309 ELSE IF( IWORK( K ).NE.K ) THEN
310 K = IWORK( K )
311 GO TO 100
312 END IF
313 END IF
314 *
315 * Check error code from CSYTRF.
316 *
317 IF( INFO.NE.K )
318 $ CALL ALAERH( PATH, 'CSYTRF', INFO, K, UPLO, N, N,
319 $ -1, -1, NB, IMAT, NFAIL, NERRS, NOUT )
320 IF( INFO.NE.0 ) THEN
321 TRFCON = .TRUE.
322 ELSE
323 TRFCON = .FALSE.
324 END IF
325 *
326 *+ TEST 1
327 * Reconstruct matrix from factors and compute residual.
328 *
329 CALL CSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK, AINV,
330 $ LDA, RWORK, RESULT( 1 ) )
331 NT = 1
332 *
333 *+ TEST 2
334 * Form the inverse and compute the residual.
335 *
336 IF( INB.EQ.1 .AND. .NOT.TRFCON ) THEN
337 CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
338 SRNAMT = 'CSYTRI2'
339 LWORK = (N+NB+1)*(NB+3)
340 CALL CSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
341 $ LWORK, INFO )
342 *
343 * Check error code from CSYTRI.
344 *
345 IF( INFO.NE.0 )
346 $ CALL ALAERH( PATH, 'CSYTRI', INFO, 0, UPLO, N,
347 $ N, -1, -1, -1, IMAT, NFAIL, NERRS,
348 $ NOUT )
349 *
350 CALL CSYT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA,
351 $ RWORK, RCONDC, RESULT( 2 ) )
352 NT = 2
353 END IF
354 *
355 * Print information about the tests that did not pass
356 * the threshold.
357 *
358 DO 110 K = 1, NT
359 IF( RESULT( K ).GE.THRESH ) THEN
360 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
361 $ CALL ALAHD( NOUT, PATH )
362 WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
363 $ RESULT( K )
364 NFAIL = NFAIL + 1
365 END IF
366 110 CONTINUE
367 NRUN = NRUN + NT
368 *
369 * Skip the other tests if this is not the first block
370 * size.
371 *
372 IF( INB.GT.1 )
373 $ GO TO 150
374 *
375 * Do only the condition estimate if INFO is not 0.
376 *
377 IF( TRFCON ) THEN
378 RCONDC = ZERO
379 GO TO 140
380 END IF
381 *
382 DO 130 IRHS = 1, NNS
383 NRHS = NSVAL( IRHS )
384 *
385 *+ TEST 3
386 * Solve and compute residual for A * X = B.
387 *
388 SRNAMT = 'CLARHS'
389 CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
390 $ NRHS, A, LDA, XACT, LDA, B, LDA,
391 $ ISEED, INFO )
392 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
393 *
394 SRNAMT = 'CSYTRS'
395 CALL CSYTRS( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
396 $ LDA, INFO )
397 *
398 * Check error code from CSYTRS.
399 *
400 IF( INFO.NE.0 )
401 $ CALL ALAERH( PATH, 'CSYTRS', INFO, 0, UPLO, N,
402 $ N, -1, -1, NRHS, IMAT, NFAIL,
403 $ NERRS, NOUT )
404 *
405 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
406 CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
407 $ LDA, RWORK, RESULT( 3 ) )
408 *
409 *+ TEST 4
410 * Solve and compute residual for A * X = B.
411 *
412 SRNAMT = 'CLARHS'
413 CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
414 $ NRHS, A, LDA, XACT, LDA, B, LDA,
415 $ ISEED, INFO )
416 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
417 *
418 SRNAMT = 'CSYTRS2'
419 CALL CSYTRS2( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
420 $ LDA, WORK, INFO )
421 *
422 * Check error code from CSYTRS2.
423 *
424 IF( INFO.NE.0 )
425 $ CALL ALAERH( PATH, 'CSYTRS2', INFO, 0, UPLO, N,
426 $ N, -1, -1, NRHS, IMAT, NFAIL,
427 $ NERRS, NOUT )
428 *
429 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
430 CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
431 $ LDA, RWORK, RESULT( 4 ) )
432 *
433 *+ TEST 5
434 * Check solution from generated exact solution.
435 *
436 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
437 $ RESULT( 5 ) )
438 *
439 *+ TESTS 6, 7, and 8
440 * Use iterative refinement to improve the solution.
441 *
442 SRNAMT = 'CSYRFS'
443 CALL CSYRFS( UPLO, N, NRHS, A, LDA, AFAC, LDA,
444 $ IWORK, B, LDA, X, LDA, RWORK,
445 $ RWORK( NRHS+1 ), WORK,
446 $ RWORK( 2*NRHS+1 ), INFO )
447 *
448 * Check error code from CSYRFS.
449 *
450 IF( INFO.NE.0 )
451 $ CALL ALAERH( PATH, 'CSYRFS', INFO, 0, UPLO, N,
452 $ N, -1, -1, NRHS, IMAT, NFAIL,
453 $ NERRS, NOUT )
454 *
455 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
456 $ RESULT( 6 ) )
457 CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
458 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
459 $ RESULT( 7 ) )
460 *
461 * Print information about the tests that did not pass
462 * the threshold.
463 *
464 DO 120 K = 3, 8
465 IF( RESULT( K ).GE.THRESH ) THEN
466 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
467 $ CALL ALAHD( NOUT, PATH )
468 WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
469 $ IMAT, K, RESULT( K )
470 NFAIL = NFAIL + 1
471 END IF
472 120 CONTINUE
473 NRUN = NRUN + 5
474 130 CONTINUE
475 *
476 *+ TEST 9
477 * Get an estimate of RCOND = 1/CNDNUM.
478 *
479 140 CONTINUE
480 ANORM = CLANSY( '1', UPLO, N, A, LDA, RWORK )
481 SRNAMT = 'CSYCON'
482 CALL CSYCON( UPLO, N, AFAC, LDA, IWORK, ANORM, RCOND,
483 $ WORK, INFO )
484 *
485 * Check error code from CSYCON.
486 *
487 IF( INFO.NE.0 )
488 $ CALL ALAERH( PATH, 'CSYCON', INFO, 0, UPLO, N, N,
489 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
490 *
491 RESULT( 9 ) = SGET06( RCOND, RCONDC )
492 *
493 * Print information about the tests that did not pass
494 * the threshold.
495 *
496 IF( RESULT( 9 ).GE.THRESH ) THEN
497 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
498 $ CALL ALAHD( NOUT, PATH )
499 WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 9,
500 $ RESULT( 9 )
501 NFAIL = NFAIL + 1
502 END IF
503 NRUN = NRUN + 1
504 150 CONTINUE
505 160 CONTINUE
506 170 CONTINUE
507 180 CONTINUE
508 *
509 * Print a summary of the results.
510 *
511 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
512 *
513 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
514 $ I2, ', test ', I2, ', ratio =', G12.5 )
515 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
516 $ I2, ', test(', I2, ') =', G12.5 )
517 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
518 $ ', test(', I2, ') =', G12.5 )
519 RETURN
520 *
521 * End of CCHKSY
522 *
523 END
2 $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
3 $ XACT, 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 NMAX, NN, NNB, NNS, NOUT
12 REAL THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
17 REAL RWORK( * )
18 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
19 $ WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * CCHKSY tests CSYTRF, -TRI2, -TRS, -TRS2, -RFS, and -CON.
26 *
27 * Arguments
28 * =========
29 *
30 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
31 * The matrix types to be used for testing. Matrices of type j
32 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
33 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
34 *
35 * NN (input) INTEGER
36 * The number of values of N contained in the vector NVAL.
37 *
38 * NVAL (input) INTEGER array, dimension (NN)
39 * The values of the matrix dimension N.
40 *
41 * NNB (input) INTEGER
42 * The number of values of NB contained in the vector NBVAL.
43 *
44 * NBVAL (input) INTEGER array, dimension (NBVAL)
45 * The values of the blocksize NB.
46 *
47 * NNS (input) INTEGER
48 * The number of values of NRHS contained in the vector NSVAL.
49 *
50 * NSVAL (input) INTEGER array, dimension (NNS)
51 * The values of the number of right hand sides NRHS.
52 *
53 * THRESH (input) REAL
54 * The threshold value for the test ratios. A result is
55 * included in the output file if RESULT >= THRESH. To have
56 * every test ratio printed, use THRESH = 0.
57 *
58 * TSTERR (input) LOGICAL
59 * Flag that indicates whether error exits are to be tested.
60 *
61 * NMAX (input) INTEGER
62 * The maximum value permitted for N, used in dimensioning the
63 * work arrays.
64 *
65 * A (workspace) COMPLEX array, dimension (NMAX*NMAX)
66 *
67 * AFAC (workspace) COMPLEX array, dimension (NMAX*NMAX)
68 *
69 * AINV (workspace) COMPLEX array, dimension (NMAX*NMAX)
70 *
71 * B (workspace) COMPLEX array, dimension (NMAX*NSMAX)
72 * where NSMAX is the largest entry in NSVAL.
73 *
74 * X (workspace) COMPLEX array, dimension (NMAX*NSMAX)
75 *
76 * XACT (workspace) COMPLEX array, dimension (NMAX*NSMAX)
77 *
78 * WORK (workspace) COMPLEX array, dimension
79 * (NMAX*max(2,NSMAX))
80 *
81 * RWORK (workspace) REAL array,
82 * dimension (NMAX+2*NSMAX)
83 *
84 * IWORK (workspace) INTEGER array, dimension (NMAX)
85 *
86 * NOUT (input) INTEGER
87 * The unit number for output.
88 *
89 * =====================================================================
90 *
91 * .. Parameters ..
92 REAL ZERO
93 PARAMETER ( ZERO = 0.0E+0 )
94 INTEGER NTYPES
95 PARAMETER ( NTYPES = 11 )
96 INTEGER NTESTS
97 PARAMETER ( NTESTS = 9 )
98 * ..
99 * .. Local Scalars ..
100 LOGICAL TRFCON, ZEROT
101 CHARACTER DIST, TYPE, UPLO, XTYPE
102 CHARACTER*3 PATH
103 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
104 $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
105 $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
106 REAL ANORM, CNDNUM, RCOND, RCONDC
107 * ..
108 * .. Local Arrays ..
109 CHARACTER UPLOS( 2 )
110 INTEGER ISEED( 4 ), ISEEDY( 4 )
111 REAL RESULT( NTESTS )
112 * ..
113 * .. External Functions ..
114 REAL CLANSY, SGET06
115 EXTERNAL CLANSY, SGET06
116 * ..
117 * .. External Subroutines ..
118 EXTERNAL ALAERH, ALAHD, ALASUM, CERRSY, CGET04, CLACPY,
119 $ CLARHS, CLATB4, CLATMS, CLATSY, CPOT05, CSYCON,
120 $ CSYRFS, CSYT01, CSYT02, CSYT03, CSYTRF,
121 $ CSYTRI2, CSYTRS, XLAENV
122 * ..
123 * .. Intrinsic Functions ..
124 INTRINSIC MAX, MIN
125 * ..
126 * .. Scalars in Common ..
127 LOGICAL LERR, OK
128 CHARACTER*32 SRNAMT
129 INTEGER INFOT, NUNIT
130 * ..
131 * .. Common blocks ..
132 COMMON / INFOC / INFOT, NUNIT, OK, LERR
133 COMMON / SRNAMC / SRNAMT
134 * ..
135 * .. Data statements ..
136 DATA ISEEDY / 1988, 1989, 1990, 1991 /
137 DATA UPLOS / 'U', 'L' /
138 * ..
139 * .. Executable Statements ..
140 *
141 * Initialize constants and the random number seed.
142 *
143 PATH( 1: 1 ) = 'Complex precision'
144 PATH( 2: 3 ) = 'SY'
145 NRUN = 0
146 NFAIL = 0
147 NERRS = 0
148 DO 10 I = 1, 4
149 ISEED( I ) = ISEEDY( I )
150 10 CONTINUE
151 *
152 * Test the error exits
153 *
154 IF( TSTERR )
155 $ CALL CERRSY( PATH, NOUT )
156 INFOT = 0
157 *
158 * Do for each value of N in NVAL
159 *
160 DO 180 IN = 1, NN
161 N = NVAL( IN )
162 LDA = MAX( N, 1 )
163 XTYPE = 'N'
164 NIMAT = NTYPES
165 IF( N.LE.0 )
166 $ NIMAT = 1
167 *
168 IZERO = 0
169 DO 170 IMAT = 1, NIMAT
170 *
171 * Do the tests only if DOTYPE( IMAT ) is true.
172 *
173 IF( .NOT.DOTYPE( IMAT ) )
174 $ GO TO 170
175 *
176 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
177 *
178 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
179 IF( ZEROT .AND. N.LT.IMAT-2 )
180 $ GO TO 170
181 *
182 * Do first for UPLO = 'U', then for UPLO = 'L'
183 *
184 DO 160 IUPLO = 1, 2
185 UPLO = UPLOS( IUPLO )
186 *
187 IF( IMAT.NE.NTYPES ) THEN
188 *
189 * Set up parameters with CLATB4 and generate a test
190 * matrix with CLATMS.
191 *
192 CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
193 $ MODE, CNDNUM, DIST )
194 *
195 SRNAMT = 'CLATMS'
196 CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
197 $ CNDNUM, ANORM, KL, KU, 'N', A, LDA, WORK,
198 $ INFO )
199 *
200 * Check error code from CLATMS.
201 *
202 IF( INFO.NE.0 ) THEN
203 CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N,
204 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
205 GO TO 160
206 END IF
207 *
208 * For types 3-6, zero one or more rows and columns of
209 * the matrix to test that INFO is returned correctly.
210 *
211 IF( ZEROT ) THEN
212 IF( IMAT.EQ.3 ) THEN
213 IZERO = 1
214 ELSE IF( IMAT.EQ.4 ) THEN
215 IZERO = N
216 ELSE
217 IZERO = N / 2 + 1
218 END IF
219 *
220 IF( IMAT.LT.6 ) THEN
221 *
222 * Set row and column IZERO to zero.
223 *
224 IF( IUPLO.EQ.1 ) THEN
225 IOFF = ( IZERO-1 )*LDA
226 DO 20 I = 1, IZERO - 1
227 A( IOFF+I ) = ZERO
228 20 CONTINUE
229 IOFF = IOFF + IZERO
230 DO 30 I = IZERO, N
231 A( IOFF ) = ZERO
232 IOFF = IOFF + LDA
233 30 CONTINUE
234 ELSE
235 IOFF = IZERO
236 DO 40 I = 1, IZERO - 1
237 A( IOFF ) = ZERO
238 IOFF = IOFF + LDA
239 40 CONTINUE
240 IOFF = IOFF - IZERO
241 DO 50 I = IZERO, N
242 A( IOFF+I ) = ZERO
243 50 CONTINUE
244 END IF
245 ELSE
246 IF( IUPLO.EQ.1 ) THEN
247 *
248 * Set the first IZERO rows to zero.
249 *
250 IOFF = 0
251 DO 70 J = 1, N
252 I2 = MIN( J, IZERO )
253 DO 60 I = 1, I2
254 A( IOFF+I ) = ZERO
255 60 CONTINUE
256 IOFF = IOFF + LDA
257 70 CONTINUE
258 ELSE
259 *
260 * Set the last IZERO rows to zero.
261 *
262 IOFF = 0
263 DO 90 J = 1, N
264 I1 = MAX( J, IZERO )
265 DO 80 I = I1, N
266 A( IOFF+I ) = ZERO
267 80 CONTINUE
268 IOFF = IOFF + LDA
269 90 CONTINUE
270 END IF
271 END IF
272 ELSE
273 IZERO = 0
274 END IF
275 ELSE
276 *
277 * Use a special block diagonal matrix to test alternate
278 * code for the 2 x 2 blocks.
279 *
280 CALL CLATSY( UPLO, N, A, LDA, ISEED )
281 END IF
282 *
283 * Do for each value of NB in NBVAL
284 *
285 DO 150 INB = 1, NNB
286 NB = NBVAL( INB )
287 CALL XLAENV( 1, NB )
288 *
289 * Compute the L*D*L' or U*D*U' factorization of the
290 * matrix.
291 *
292 CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
293 LWORK = MAX( 2, NB )*LDA
294 SRNAMT = 'CSYTRF'
295 CALL CSYTRF( UPLO, N, AFAC, LDA, IWORK, AINV, LWORK,
296 $ INFO )
297 *
298 * Adjust the expected value of INFO to account for
299 * pivoting.
300 *
301 K = IZERO
302 IF( K.GT.0 ) THEN
303 100 CONTINUE
304 IF( IWORK( K ).LT.0 ) THEN
305 IF( IWORK( K ).NE.-K ) THEN
306 K = -IWORK( K )
307 GO TO 100
308 END IF
309 ELSE IF( IWORK( K ).NE.K ) THEN
310 K = IWORK( K )
311 GO TO 100
312 END IF
313 END IF
314 *
315 * Check error code from CSYTRF.
316 *
317 IF( INFO.NE.K )
318 $ CALL ALAERH( PATH, 'CSYTRF', INFO, K, UPLO, N, N,
319 $ -1, -1, NB, IMAT, NFAIL, NERRS, NOUT )
320 IF( INFO.NE.0 ) THEN
321 TRFCON = .TRUE.
322 ELSE
323 TRFCON = .FALSE.
324 END IF
325 *
326 *+ TEST 1
327 * Reconstruct matrix from factors and compute residual.
328 *
329 CALL CSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK, AINV,
330 $ LDA, RWORK, RESULT( 1 ) )
331 NT = 1
332 *
333 *+ TEST 2
334 * Form the inverse and compute the residual.
335 *
336 IF( INB.EQ.1 .AND. .NOT.TRFCON ) THEN
337 CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
338 SRNAMT = 'CSYTRI2'
339 LWORK = (N+NB+1)*(NB+3)
340 CALL CSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
341 $ LWORK, INFO )
342 *
343 * Check error code from CSYTRI.
344 *
345 IF( INFO.NE.0 )
346 $ CALL ALAERH( PATH, 'CSYTRI', INFO, 0, UPLO, N,
347 $ N, -1, -1, -1, IMAT, NFAIL, NERRS,
348 $ NOUT )
349 *
350 CALL CSYT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA,
351 $ RWORK, RCONDC, RESULT( 2 ) )
352 NT = 2
353 END IF
354 *
355 * Print information about the tests that did not pass
356 * the threshold.
357 *
358 DO 110 K = 1, NT
359 IF( RESULT( K ).GE.THRESH ) THEN
360 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
361 $ CALL ALAHD( NOUT, PATH )
362 WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
363 $ RESULT( K )
364 NFAIL = NFAIL + 1
365 END IF
366 110 CONTINUE
367 NRUN = NRUN + NT
368 *
369 * Skip the other tests if this is not the first block
370 * size.
371 *
372 IF( INB.GT.1 )
373 $ GO TO 150
374 *
375 * Do only the condition estimate if INFO is not 0.
376 *
377 IF( TRFCON ) THEN
378 RCONDC = ZERO
379 GO TO 140
380 END IF
381 *
382 DO 130 IRHS = 1, NNS
383 NRHS = NSVAL( IRHS )
384 *
385 *+ TEST 3
386 * Solve and compute residual for A * X = B.
387 *
388 SRNAMT = 'CLARHS'
389 CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
390 $ NRHS, A, LDA, XACT, LDA, B, LDA,
391 $ ISEED, INFO )
392 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
393 *
394 SRNAMT = 'CSYTRS'
395 CALL CSYTRS( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
396 $ LDA, INFO )
397 *
398 * Check error code from CSYTRS.
399 *
400 IF( INFO.NE.0 )
401 $ CALL ALAERH( PATH, 'CSYTRS', INFO, 0, UPLO, N,
402 $ N, -1, -1, NRHS, IMAT, NFAIL,
403 $ NERRS, NOUT )
404 *
405 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
406 CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
407 $ LDA, RWORK, RESULT( 3 ) )
408 *
409 *+ TEST 4
410 * Solve and compute residual for A * X = B.
411 *
412 SRNAMT = 'CLARHS'
413 CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
414 $ NRHS, A, LDA, XACT, LDA, B, LDA,
415 $ ISEED, INFO )
416 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
417 *
418 SRNAMT = 'CSYTRS2'
419 CALL CSYTRS2( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
420 $ LDA, WORK, INFO )
421 *
422 * Check error code from CSYTRS2.
423 *
424 IF( INFO.NE.0 )
425 $ CALL ALAERH( PATH, 'CSYTRS2', INFO, 0, UPLO, N,
426 $ N, -1, -1, NRHS, IMAT, NFAIL,
427 $ NERRS, NOUT )
428 *
429 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
430 CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
431 $ LDA, RWORK, RESULT( 4 ) )
432 *
433 *+ TEST 5
434 * Check solution from generated exact solution.
435 *
436 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
437 $ RESULT( 5 ) )
438 *
439 *+ TESTS 6, 7, and 8
440 * Use iterative refinement to improve the solution.
441 *
442 SRNAMT = 'CSYRFS'
443 CALL CSYRFS( UPLO, N, NRHS, A, LDA, AFAC, LDA,
444 $ IWORK, B, LDA, X, LDA, RWORK,
445 $ RWORK( NRHS+1 ), WORK,
446 $ RWORK( 2*NRHS+1 ), INFO )
447 *
448 * Check error code from CSYRFS.
449 *
450 IF( INFO.NE.0 )
451 $ CALL ALAERH( PATH, 'CSYRFS', INFO, 0, UPLO, N,
452 $ N, -1, -1, NRHS, IMAT, NFAIL,
453 $ NERRS, NOUT )
454 *
455 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
456 $ RESULT( 6 ) )
457 CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
458 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
459 $ RESULT( 7 ) )
460 *
461 * Print information about the tests that did not pass
462 * the threshold.
463 *
464 DO 120 K = 3, 8
465 IF( RESULT( K ).GE.THRESH ) THEN
466 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
467 $ CALL ALAHD( NOUT, PATH )
468 WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
469 $ IMAT, K, RESULT( K )
470 NFAIL = NFAIL + 1
471 END IF
472 120 CONTINUE
473 NRUN = NRUN + 5
474 130 CONTINUE
475 *
476 *+ TEST 9
477 * Get an estimate of RCOND = 1/CNDNUM.
478 *
479 140 CONTINUE
480 ANORM = CLANSY( '1', UPLO, N, A, LDA, RWORK )
481 SRNAMT = 'CSYCON'
482 CALL CSYCON( UPLO, N, AFAC, LDA, IWORK, ANORM, RCOND,
483 $ WORK, INFO )
484 *
485 * Check error code from CSYCON.
486 *
487 IF( INFO.NE.0 )
488 $ CALL ALAERH( PATH, 'CSYCON', INFO, 0, UPLO, N, N,
489 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
490 *
491 RESULT( 9 ) = SGET06( RCOND, RCONDC )
492 *
493 * Print information about the tests that did not pass
494 * the threshold.
495 *
496 IF( RESULT( 9 ).GE.THRESH ) THEN
497 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
498 $ CALL ALAHD( NOUT, PATH )
499 WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 9,
500 $ RESULT( 9 )
501 NFAIL = NFAIL + 1
502 END IF
503 NRUN = NRUN + 1
504 150 CONTINUE
505 160 CONTINUE
506 170 CONTINUE
507 180 CONTINUE
508 *
509 * Print a summary of the results.
510 *
511 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
512 *
513 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
514 $ I2, ', test ', I2, ', ratio =', G12.5 )
515 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
516 $ I2, ', test(', I2, ') =', G12.5 )
517 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
518 $ ', test(', I2, ') =', G12.5 )
519 RETURN
520 *
521 * End of CCHKSY
522 *
523 END