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