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