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