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