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