1*> \brief \b SDRVSY_AA_2STAGE 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_AA_2STAGE( 12* DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 13* A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, 14* NOUT ) 15* 16* .. Scalar Arguments .. 17* LOGICAL TSTERR 18* INTEGER NMAX, NN, NOUT, NRHS 19* REAL THRESH 20* .. 21* .. Array Arguments .. 22* LOGICAL DOTYPE( * ) 23* INTEGER IWORK( * ), NVAL( * ) 24* REAL RWORK( * ) 25* REAL A( * ), AFAC( * ), AINV( * ), B( * ), 26* $ WORK( * ), X( * ), XACT( * ) 27* .. 28* 29* 30*> \par Purpose: 31* ============= 32*> 33*> \verbatim 34*> 35*> SDRVSY_AA_2STAGE tests the driver routine SSYSV_AA_2STAGE. 36*> \endverbatim 37* 38* Arguments: 39* ========== 40* 41*> \param[in] DOTYPE 42*> \verbatim 43*> DOTYPE is LOGICAL array, dimension (NTYPES) 44*> The matrix types to be used for testing. Matrices of type j 45*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 46*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 47*> \endverbatim 48*> 49*> \param[in] NN 50*> \verbatim 51*> NN is INTEGER 52*> The number of values of N contained in the vector NVAL. 53*> \endverbatim 54*> 55*> \param[in] NVAL 56*> \verbatim 57*> NVAL is INTEGER array, dimension (NN) 58*> The values of the matrix dimension N. 59*> \endverbatim 60*> 61*> \param[in] NRHS 62*> \verbatim 63*> NRHS is INTEGER 64*> The number of right hand side vectors to be generated for 65*> each linear system. 66*> \endverbatim 67*> 68*> \param[in] THRESH 69*> \verbatim 70*> THRESH is REAL 71*> The threshold value for the test ratios. A result is 72*> included in the output file if RESULT >= THRESH. To have 73*> every test ratio printed, use THRESH = 0. 74*> \endverbatim 75*> 76*> \param[in] TSTERR 77*> \verbatim 78*> TSTERR is LOGICAL 79*> Flag that indicates whether error exits are to be tested. 80*> \endverbatim 81*> 82*> \param[in] NMAX 83*> \verbatim 84*> NMAX is INTEGER 85*> The maximum value permitted for N, used in dimensioning the 86*> work arrays. 87*> \endverbatim 88*> 89*> \param[out] A 90*> \verbatim 91*> A is REAL array, dimension (NMAX*NMAX) 92*> \endverbatim 93*> 94*> \param[out] AFAC 95*> \verbatim 96*> AFAC is REAL array, dimension (NMAX*NMAX) 97*> \endverbatim 98*> 99*> \param[out] AINV 100*> \verbatim 101*> AINV is REAL array, dimension (NMAX*NMAX) 102*> \endverbatim 103*> 104*> \param[out] B 105*> \verbatim 106*> B is REAL array, dimension (NMAX*NRHS) 107*> \endverbatim 108*> 109*> \param[out] X 110*> \verbatim 111*> X is REAL array, dimension (NMAX*NRHS) 112*> \endverbatim 113*> 114*> \param[out] XACT 115*> \verbatim 116*> XACT is REAL array, dimension (NMAX*NRHS) 117*> \endverbatim 118*> 119*> \param[out] WORK 120*> \verbatim 121*> WORK is REAL array, dimension (NMAX*max(2,NRHS)) 122*> \endverbatim 123*> 124*> \param[out] RWORK 125*> \verbatim 126*> RWORK is REAL array, dimension (NMAX+2*NRHS) 127*> \endverbatim 128*> 129*> \param[out] IWORK 130*> \verbatim 131*> IWORK is INTEGER array, dimension (NMAX) 132*> \endverbatim 133*> 134*> \param[in] NOUT 135*> \verbatim 136*> NOUT is INTEGER 137*> The unit number for output. 138*> \endverbatim 139* 140* Authors: 141* ======== 142* 143*> \author Univ. of Tennessee 144*> \author Univ. of California Berkeley 145*> \author Univ. of Colorado Denver 146*> \author NAG Ltd. 147* 148*> \ingroup real_lin 149* 150* ===================================================================== 151 SUBROUTINE SDRVSY_AA_2STAGE( 152 $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, 153 $ NMAX, A, AFAC, AINV, B, X, XACT, WORK, 154 $ RWORK, IWORK, NOUT ) 155* 156* -- LAPACK test routine -- 157* -- LAPACK is a software package provided by Univ. of Tennessee, -- 158* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 159* 160* .. Scalar Arguments .. 161 LOGICAL TSTERR 162 INTEGER NMAX, NN, NOUT, NRHS 163 REAL THRESH 164* .. 165* .. Array Arguments .. 166 LOGICAL DOTYPE( * ) 167 INTEGER IWORK( * ), NVAL( * ) 168 REAL RWORK( * ) 169 REAL A( * ), AFAC( * ), AINV( * ), B( * ), 170 $ 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 MATPATH, PATH 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 ANORM, CNDNUM 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, SGET06 199 EXTERNAL SLANSY, SGET06 200* .. 201* .. External Subroutines .. 202 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, SERRVX, 203 $ SLACPY, SLARHS, SLATB4, SLATMS, 204 $ SSYSV_AA_2STAGE, SSYT01_AA, SPOT02, 205 $ SSYTRF_AA_2STAGE 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* .. Intrinsic Functions .. 217 INTRINSIC CMPLX, MAX, MIN 218* .. 219* .. Data statements .. 220 DATA ISEEDY / 1988, 1989, 1990, 1991 / 221 DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' / 222* .. 223* .. Executable Statements .. 224* 225* Initialize constants and the random number seed. 226* 227* Test path 228* 229 PATH( 1: 1 ) = 'Single precision' 230 PATH( 2: 3 ) = 'S2' 231* 232* Path to generate matrices 233* 234 MATPATH( 1: 1 ) = 'Single precision' 235 MATPATH( 2: 3 ) = 'SY' 236* 237 NRUN = 0 238 NFAIL = 0 239 NERRS = 0 240 DO 10 I = 1, 4 241 ISEED( I ) = ISEEDY( I ) 242 10 CONTINUE 243* 244* Test the error exits 245* 246 IF( TSTERR ) 247 $ CALL SERRVX( PATH, NOUT ) 248 INFOT = 0 249* 250* Set the block size and minimum block size for testing. 251* 252 NB = 1 253 NBMIN = 2 254 CALL XLAENV( 1, NB ) 255 CALL XLAENV( 2, NBMIN ) 256* 257* Do for each value of N in NVAL 258* 259 DO 180 IN = 1, NN 260 N = NVAL( IN ) 261 LDA = MAX( N, 1 ) 262 XTYPE = 'N' 263 NIMAT = NTYPES 264 IF( N.LE.0 ) 265 $ NIMAT = 1 266* 267 DO 170 IMAT = 1, NIMAT 268* 269* Do the tests only if DOTYPE( IMAT ) is true. 270* 271 IF( .NOT.DOTYPE( IMAT ) ) 272 $ GO TO 170 273* 274* Skip types 3, 4, 5, or 6 if the matrix size is too small. 275* 276 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6 277 IF( ZEROT .AND. N.LT.IMAT-2 ) 278 $ GO TO 170 279* 280* Do first for UPLO = 'U', then for UPLO = 'L' 281* 282 DO 160 IUPLO = 1, 2 283 UPLO = UPLOS( IUPLO ) 284* 285* Begin generate the test matrix A. 286* 287* Set up parameters with SLATB4 for the matrix generator 288* based on the type of matrix to be generated. 289* 290 CALL SLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM, 291 $ MODE, CNDNUM, DIST ) 292* 293* Generate a matrix with SLATMS. 294* 295 SRNAMT = 'SLATMS' 296 CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 297 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, 298 $ WORK, INFO ) 299* 300* Check error code from SLATMS and handle error. 301* 302 IF( INFO.NE.0 ) THEN 303 CALL ALAERH( PATH, 'SLATMS', INFO, 0, UPLO, N, N, 304 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 305 GO TO 160 306 END IF 307* 308* For types 3-6, zero one or more rows and columns of 309* the matrix to test that INFO is returned correctly. 310* 311 IF( ZEROT ) THEN 312 IF( IMAT.EQ.3 ) THEN 313 IZERO = 1 314 ELSE IF( IMAT.EQ.4 ) THEN 315 IZERO = N 316 ELSE 317 IZERO = N / 2 + 1 318 END IF 319* 320 IF( IMAT.LT.6 ) THEN 321* 322* Set row and column IZERO to zero. 323* 324 IF( IUPLO.EQ.1 ) THEN 325 IOFF = ( IZERO-1 )*LDA 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 IOFF = 0 347 IF( IUPLO.EQ.1 ) THEN 348* 349* Set the first IZERO rows and columns to zero. 350* 351 DO 70 J = 1, N 352 I2 = MIN( J, IZERO ) 353 DO 60 I = 1, I2 354 A( IOFF+I ) = ZERO 355 60 CONTINUE 356 IOFF = IOFF + LDA 357 70 CONTINUE 358 IZERO = 1 359 ELSE 360* 361* Set the first IZERO rows and columns to zero. 362* 363 IOFF = 0 364 DO 90 J = 1, N 365 I1 = MAX( J, IZERO ) 366 DO 80 I = I1, N 367 A( IOFF+I ) = ZERO 368 80 CONTINUE 369 IOFF = IOFF + LDA 370 90 CONTINUE 371 END IF 372 END IF 373 ELSE 374 IZERO = 0 375 END IF 376* 377* End generate the test matrix A. 378* 379* 380 DO 150 IFACT = 1, NFACT 381* 382* Do first for FACT = 'F', then for other values. 383* 384 FACT = FACTS( IFACT ) 385* 386* Form an exact solution and set the right hand side. 387* 388 SRNAMT = 'SLARHS' 389 CALL SLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU, 390 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED, 391 $ INFO ) 392 XTYPE = 'C' 393* 394* --- Test SSYSV_AA_2STAGE --- 395* 396 IF( IFACT.EQ.2 ) THEN 397 CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 398 CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 399* 400* Factor the matrix and solve the system using SSYSV_AA. 401* 402 SRNAMT = 'SSYSV_AA_2STAGE ' 403 LWORK = MIN(N*NB, 3*NMAX*NMAX) 404 CALL SSYSV_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA, 405 $ AINV, (3*NB+1)*N, 406 $ IWORK, IWORK( 1+N ), 407 $ X, LDA, WORK, LWORK, INFO ) 408* 409* Adjust the expected value of INFO to account for 410* pivoting. 411* 412 IF( IZERO.GT.0 ) THEN 413 J = 1 414 K = IZERO 415 100 CONTINUE 416 IF( J.EQ.K ) THEN 417 K = IWORK( J ) 418 ELSE IF( IWORK( J ).EQ.K ) THEN 419 K = J 420 END IF 421 IF( J.LT.K ) THEN 422 J = J + 1 423 GO TO 100 424 END IF 425 ELSE 426 K = 0 427 END IF 428* 429* Check error code from SSYSV_AA . 430* 431 IF( INFO.NE.K ) THEN 432 CALL ALAERH( PATH, 'SSYSV_AA', INFO, K, 433 $ UPLO, N, N, -1, -1, NRHS, 434 $ IMAT, NFAIL, NERRS, NOUT ) 435 GO TO 120 436 ELSE IF( INFO.NE.0 ) THEN 437 GO TO 120 438 END IF 439* 440* Compute residual of the computed solution. 441* 442 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 443 CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 444 $ LDA, RWORK, RESULT( 1 ) ) 445* 446* Reconstruct matrix from factors and compute 447* residual. 448* 449c CALL SSY01_AA( UPLO, N, A, LDA, AFAC, LDA, 450c $ IWORK, AINV, LDA, RWORK, 451c $ RESULT( 2 ) ) 452c NT = 2 453 NT = 1 454* 455* Print information about the tests that did not pass 456* the threshold. 457* 458 DO 110 K = 1, NT 459 IF( RESULT( K ).GE.THRESH ) THEN 460 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 461 $ CALL ALADHD( NOUT, PATH ) 462 WRITE( NOUT, FMT = 9999 )'SSYSV_AA ', 463 $ UPLO, N, IMAT, K, RESULT( K ) 464 NFAIL = NFAIL + 1 465 END IF 466 110 CONTINUE 467 NRUN = NRUN + NT 468 120 CONTINUE 469 END IF 470* 471 150 CONTINUE 472* 473 160 CONTINUE 474 170 CONTINUE 475 180 CONTINUE 476* 477* Print a summary of the results. 478* 479 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 480* 481 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2, 482 $ ', test ', I2, ', ratio =', G12.5 ) 483 RETURN 484* 485* End of SDRVSY_AA_2STAGE 486* 487 END 488