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