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