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