1*> \brief \b CCHKPT 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 CCHKPT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 12* A, D, E, B, X, XACT, WORK, RWORK, 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 NSVAL( * ), NVAL( * ) 22* REAL D( * ), RWORK( * ) 23* COMPLEX A( * ), B( * ), E( * ), WORK( * ), X( * ), 24* $ XACT( * ) 25* .. 26* 27* 28*> \par Purpose: 29* ============= 30*> 31*> \verbatim 32*> 33*> CCHKPT tests CPTTRF, -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*2) 88*> \endverbatim 89*> 90*> \param[out] D 91*> \verbatim 92*> D is REAL array, dimension (NMAX*2) 93*> \endverbatim 94*> 95*> \param[out] E 96*> \verbatim 97*> E is COMPLEX array, dimension (NMAX*2) 98*> \endverbatim 99*> 100*> \param[out] B 101*> \verbatim 102*> B is COMPLEX array, dimension (NMAX*NSMAX) 103*> where NSMAX is the largest entry in NSVAL. 104*> \endverbatim 105*> 106*> \param[out] X 107*> \verbatim 108*> X is COMPLEX array, dimension (NMAX*NSMAX) 109*> \endverbatim 110*> 111*> \param[out] XACT 112*> \verbatim 113*> XACT is COMPLEX array, dimension (NMAX*NSMAX) 114*> \endverbatim 115*> 116*> \param[out] WORK 117*> \verbatim 118*> WORK is COMPLEX array, dimension 119*> (NMAX*max(3,NSMAX)) 120*> \endverbatim 121*> 122*> \param[out] RWORK 123*> \verbatim 124*> RWORK is REAL array, dimension 125*> (max(NMAX,2*NSMAX)) 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 CCHKPT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 148 $ A, D, E, B, X, XACT, WORK, RWORK, 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 NSVAL( * ), NVAL( * ) 163 REAL D( * ), RWORK( * ) 164 COMPLEX A( * ), B( * ), E( * ), 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 ZEROT 180 CHARACTER DIST, TYPE, UPLO 181 CHARACTER*3 PATH 182 INTEGER I, IA, IMAT, IN, INFO, IRHS, IUPLO, IX, IZERO, 183 $ J, K, KL, KU, LDA, MODE, N, NERRS, NFAIL, 184 $ NIMAT, NRHS, NRUN 185 REAL AINVNM, ANORM, COND, DMAX, RCOND, RCONDC 186* .. 187* .. Local Arrays .. 188 CHARACTER UPLOS( 2 ) 189 INTEGER ISEED( 4 ), ISEEDY( 4 ) 190 REAL RESULT( NTESTS ) 191 COMPLEX Z( 3 ) 192* .. 193* .. External Functions .. 194 INTEGER ISAMAX 195 REAL CLANHT, SCASUM, SGET06 196 EXTERNAL ISAMAX, CLANHT, SCASUM, SGET06 197* .. 198* .. External Subroutines .. 199 EXTERNAL ALAERH, ALAHD, ALASUM, CCOPY, CERRGT, CGET04, 200 $ CLACPY, CLAPTM, CLARNV, CLATB4, CLATMS, CPTCON, 201 $ CPTRFS, CPTT01, CPTT02, CPTT05, CPTTRF, CPTTRS, 202 $ CSSCAL, SCOPY, SLARNV, SSCAL 203* .. 204* .. Intrinsic Functions .. 205 INTRINSIC ABS, MAX, REAL 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 / , UPLOS / 'U', 'L' / 218* .. 219* .. Executable Statements .. 220* 221 PATH( 1: 1 ) = 'Complex precision' 222 PATH( 2: 3 ) = 'PT' 223 NRUN = 0 224 NFAIL = 0 225 NERRS = 0 226 DO 10 I = 1, 4 227 ISEED( I ) = ISEEDY( I ) 228 10 CONTINUE 229* 230* Test the error exits 231* 232 IF( TSTERR ) 233 $ CALL CERRGT( PATH, NOUT ) 234 INFOT = 0 235* 236 DO 120 IN = 1, NN 237* 238* Do for each value of N in NVAL. 239* 240 N = NVAL( IN ) 241 LDA = MAX( 1, N ) 242 NIMAT = NTYPES 243 IF( N.LE.0 ) 244 $ NIMAT = 1 245* 246 DO 110 IMAT = 1, NIMAT 247* 248* Do the tests only if DOTYPE( IMAT ) is true. 249* 250 IF( N.GT.0 .AND. .NOT.DOTYPE( IMAT ) ) 251 $ GO TO 110 252* 253* Set up parameters with CLATB4. 254* 255 CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 256 $ COND, DIST ) 257* 258 ZEROT = IMAT.GE.8 .AND. IMAT.LE.10 259 IF( IMAT.LE.6 ) THEN 260* 261* Type 1-6: generate a Hermitian tridiagonal matrix of 262* known condition number in lower triangular band storage. 263* 264 SRNAMT = 'CLATMS' 265 CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, COND, 266 $ ANORM, KL, KU, 'B', A, 2, WORK, INFO ) 267* 268* Check the error code from CLATMS. 269* 270 IF( INFO.NE.0 ) THEN 271 CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', N, N, KL, 272 $ KU, -1, IMAT, NFAIL, NERRS, NOUT ) 273 GO TO 110 274 END IF 275 IZERO = 0 276* 277* Copy the matrix to D and E. 278* 279 IA = 1 280 DO 20 I = 1, N - 1 281 D( I ) = REAL( A( IA ) ) 282 E( I ) = A( IA+1 ) 283 IA = IA + 2 284 20 CONTINUE 285 IF( N.GT.0 ) 286 $ D( N ) = REAL( A( IA ) ) 287 ELSE 288* 289* Type 7-12: generate a diagonally dominant matrix with 290* unknown condition number in the vectors D and E. 291* 292 IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 7 ) ) THEN 293* 294* Let E be complex, D real, with values from [-1,1]. 295* 296 CALL SLARNV( 2, ISEED, N, D ) 297 CALL CLARNV( 2, ISEED, N-1, E ) 298* 299* Make the tridiagonal matrix diagonally dominant. 300* 301 IF( N.EQ.1 ) THEN 302 D( 1 ) = ABS( D( 1 ) ) 303 ELSE 304 D( 1 ) = ABS( D( 1 ) ) + ABS( E( 1 ) ) 305 D( N ) = ABS( D( N ) ) + ABS( E( N-1 ) ) 306 DO 30 I = 2, N - 1 307 D( I ) = ABS( D( I ) ) + ABS( E( I ) ) + 308 $ ABS( E( I-1 ) ) 309 30 CONTINUE 310 END IF 311* 312* Scale D and E so the maximum element is ANORM. 313* 314 IX = ISAMAX( N, D, 1 ) 315 DMAX = D( IX ) 316 CALL SSCAL( N, ANORM / DMAX, D, 1 ) 317 CALL CSSCAL( N-1, ANORM / DMAX, E, 1 ) 318* 319 ELSE IF( IZERO.GT.0 ) THEN 320* 321* Reuse the last matrix by copying back the zeroed out 322* elements. 323* 324 IF( IZERO.EQ.1 ) THEN 325 D( 1 ) = Z( 2 ) 326 IF( N.GT.1 ) 327 $ E( 1 ) = Z( 3 ) 328 ELSE IF( IZERO.EQ.N ) THEN 329 E( N-1 ) = Z( 1 ) 330 D( N ) = Z( 2 ) 331 ELSE 332 E( IZERO-1 ) = Z( 1 ) 333 D( IZERO ) = Z( 2 ) 334 E( IZERO ) = Z( 3 ) 335 END IF 336 END IF 337* 338* For types 8-10, set one row and column of the matrix to 339* zero. 340* 341 IZERO = 0 342 IF( IMAT.EQ.8 ) THEN 343 IZERO = 1 344 Z( 2 ) = D( 1 ) 345 D( 1 ) = ZERO 346 IF( N.GT.1 ) THEN 347 Z( 3 ) = E( 1 ) 348 E( 1 ) = ZERO 349 END IF 350 ELSE IF( IMAT.EQ.9 ) THEN 351 IZERO = N 352 IF( N.GT.1 ) THEN 353 Z( 1 ) = E( N-1 ) 354 E( N-1 ) = ZERO 355 END IF 356 Z( 2 ) = D( N ) 357 D( N ) = ZERO 358 ELSE IF( IMAT.EQ.10 ) THEN 359 IZERO = ( N+1 ) / 2 360 IF( IZERO.GT.1 ) THEN 361 Z( 1 ) = E( IZERO-1 ) 362 Z( 3 ) = E( IZERO ) 363 E( IZERO-1 ) = ZERO 364 E( IZERO ) = ZERO 365 END IF 366 Z( 2 ) = D( IZERO ) 367 D( IZERO ) = ZERO 368 END IF 369 END IF 370* 371 CALL SCOPY( N, D, 1, D( N+1 ), 1 ) 372 IF( N.GT.1 ) 373 $ CALL CCOPY( N-1, E, 1, E( N+1 ), 1 ) 374* 375*+ TEST 1 376* Factor A as L*D*L' and compute the ratio 377* norm(L*D*L' - A) / (n * norm(A) * EPS ) 378* 379 CALL CPTTRF( N, D( N+1 ), E( N+1 ), INFO ) 380* 381* Check error code from CPTTRF. 382* 383 IF( INFO.NE.IZERO ) THEN 384 CALL ALAERH( PATH, 'CPTTRF', INFO, IZERO, ' ', N, N, -1, 385 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 386 GO TO 110 387 END IF 388* 389 IF( INFO.GT.0 ) THEN 390 RCONDC = ZERO 391 GO TO 100 392 END IF 393* 394 CALL CPTT01( N, D, E, D( N+1 ), E( N+1 ), WORK, 395 $ RESULT( 1 ) ) 396* 397* Print the test ratio if greater than or equal to THRESH. 398* 399 IF( RESULT( 1 ).GE.THRESH ) THEN 400 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 401 $ CALL ALAHD( NOUT, PATH ) 402 WRITE( NOUT, FMT = 9999 )N, IMAT, 1, RESULT( 1 ) 403 NFAIL = NFAIL + 1 404 END IF 405 NRUN = NRUN + 1 406* 407* Compute RCONDC = 1 / (norm(A) * norm(inv(A)) 408* 409* Compute norm(A). 410* 411 ANORM = CLANHT( '1', N, D, E ) 412* 413* Use CPTTRS to solve for one column at a time of inv(A), 414* computing the maximum column sum as we go. 415* 416 AINVNM = ZERO 417 DO 50 I = 1, N 418 DO 40 J = 1, N 419 X( J ) = ZERO 420 40 CONTINUE 421 X( I ) = ONE 422 CALL CPTTRS( 'Lower', N, 1, D( N+1 ), E( N+1 ), X, LDA, 423 $ INFO ) 424 AINVNM = MAX( AINVNM, SCASUM( N, X, 1 ) ) 425 50 CONTINUE 426 RCONDC = ONE / MAX( ONE, ANORM*AINVNM ) 427* 428 DO 90 IRHS = 1, NNS 429 NRHS = NSVAL( IRHS ) 430* 431* Generate NRHS random solution vectors. 432* 433 IX = 1 434 DO 60 J = 1, NRHS 435 CALL CLARNV( 2, ISEED, N, XACT( IX ) ) 436 IX = IX + LDA 437 60 CONTINUE 438* 439 DO 80 IUPLO = 1, 2 440* 441* Do first for UPLO = 'U', then for UPLO = 'L'. 442* 443 UPLO = UPLOS( IUPLO ) 444* 445* Set the right hand side. 446* 447 CALL CLAPTM( UPLO, N, NRHS, ONE, D, E, XACT, LDA, 448 $ ZERO, B, LDA ) 449* 450*+ TEST 2 451* Solve A*x = b and compute the residual. 452* 453 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 454 CALL CPTTRS( UPLO, N, NRHS, D( N+1 ), E( N+1 ), X, 455 $ LDA, INFO ) 456* 457* Check error code from CPTTRS. 458* 459 IF( INFO.NE.0 ) 460 $ CALL ALAERH( PATH, 'CPTTRS', INFO, 0, UPLO, N, N, 461 $ -1, -1, NRHS, IMAT, NFAIL, NERRS, 462 $ NOUT ) 463* 464 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 465 CALL CPTT02( UPLO, N, NRHS, D, E, X, LDA, WORK, LDA, 466 $ RESULT( 2 ) ) 467* 468*+ TEST 3 469* Check solution from generated exact solution. 470* 471 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 472 $ RESULT( 3 ) ) 473* 474*+ TESTS 4, 5, and 6 475* Use iterative refinement to improve the solution. 476* 477 SRNAMT = 'CPTRFS' 478 CALL CPTRFS( UPLO, N, NRHS, D, E, D( N+1 ), E( N+1 ), 479 $ B, LDA, X, LDA, RWORK, RWORK( NRHS+1 ), 480 $ WORK, RWORK( 2*NRHS+1 ), INFO ) 481* 482* Check error code from CPTRFS. 483* 484 IF( INFO.NE.0 ) 485 $ CALL ALAERH( PATH, 'CPTRFS', INFO, 0, UPLO, N, N, 486 $ -1, -1, NRHS, IMAT, NFAIL, NERRS, 487 $ NOUT ) 488* 489 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 490 $ RESULT( 4 ) ) 491 CALL CPTT05( N, NRHS, D, E, B, LDA, X, LDA, XACT, LDA, 492 $ RWORK, RWORK( NRHS+1 ), RESULT( 5 ) ) 493* 494* Print information about the tests that did not pass the 495* threshold. 496* 497 DO 70 K = 2, 6 498 IF( RESULT( K ).GE.THRESH ) THEN 499 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 500 $ CALL ALAHD( NOUT, PATH ) 501 WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, IMAT, 502 $ K, RESULT( K ) 503 NFAIL = NFAIL + 1 504 END IF 505 70 CONTINUE 506 NRUN = NRUN + 5 507* 508 80 CONTINUE 509 90 CONTINUE 510* 511*+ TEST 7 512* Estimate the reciprocal of the condition number of the 513* matrix. 514* 515 100 CONTINUE 516 SRNAMT = 'CPTCON' 517 CALL CPTCON( N, D( N+1 ), E( N+1 ), ANORM, RCOND, RWORK, 518 $ INFO ) 519* 520* Check error code from CPTCON. 521* 522 IF( INFO.NE.0 ) 523 $ CALL ALAERH( PATH, 'CPTCON', INFO, 0, ' ', N, N, -1, -1, 524 $ -1, IMAT, NFAIL, NERRS, NOUT ) 525* 526 RESULT( 7 ) = SGET06( RCOND, RCONDC ) 527* 528* Print the test ratio if greater than or equal to THRESH. 529* 530 IF( RESULT( 7 ).GE.THRESH ) THEN 531 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 532 $ CALL ALAHD( NOUT, PATH ) 533 WRITE( NOUT, FMT = 9999 )N, IMAT, 7, RESULT( 7 ) 534 NFAIL = NFAIL + 1 535 END IF 536 NRUN = NRUN + 1 537 110 CONTINUE 538 120 CONTINUE 539* 540* Print a summary of the results. 541* 542 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 543* 544 9999 FORMAT( ' N =', I5, ', type ', I2, ', test ', I2, ', ratio = ', 545 $ G12.5 ) 546 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS =', I3, 547 $ ', type ', I2, ', test ', I2, ', ratio = ', G12.5 ) 548 RETURN 549* 550* End of CCHKPT 551* 552 END 553