1*> \brief \b ZCHKGT 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 ZCHKGT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 12* A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT ) 13* 14* .. Scalar Arguments .. 15* LOGICAL TSTERR 16* INTEGER NN, NNS, NOUT 17* DOUBLE PRECISION THRESH 18* .. 19* .. Array Arguments .. 20* LOGICAL DOTYPE( * ) 21* INTEGER IWORK( * ), NSVAL( * ), NVAL( * ) 22* DOUBLE PRECISION RWORK( * ) 23* COMPLEX*16 A( * ), AF( * ), B( * ), WORK( * ), X( * ), 24* $ XACT( * ) 25* .. 26* 27* 28*> \par Purpose: 29* ============= 30*> 31*> \verbatim 32*> 33*> ZCHKGT tests ZGTTRF, -TRS, -RFS, and -CON 34*> \endverbatim 35* 36* Arguments: 37* ========== 38* 39*> \param[in] DOTYPE 40*> \verbatim 41*> DOTYPE is LOGICAL array, dimension (NTYPES) 42*> The matrix types to be used for testing. Matrices of type j 43*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 44*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 45*> \endverbatim 46*> 47*> \param[in] NN 48*> \verbatim 49*> NN is INTEGER 50*> The number of values of N contained in the vector NVAL. 51*> \endverbatim 52*> 53*> \param[in] NVAL 54*> \verbatim 55*> NVAL is INTEGER array, dimension (NN) 56*> The values of the matrix dimension N. 57*> \endverbatim 58*> 59*> \param[in] NNS 60*> \verbatim 61*> NNS is INTEGER 62*> The number of values of NRHS contained in the vector NSVAL. 63*> \endverbatim 64*> 65*> \param[in] NSVAL 66*> \verbatim 67*> NSVAL is INTEGER array, dimension (NNS) 68*> The values of the number of right hand sides NRHS. 69*> \endverbatim 70*> 71*> \param[in] THRESH 72*> \verbatim 73*> THRESH is DOUBLE PRECISION 74*> The threshold value for the test ratios. A result is 75*> included in the output file if RESULT >= THRESH. To have 76*> every test ratio printed, use THRESH = 0. 77*> \endverbatim 78*> 79*> \param[in] TSTERR 80*> \verbatim 81*> TSTERR is LOGICAL 82*> Flag that indicates whether error exits are to be tested. 83*> \endverbatim 84*> 85*> \param[out] A 86*> \verbatim 87*> A is COMPLEX*16 array, dimension (NMAX*4) 88*> \endverbatim 89*> 90*> \param[out] AF 91*> \verbatim 92*> AF is COMPLEX*16 array, dimension (NMAX*4) 93*> \endverbatim 94*> 95*> \param[out] B 96*> \verbatim 97*> B is COMPLEX*16 array, dimension (NMAX*NSMAX) 98*> where NSMAX is the largest entry in NSVAL. 99*> \endverbatim 100*> 101*> \param[out] X 102*> \verbatim 103*> X is COMPLEX*16 array, dimension (NMAX*NSMAX) 104*> \endverbatim 105*> 106*> \param[out] XACT 107*> \verbatim 108*> XACT is COMPLEX*16 array, dimension (NMAX*NSMAX) 109*> \endverbatim 110*> 111*> \param[out] WORK 112*> \verbatim 113*> WORK is COMPLEX*16 array, dimension 114*> (NMAX*max(3,NSMAX)) 115*> \endverbatim 116*> 117*> \param[out] RWORK 118*> \verbatim 119*> RWORK is DOUBLE PRECISION array, dimension 120*> (max(NMAX)+2*NSMAX) 121*> \endverbatim 122*> 123*> \param[out] IWORK 124*> \verbatim 125*> IWORK is INTEGER array, dimension (NMAX) 126*> \endverbatim 127*> 128*> \param[in] NOUT 129*> \verbatim 130*> NOUT is INTEGER 131*> The unit number for output. 132*> \endverbatim 133* 134* Authors: 135* ======== 136* 137*> \author Univ. of Tennessee 138*> \author Univ. of California Berkeley 139*> \author Univ. of Colorado Denver 140*> \author NAG Ltd. 141* 142*> \ingroup complex16_lin 143* 144* ===================================================================== 145 SUBROUTINE ZCHKGT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 146 $ A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT ) 147* 148* -- LAPACK test routine -- 149* -- LAPACK is a software package provided by Univ. of Tennessee, -- 150* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 151* 152* .. Scalar Arguments .. 153 LOGICAL TSTERR 154 INTEGER NN, NNS, NOUT 155 DOUBLE PRECISION THRESH 156* .. 157* .. Array Arguments .. 158 LOGICAL DOTYPE( * ) 159 INTEGER IWORK( * ), NSVAL( * ), NVAL( * ) 160 DOUBLE PRECISION RWORK( * ) 161 COMPLEX*16 A( * ), AF( * ), B( * ), WORK( * ), X( * ), 162 $ XACT( * ) 163* .. 164* 165* ===================================================================== 166* 167* .. Parameters .. 168 DOUBLE PRECISION ONE, ZERO 169 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 170 INTEGER NTYPES 171 PARAMETER ( NTYPES = 12 ) 172 INTEGER NTESTS 173 PARAMETER ( NTESTS = 7 ) 174* .. 175* .. Local Scalars .. 176 LOGICAL TRFCON, ZEROT 177 CHARACTER DIST, NORM, TRANS, TYPE 178 CHARACTER*3 PATH 179 INTEGER I, IMAT, IN, INFO, IRHS, ITRAN, IX, IZERO, J, 180 $ K, KL, KOFF, KU, LDA, M, MODE, N, NERRS, NFAIL, 181 $ NIMAT, NRHS, NRUN 182 DOUBLE PRECISION AINVNM, ANORM, COND, RCOND, RCONDC, RCONDI, 183 $ RCONDO 184* .. 185* .. Local Arrays .. 186 CHARACTER TRANSS( 3 ) 187 INTEGER ISEED( 4 ), ISEEDY( 4 ) 188 DOUBLE PRECISION RESULT( NTESTS ) 189 COMPLEX*16 Z( 3 ) 190* .. 191* .. External Functions .. 192 DOUBLE PRECISION DGET06, DZASUM, ZLANGT 193 EXTERNAL DGET06, DZASUM, ZLANGT 194* .. 195* .. External Subroutines .. 196 EXTERNAL ALAERH, ALAHD, ALASUM, ZCOPY, ZDSCAL, ZERRGE, 197 $ ZGET04, ZGTCON, ZGTRFS, ZGTT01, ZGTT02, ZGTT05, 198 $ ZGTTRF, ZGTTRS, ZLACPY, ZLAGTM, ZLARNV, ZLATB4, 199 $ ZLATMS 200* .. 201* .. Intrinsic Functions .. 202 INTRINSIC MAX 203* .. 204* .. Scalars in Common .. 205 LOGICAL LERR, OK 206 CHARACTER*32 SRNAMT 207 INTEGER INFOT, NUNIT 208* .. 209* .. Common blocks .. 210 COMMON / INFOC / INFOT, NUNIT, OK, LERR 211 COMMON / SRNAMC / SRNAMT 212* .. 213* .. Data statements .. 214 DATA ISEEDY / 0, 0, 0, 1 / , TRANSS / 'N', 'T', 215 $ 'C' / 216* .. 217* .. Executable Statements .. 218* 219 PATH( 1: 1 ) = 'Zomplex precision' 220 PATH( 2: 3 ) = 'GT' 221 NRUN = 0 222 NFAIL = 0 223 NERRS = 0 224 DO 10 I = 1, 4 225 ISEED( I ) = ISEEDY( I ) 226 10 CONTINUE 227* 228* Test the error exits 229* 230 IF( TSTERR ) 231 $ CALL ZERRGE( PATH, NOUT ) 232 INFOT = 0 233* 234 DO 110 IN = 1, NN 235* 236* Do for each value of N in NVAL. 237* 238 N = NVAL( IN ) 239 M = MAX( N-1, 0 ) 240 LDA = MAX( 1, N ) 241 NIMAT = NTYPES 242 IF( N.LE.0 ) 243 $ NIMAT = 1 244* 245 DO 100 IMAT = 1, NIMAT 246* 247* Do the tests only if DOTYPE( IMAT ) is true. 248* 249 IF( .NOT.DOTYPE( IMAT ) ) 250 $ GO TO 100 251* 252* Set up parameters with ZLATB4. 253* 254 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 255 $ COND, DIST ) 256* 257 ZEROT = IMAT.GE.8 .AND. IMAT.LE.10 258 IF( IMAT.LE.6 ) THEN 259* 260* Types 1-6: generate matrices of known condition number. 261* 262 KOFF = MAX( 2-KU, 3-MAX( 1, N ) ) 263 SRNAMT = 'ZLATMS' 264 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, COND, 265 $ ANORM, KL, KU, 'Z', AF( KOFF ), 3, WORK, 266 $ INFO ) 267* 268* Check the error code from ZLATMS. 269* 270 IF( INFO.NE.0 ) THEN 271 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', N, N, KL, 272 $ KU, -1, IMAT, NFAIL, NERRS, NOUT ) 273 GO TO 100 274 END IF 275 IZERO = 0 276* 277 IF( N.GT.1 ) THEN 278 CALL ZCOPY( N-1, AF( 4 ), 3, A, 1 ) 279 CALL ZCOPY( N-1, AF( 3 ), 3, A( N+M+1 ), 1 ) 280 END IF 281 CALL ZCOPY( N, AF( 2 ), 3, A( M+1 ), 1 ) 282 ELSE 283* 284* Types 7-12: generate tridiagonal matrices with 285* unknown condition numbers. 286* 287 IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 7 ) ) THEN 288* 289* Generate a matrix with elements whose real and 290* imaginary parts are from [-1,1]. 291* 292 CALL ZLARNV( 2, ISEED, N+2*M, A ) 293 IF( ANORM.NE.ONE ) 294 $ CALL ZDSCAL( N+2*M, ANORM, A, 1 ) 295 ELSE IF( IZERO.GT.0 ) THEN 296* 297* Reuse the last matrix by copying back the zeroed out 298* elements. 299* 300 IF( IZERO.EQ.1 ) THEN 301 A( N ) = Z( 2 ) 302 IF( N.GT.1 ) 303 $ A( 1 ) = Z( 3 ) 304 ELSE IF( IZERO.EQ.N ) THEN 305 A( 3*N-2 ) = Z( 1 ) 306 A( 2*N-1 ) = Z( 2 ) 307 ELSE 308 A( 2*N-2+IZERO ) = Z( 1 ) 309 A( N-1+IZERO ) = Z( 2 ) 310 A( IZERO ) = Z( 3 ) 311 END IF 312 END IF 313* 314* If IMAT > 7, set one column of the matrix to 0. 315* 316 IF( .NOT.ZEROT ) THEN 317 IZERO = 0 318 ELSE IF( IMAT.EQ.8 ) THEN 319 IZERO = 1 320 Z( 2 ) = A( N ) 321 A( N ) = ZERO 322 IF( N.GT.1 ) THEN 323 Z( 3 ) = A( 1 ) 324 A( 1 ) = ZERO 325 END IF 326 ELSE IF( IMAT.EQ.9 ) THEN 327 IZERO = N 328 Z( 1 ) = A( 3*N-2 ) 329 Z( 2 ) = A( 2*N-1 ) 330 A( 3*N-2 ) = ZERO 331 A( 2*N-1 ) = ZERO 332 ELSE 333 IZERO = ( N+1 ) / 2 334 DO 20 I = IZERO, N - 1 335 A( 2*N-2+I ) = ZERO 336 A( N-1+I ) = ZERO 337 A( I ) = ZERO 338 20 CONTINUE 339 A( 3*N-2 ) = ZERO 340 A( 2*N-1 ) = ZERO 341 END IF 342 END IF 343* 344*+ TEST 1 345* Factor A as L*U and compute the ratio 346* norm(L*U - A) / (n * norm(A) * EPS ) 347* 348 CALL ZCOPY( N+2*M, A, 1, AF, 1 ) 349 SRNAMT = 'ZGTTRF' 350 CALL ZGTTRF( N, AF, AF( M+1 ), AF( N+M+1 ), AF( N+2*M+1 ), 351 $ IWORK, INFO ) 352* 353* Check error code from ZGTTRF. 354* 355 IF( INFO.NE.IZERO ) 356 $ CALL ALAERH( PATH, 'ZGTTRF', INFO, IZERO, ' ', N, N, 1, 357 $ 1, -1, IMAT, NFAIL, NERRS, NOUT ) 358 TRFCON = INFO.NE.0 359* 360 CALL ZGTT01( N, A, A( M+1 ), A( N+M+1 ), AF, AF( M+1 ), 361 $ AF( N+M+1 ), AF( N+2*M+1 ), IWORK, WORK, LDA, 362 $ RWORK, RESULT( 1 ) ) 363* 364* Print the test ratio if it is .GE. THRESH. 365* 366 IF( RESULT( 1 ).GE.THRESH ) THEN 367 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 368 $ CALL ALAHD( NOUT, PATH ) 369 WRITE( NOUT, FMT = 9999 )N, IMAT, 1, RESULT( 1 ) 370 NFAIL = NFAIL + 1 371 END IF 372 NRUN = NRUN + 1 373* 374 DO 50 ITRAN = 1, 2 375 TRANS = TRANSS( ITRAN ) 376 IF( ITRAN.EQ.1 ) THEN 377 NORM = 'O' 378 ELSE 379 NORM = 'I' 380 END IF 381 ANORM = ZLANGT( NORM, N, A, A( M+1 ), A( N+M+1 ) ) 382* 383 IF( .NOT.TRFCON ) THEN 384* 385* Use ZGTTRS to solve for one column at a time of 386* inv(A), computing the maximum column sum as we go. 387* 388 AINVNM = ZERO 389 DO 40 I = 1, N 390 DO 30 J = 1, N 391 X( J ) = ZERO 392 30 CONTINUE 393 X( I ) = ONE 394 CALL ZGTTRS( TRANS, N, 1, AF, AF( M+1 ), 395 $ AF( N+M+1 ), AF( N+2*M+1 ), IWORK, X, 396 $ LDA, INFO ) 397 AINVNM = MAX( AINVNM, DZASUM( N, X, 1 ) ) 398 40 CONTINUE 399* 400* Compute RCONDC = 1 / (norm(A) * norm(inv(A)) 401* 402 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 403 RCONDC = ONE 404 ELSE 405 RCONDC = ( ONE / ANORM ) / AINVNM 406 END IF 407 IF( ITRAN.EQ.1 ) THEN 408 RCONDO = RCONDC 409 ELSE 410 RCONDI = RCONDC 411 END IF 412 ELSE 413 RCONDC = ZERO 414 END IF 415* 416*+ TEST 7 417* Estimate the reciprocal of the condition number of the 418* matrix. 419* 420 SRNAMT = 'ZGTCON' 421 CALL ZGTCON( NORM, N, AF, AF( M+1 ), AF( N+M+1 ), 422 $ AF( N+2*M+1 ), IWORK, ANORM, RCOND, WORK, 423 $ INFO ) 424* 425* Check error code from ZGTCON. 426* 427 IF( INFO.NE.0 ) 428 $ CALL ALAERH( PATH, 'ZGTCON', INFO, 0, NORM, N, N, -1, 429 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 430* 431 RESULT( 7 ) = DGET06( RCOND, RCONDC ) 432* 433* Print the test ratio if it is .GE. THRESH. 434* 435 IF( RESULT( 7 ).GE.THRESH ) THEN 436 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 437 $ CALL ALAHD( NOUT, PATH ) 438 WRITE( NOUT, FMT = 9997 )NORM, N, IMAT, 7, 439 $ RESULT( 7 ) 440 NFAIL = NFAIL + 1 441 END IF 442 NRUN = NRUN + 1 443 50 CONTINUE 444* 445* Skip the remaining tests if the matrix is singular. 446* 447 IF( TRFCON ) 448 $ GO TO 100 449* 450 DO 90 IRHS = 1, NNS 451 NRHS = NSVAL( IRHS ) 452* 453* Generate NRHS random solution vectors. 454* 455 IX = 1 456 DO 60 J = 1, NRHS 457 CALL ZLARNV( 2, ISEED, N, XACT( IX ) ) 458 IX = IX + LDA 459 60 CONTINUE 460* 461 DO 80 ITRAN = 1, 3 462 TRANS = TRANSS( ITRAN ) 463 IF( ITRAN.EQ.1 ) THEN 464 RCONDC = RCONDO 465 ELSE 466 RCONDC = RCONDI 467 END IF 468* 469* Set the right hand side. 470* 471 CALL ZLAGTM( TRANS, N, NRHS, ONE, A, A( M+1 ), 472 $ A( N+M+1 ), XACT, LDA, ZERO, B, LDA ) 473* 474*+ TEST 2 475* Solve op(A) * X = B and compute the residual. 476* 477 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 478 SRNAMT = 'ZGTTRS' 479 CALL ZGTTRS( TRANS, N, NRHS, AF, AF( M+1 ), 480 $ AF( N+M+1 ), AF( N+2*M+1 ), IWORK, X, 481 $ LDA, INFO ) 482* 483* Check error code from ZGTTRS. 484* 485 IF( INFO.NE.0 ) 486 $ CALL ALAERH( PATH, 'ZGTTRS', INFO, 0, TRANS, N, N, 487 $ -1, -1, NRHS, IMAT, NFAIL, NERRS, 488 $ NOUT ) 489* 490 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 491 CALL ZGTT02( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ), 492 $ X, LDA, WORK, LDA, RESULT( 2 ) ) 493* 494*+ TEST 3 495* Check solution from generated exact solution. 496* 497 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 498 $ RESULT( 3 ) ) 499* 500*+ TESTS 4, 5, and 6 501* Use iterative refinement to improve the solution. 502* 503 SRNAMT = 'ZGTRFS' 504 CALL ZGTRFS( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ), 505 $ AF, AF( M+1 ), AF( N+M+1 ), 506 $ AF( N+2*M+1 ), IWORK, B, LDA, X, LDA, 507 $ RWORK, RWORK( NRHS+1 ), WORK, 508 $ RWORK( 2*NRHS+1 ), INFO ) 509* 510* Check error code from ZGTRFS. 511* 512 IF( INFO.NE.0 ) 513 $ CALL ALAERH( PATH, 'ZGTRFS', INFO, 0, TRANS, N, N, 514 $ -1, -1, NRHS, IMAT, NFAIL, NERRS, 515 $ NOUT ) 516* 517 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 518 $ RESULT( 4 ) ) 519 CALL ZGTT05( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ), 520 $ B, LDA, X, LDA, XACT, LDA, RWORK, 521 $ RWORK( NRHS+1 ), RESULT( 5 ) ) 522* 523* Print information about the tests that did not pass the 524* threshold. 525* 526 DO 70 K = 2, 6 527 IF( RESULT( K ).GE.THRESH ) THEN 528 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 529 $ CALL ALAHD( NOUT, PATH ) 530 WRITE( NOUT, FMT = 9998 )TRANS, N, NRHS, IMAT, 531 $ K, RESULT( K ) 532 NFAIL = NFAIL + 1 533 END IF 534 70 CONTINUE 535 NRUN = NRUN + 5 536 80 CONTINUE 537 90 CONTINUE 538 100 CONTINUE 539 110 CONTINUE 540* 541* Print a summary of the results. 542* 543 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 544* 545 9999 FORMAT( 12X, 'N =', I5, ',', 10X, ' type ', I2, ', test(', I2, 546 $ ') = ', G12.5 ) 547 9998 FORMAT( ' TRANS=''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', 548 $ I2, ', test(', I2, ') = ', G12.5 ) 549 9997 FORMAT( ' NORM =''', A1, ''', N =', I5, ',', 10X, ' type ', I2, 550 $ ', test(', I2, ') = ', G12.5 ) 551 RETURN 552* 553* End of ZCHKGT 554* 555 END 556