1 SUBROUTINE CDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
2 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
3 $ NOUT )
4 *
5 * -- LAPACK test routine (version 3.2) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 LOGICAL TSTERR
11 INTEGER NMAX, NN, NOUT, NRHS
12 REAL THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), NVAL( * )
17 REAL RWORK( * )
18 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
19 $ WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * CDRVSY tests the driver routines CSYSV, -SVX, and -SVXX.
26 *
27 * Note that this file is used only when the XBLAS are available,
28 * otherwise cdrvsy.f defines this subroutine.
29 *
30 * Arguments
31 * =========
32 *
33 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
34 * The matrix types to be used for testing. Matrices of type j
35 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
36 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
37 *
38 * NN (input) INTEGER
39 * The number of values of N contained in the vector NVAL.
40 *
41 * NVAL (input) INTEGER array, dimension (NN)
42 * The values of the matrix dimension N.
43 *
44 * NRHS (input) INTEGER
45 * The number of right hand side vectors to be generated for
46 * each linear system.
47 *
48 * THRESH (input) REAL
49 * The threshold value for the test ratios. A result is
50 * included in the output file if RESULT >= THRESH. To have
51 * every test ratio printed, use THRESH = 0.
52 *
53 * TSTERR (input) LOGICAL
54 * Flag that indicates whether error exits are to be tested.
55 *
56 * NMAX (input) INTEGER
57 * The maximum value permitted for N, used in dimensioning the
58 * work arrays.
59 *
60 * A (workspace) COMPLEX array, dimension (NMAX*NMAX)
61 *
62 * AFAC (workspace) COMPLEX array, dimension (NMAX*NMAX)
63 *
64 * AINV (workspace) COMPLEX array, dimension (NMAX*NMAX)
65 *
66 * B (workspace) COMPLEX array, dimension (NMAX*NRHS)
67 *
68 * X (workspace) COMPLEX array, dimension (NMAX*NRHS)
69 *
70 * XACT (workspace) COMPLEX array, dimension (NMAX*NRHS)
71 *
72 * WORK (workspace) COMPLEX array, dimension
73 * (NMAX*max(2,NRHS))
74 *
75 * RWORK (workspace) REAL array, dimension (NMAX+2*NRHS)
76 *
77 * IWORK (workspace) INTEGER array, dimension (NMAX)
78 *
79 * NOUT (input) INTEGER
80 * The unit number for output.
81 *
82 * =====================================================================
83 *
84 * .. Parameters ..
85 REAL ONE, ZERO
86 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
87 INTEGER NTYPES, NTESTS
88 PARAMETER ( NTYPES = 11, NTESTS = 6 )
89 INTEGER NFACT
90 PARAMETER ( NFACT = 2 )
91 * ..
92 * .. Local Scalars ..
93 LOGICAL ZEROT
94 CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE
95 CHARACTER*3 PATH
96 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
97 $ IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N,
98 $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT,
99 $ N_ERR_BNDS
100 REAL AINVNM, ANORM, CNDNUM, RCOND, RCONDC,
101 $ RPVGRW_SVXX
102 * ..
103 * .. Local Arrays ..
104 CHARACTER FACTS( NFACT ), UPLOS( 2 )
105 INTEGER ISEED( 4 ), ISEEDY( 4 )
106 REAL RESULT( NTESTS ), BERR( NRHS ),
107 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
108 * ..
109 * .. External Functions ..
110 REAL CLANSY, SGET06
111 EXTERNAL CLANSY, SGET06
112 * ..
113 * .. External Subroutines ..
114 EXTERNAL ALADHD, ALAERH, ALASVM, CERRVX, CGET04, CLACPY,
115 $ CLARHS, CLASET, CLATB4, CLATMS, CLATSY, CPOT05,
116 $ CSYSV, CSYSVX, CSYT01, CSYT02, CSYTRF, CSYTRI2,
117 $ XLAENV, CSYSVXX
118 * ..
119 * .. Scalars in Common ..
120 LOGICAL LERR, OK
121 CHARACTER*32 SRNAMT
122 INTEGER INFOT, NUNIT
123 * ..
124 * .. Common blocks ..
125 COMMON / INFOC / INFOT, NUNIT, OK, LERR
126 COMMON / SRNAMC / SRNAMT
127 * ..
128 * .. Intrinsic Functions ..
129 INTRINSIC CMPLX, MAX, MIN
130 * ..
131 * .. Data statements ..
132 DATA ISEEDY / 1988, 1989, 1990, 1991 /
133 DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
134 * ..
135 * .. Executable Statements ..
136 *
137 * Initialize constants and the random number seed.
138 *
139 PATH( 1: 1 ) = 'Complex precision'
140 PATH( 2: 3 ) = 'SY'
141 NRUN = 0
142 NFAIL = 0
143 NERRS = 0
144 DO 10 I = 1, 4
145 ISEED( I ) = ISEEDY( I )
146 10 CONTINUE
147 LWORK = MAX( 2*NMAX, NMAX*NRHS )
148 *
149 * Test the error exits
150 *
151 IF( TSTERR )
152 $ CALL CERRVX( PATH, NOUT )
153 INFOT = 0
154 *
155 * Set the block size and minimum block size for testing.
156 *
157 NB = 1
158 NBMIN = 2
159 CALL XLAENV( 1, NB )
160 CALL XLAENV( 2, NBMIN )
161 *
162 * Do for each value of N in NVAL
163 *
164 DO 180 IN = 1, NN
165 N = NVAL( IN )
166 LDA = MAX( N, 1 )
167 XTYPE = 'N'
168 NIMAT = NTYPES
169 IF( N.LE.0 )
170 $ NIMAT = 1
171 *
172 DO 170 IMAT = 1, NIMAT
173 *
174 * Do the tests only if DOTYPE( IMAT ) is true.
175 *
176 IF( .NOT.DOTYPE( IMAT ) )
177 $ GO TO 170
178 *
179 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
180 *
181 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
182 IF( ZEROT .AND. N.LT.IMAT-2 )
183 $ GO TO 170
184 *
185 * Do first for UPLO = 'U', then for UPLO = 'L'
186 *
187 DO 160 IUPLO = 1, 2
188 UPLO = UPLOS( IUPLO )
189 *
190 IF( IMAT.NE.NTYPES ) THEN
191 *
192 * Set up parameters with CLATB4 and generate a test
193 * matrix with CLATMS.
194 *
195 CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
196 $ MODE, CNDNUM, DIST )
197 *
198 SRNAMT = 'CLATMS'
199 CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
200 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
201 $ WORK, INFO )
202 *
203 * Check error code from CLATMS.
204 *
205 IF( INFO.NE.0 ) THEN
206 CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N,
207 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
208 GO TO 160
209 END IF
210 *
211 * For types 3-6, zero one or more rows and columns of
212 * the matrix to test that INFO is returned correctly.
213 *
214 IF( ZEROT ) THEN
215 IF( IMAT.EQ.3 ) THEN
216 IZERO = 1
217 ELSE IF( IMAT.EQ.4 ) THEN
218 IZERO = N
219 ELSE
220 IZERO = N / 2 + 1
221 END IF
222 *
223 IF( IMAT.LT.6 ) THEN
224 *
225 * Set row and column IZERO to zero.
226 *
227 IF( IUPLO.EQ.1 ) THEN
228 IOFF = ( IZERO-1 )*LDA
229 DO 20 I = 1, IZERO - 1
230 A( IOFF+I ) = ZERO
231 20 CONTINUE
232 IOFF = IOFF + IZERO
233 DO 30 I = IZERO, N
234 A( IOFF ) = ZERO
235 IOFF = IOFF + LDA
236 30 CONTINUE
237 ELSE
238 IOFF = IZERO
239 DO 40 I = 1, IZERO - 1
240 A( IOFF ) = ZERO
241 IOFF = IOFF + LDA
242 40 CONTINUE
243 IOFF = IOFF - IZERO
244 DO 50 I = IZERO, N
245 A( IOFF+I ) = ZERO
246 50 CONTINUE
247 END IF
248 ELSE
249 IF( IUPLO.EQ.1 ) THEN
250 *
251 * Set the first IZERO rows to zero.
252 *
253 IOFF = 0
254 DO 70 J = 1, N
255 I2 = MIN( J, IZERO )
256 DO 60 I = 1, I2
257 A( IOFF+I ) = ZERO
258 60 CONTINUE
259 IOFF = IOFF + LDA
260 70 CONTINUE
261 ELSE
262 *
263 * Set the last IZERO rows to zero.
264 *
265 IOFF = 0
266 DO 90 J = 1, N
267 I1 = MAX( J, IZERO )
268 DO 80 I = I1, N
269 A( IOFF+I ) = ZERO
270 80 CONTINUE
271 IOFF = IOFF + LDA
272 90 CONTINUE
273 END IF
274 END IF
275 ELSE
276 IZERO = 0
277 END IF
278 ELSE
279 *
280 * IMAT = NTYPES: Use a special block diagonal matrix to
281 * test alternate code for the 2-by-2 blocks.
282 *
283 CALL CLATSY( UPLO, N, A, LDA, ISEED )
284 END IF
285 *
286 DO 150 IFACT = 1, NFACT
287 *
288 * Do first for FACT = 'F', then for other values.
289 *
290 FACT = FACTS( IFACT )
291 *
292 * Compute the condition number for comparison with
293 * the value returned by CSYSVX.
294 *
295 IF( ZEROT ) THEN
296 IF( IFACT.EQ.1 )
297 $ GO TO 150
298 RCONDC = ZERO
299 *
300 ELSE IF( IFACT.EQ.1 ) THEN
301 *
302 * Compute the 1-norm of A.
303 *
304 ANORM = CLANSY( '1', UPLO, N, A, LDA, RWORK )
305 *
306 * Factor the matrix A.
307 *
308 CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
309 CALL CSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK,
310 $ LWORK, INFO )
311 *
312 * Compute inv(A) and take its norm.
313 *
314 CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
315 LWORK = (N+NB+1)*(NB+3)
316 CALL CSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
317 $ LWORK, INFO )
318 AINVNM = CLANSY( '1', UPLO, N, AINV, LDA, RWORK )
319 *
320 * Compute the 1-norm condition number of A.
321 *
322 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
323 RCONDC = ONE
324 ELSE
325 RCONDC = ( ONE / ANORM ) / AINVNM
326 END IF
327 END IF
328 *
329 * Form an exact solution and set the right hand side.
330 *
331 SRNAMT = 'CLARHS'
332 CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
333 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
334 $ INFO )
335 XTYPE = 'C'
336 *
337 * --- Test CSYSV ---
338 *
339 IF( IFACT.EQ.2 ) THEN
340 CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
341 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
342 *
343 * Factor the matrix and solve the system using CSYSV.
344 *
345 SRNAMT = 'CSYSV '
346 CALL CSYSV( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
347 $ LDA, WORK, LWORK, INFO )
348 *
349 * Adjust the expected value of INFO to account for
350 * pivoting.
351 *
352 K = IZERO
353 IF( K.GT.0 ) THEN
354 100 CONTINUE
355 IF( IWORK( K ).LT.0 ) THEN
356 IF( IWORK( K ).NE.-K ) THEN
357 K = -IWORK( K )
358 GO TO 100
359 END IF
360 ELSE IF( IWORK( K ).NE.K ) THEN
361 K = IWORK( K )
362 GO TO 100
363 END IF
364 END IF
365 *
366 * Check error code from CSYSV .
367 *
368 IF( INFO.NE.K ) THEN
369 CALL ALAERH( PATH, 'CSYSV ', INFO, K, UPLO, N,
370 $ N, -1, -1, NRHS, IMAT, NFAIL,
371 $ NERRS, NOUT )
372 GO TO 120
373 ELSE IF( INFO.NE.0 ) THEN
374 GO TO 120
375 END IF
376 *
377 * Reconstruct matrix from factors and compute
378 * residual.
379 *
380 CALL CSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
381 $ AINV, LDA, RWORK, RESULT( 1 ) )
382 *
383 * Compute residual of the computed solution.
384 *
385 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
386 CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
387 $ LDA, RWORK, RESULT( 2 ) )
388 *
389 * Check solution from generated exact solution.
390 *
391 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
392 $ RESULT( 3 ) )
393 NT = 3
394 *
395 * Print information about the tests that did not pass
396 * the threshold.
397 *
398 DO 110 K = 1, NT
399 IF( RESULT( K ).GE.THRESH ) THEN
400 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
401 $ CALL ALADHD( NOUT, PATH )
402 WRITE( NOUT, FMT = 9999 )'CSYSV ', UPLO, N,
403 $ IMAT, K, RESULT( K )
404 NFAIL = NFAIL + 1
405 END IF
406 110 CONTINUE
407 NRUN = NRUN + NT
408 120 CONTINUE
409 END IF
410 *
411 * --- Test CSYSVX ---
412 *
413 IF( IFACT.EQ.2 )
414 $ CALL CLASET( UPLO, N, N, CMPLX( ZERO ),
415 $ CMPLX( ZERO ), AFAC, LDA )
416 CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ),
417 $ CMPLX( ZERO ), X, LDA )
418 *
419 * Solve the system and compute the condition number and
420 * error bounds using CSYSVX.
421 *
422 SRNAMT = 'CSYSVX'
423 CALL CSYSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA,
424 $ IWORK, B, LDA, X, LDA, RCOND, RWORK,
425 $ RWORK( NRHS+1 ), WORK, LWORK,
426 $ RWORK( 2*NRHS+1 ), INFO )
427 *
428 * Adjust the expected value of INFO to account for
429 * pivoting.
430 *
431 K = IZERO
432 IF( K.GT.0 ) THEN
433 130 CONTINUE
434 IF( IWORK( K ).LT.0 ) THEN
435 IF( IWORK( K ).NE.-K ) THEN
436 K = -IWORK( K )
437 GO TO 130
438 END IF
439 ELSE IF( IWORK( K ).NE.K ) THEN
440 K = IWORK( K )
441 GO TO 130
442 END IF
443 END IF
444 *
445 * Check the error code from CSYSVX.
446 *
447 IF( INFO.NE.K ) THEN
448 CALL ALAERH( PATH, 'CSYSVX', INFO, K, FACT // UPLO,
449 $ N, N, -1, -1, NRHS, IMAT, NFAIL,
450 $ NERRS, NOUT )
451 GO TO 150
452 END IF
453 *
454 IF( INFO.EQ.0 ) THEN
455 IF( IFACT.GE.2 ) THEN
456 *
457 * Reconstruct matrix from factors and compute
458 * residual.
459 *
460 CALL CSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
461 $ AINV, LDA, RWORK( 2*NRHS+1 ),
462 $ RESULT( 1 ) )
463 K1 = 1
464 ELSE
465 K1 = 2
466 END IF
467 *
468 * Compute residual of the computed solution.
469 *
470 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
471 CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
472 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
473 *
474 * Check solution from generated exact solution.
475 *
476 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
477 $ RESULT( 3 ) )
478 *
479 * Check the error bounds from iterative refinement.
480 *
481 CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
482 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
483 $ RESULT( 4 ) )
484 ELSE
485 K1 = 6
486 END IF
487 *
488 * Compare RCOND from CSYSVX with the computed value
489 * in RCONDC.
490 *
491 RESULT( 6 ) = SGET06( RCOND, RCONDC )
492 *
493 * Print information about the tests that did not pass
494 * the threshold.
495 *
496 DO 140 K = K1, 6
497 IF( RESULT( K ).GE.THRESH ) THEN
498 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
499 $ CALL ALADHD( NOUT, PATH )
500 WRITE( NOUT, FMT = 9998 )'CSYSVX', FACT, UPLO,
501 $ N, IMAT, K, RESULT( K )
502 NFAIL = NFAIL + 1
503 END IF
504 140 CONTINUE
505 NRUN = NRUN + 7 - K1
506 *
507 * --- Test CSYSVXX ---
508 *
509 * Restore the matrices A and B.
510 *
511 IF( IFACT.EQ.2 )
512 $ CALL CLASET( UPLO, N, N, CMPLX( ZERO ),
513 $ CMPLX( ZERO ), AFAC, LDA )
514 CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ),
515 $ CMPLX( ZERO ), X, LDA )
516 *
517 * Solve the system and compute the condition number
518 * and error bounds using CSYSVXX.
519 *
520 SRNAMT = 'CSYSVXX'
521 N_ERR_BNDS = 3
522 EQUED = 'N'
523 CALL CSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
524 $ LDA, IWORK, EQUED, WORK( N+1 ), B, LDA, X,
525 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
526 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
527 $ IWORK( N+1 ), INFO )
528 *
529 * Adjust the expected value of INFO to account for
530 * pivoting.
531 *
532 K = IZERO
533 IF( K.GT.0 ) THEN
534 135 CONTINUE
535 IF( IWORK( K ).LT.0 ) THEN
536 IF( IWORK( K ).NE.-K ) THEN
537 K = -IWORK( K )
538 GO TO 135
539 END IF
540 ELSE IF( IWORK( K ).NE.K ) THEN
541 K = IWORK( K )
542 GO TO 135
543 END IF
544 END IF
545 *
546 * Check the error code from CSYSVXX.
547 *
548 IF( INFO.NE.K ) THEN
549 CALL ALAERH( PATH, 'CSYSVXX', INFO, K,
550 $ FACT // UPLO, N, N, -1, -1, NRHS, IMAT, NFAIL,
551 $ NERRS, NOUT )
552 GO TO 150
553 END IF
554 *
555 IF( INFO.EQ.0 ) THEN
556 IF( IFACT.GE.2 ) THEN
557 *
558 * Reconstruct matrix from factors and compute
559 * residual.
560 *
561 CALL CSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
562 $ AINV, LDA, RWORK(2*NRHS+1),
563 $ RESULT( 1 ) )
564 K1 = 1
565 ELSE
566 K1 = 2
567 END IF
568 *
569 * Compute residual of the computed solution.
570 *
571 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
572 CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
573 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
574 RESULT( 2 ) = 0.0
575 *
576 * Check solution from generated exact solution.
577 *
578 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
579 $ RESULT( 3 ) )
580 *
581 * Check the error bounds from iterative refinement.
582 *
583 CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
584 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
585 $ RESULT( 4 ) )
586 ELSE
587 K1 = 6
588 END IF
589 *
590 * Compare RCOND from CSYSVXX with the computed value
591 * in RCONDC.
592 *
593 RESULT( 6 ) = SGET06( RCOND, RCONDC )
594 *
595 * Print information about the tests that did not pass
596 * the threshold.
597 *
598 DO 85 K = K1, 6
599 IF( RESULT( K ).GE.THRESH ) THEN
600 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
601 $ CALL ALADHD( NOUT, PATH )
602 WRITE( NOUT, FMT = 9998 )'CSYSVXX',
603 $ FACT, UPLO, N, IMAT, K,
604 $ RESULT( K )
605 NFAIL = NFAIL + 1
606 END IF
607 85 CONTINUE
608 NRUN = NRUN + 7 - K1
609 *
610 150 CONTINUE
611 *
612 160 CONTINUE
613 170 CONTINUE
614 180 CONTINUE
615 *
616 * Print a summary of the results.
617 *
618 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
619 *
620
621 * Test Error Bounds from CSYSVXX
622
623 CALL CEBCHVXX(THRESH, PATH)
624
625 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
626 $ ', test ', I2, ', ratio =', G12.5 )
627 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5,
628 $ ', type ', I2, ', test ', I2, ', ratio =', G12.5 )
629 RETURN
630 *
631 * End of CDRVSY
632 *
633 END
2 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
3 $ NOUT )
4 *
5 * -- LAPACK test routine (version 3.2) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 LOGICAL TSTERR
11 INTEGER NMAX, NN, NOUT, NRHS
12 REAL THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), NVAL( * )
17 REAL RWORK( * )
18 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
19 $ WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * CDRVSY tests the driver routines CSYSV, -SVX, and -SVXX.
26 *
27 * Note that this file is used only when the XBLAS are available,
28 * otherwise cdrvsy.f defines this subroutine.
29 *
30 * Arguments
31 * =========
32 *
33 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
34 * The matrix types to be used for testing. Matrices of type j
35 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
36 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
37 *
38 * NN (input) INTEGER
39 * The number of values of N contained in the vector NVAL.
40 *
41 * NVAL (input) INTEGER array, dimension (NN)
42 * The values of the matrix dimension N.
43 *
44 * NRHS (input) INTEGER
45 * The number of right hand side vectors to be generated for
46 * each linear system.
47 *
48 * THRESH (input) REAL
49 * The threshold value for the test ratios. A result is
50 * included in the output file if RESULT >= THRESH. To have
51 * every test ratio printed, use THRESH = 0.
52 *
53 * TSTERR (input) LOGICAL
54 * Flag that indicates whether error exits are to be tested.
55 *
56 * NMAX (input) INTEGER
57 * The maximum value permitted for N, used in dimensioning the
58 * work arrays.
59 *
60 * A (workspace) COMPLEX array, dimension (NMAX*NMAX)
61 *
62 * AFAC (workspace) COMPLEX array, dimension (NMAX*NMAX)
63 *
64 * AINV (workspace) COMPLEX array, dimension (NMAX*NMAX)
65 *
66 * B (workspace) COMPLEX array, dimension (NMAX*NRHS)
67 *
68 * X (workspace) COMPLEX array, dimension (NMAX*NRHS)
69 *
70 * XACT (workspace) COMPLEX array, dimension (NMAX*NRHS)
71 *
72 * WORK (workspace) COMPLEX array, dimension
73 * (NMAX*max(2,NRHS))
74 *
75 * RWORK (workspace) REAL array, dimension (NMAX+2*NRHS)
76 *
77 * IWORK (workspace) INTEGER array, dimension (NMAX)
78 *
79 * NOUT (input) INTEGER
80 * The unit number for output.
81 *
82 * =====================================================================
83 *
84 * .. Parameters ..
85 REAL ONE, ZERO
86 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
87 INTEGER NTYPES, NTESTS
88 PARAMETER ( NTYPES = 11, NTESTS = 6 )
89 INTEGER NFACT
90 PARAMETER ( NFACT = 2 )
91 * ..
92 * .. Local Scalars ..
93 LOGICAL ZEROT
94 CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE
95 CHARACTER*3 PATH
96 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
97 $ IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N,
98 $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT,
99 $ N_ERR_BNDS
100 REAL AINVNM, ANORM, CNDNUM, RCOND, RCONDC,
101 $ RPVGRW_SVXX
102 * ..
103 * .. Local Arrays ..
104 CHARACTER FACTS( NFACT ), UPLOS( 2 )
105 INTEGER ISEED( 4 ), ISEEDY( 4 )
106 REAL RESULT( NTESTS ), BERR( NRHS ),
107 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
108 * ..
109 * .. External Functions ..
110 REAL CLANSY, SGET06
111 EXTERNAL CLANSY, SGET06
112 * ..
113 * .. External Subroutines ..
114 EXTERNAL ALADHD, ALAERH, ALASVM, CERRVX, CGET04, CLACPY,
115 $ CLARHS, CLASET, CLATB4, CLATMS, CLATSY, CPOT05,
116 $ CSYSV, CSYSVX, CSYT01, CSYT02, CSYTRF, CSYTRI2,
117 $ XLAENV, CSYSVXX
118 * ..
119 * .. Scalars in Common ..
120 LOGICAL LERR, OK
121 CHARACTER*32 SRNAMT
122 INTEGER INFOT, NUNIT
123 * ..
124 * .. Common blocks ..
125 COMMON / INFOC / INFOT, NUNIT, OK, LERR
126 COMMON / SRNAMC / SRNAMT
127 * ..
128 * .. Intrinsic Functions ..
129 INTRINSIC CMPLX, MAX, MIN
130 * ..
131 * .. Data statements ..
132 DATA ISEEDY / 1988, 1989, 1990, 1991 /
133 DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
134 * ..
135 * .. Executable Statements ..
136 *
137 * Initialize constants and the random number seed.
138 *
139 PATH( 1: 1 ) = 'Complex precision'
140 PATH( 2: 3 ) = 'SY'
141 NRUN = 0
142 NFAIL = 0
143 NERRS = 0
144 DO 10 I = 1, 4
145 ISEED( I ) = ISEEDY( I )
146 10 CONTINUE
147 LWORK = MAX( 2*NMAX, NMAX*NRHS )
148 *
149 * Test the error exits
150 *
151 IF( TSTERR )
152 $ CALL CERRVX( PATH, NOUT )
153 INFOT = 0
154 *
155 * Set the block size and minimum block size for testing.
156 *
157 NB = 1
158 NBMIN = 2
159 CALL XLAENV( 1, NB )
160 CALL XLAENV( 2, NBMIN )
161 *
162 * Do for each value of N in NVAL
163 *
164 DO 180 IN = 1, NN
165 N = NVAL( IN )
166 LDA = MAX( N, 1 )
167 XTYPE = 'N'
168 NIMAT = NTYPES
169 IF( N.LE.0 )
170 $ NIMAT = 1
171 *
172 DO 170 IMAT = 1, NIMAT
173 *
174 * Do the tests only if DOTYPE( IMAT ) is true.
175 *
176 IF( .NOT.DOTYPE( IMAT ) )
177 $ GO TO 170
178 *
179 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
180 *
181 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
182 IF( ZEROT .AND. N.LT.IMAT-2 )
183 $ GO TO 170
184 *
185 * Do first for UPLO = 'U', then for UPLO = 'L'
186 *
187 DO 160 IUPLO = 1, 2
188 UPLO = UPLOS( IUPLO )
189 *
190 IF( IMAT.NE.NTYPES ) THEN
191 *
192 * Set up parameters with CLATB4 and generate a test
193 * matrix with CLATMS.
194 *
195 CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
196 $ MODE, CNDNUM, DIST )
197 *
198 SRNAMT = 'CLATMS'
199 CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
200 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
201 $ WORK, INFO )
202 *
203 * Check error code from CLATMS.
204 *
205 IF( INFO.NE.0 ) THEN
206 CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N,
207 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
208 GO TO 160
209 END IF
210 *
211 * For types 3-6, zero one or more rows and columns of
212 * the matrix to test that INFO is returned correctly.
213 *
214 IF( ZEROT ) THEN
215 IF( IMAT.EQ.3 ) THEN
216 IZERO = 1
217 ELSE IF( IMAT.EQ.4 ) THEN
218 IZERO = N
219 ELSE
220 IZERO = N / 2 + 1
221 END IF
222 *
223 IF( IMAT.LT.6 ) THEN
224 *
225 * Set row and column IZERO to zero.
226 *
227 IF( IUPLO.EQ.1 ) THEN
228 IOFF = ( IZERO-1 )*LDA
229 DO 20 I = 1, IZERO - 1
230 A( IOFF+I ) = ZERO
231 20 CONTINUE
232 IOFF = IOFF + IZERO
233 DO 30 I = IZERO, N
234 A( IOFF ) = ZERO
235 IOFF = IOFF + LDA
236 30 CONTINUE
237 ELSE
238 IOFF = IZERO
239 DO 40 I = 1, IZERO - 1
240 A( IOFF ) = ZERO
241 IOFF = IOFF + LDA
242 40 CONTINUE
243 IOFF = IOFF - IZERO
244 DO 50 I = IZERO, N
245 A( IOFF+I ) = ZERO
246 50 CONTINUE
247 END IF
248 ELSE
249 IF( IUPLO.EQ.1 ) THEN
250 *
251 * Set the first IZERO rows to zero.
252 *
253 IOFF = 0
254 DO 70 J = 1, N
255 I2 = MIN( J, IZERO )
256 DO 60 I = 1, I2
257 A( IOFF+I ) = ZERO
258 60 CONTINUE
259 IOFF = IOFF + LDA
260 70 CONTINUE
261 ELSE
262 *
263 * Set the last IZERO rows to zero.
264 *
265 IOFF = 0
266 DO 90 J = 1, N
267 I1 = MAX( J, IZERO )
268 DO 80 I = I1, N
269 A( IOFF+I ) = ZERO
270 80 CONTINUE
271 IOFF = IOFF + LDA
272 90 CONTINUE
273 END IF
274 END IF
275 ELSE
276 IZERO = 0
277 END IF
278 ELSE
279 *
280 * IMAT = NTYPES: Use a special block diagonal matrix to
281 * test alternate code for the 2-by-2 blocks.
282 *
283 CALL CLATSY( UPLO, N, A, LDA, ISEED )
284 END IF
285 *
286 DO 150 IFACT = 1, NFACT
287 *
288 * Do first for FACT = 'F', then for other values.
289 *
290 FACT = FACTS( IFACT )
291 *
292 * Compute the condition number for comparison with
293 * the value returned by CSYSVX.
294 *
295 IF( ZEROT ) THEN
296 IF( IFACT.EQ.1 )
297 $ GO TO 150
298 RCONDC = ZERO
299 *
300 ELSE IF( IFACT.EQ.1 ) THEN
301 *
302 * Compute the 1-norm of A.
303 *
304 ANORM = CLANSY( '1', UPLO, N, A, LDA, RWORK )
305 *
306 * Factor the matrix A.
307 *
308 CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
309 CALL CSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK,
310 $ LWORK, INFO )
311 *
312 * Compute inv(A) and take its norm.
313 *
314 CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
315 LWORK = (N+NB+1)*(NB+3)
316 CALL CSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
317 $ LWORK, INFO )
318 AINVNM = CLANSY( '1', UPLO, N, AINV, LDA, RWORK )
319 *
320 * Compute the 1-norm condition number of A.
321 *
322 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
323 RCONDC = ONE
324 ELSE
325 RCONDC = ( ONE / ANORM ) / AINVNM
326 END IF
327 END IF
328 *
329 * Form an exact solution and set the right hand side.
330 *
331 SRNAMT = 'CLARHS'
332 CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
333 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
334 $ INFO )
335 XTYPE = 'C'
336 *
337 * --- Test CSYSV ---
338 *
339 IF( IFACT.EQ.2 ) THEN
340 CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
341 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
342 *
343 * Factor the matrix and solve the system using CSYSV.
344 *
345 SRNAMT = 'CSYSV '
346 CALL CSYSV( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
347 $ LDA, WORK, LWORK, INFO )
348 *
349 * Adjust the expected value of INFO to account for
350 * pivoting.
351 *
352 K = IZERO
353 IF( K.GT.0 ) THEN
354 100 CONTINUE
355 IF( IWORK( K ).LT.0 ) THEN
356 IF( IWORK( K ).NE.-K ) THEN
357 K = -IWORK( K )
358 GO TO 100
359 END IF
360 ELSE IF( IWORK( K ).NE.K ) THEN
361 K = IWORK( K )
362 GO TO 100
363 END IF
364 END IF
365 *
366 * Check error code from CSYSV .
367 *
368 IF( INFO.NE.K ) THEN
369 CALL ALAERH( PATH, 'CSYSV ', INFO, K, UPLO, N,
370 $ N, -1, -1, NRHS, IMAT, NFAIL,
371 $ NERRS, NOUT )
372 GO TO 120
373 ELSE IF( INFO.NE.0 ) THEN
374 GO TO 120
375 END IF
376 *
377 * Reconstruct matrix from factors and compute
378 * residual.
379 *
380 CALL CSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
381 $ AINV, LDA, RWORK, RESULT( 1 ) )
382 *
383 * Compute residual of the computed solution.
384 *
385 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
386 CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
387 $ LDA, RWORK, RESULT( 2 ) )
388 *
389 * Check solution from generated exact solution.
390 *
391 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
392 $ RESULT( 3 ) )
393 NT = 3
394 *
395 * Print information about the tests that did not pass
396 * the threshold.
397 *
398 DO 110 K = 1, NT
399 IF( RESULT( K ).GE.THRESH ) THEN
400 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
401 $ CALL ALADHD( NOUT, PATH )
402 WRITE( NOUT, FMT = 9999 )'CSYSV ', UPLO, N,
403 $ IMAT, K, RESULT( K )
404 NFAIL = NFAIL + 1
405 END IF
406 110 CONTINUE
407 NRUN = NRUN + NT
408 120 CONTINUE
409 END IF
410 *
411 * --- Test CSYSVX ---
412 *
413 IF( IFACT.EQ.2 )
414 $ CALL CLASET( UPLO, N, N, CMPLX( ZERO ),
415 $ CMPLX( ZERO ), AFAC, LDA )
416 CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ),
417 $ CMPLX( ZERO ), X, LDA )
418 *
419 * Solve the system and compute the condition number and
420 * error bounds using CSYSVX.
421 *
422 SRNAMT = 'CSYSVX'
423 CALL CSYSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA,
424 $ IWORK, B, LDA, X, LDA, RCOND, RWORK,
425 $ RWORK( NRHS+1 ), WORK, LWORK,
426 $ RWORK( 2*NRHS+1 ), INFO )
427 *
428 * Adjust the expected value of INFO to account for
429 * pivoting.
430 *
431 K = IZERO
432 IF( K.GT.0 ) THEN
433 130 CONTINUE
434 IF( IWORK( K ).LT.0 ) THEN
435 IF( IWORK( K ).NE.-K ) THEN
436 K = -IWORK( K )
437 GO TO 130
438 END IF
439 ELSE IF( IWORK( K ).NE.K ) THEN
440 K = IWORK( K )
441 GO TO 130
442 END IF
443 END IF
444 *
445 * Check the error code from CSYSVX.
446 *
447 IF( INFO.NE.K ) THEN
448 CALL ALAERH( PATH, 'CSYSVX', INFO, K, FACT // UPLO,
449 $ N, N, -1, -1, NRHS, IMAT, NFAIL,
450 $ NERRS, NOUT )
451 GO TO 150
452 END IF
453 *
454 IF( INFO.EQ.0 ) THEN
455 IF( IFACT.GE.2 ) THEN
456 *
457 * Reconstruct matrix from factors and compute
458 * residual.
459 *
460 CALL CSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
461 $ AINV, LDA, RWORK( 2*NRHS+1 ),
462 $ RESULT( 1 ) )
463 K1 = 1
464 ELSE
465 K1 = 2
466 END IF
467 *
468 * Compute residual of the computed solution.
469 *
470 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
471 CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
472 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
473 *
474 * Check solution from generated exact solution.
475 *
476 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
477 $ RESULT( 3 ) )
478 *
479 * Check the error bounds from iterative refinement.
480 *
481 CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
482 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
483 $ RESULT( 4 ) )
484 ELSE
485 K1 = 6
486 END IF
487 *
488 * Compare RCOND from CSYSVX with the computed value
489 * in RCONDC.
490 *
491 RESULT( 6 ) = SGET06( RCOND, RCONDC )
492 *
493 * Print information about the tests that did not pass
494 * the threshold.
495 *
496 DO 140 K = K1, 6
497 IF( RESULT( K ).GE.THRESH ) THEN
498 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
499 $ CALL ALADHD( NOUT, PATH )
500 WRITE( NOUT, FMT = 9998 )'CSYSVX', FACT, UPLO,
501 $ N, IMAT, K, RESULT( K )
502 NFAIL = NFAIL + 1
503 END IF
504 140 CONTINUE
505 NRUN = NRUN + 7 - K1
506 *
507 * --- Test CSYSVXX ---
508 *
509 * Restore the matrices A and B.
510 *
511 IF( IFACT.EQ.2 )
512 $ CALL CLASET( UPLO, N, N, CMPLX( ZERO ),
513 $ CMPLX( ZERO ), AFAC, LDA )
514 CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ),
515 $ CMPLX( ZERO ), X, LDA )
516 *
517 * Solve the system and compute the condition number
518 * and error bounds using CSYSVXX.
519 *
520 SRNAMT = 'CSYSVXX'
521 N_ERR_BNDS = 3
522 EQUED = 'N'
523 CALL CSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
524 $ LDA, IWORK, EQUED, WORK( N+1 ), B, LDA, X,
525 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
526 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
527 $ IWORK( N+1 ), INFO )
528 *
529 * Adjust the expected value of INFO to account for
530 * pivoting.
531 *
532 K = IZERO
533 IF( K.GT.0 ) THEN
534 135 CONTINUE
535 IF( IWORK( K ).LT.0 ) THEN
536 IF( IWORK( K ).NE.-K ) THEN
537 K = -IWORK( K )
538 GO TO 135
539 END IF
540 ELSE IF( IWORK( K ).NE.K ) THEN
541 K = IWORK( K )
542 GO TO 135
543 END IF
544 END IF
545 *
546 * Check the error code from CSYSVXX.
547 *
548 IF( INFO.NE.K ) THEN
549 CALL ALAERH( PATH, 'CSYSVXX', INFO, K,
550 $ FACT // UPLO, N, N, -1, -1, NRHS, IMAT, NFAIL,
551 $ NERRS, NOUT )
552 GO TO 150
553 END IF
554 *
555 IF( INFO.EQ.0 ) THEN
556 IF( IFACT.GE.2 ) THEN
557 *
558 * Reconstruct matrix from factors and compute
559 * residual.
560 *
561 CALL CSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
562 $ AINV, LDA, RWORK(2*NRHS+1),
563 $ RESULT( 1 ) )
564 K1 = 1
565 ELSE
566 K1 = 2
567 END IF
568 *
569 * Compute residual of the computed solution.
570 *
571 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
572 CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
573 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
574 RESULT( 2 ) = 0.0
575 *
576 * Check solution from generated exact solution.
577 *
578 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
579 $ RESULT( 3 ) )
580 *
581 * Check the error bounds from iterative refinement.
582 *
583 CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
584 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
585 $ RESULT( 4 ) )
586 ELSE
587 K1 = 6
588 END IF
589 *
590 * Compare RCOND from CSYSVXX with the computed value
591 * in RCONDC.
592 *
593 RESULT( 6 ) = SGET06( RCOND, RCONDC )
594 *
595 * Print information about the tests that did not pass
596 * the threshold.
597 *
598 DO 85 K = K1, 6
599 IF( RESULT( K ).GE.THRESH ) THEN
600 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
601 $ CALL ALADHD( NOUT, PATH )
602 WRITE( NOUT, FMT = 9998 )'CSYSVXX',
603 $ FACT, UPLO, N, IMAT, K,
604 $ RESULT( K )
605 NFAIL = NFAIL + 1
606 END IF
607 85 CONTINUE
608 NRUN = NRUN + 7 - K1
609 *
610 150 CONTINUE
611 *
612 160 CONTINUE
613 170 CONTINUE
614 180 CONTINUE
615 *
616 * Print a summary of the results.
617 *
618 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
619 *
620
621 * Test Error Bounds from CSYSVXX
622
623 CALL CEBCHVXX(THRESH, PATH)
624
625 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
626 $ ', test ', I2, ', ratio =', G12.5 )
627 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5,
628 $ ', type ', I2, ', test ', I2, ', ratio =', G12.5 )
629 RETURN
630 *
631 * End of CDRVSY
632 *
633 END