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