1*> \brief \b CCHKTP 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 CCHKTP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 12* NMAX, AP, AINVP, 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 AINVP( * ), AP( * ), B( * ), WORK( * ), X( * ), 25* $ XACT( * ) 26* .. 27* 28* 29*> \par Purpose: 30* ============= 31*> 32*> \verbatim 33*> 34*> CCHKTP tests CTPTRI, -TRS, -RFS, and -CON, and CLATPS 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 column 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 leading dimension of the work arrays. NMAX >= the 90*> maximumm value of N in NVAL. 91*> \endverbatim 92*> 93*> \param[out] AP 94*> \verbatim 95*> AP is COMPLEX array, dimension (NMAX*(NMAX+1)/2) 96*> \endverbatim 97*> 98*> \param[out] AINVP 99*> \verbatim 100*> AINVP is COMPLEX array, dimension (NMAX*(NMAX+1)/2) 101*> \endverbatim 102*> 103*> \param[out] B 104*> \verbatim 105*> B is COMPLEX array, dimension (NMAX*NSMAX) 106*> where NSMAX is the largest entry in NSVAL. 107*> \endverbatim 108*> 109*> \param[out] X 110*> \verbatim 111*> X is COMPLEX array, dimension (NMAX*NSMAX) 112*> \endverbatim 113*> 114*> \param[out] XACT 115*> \verbatim 116*> XACT is COMPLEX array, dimension (NMAX*NSMAX) 117*> \endverbatim 118*> 119*> \param[out] WORK 120*> \verbatim 121*> WORK is COMPLEX array, dimension 122*> (NMAX*max(3,NSMAX)) 123*> \endverbatim 124*> 125*> \param[out] RWORK 126*> \verbatim 127*> RWORK is REAL array, dimension 128*> (max(NMAX,2*NSMAX)) 129*> \endverbatim 130*> 131*> \param[in] NOUT 132*> \verbatim 133*> NOUT is INTEGER 134*> The unit number for output. 135*> \endverbatim 136* 137* Authors: 138* ======== 139* 140*> \author Univ. of Tennessee 141*> \author Univ. of California Berkeley 142*> \author Univ. of Colorado Denver 143*> \author NAG Ltd. 144* 145*> \date November 2011 146* 147*> \ingroup complex_lin 148* 149* ===================================================================== 150 SUBROUTINE CCHKTP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 151 $ NMAX, AP, AINVP, B, X, XACT, WORK, RWORK, 152 $ NOUT ) 153* 154* -- LAPACK test routine (version 3.4.0) -- 155* -- LAPACK is a software package provided by Univ. of Tennessee, -- 156* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 157* November 2011 158* 159* .. Scalar Arguments .. 160 LOGICAL TSTERR 161 INTEGER NMAX, NN, NNS, NOUT 162 REAL THRESH 163* .. 164* .. Array Arguments .. 165 LOGICAL DOTYPE( * ) 166 INTEGER NSVAL( * ), NVAL( * ) 167 REAL RWORK( * ) 168 COMPLEX AINVP( * ), AP( * ), B( * ), WORK( * ), X( * ), 169 $ XACT( * ) 170* .. 171* 172* ===================================================================== 173* 174* .. Parameters .. 175 INTEGER NTYPE1, NTYPES 176 PARAMETER ( NTYPE1 = 10, NTYPES = 18 ) 177 INTEGER NTESTS 178 PARAMETER ( NTESTS = 9 ) 179 INTEGER NTRAN 180 PARAMETER ( NTRAN = 3 ) 181 REAL ONE, ZERO 182 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 183* .. 184* .. Local Scalars .. 185 CHARACTER DIAG, NORM, TRANS, UPLO, XTYPE 186 CHARACTER*3 PATH 187 INTEGER I, IDIAG, IMAT, IN, INFO, IRHS, ITRAN, IUPLO, 188 $ K, LAP, LDA, N, NERRS, NFAIL, NRHS, NRUN 189 REAL AINVNM, ANORM, RCOND, RCONDC, RCONDI, RCONDO, 190 $ SCALE 191* .. 192* .. Local Arrays .. 193 CHARACTER TRANSS( NTRAN ), UPLOS( 2 ) 194 INTEGER ISEED( 4 ), ISEEDY( 4 ) 195 REAL RESULT( NTESTS ) 196* .. 197* .. External Functions .. 198 LOGICAL LSAME 199 REAL CLANTP 200 EXTERNAL LSAME, CLANTP 201* .. 202* .. External Subroutines .. 203 EXTERNAL ALAERH, ALAHD, ALASUM, CCOPY, CERRTR, CGET04, 204 $ CLACPY, CLARHS, CLATPS, CLATTP, CTPCON, CTPRFS, 205 $ CTPT01, CTPT02, CTPT03, CTPT05, CTPT06, CTPTRI, 206 $ CTPTRS 207* .. 208* .. Scalars in Common .. 209 LOGICAL LERR, OK 210 CHARACTER*32 SRNAMT 211 INTEGER INFOT, IOUNIT 212* .. 213* .. Common blocks .. 214 COMMON / INFOC / INFOT, IOUNIT, OK, LERR 215 COMMON / SRNAMC / SRNAMT 216* .. 217* .. Intrinsic Functions .. 218 INTRINSIC MAX 219* .. 220* .. Data statements .. 221 DATA ISEEDY / 1988, 1989, 1990, 1991 / 222 DATA UPLOS / 'U', 'L' / , TRANSS / 'N', 'T', 'C' / 223* .. 224* .. Executable Statements .. 225* 226* Initialize constants and the random number seed. 227* 228 PATH( 1: 1 ) = 'Complex precision' 229 PATH( 2: 3 ) = 'TP' 230 NRUN = 0 231 NFAIL = 0 232 NERRS = 0 233 DO 10 I = 1, 4 234 ISEED( I ) = ISEEDY( I ) 235 10 CONTINUE 236* 237* Test the error exits 238* 239 IF( TSTERR ) 240 $ CALL CERRTR( PATH, NOUT ) 241 INFOT = 0 242* 243 DO 110 IN = 1, NN 244* 245* Do for each value of N in NVAL 246* 247 N = NVAL( IN ) 248 LDA = MAX( 1, N ) 249 LAP = LDA*( LDA+1 ) / 2 250 XTYPE = 'N' 251* 252 DO 70 IMAT = 1, NTYPE1 253* 254* Do the tests only if DOTYPE( IMAT ) is true. 255* 256 IF( .NOT.DOTYPE( IMAT ) ) 257 $ GO TO 70 258* 259 DO 60 IUPLO = 1, 2 260* 261* Do first for UPLO = 'U', then for UPLO = 'L' 262* 263 UPLO = UPLOS( IUPLO ) 264* 265* Call CLATTP to generate a triangular test matrix. 266* 267 SRNAMT = 'CLATTP' 268 CALL CLATTP( IMAT, UPLO, 'No transpose', DIAG, ISEED, N, 269 $ AP, X, WORK, RWORK, INFO ) 270* 271* Set IDIAG = 1 for non-unit matrices, 2 for unit. 272* 273 IF( LSAME( DIAG, 'N' ) ) THEN 274 IDIAG = 1 275 ELSE 276 IDIAG = 2 277 END IF 278* 279*+ TEST 1 280* Form the inverse of A. 281* 282 IF( N.GT.0 ) 283 $ CALL CCOPY( LAP, AP, 1, AINVP, 1 ) 284 SRNAMT = 'CTPTRI' 285 CALL CTPTRI( UPLO, DIAG, N, AINVP, INFO ) 286* 287* Check error code from CTPTRI. 288* 289 IF( INFO.NE.0 ) 290 $ CALL ALAERH( PATH, 'CTPTRI', INFO, 0, UPLO // DIAG, N, 291 $ N, -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 292* 293* Compute the infinity-norm condition number of A. 294* 295 ANORM = CLANTP( 'I', UPLO, DIAG, N, AP, RWORK ) 296 AINVNM = CLANTP( 'I', UPLO, DIAG, N, AINVP, RWORK ) 297 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 298 RCONDI = ONE 299 ELSE 300 RCONDI = ( ONE / ANORM ) / AINVNM 301 END IF 302* 303* Compute the residual for the triangular matrix times its 304* inverse. Also compute the 1-norm condition number of A. 305* 306 CALL CTPT01( UPLO, DIAG, N, AP, AINVP, RCONDO, RWORK, 307 $ RESULT( 1 ) ) 308* 309* Print the test ratio if it is .GE. THRESH. 310* 311 IF( RESULT( 1 ).GE.THRESH ) THEN 312 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 313 $ CALL ALAHD( NOUT, PATH ) 314 WRITE( NOUT, FMT = 9999 )UPLO, DIAG, N, IMAT, 1, 315 $ RESULT( 1 ) 316 NFAIL = NFAIL + 1 317 END IF 318 NRUN = NRUN + 1 319* 320 DO 40 IRHS = 1, NNS 321 NRHS = NSVAL( IRHS ) 322 XTYPE = 'N' 323* 324 DO 30 ITRAN = 1, NTRAN 325* 326* Do for op(A) = A, A**T, or A**H. 327* 328 TRANS = TRANSS( ITRAN ) 329 IF( ITRAN.EQ.1 ) THEN 330 NORM = 'O' 331 RCONDC = RCONDO 332 ELSE 333 NORM = 'I' 334 RCONDC = RCONDI 335 END IF 336* 337*+ TEST 2 338* Solve and compute residual for op(A)*x = b. 339* 340 SRNAMT = 'CLARHS' 341 CALL CLARHS( PATH, XTYPE, UPLO, TRANS, N, N, 0, 342 $ IDIAG, NRHS, AP, LAP, XACT, LDA, B, 343 $ LDA, ISEED, INFO ) 344 XTYPE = 'C' 345 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 346* 347 SRNAMT = 'CTPTRS' 348 CALL CTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, X, 349 $ LDA, INFO ) 350* 351* Check error code from CTPTRS. 352* 353 IF( INFO.NE.0 ) 354 $ CALL ALAERH( PATH, 'CTPTRS', INFO, 0, 355 $ UPLO // TRANS // DIAG, N, N, -1, 356 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 357* 358 CALL CTPT02( UPLO, TRANS, DIAG, N, NRHS, AP, X, 359 $ LDA, B, LDA, WORK, RWORK, 360 $ RESULT( 2 ) ) 361* 362*+ TEST 3 363* Check solution from generated exact solution. 364* 365 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 366 $ RESULT( 3 ) ) 367* 368*+ TESTS 4, 5, and 6 369* Use iterative refinement to improve the solution and 370* compute error bounds. 371* 372 SRNAMT = 'CTPRFS' 373 CALL CTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, 374 $ LDA, X, LDA, RWORK, RWORK( NRHS+1 ), 375 $ WORK, RWORK( 2*NRHS+1 ), INFO ) 376* 377* Check error code from CTPRFS. 378* 379 IF( INFO.NE.0 ) 380 $ CALL ALAERH( PATH, 'CTPRFS', INFO, 0, 381 $ UPLO // TRANS // DIAG, N, N, -1, 382 $ -1, NRHS, IMAT, NFAIL, NERRS, 383 $ NOUT ) 384* 385 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 386 $ RESULT( 4 ) ) 387 CALL CTPT05( UPLO, TRANS, DIAG, N, NRHS, AP, B, 388 $ LDA, X, LDA, XACT, LDA, RWORK, 389 $ RWORK( NRHS+1 ), RESULT( 5 ) ) 390* 391* Print information about the tests that did not pass 392* the threshold. 393* 394 DO 20 K = 2, 6 395 IF( RESULT( K ).GE.THRESH ) THEN 396 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 397 $ CALL ALAHD( NOUT, PATH ) 398 WRITE( NOUT, FMT = 9998 )UPLO, TRANS, DIAG, 399 $ N, NRHS, IMAT, K, RESULT( K ) 400 NFAIL = NFAIL + 1 401 END IF 402 20 CONTINUE 403 NRUN = NRUN + 5 404 30 CONTINUE 405 40 CONTINUE 406* 407*+ TEST 7 408* Get an estimate of RCOND = 1/CNDNUM. 409* 410 DO 50 ITRAN = 1, 2 411 IF( ITRAN.EQ.1 ) THEN 412 NORM = 'O' 413 RCONDC = RCONDO 414 ELSE 415 NORM = 'I' 416 RCONDC = RCONDI 417 END IF 418 SRNAMT = 'CTPCON' 419 CALL CTPCON( NORM, UPLO, DIAG, N, AP, RCOND, WORK, 420 $ RWORK, INFO ) 421* 422* Check error code from CTPCON. 423* 424 IF( INFO.NE.0 ) 425 $ CALL ALAERH( PATH, 'CTPCON', INFO, 0, 426 $ NORM // UPLO // DIAG, N, N, -1, -1, 427 $ -1, IMAT, NFAIL, NERRS, NOUT ) 428* 429 CALL CTPT06( RCOND, RCONDC, UPLO, DIAG, N, AP, RWORK, 430 $ RESULT( 7 ) ) 431* 432* Print the test ratio if it is .GE. THRESH. 433* 434 IF( RESULT( 7 ).GE.THRESH ) THEN 435 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 436 $ CALL ALAHD( NOUT, PATH ) 437 WRITE( NOUT, FMT = 9997 ) 'CTPCON', NORM, UPLO, 438 $ DIAG, N, IMAT, 7, RESULT( 7 ) 439 NFAIL = NFAIL + 1 440 END IF 441 NRUN = NRUN + 1 442 50 CONTINUE 443 60 CONTINUE 444 70 CONTINUE 445* 446* Use pathological test matrices to test CLATPS. 447* 448 DO 100 IMAT = NTYPE1 + 1, NTYPES 449* 450* Do the tests only if DOTYPE( IMAT ) is true. 451* 452 IF( .NOT.DOTYPE( IMAT ) ) 453 $ GO TO 100 454* 455 DO 90 IUPLO = 1, 2 456* 457* Do first for UPLO = 'U', then for UPLO = 'L' 458* 459 UPLO = UPLOS( IUPLO ) 460 DO 80 ITRAN = 1, NTRAN 461* 462* Do for op(A) = A, A**T, or A**H. 463* 464 TRANS = TRANSS( ITRAN ) 465* 466* Call CLATTP to generate a triangular test matrix. 467* 468 SRNAMT = 'CLATTP' 469 CALL CLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, X, 470 $ WORK, RWORK, INFO ) 471* 472*+ TEST 8 473* Solve the system op(A)*x = b. 474* 475 SRNAMT = 'CLATPS' 476 CALL CCOPY( N, X, 1, B, 1 ) 477 CALL CLATPS( UPLO, TRANS, DIAG, 'N', N, AP, B, SCALE, 478 $ RWORK, INFO ) 479* 480* Check error code from CLATPS. 481* 482 IF( INFO.NE.0 ) 483 $ CALL ALAERH( PATH, 'CLATPS', INFO, 0, 484 $ UPLO // TRANS // DIAG // 'N', N, N, 485 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 486* 487 CALL CTPT03( UPLO, TRANS, DIAG, N, 1, AP, SCALE, 488 $ RWORK, ONE, B, LDA, X, LDA, WORK, 489 $ RESULT( 8 ) ) 490* 491*+ TEST 9 492* Solve op(A)*x = b again with NORMIN = 'Y'. 493* 494 CALL CCOPY( N, X, 1, B( N+1 ), 1 ) 495 CALL CLATPS( UPLO, TRANS, DIAG, 'Y', N, AP, B( N+1 ), 496 $ SCALE, RWORK, INFO ) 497* 498* Check error code from CLATPS. 499* 500 IF( INFO.NE.0 ) 501 $ CALL ALAERH( PATH, 'CLATPS', INFO, 0, 502 $ UPLO // TRANS // DIAG // 'Y', N, N, 503 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 504* 505 CALL CTPT03( UPLO, TRANS, DIAG, N, 1, AP, SCALE, 506 $ RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK, 507 $ RESULT( 9 ) ) 508* 509* Print information about the tests that did not pass 510* the threshold. 511* 512 IF( RESULT( 8 ).GE.THRESH ) THEN 513 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 514 $ CALL ALAHD( NOUT, PATH ) 515 WRITE( NOUT, FMT = 9996 )'CLATPS', UPLO, TRANS, 516 $ DIAG, 'N', N, IMAT, 8, RESULT( 8 ) 517 NFAIL = NFAIL + 1 518 END IF 519 IF( RESULT( 9 ).GE.THRESH ) THEN 520 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 521 $ CALL ALAHD( NOUT, PATH ) 522 WRITE( NOUT, FMT = 9996 )'CLATPS', UPLO, TRANS, 523 $ DIAG, 'Y', N, IMAT, 9, RESULT( 9 ) 524 NFAIL = NFAIL + 1 525 END IF 526 NRUN = NRUN + 2 527 80 CONTINUE 528 90 CONTINUE 529 100 CONTINUE 530 110 CONTINUE 531* 532* Print a summary of the results. 533* 534 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 535* 536 9999 FORMAT( ' UPLO=''', A1, ''', DIAG=''', A1, ''', N=', I5, 537 $ ', type ', I2, ', test(', I2, ')= ', G12.5 ) 538 9998 FORMAT( ' UPLO=''', A1, ''', TRANS=''', A1, ''', DIAG=''', A1, 539 $ ''', N=', I5, ''', NRHS=', I5, ', type ', I2, ', test(', 540 $ I2, ')= ', G12.5 ) 541 9997 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ''', A1, ''',', 542 $ I5, ', ... ), type ', I2, ', test(', I2, ')=', G12.5 ) 543 9996 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ''', A1, ''', ''', 544 $ A1, ''',', I5, ', ... ), type ', I2, ', test(', I2, ')=', 545 $ G12.5 ) 546 RETURN 547* 548* End of CCHKTP 549* 550 END 551