1*> \brief \b CCHKPP 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 CCHKPP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 12* NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, 13* NOUT ) 14* 15* .. Scalar Arguments .. 16* LOGICAL TSTERR 17* INTEGER NMAX, NN, NNS, NOUT 18* REAL THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER NSVAL( * ), NVAL( * ) 23* REAL RWORK( * ) 24* COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ), 25* $ WORK( * ), X( * ), XACT( * ) 26* .. 27* 28* 29*> \par Purpose: 30* ============= 31*> 32*> \verbatim 33*> 34*> CCHKPP tests CPPTRF, -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 REAL 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 array, dimension 96*> (NMAX*(NMAX+1)/2) 97*> \endverbatim 98*> 99*> \param[out] AFAC 100*> \verbatim 101*> AFAC is COMPLEX array, dimension 102*> (NMAX*(NMAX+1)/2) 103*> \endverbatim 104*> 105*> \param[out] AINV 106*> \verbatim 107*> AINV is COMPLEX array, dimension 108*> (NMAX*(NMAX+1)/2) 109*> \endverbatim 110*> 111*> \param[out] B 112*> \verbatim 113*> B is COMPLEX 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 array, dimension (NMAX*NSMAX) 120*> \endverbatim 121*> 122*> \param[out] XACT 123*> \verbatim 124*> XACT is COMPLEX array, dimension (NMAX*NSMAX) 125*> \endverbatim 126*> 127*> \param[out] WORK 128*> \verbatim 129*> WORK is COMPLEX array, dimension 130*> (NMAX*max(3,NSMAX)) 131*> \endverbatim 132*> 133*> \param[out] RWORK 134*> \verbatim 135*> RWORK is REAL array, dimension 136*> (max(NMAX,2*NSMAX)) 137*> \endverbatim 138*> 139*> \param[in] NOUT 140*> \verbatim 141*> NOUT is INTEGER 142*> The unit number for output. 143*> \endverbatim 144* 145* Authors: 146* ======== 147* 148*> \author Univ. of Tennessee 149*> \author Univ. of California Berkeley 150*> \author Univ. of Colorado Denver 151*> \author NAG Ltd. 152* 153*> \date November 2011 154* 155*> \ingroup complex_lin 156* 157* ===================================================================== 158 SUBROUTINE CCHKPP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 159 $ NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, 160 $ NOUT ) 161* 162* -- LAPACK test routine (version 3.4.0) -- 163* -- LAPACK is a software package provided by Univ. of Tennessee, -- 164* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 165* November 2011 166* 167* .. Scalar Arguments .. 168 LOGICAL TSTERR 169 INTEGER NMAX, NN, NNS, NOUT 170 REAL THRESH 171* .. 172* .. Array Arguments .. 173 LOGICAL DOTYPE( * ) 174 INTEGER NSVAL( * ), NVAL( * ) 175 REAL RWORK( * ) 176 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ), 177 $ WORK( * ), X( * ), XACT( * ) 178* .. 179* 180* ===================================================================== 181* 182* .. Parameters .. 183 REAL ZERO 184 PARAMETER ( ZERO = 0.0E+0 ) 185 INTEGER NTYPES 186 PARAMETER ( NTYPES = 9 ) 187 INTEGER NTESTS 188 PARAMETER ( NTESTS = 8 ) 189* .. 190* .. Local Scalars .. 191 LOGICAL ZEROT 192 CHARACTER DIST, PACKIT, TYPE, UPLO, XTYPE 193 CHARACTER*3 PATH 194 INTEGER I, IMAT, IN, INFO, IOFF, IRHS, IUPLO, IZERO, K, 195 $ KL, KU, LDA, MODE, N, NERRS, NFAIL, NIMAT, NPP, 196 $ NRHS, NRUN 197 REAL ANORM, CNDNUM, RCOND, RCONDC 198* .. 199* .. Local Arrays .. 200 CHARACTER PACKS( 2 ), UPLOS( 2 ) 201 INTEGER ISEED( 4 ), ISEEDY( 4 ) 202 REAL RESULT( NTESTS ) 203* .. 204* .. External Functions .. 205 REAL CLANHP, SGET06 206 EXTERNAL CLANHP, SGET06 207* .. 208* .. External Subroutines .. 209 EXTERNAL ALAERH, ALAHD, ALASUM, CCOPY, CERRPO, CGET04, 210 $ CLACPY, CLAIPD, CLARHS, CLATB4, CLATMS, CPPCON, 211 $ CPPRFS, CPPT01, CPPT02, CPPT03, CPPT05, CPPTRF, 212 $ CPPTRI, CPPTRS 213* .. 214* .. Scalars in Common .. 215 LOGICAL LERR, OK 216 CHARACTER*32 SRNAMT 217 INTEGER INFOT, NUNIT 218* .. 219* .. Common blocks .. 220 COMMON / INFOC / INFOT, NUNIT, OK, LERR 221 COMMON / SRNAMC / SRNAMT 222* .. 223* .. Intrinsic Functions .. 224 INTRINSIC MAX 225* .. 226* .. Data statements .. 227 DATA ISEEDY / 1988, 1989, 1990, 1991 / 228 DATA UPLOS / 'U', 'L' / , PACKS / 'C', 'R' / 229* .. 230* .. Executable Statements .. 231* 232* Initialize constants and the random number seed. 233* 234 PATH( 1: 1 ) = 'Complex precision' 235 PATH( 2: 3 ) = 'PP' 236 NRUN = 0 237 NFAIL = 0 238 NERRS = 0 239 DO 10 I = 1, 4 240 ISEED( I ) = ISEEDY( I ) 241 10 CONTINUE 242* 243* Test the error exits 244* 245 IF( TSTERR ) 246 $ CALL CERRPO( PATH, NOUT ) 247 INFOT = 0 248* 249* Do for each value of N in NVAL 250* 251 DO 110 IN = 1, NN 252 N = NVAL( IN ) 253 LDA = MAX( N, 1 ) 254 XTYPE = 'N' 255 NIMAT = NTYPES 256 IF( N.LE.0 ) 257 $ NIMAT = 1 258* 259 DO 100 IMAT = 1, NIMAT 260* 261* Do the tests only if DOTYPE( IMAT ) is true. 262* 263 IF( .NOT.DOTYPE( IMAT ) ) 264 $ GO TO 100 265* 266* Skip types 3, 4, or 5 if the matrix size is too small. 267* 268 ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 269 IF( ZEROT .AND. N.LT.IMAT-2 ) 270 $ GO TO 100 271* 272* Do first for UPLO = 'U', then for UPLO = 'L' 273* 274 DO 90 IUPLO = 1, 2 275 UPLO = UPLOS( IUPLO ) 276 PACKIT = PACKS( IUPLO ) 277* 278* Set up parameters with CLATB4 and generate a test matrix 279* with CLATMS. 280* 281 CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 282 $ CNDNUM, DIST ) 283* 284 SRNAMT = 'CLATMS' 285 CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 286 $ CNDNUM, ANORM, KL, KU, PACKIT, A, LDA, WORK, 287 $ INFO ) 288* 289* Check error code from CLATMS. 290* 291 IF( INFO.NE.0 ) THEN 292 CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1, 293 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 294 GO TO 90 295 END IF 296* 297* For types 3-5, zero one row and column of the matrix to 298* test that INFO is returned correctly. 299* 300 IF( ZEROT ) THEN 301 IF( IMAT.EQ.3 ) THEN 302 IZERO = 1 303 ELSE IF( IMAT.EQ.4 ) THEN 304 IZERO = N 305 ELSE 306 IZERO = N / 2 + 1 307 END IF 308* 309* Set row and column IZERO of A to 0. 310* 311 IF( IUPLO.EQ.1 ) THEN 312 IOFF = ( IZERO-1 )*IZERO / 2 313 DO 20 I = 1, IZERO - 1 314 A( IOFF+I ) = ZERO 315 20 CONTINUE 316 IOFF = IOFF + IZERO 317 DO 30 I = IZERO, N 318 A( IOFF ) = ZERO 319 IOFF = IOFF + I 320 30 CONTINUE 321 ELSE 322 IOFF = IZERO 323 DO 40 I = 1, IZERO - 1 324 A( IOFF ) = ZERO 325 IOFF = IOFF + N - I 326 40 CONTINUE 327 IOFF = IOFF - IZERO 328 DO 50 I = IZERO, N 329 A( IOFF+I ) = ZERO 330 50 CONTINUE 331 END IF 332 ELSE 333 IZERO = 0 334 END IF 335* 336* Set the imaginary part of the diagonals. 337* 338 IF( IUPLO.EQ.1 ) THEN 339 CALL CLAIPD( N, A, 2, 1 ) 340 ELSE 341 CALL CLAIPD( N, A, N, -1 ) 342 END IF 343* 344* Compute the L*L' or U'*U factorization of the matrix. 345* 346 NPP = N*( N+1 ) / 2 347 CALL CCOPY( NPP, A, 1, AFAC, 1 ) 348 SRNAMT = 'CPPTRF' 349 CALL CPPTRF( UPLO, N, AFAC, INFO ) 350* 351* Check error code from CPPTRF. 352* 353 IF( INFO.NE.IZERO ) THEN 354 CALL ALAERH( PATH, 'CPPTRF', INFO, IZERO, UPLO, N, N, 355 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 356 GO TO 90 357 END IF 358* 359* Skip the tests if INFO is not 0. 360* 361 IF( INFO.NE.0 ) 362 $ GO TO 90 363* 364*+ TEST 1 365* Reconstruct matrix from factors and compute residual. 366* 367 CALL CCOPY( NPP, AFAC, 1, AINV, 1 ) 368 CALL CPPT01( UPLO, N, A, AINV, RWORK, RESULT( 1 ) ) 369* 370*+ TEST 2 371* Form the inverse and compute the residual. 372* 373 CALL CCOPY( NPP, AFAC, 1, AINV, 1 ) 374 SRNAMT = 'CPPTRI' 375 CALL CPPTRI( UPLO, N, AINV, INFO ) 376* 377* Check error code from CPPTRI. 378* 379 IF( INFO.NE.0 ) 380 $ CALL ALAERH( PATH, 'CPPTRI', INFO, 0, UPLO, N, N, -1, 381 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 382* 383 CALL CPPT03( UPLO, N, A, AINV, WORK, LDA, RWORK, RCONDC, 384 $ RESULT( 2 ) ) 385* 386* Print information about the tests that did not pass 387* the threshold. 388* 389 DO 60 K = 1, 2 390 IF( RESULT( K ).GE.THRESH ) THEN 391 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 392 $ CALL ALAHD( NOUT, PATH ) 393 WRITE( NOUT, FMT = 9999 )UPLO, N, IMAT, K, 394 $ RESULT( K ) 395 NFAIL = NFAIL + 1 396 END IF 397 60 CONTINUE 398 NRUN = NRUN + 2 399* 400 DO 80 IRHS = 1, NNS 401 NRHS = NSVAL( IRHS ) 402* 403*+ TEST 3 404* Solve and compute residual for A * X = B. 405* 406 SRNAMT = 'CLARHS' 407 CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 408 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED, 409 $ INFO ) 410 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 411* 412 SRNAMT = 'CPPTRS' 413 CALL CPPTRS( UPLO, N, NRHS, AFAC, X, LDA, INFO ) 414* 415* Check error code from CPPTRS. 416* 417 IF( INFO.NE.0 ) 418 $ CALL ALAERH( PATH, 'CPPTRS', INFO, 0, UPLO, N, N, 419 $ -1, -1, NRHS, IMAT, NFAIL, NERRS, 420 $ NOUT ) 421* 422 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 423 CALL CPPT02( UPLO, N, NRHS, A, X, LDA, WORK, LDA, 424 $ RWORK, RESULT( 3 ) ) 425* 426*+ TEST 4 427* Check solution from generated exact solution. 428* 429 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 430 $ RESULT( 4 ) ) 431* 432*+ TESTS 5, 6, and 7 433* Use iterative refinement to improve the solution. 434* 435 SRNAMT = 'CPPRFS' 436 CALL CPPRFS( UPLO, N, NRHS, A, AFAC, B, LDA, X, LDA, 437 $ RWORK, RWORK( NRHS+1 ), WORK, 438 $ RWORK( 2*NRHS+1 ), INFO ) 439* 440* Check error code from CPPRFS. 441* 442 IF( INFO.NE.0 ) 443 $ CALL ALAERH( PATH, 'CPPRFS', INFO, 0, UPLO, N, N, 444 $ -1, -1, NRHS, IMAT, NFAIL, NERRS, 445 $ NOUT ) 446* 447 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 448 $ RESULT( 5 ) ) 449 CALL CPPT05( UPLO, N, NRHS, A, B, LDA, X, LDA, XACT, 450 $ LDA, RWORK, RWORK( NRHS+1 ), 451 $ RESULT( 6 ) ) 452* 453* Print information about the tests that did not pass 454* the threshold. 455* 456 DO 70 K = 3, 7 457 IF( RESULT( K ).GE.THRESH ) THEN 458 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 459 $ CALL ALAHD( NOUT, PATH ) 460 WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, IMAT, 461 $ K, RESULT( K ) 462 NFAIL = NFAIL + 1 463 END IF 464 70 CONTINUE 465 NRUN = NRUN + 5 466 80 CONTINUE 467* 468*+ TEST 8 469* Get an estimate of RCOND = 1/CNDNUM. 470* 471 ANORM = CLANHP( '1', UPLO, N, A, RWORK ) 472 SRNAMT = 'CPPCON' 473 CALL CPPCON( UPLO, N, AFAC, ANORM, RCOND, WORK, RWORK, 474 $ INFO ) 475* 476* Check error code from CPPCON. 477* 478 IF( INFO.NE.0 ) 479 $ CALL ALAERH( PATH, 'CPPCON', INFO, 0, UPLO, N, N, -1, 480 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 481* 482 RESULT( 8 ) = SGET06( RCOND, RCONDC ) 483* 484* Print the test ratio if greater than or equal to THRESH. 485* 486 IF( RESULT( 8 ).GE.THRESH ) THEN 487 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 488 $ CALL ALAHD( NOUT, PATH ) 489 WRITE( NOUT, FMT = 9999 )UPLO, N, IMAT, 8, 490 $ RESULT( 8 ) 491 NFAIL = NFAIL + 1 492 END IF 493 NRUN = NRUN + 1 494* 495 90 CONTINUE 496 100 CONTINUE 497 110 CONTINUE 498* 499* Print a summary of the results. 500* 501 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 502* 503 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', type ', I2, ', test ', 504 $ I2, ', ratio =', G12.5 ) 505 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', 506 $ I2, ', test(', I2, ') =', G12.5 ) 507 RETURN 508* 509* End of CCHKPP 510* 511 END 512