1*> \brief \b ZCHKTR 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 ZCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, 12* THRESH, TSTERR, NMAX, A, AINV, B, X, XACT, 13* WORK, RWORK, NOUT ) 14* 15* .. Scalar Arguments .. 16* LOGICAL TSTERR 17* INTEGER NMAX, NN, NNB, NNS, NOUT 18* DOUBLE PRECISION THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER NBVAL( * ), NSVAL( * ), NVAL( * ) 23* DOUBLE PRECISION RWORK( * ) 24* COMPLEX*16 A( * ), AINV( * ), B( * ), WORK( * ), X( * ), 25* $ XACT( * ) 26* .. 27* 28* 29*> \par Purpose: 30* ============= 31*> 32*> \verbatim 33*> 34*> ZCHKTR tests ZTRTRI, -TRS, -RFS, and -CON, and ZLATRS 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 column dimension N. 58*> \endverbatim 59*> 60*> \param[in] NNB 61*> \verbatim 62*> NNB is INTEGER 63*> The number of values of NB contained in the vector NBVAL. 64*> \endverbatim 65*> 66*> \param[in] NBVAL 67*> \verbatim 68*> NBVAL is INTEGER array, dimension (NNB) 69*> The values of the blocksize NB. 70*> \endverbatim 71*> 72*> \param[in] NNS 73*> \verbatim 74*> NNS is INTEGER 75*> The number of values of NRHS contained in the vector NSVAL. 76*> \endverbatim 77*> 78*> \param[in] NSVAL 79*> \verbatim 80*> NSVAL is INTEGER array, dimension (NNS) 81*> The values of the number of right hand sides NRHS. 82*> \endverbatim 83*> 84*> \param[in] THRESH 85*> \verbatim 86*> THRESH is DOUBLE PRECISION 87*> The threshold value for the test ratios. A result is 88*> included in the output file if RESULT >= THRESH. To have 89*> every test ratio printed, use THRESH = 0. 90*> \endverbatim 91*> 92*> \param[in] TSTERR 93*> \verbatim 94*> TSTERR is LOGICAL 95*> Flag that indicates whether error exits are to be tested. 96*> \endverbatim 97*> 98*> \param[in] NMAX 99*> \verbatim 100*> NMAX is INTEGER 101*> The leading dimension of the work arrays. 102*> NMAX >= the maximum value of N in NVAL. 103*> \endverbatim 104*> 105*> \param[out] A 106*> \verbatim 107*> A is COMPLEX*16 array, dimension (NMAX*NMAX) 108*> \endverbatim 109*> 110*> \param[out] AINV 111*> \verbatim 112*> AINV is COMPLEX*16 array, dimension (NMAX*NMAX) 113*> \endverbatim 114*> 115*> \param[out] B 116*> \verbatim 117*> B is COMPLEX*16 array, dimension (NMAX*NSMAX) 118*> where NSMAX is the largest entry in NSVAL. 119*> \endverbatim 120*> 121*> \param[out] X 122*> \verbatim 123*> X is COMPLEX*16 array, dimension (NMAX*NSMAX) 124*> \endverbatim 125*> 126*> \param[out] XACT 127*> \verbatim 128*> XACT is COMPLEX*16 array, dimension (NMAX*NSMAX) 129*> \endverbatim 130*> 131*> \param[out] WORK 132*> \verbatim 133*> WORK is COMPLEX*16 array, dimension 134*> (NMAX*max(3,NSMAX)) 135*> \endverbatim 136*> 137*> \param[out] RWORK 138*> \verbatim 139*> RWORK is DOUBLE PRECISION array, dimension 140*> (max(NMAX,2*NSMAX)) 141*> \endverbatim 142*> 143*> \param[in] NOUT 144*> \verbatim 145*> NOUT is INTEGER 146*> The unit number for output. 147*> \endverbatim 148* 149* Authors: 150* ======== 151* 152*> \author Univ. of Tennessee 153*> \author Univ. of California Berkeley 154*> \author Univ. of Colorado Denver 155*> \author NAG Ltd. 156* 157*> \date December 2016 158* 159*> \ingroup complex16_lin 160* 161* ===================================================================== 162 SUBROUTINE ZCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, 163 $ THRESH, TSTERR, NMAX, A, AINV, B, X, XACT, 164 $ WORK, RWORK, NOUT ) 165* 166* -- LAPACK test routine (version 3.7.0) -- 167* -- LAPACK is a software package provided by Univ. of Tennessee, -- 168* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 169* December 2016 170* 171* .. Scalar Arguments .. 172 LOGICAL TSTERR 173 INTEGER NMAX, NN, NNB, NNS, NOUT 174 DOUBLE PRECISION THRESH 175* .. 176* .. Array Arguments .. 177 LOGICAL DOTYPE( * ) 178 INTEGER NBVAL( * ), NSVAL( * ), NVAL( * ) 179 DOUBLE PRECISION RWORK( * ) 180 COMPLEX*16 A( * ), AINV( * ), B( * ), WORK( * ), X( * ), 181 $ XACT( * ) 182* .. 183* 184* ===================================================================== 185* 186* .. Parameters .. 187 INTEGER NTYPE1, NTYPES 188 PARAMETER ( NTYPE1 = 10, NTYPES = 18 ) 189 INTEGER NTESTS 190 PARAMETER ( NTESTS = 9 ) 191 INTEGER NTRAN 192 PARAMETER ( NTRAN = 3 ) 193 DOUBLE PRECISION ONE, ZERO 194 PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 ) 195* .. 196* .. Local Scalars .. 197 CHARACTER DIAG, NORM, TRANS, UPLO, XTYPE 198 CHARACTER*3 PATH 199 INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN, 200 $ IUPLO, K, LDA, N, NB, NERRS, NFAIL, NRHS, NRUN 201 DOUBLE PRECISION AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI, 202 $ RCONDO, SCALE 203* .. 204* .. Local Arrays .. 205 CHARACTER TRANSS( NTRAN ), UPLOS( 2 ) 206 INTEGER ISEED( 4 ), ISEEDY( 4 ) 207 DOUBLE PRECISION RESULT( NTESTS ) 208* .. 209* .. External Functions .. 210 LOGICAL LSAME 211 DOUBLE PRECISION ZLANTR 212 EXTERNAL LSAME, ZLANTR 213* .. 214* .. External Subroutines .. 215 EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZCOPY, ZERRTR, 216 $ ZGET04, ZLACPY, ZLARHS, ZLATRS, ZLATTR, ZTRCON, 217 $ ZTRRFS, ZTRT01, ZTRT02, ZTRT03, ZTRT05, ZTRT06, 218 $ ZTRTRI, ZTRTRS 219* .. 220* .. Scalars in Common .. 221 LOGICAL LERR, OK 222 CHARACTER*32 SRNAMT 223 INTEGER INFOT, IOUNIT 224* .. 225* .. Common blocks .. 226 COMMON / INFOC / INFOT, IOUNIT, OK, LERR 227 COMMON / SRNAMC / SRNAMT 228* .. 229* .. Intrinsic Functions .. 230 INTRINSIC MAX 231* .. 232* .. Data statements .. 233 DATA ISEEDY / 1988, 1989, 1990, 1991 / 234 DATA UPLOS / 'U', 'L' / , TRANSS / 'N', 'T', 'C' / 235* .. 236* .. Executable Statements .. 237* 238* Initialize constants and the random number seed. 239* 240 PATH( 1: 1 ) = 'Zomplex precision' 241 PATH( 2: 3 ) = 'TR' 242 NRUN = 0 243 NFAIL = 0 244 NERRS = 0 245 DO 10 I = 1, 4 246 ISEED( I ) = ISEEDY( I ) 247 10 CONTINUE 248* 249* Test the error exits 250* 251 IF( TSTERR ) 252 $ CALL ZERRTR( PATH, NOUT ) 253 INFOT = 0 254* 255 DO 120 IN = 1, NN 256* 257* Do for each value of N in NVAL 258* 259 N = NVAL( IN ) 260 LDA = MAX( 1, N ) 261 XTYPE = 'N' 262* 263 DO 80 IMAT = 1, NTYPE1 264* 265* Do the tests only if DOTYPE( IMAT ) is true. 266* 267 IF( .NOT.DOTYPE( IMAT ) ) 268 $ GO TO 80 269* 270 DO 70 IUPLO = 1, 2 271* 272* Do first for UPLO = 'U', then for UPLO = 'L' 273* 274 UPLO = UPLOS( IUPLO ) 275* 276* Call ZLATTR to generate a triangular test matrix. 277* 278 SRNAMT = 'ZLATTR' 279 CALL ZLATTR( IMAT, UPLO, 'No transpose', DIAG, ISEED, N, 280 $ A, LDA, X, WORK, RWORK, INFO ) 281* 282* Set IDIAG = 1 for non-unit matrices, 2 for unit. 283* 284 IF( LSAME( DIAG, 'N' ) ) THEN 285 IDIAG = 1 286 ELSE 287 IDIAG = 2 288 END IF 289* 290 DO 60 INB = 1, NNB 291* 292* Do for each blocksize in NBVAL 293* 294 NB = NBVAL( INB ) 295 CALL XLAENV( 1, NB ) 296* 297*+ TEST 1 298* Form the inverse of A. 299* 300 CALL ZLACPY( UPLO, N, N, A, LDA, AINV, LDA ) 301 SRNAMT = 'ZTRTRI' 302 CALL ZTRTRI( UPLO, DIAG, N, AINV, LDA, INFO ) 303* 304* Check error code from ZTRTRI. 305* 306 IF( INFO.NE.0 ) 307 $ CALL ALAERH( PATH, 'ZTRTRI', INFO, 0, UPLO // DIAG, 308 $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, 309 $ NOUT ) 310* 311* Compute the infinity-norm condition number of A. 312* 313 ANORM = ZLANTR( 'I', UPLO, DIAG, N, N, A, LDA, RWORK ) 314 AINVNM = ZLANTR( 'I', UPLO, DIAG, N, N, AINV, LDA, 315 $ RWORK ) 316 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 317 RCONDI = ONE 318 ELSE 319 RCONDI = ( ONE / ANORM ) / AINVNM 320 END IF 321* 322* Compute the residual for the triangular matrix times 323* its inverse. Also compute the 1-norm condition number 324* of A. 325* 326 CALL ZTRT01( UPLO, DIAG, N, A, LDA, AINV, LDA, RCONDO, 327 $ RWORK, RESULT( 1 ) ) 328* Print the test ratio if it is .GE. THRESH. 329* 330 IF( RESULT( 1 ).GE.THRESH ) THEN 331 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 332 $ CALL ALAHD( NOUT, PATH ) 333 WRITE( NOUT, FMT = 9999 )UPLO, DIAG, N, NB, IMAT, 334 $ 1, RESULT( 1 ) 335 NFAIL = NFAIL + 1 336 END IF 337 NRUN = NRUN + 1 338* 339* Skip remaining tests if not the first block size. 340* 341 IF( INB.NE.1 ) 342 $ GO TO 60 343* 344 DO 40 IRHS = 1, NNS 345 NRHS = NSVAL( IRHS ) 346 XTYPE = 'N' 347* 348 DO 30 ITRAN = 1, NTRAN 349* 350* Do for op(A) = A, A**T, or A**H. 351* 352 TRANS = TRANSS( ITRAN ) 353 IF( ITRAN.EQ.1 ) THEN 354 NORM = 'O' 355 RCONDC = RCONDO 356 ELSE 357 NORM = 'I' 358 RCONDC = RCONDI 359 END IF 360* 361*+ TEST 2 362* Solve and compute residual for op(A)*x = b. 363* 364 SRNAMT = 'ZLARHS' 365 CALL ZLARHS( PATH, XTYPE, UPLO, TRANS, N, N, 0, 366 $ IDIAG, NRHS, A, LDA, XACT, LDA, B, 367 $ LDA, ISEED, INFO ) 368 XTYPE = 'C' 369 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 370* 371 SRNAMT = 'ZTRTRS' 372 CALL ZTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, 373 $ X, LDA, INFO ) 374* 375* Check error code from ZTRTRS. 376* 377 IF( INFO.NE.0 ) 378 $ CALL ALAERH( PATH, 'ZTRTRS', INFO, 0, 379 $ UPLO // TRANS // DIAG, N, N, -1, 380 $ -1, NRHS, IMAT, NFAIL, NERRS, 381 $ NOUT ) 382* 383* This line is needed on a Sun SPARCstation. 384* 385 IF( N.GT.0 ) 386 $ DUMMY = A( 1 ) 387* 388 CALL ZTRT02( UPLO, TRANS, DIAG, N, NRHS, A, LDA, 389 $ X, LDA, B, LDA, WORK, RWORK, 390 $ RESULT( 2 ) ) 391* 392*+ TEST 3 393* Check solution from generated exact solution. 394* 395 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 396 $ RESULT( 3 ) ) 397* 398*+ TESTS 4, 5, and 6 399* Use iterative refinement to improve the solution 400* and compute error bounds. 401* 402 SRNAMT = 'ZTRRFS' 403 CALL ZTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, 404 $ B, LDA, X, LDA, RWORK, 405 $ RWORK( NRHS+1 ), WORK, 406 $ RWORK( 2*NRHS+1 ), INFO ) 407* 408* Check error code from ZTRRFS. 409* 410 IF( INFO.NE.0 ) 411 $ CALL ALAERH( PATH, 'ZTRRFS', INFO, 0, 412 $ UPLO // TRANS // DIAG, N, N, -1, 413 $ -1, NRHS, IMAT, NFAIL, NERRS, 414 $ NOUT ) 415* 416 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 417 $ RESULT( 4 ) ) 418 CALL ZTRT05( UPLO, TRANS, DIAG, N, NRHS, A, LDA, 419 $ B, LDA, X, LDA, XACT, LDA, RWORK, 420 $ RWORK( NRHS+1 ), RESULT( 5 ) ) 421* 422* Print information about the tests that did not 423* pass the threshold. 424* 425 DO 20 K = 2, 6 426 IF( RESULT( K ).GE.THRESH ) THEN 427 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 428 $ CALL ALAHD( NOUT, PATH ) 429 WRITE( NOUT, FMT = 9998 )UPLO, TRANS, 430 $ DIAG, N, NRHS, IMAT, K, RESULT( K ) 431 NFAIL = NFAIL + 1 432 END IF 433 20 CONTINUE 434 NRUN = NRUN + 5 435 30 CONTINUE 436 40 CONTINUE 437* 438*+ TEST 7 439* Get an estimate of RCOND = 1/CNDNUM. 440* 441 DO 50 ITRAN = 1, 2 442 IF( ITRAN.EQ.1 ) THEN 443 NORM = 'O' 444 RCONDC = RCONDO 445 ELSE 446 NORM = 'I' 447 RCONDC = RCONDI 448 END IF 449 SRNAMT = 'ZTRCON' 450 CALL ZTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, 451 $ WORK, RWORK, INFO ) 452* 453* Check error code from ZTRCON. 454* 455 IF( INFO.NE.0 ) 456 $ CALL ALAERH( PATH, 'ZTRCON', INFO, 0, 457 $ NORM // UPLO // DIAG, N, N, -1, -1, 458 $ -1, IMAT, NFAIL, NERRS, NOUT ) 459* 460 CALL ZTRT06( RCOND, RCONDC, UPLO, DIAG, N, A, LDA, 461 $ RWORK, RESULT( 7 ) ) 462* 463* Print the test ratio if it is .GE. THRESH. 464* 465 IF( RESULT( 7 ).GE.THRESH ) THEN 466 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 467 $ CALL ALAHD( NOUT, PATH ) 468 WRITE( NOUT, FMT = 9997 )NORM, UPLO, N, IMAT, 469 $ 7, RESULT( 7 ) 470 NFAIL = NFAIL + 1 471 END IF 472 NRUN = NRUN + 1 473 50 CONTINUE 474 60 CONTINUE 475 70 CONTINUE 476 80 CONTINUE 477* 478* Use pathological test matrices to test ZLATRS. 479* 480 DO 110 IMAT = NTYPE1 + 1, NTYPES 481* 482* Do the tests only if DOTYPE( IMAT ) is true. 483* 484 IF( .NOT.DOTYPE( IMAT ) ) 485 $ GO TO 110 486* 487 DO 100 IUPLO = 1, 2 488* 489* Do first for UPLO = 'U', then for UPLO = 'L' 490* 491 UPLO = UPLOS( IUPLO ) 492 DO 90 ITRAN = 1, NTRAN 493* 494* Do for op(A) = A, A**T, and A**H. 495* 496 TRANS = TRANSS( ITRAN ) 497* 498* Call ZLATTR to generate a triangular test matrix. 499* 500 SRNAMT = 'ZLATTR' 501 CALL ZLATTR( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, 502 $ LDA, X, WORK, RWORK, INFO ) 503* 504*+ TEST 8 505* Solve the system op(A)*x = b. 506* 507 SRNAMT = 'ZLATRS' 508 CALL ZCOPY( N, X, 1, B, 1 ) 509 CALL ZLATRS( UPLO, TRANS, DIAG, 'N', N, A, LDA, B, 510 $ SCALE, RWORK, INFO ) 511* 512* Check error code from ZLATRS. 513* 514 IF( INFO.NE.0 ) 515 $ CALL ALAERH( PATH, 'ZLATRS', INFO, 0, 516 $ UPLO // TRANS // DIAG // 'N', N, N, 517 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 518* 519 CALL ZTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA, SCALE, 520 $ RWORK, ONE, B, LDA, X, LDA, WORK, 521 $ RESULT( 8 ) ) 522* 523*+ TEST 9 524* Solve op(A)*X = b again with NORMIN = 'Y'. 525* 526 CALL ZCOPY( N, X, 1, B( N+1 ), 1 ) 527 CALL ZLATRS( UPLO, TRANS, DIAG, 'Y', N, A, LDA, 528 $ B( N+1 ), SCALE, RWORK, INFO ) 529* 530* Check error code from ZLATRS. 531* 532 IF( INFO.NE.0 ) 533 $ CALL ALAERH( PATH, 'ZLATRS', INFO, 0, 534 $ UPLO // TRANS // DIAG // 'Y', N, N, 535 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 536* 537 CALL ZTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA, SCALE, 538 $ RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK, 539 $ RESULT( 9 ) ) 540* 541* Print information about the tests that did not pass 542* the threshold. 543* 544 IF( RESULT( 8 ).GE.THRESH ) THEN 545 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 546 $ CALL ALAHD( NOUT, PATH ) 547 WRITE( NOUT, FMT = 9996 )'ZLATRS', UPLO, TRANS, 548 $ DIAG, 'N', N, IMAT, 8, RESULT( 8 ) 549 NFAIL = NFAIL + 1 550 END IF 551 IF( RESULT( 9 ).GE.THRESH ) THEN 552 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 553 $ CALL ALAHD( NOUT, PATH ) 554 WRITE( NOUT, FMT = 9996 )'ZLATRS', UPLO, TRANS, 555 $ DIAG, 'Y', N, IMAT, 9, RESULT( 9 ) 556 NFAIL = NFAIL + 1 557 END IF 558 NRUN = NRUN + 2 559 90 CONTINUE 560 100 CONTINUE 561 110 CONTINUE 562 120 CONTINUE 563* 564* Print a summary of the results. 565* 566 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 567* 568 9999 FORMAT( ' UPLO=''', A1, ''', DIAG=''', A1, ''', N=', I5, ', NB=', 569 $ I4, ', type ', I2, ', test(', I2, ')= ', G12.5 ) 570 9998 FORMAT( ' UPLO=''', A1, ''', TRANS=''', A1, ''', DIAG=''', A1, 571 $ ''', N=', I5, ', NB=', I4, ', type ', I2, ', 572 $ test(', I2, ')= ', G12.5 ) 573 9997 FORMAT( ' NORM=''', A1, ''', UPLO =''', A1, ''', N=', I5, ',', 574 $ 11X, ' type ', I2, ', test(', I2, ')=', G12.5 ) 575 9996 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ''', A1, ''', ''', 576 $ A1, ''',', I5, ', ... ), type ', I2, ', test(', I2, ')=', 577 $ G12.5 ) 578 RETURN 579* 580* End of ZCHKTR 581* 582 END 583