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