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