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