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