![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SDRVSYX 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE SDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 00012 * A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, 00013 * NOUT ) 00014 * 00015 * .. Scalar Arguments .. 00016 * LOGICAL TSTERR 00017 * INTEGER NMAX, NN, NOUT, NRHS 00018 * REAL THRESH 00019 * .. 00020 * .. Array Arguments .. 00021 * LOGICAL DOTYPE( * ) 00022 * INTEGER IWORK( * ), NVAL( * ) 00023 * REAL A( * ), AFAC( * ), AINV( * ), B( * ), 00024 * $ RWORK( * ), WORK( * ), X( * ), XACT( * ) 00025 * .. 00026 * 00027 * 00028 *> \par Purpose: 00029 * ============= 00030 *> 00031 *> \verbatim 00032 *> 00033 *> SDRVSY tests the driver routines SSYSV, -SVX, and -SVXX 00034 *> 00035 *> Note that this file is used only when the XBLAS are available, 00036 *> otherwise sdrvsy.f defines this subroutine. 00037 *> \endverbatim 00038 * 00039 * Arguments: 00040 * ========== 00041 * 00042 *> \param[in] DOTYPE 00043 *> \verbatim 00044 *> DOTYPE is LOGICAL array, dimension (NTYPES) 00045 *> The matrix types to be used for testing. Matrices of type j 00046 *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 00047 *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 00048 *> \endverbatim 00049 *> 00050 *> \param[in] NN 00051 *> \verbatim 00052 *> NN is INTEGER 00053 *> The number of values of N contained in the vector NVAL. 00054 *> \endverbatim 00055 *> 00056 *> \param[in] NVAL 00057 *> \verbatim 00058 *> NVAL is INTEGER array, dimension (NN) 00059 *> The values of the matrix dimension N. 00060 *> \endverbatim 00061 *> 00062 *> \param[in] NRHS 00063 *> \verbatim 00064 *> NRHS is INTEGER 00065 *> The number of right hand side vectors to be generated for 00066 *> each linear system. 00067 *> \endverbatim 00068 *> 00069 *> \param[in] THRESH 00070 *> \verbatim 00071 *> THRESH is REAL 00072 *> The threshold value for the test ratios. A result is 00073 *> included in the output file if RESULT >= THRESH. To have 00074 *> every test ratio printed, use THRESH = 0. 00075 *> \endverbatim 00076 *> 00077 *> \param[in] TSTERR 00078 *> \verbatim 00079 *> TSTERR is LOGICAL 00080 *> Flag that indicates whether error exits are to be tested. 00081 *> \endverbatim 00082 *> 00083 *> \param[in] NMAX 00084 *> \verbatim 00085 *> NMAX is INTEGER 00086 *> The maximum value permitted for N, used in dimensioning the 00087 *> work arrays. 00088 *> \endverbatim 00089 *> 00090 *> \param[out] A 00091 *> \verbatim 00092 *> A is REAL array, dimension (NMAX*NMAX) 00093 *> \endverbatim 00094 *> 00095 *> \param[out] AFAC 00096 *> \verbatim 00097 *> AFAC is REAL array, dimension (NMAX*NMAX) 00098 *> \endverbatim 00099 *> 00100 *> \param[out] AINV 00101 *> \verbatim 00102 *> AINV is REAL array, dimension (NMAX*NMAX) 00103 *> \endverbatim 00104 *> 00105 *> \param[out] B 00106 *> \verbatim 00107 *> B is REAL array, dimension (NMAX*NRHS) 00108 *> \endverbatim 00109 *> 00110 *> \param[out] X 00111 *> \verbatim 00112 *> X is REAL array, dimension (NMAX*NRHS) 00113 *> \endverbatim 00114 *> 00115 *> \param[out] XACT 00116 *> \verbatim 00117 *> XACT is REAL array, dimension (NMAX*NRHS) 00118 *> \endverbatim 00119 *> 00120 *> \param[out] WORK 00121 *> \verbatim 00122 *> WORK is REAL array, dimension 00123 *> (NMAX*max(2,NRHS)) 00124 *> \endverbatim 00125 *> 00126 *> \param[out] RWORK 00127 *> \verbatim 00128 *> RWORK is REAL array, dimension (NMAX+2*NRHS) 00129 *> \endverbatim 00130 *> 00131 *> \param[out] IWORK 00132 *> \verbatim 00133 *> IWORK is INTEGER array, dimension (2*NMAX) 00134 *> \endverbatim 00135 *> 00136 *> \param[in] NOUT 00137 *> \verbatim 00138 *> NOUT is INTEGER 00139 *> The unit number for output. 00140 *> \endverbatim 00141 * 00142 * Authors: 00143 * ======== 00144 * 00145 *> \author Univ. of Tennessee 00146 *> \author Univ. of California Berkeley 00147 *> \author Univ. of Colorado Denver 00148 *> \author NAG Ltd. 00149 * 00150 *> \date November 2011 00151 * 00152 *> \ingroup single_lin 00153 * 00154 * ===================================================================== 00155 SUBROUTINE SDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 00156 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, 00157 $ NOUT ) 00158 * 00159 * -- LAPACK test routine (version 3.4.0) -- 00160 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00161 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00162 * November 2011 00163 * 00164 * .. Scalar Arguments .. 00165 LOGICAL TSTERR 00166 INTEGER NMAX, NN, NOUT, NRHS 00167 REAL THRESH 00168 * .. 00169 * .. Array Arguments .. 00170 LOGICAL DOTYPE( * ) 00171 INTEGER IWORK( * ), NVAL( * ) 00172 REAL A( * ), AFAC( * ), AINV( * ), B( * ), 00173 $ RWORK( * ), WORK( * ), X( * ), XACT( * ) 00174 * .. 00175 * 00176 * ===================================================================== 00177 * 00178 * .. Parameters .. 00179 REAL ONE, ZERO 00180 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00181 INTEGER NTYPES, NTESTS 00182 PARAMETER ( NTYPES = 10, NTESTS = 6 ) 00183 INTEGER NFACT 00184 PARAMETER ( NFACT = 2 ) 00185 * .. 00186 * .. Local Scalars .. 00187 LOGICAL ZEROT 00188 CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE 00189 CHARACTER*3 PATH 00190 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO, 00191 $ IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N, 00192 $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT, 00193 $ N_ERR_BNDS 00194 REAL AINVNM, ANORM, CNDNUM, RCOND, RCONDC, 00195 $ RPVGRW_SVXX 00196 * .. 00197 * .. Local Arrays .. 00198 CHARACTER FACTS( NFACT ), UPLOS( 2 ) 00199 INTEGER ISEED( 4 ), ISEEDY( 4 ) 00200 REAL RESULT( NTESTS ), BERR( NRHS ), 00201 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 ) 00202 * .. 00203 * .. External Functions .. 00204 REAL SGET06, SLANSY 00205 EXTERNAL SGET06, SLANSY 00206 * .. 00207 * .. External Subroutines .. 00208 EXTERNAL ALADHD, ALAERH, ALASVM, SERRVX, SGET04, SLACPY, 00209 $ SLARHS, SLASET, SLATB4, SLATMS, SPOT02, SPOT05, 00210 $ SSYSV, SSYSVX, SSYT01, SSYTRF, SSYTRI2, XLAENV, 00211 $ SSYSVXX 00212 * .. 00213 * .. Scalars in Common .. 00214 LOGICAL LERR, OK 00215 CHARACTER*32 SRNAMT 00216 INTEGER INFOT, NUNIT 00217 * .. 00218 * .. Common blocks .. 00219 COMMON / INFOC / INFOT, NUNIT, OK, LERR 00220 COMMON / SRNAMC / SRNAMT 00221 * .. 00222 * .. Intrinsic Functions .. 00223 INTRINSIC MAX, MIN 00224 * .. 00225 * .. Data statements .. 00226 DATA ISEEDY / 1988, 1989, 1990, 1991 / 00227 DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' / 00228 * .. 00229 * .. Executable Statements .. 00230 * 00231 * Initialize constants and the random number seed. 00232 * 00233 PATH( 1: 1 ) = 'Single precision' 00234 PATH( 2: 3 ) = 'SY' 00235 NRUN = 0 00236 NFAIL = 0 00237 NERRS = 0 00238 DO 10 I = 1, 4 00239 ISEED( I ) = ISEEDY( I ) 00240 10 CONTINUE 00241 LWORK = MAX( 2*NMAX, NMAX*NRHS ) 00242 * 00243 * Test the error exits 00244 * 00245 IF( TSTERR ) 00246 $ CALL SERRVX( PATH, NOUT ) 00247 INFOT = 0 00248 * 00249 * Set the block size and minimum block size for testing. 00250 * 00251 NB = 1 00252 NBMIN = 2 00253 CALL XLAENV( 1, NB ) 00254 CALL XLAENV( 2, NBMIN ) 00255 * 00256 * Do for each value of N in NVAL 00257 * 00258 DO 180 IN = 1, NN 00259 N = NVAL( IN ) 00260 LDA = MAX( N, 1 ) 00261 XTYPE = 'N' 00262 NIMAT = NTYPES 00263 IF( N.LE.0 ) 00264 $ NIMAT = 1 00265 * 00266 DO 170 IMAT = 1, NIMAT 00267 * 00268 * Do the tests only if DOTYPE( IMAT ) is true. 00269 * 00270 IF( .NOT.DOTYPE( IMAT ) ) 00271 $ GO TO 170 00272 * 00273 * Skip types 3, 4, 5, or 6 if the matrix size is too small. 00274 * 00275 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6 00276 IF( ZEROT .AND. N.LT.IMAT-2 ) 00277 $ GO TO 170 00278 * 00279 * Do first for UPLO = 'U', then for UPLO = 'L' 00280 * 00281 DO 160 IUPLO = 1, 2 00282 UPLO = UPLOS( IUPLO ) 00283 * 00284 * Set up parameters with SLATB4 and generate a test matrix 00285 * with SLATMS. 00286 * 00287 CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 00288 $ CNDNUM, DIST ) 00289 * 00290 SRNAMT = 'SLATMS' 00291 CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 00292 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, 00293 $ INFO ) 00294 * 00295 * Check error code from SLATMS. 00296 * 00297 IF( INFO.NE.0 ) THEN 00298 CALL ALAERH( PATH, 'SLATMS', INFO, 0, UPLO, N, N, -1, 00299 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 00300 GO TO 160 00301 END IF 00302 * 00303 * For types 3-6, zero one or more rows and columns of the 00304 * matrix to test that INFO is returned correctly. 00305 * 00306 IF( ZEROT ) THEN 00307 IF( IMAT.EQ.3 ) THEN 00308 IZERO = 1 00309 ELSE IF( IMAT.EQ.4 ) THEN 00310 IZERO = N 00311 ELSE 00312 IZERO = N / 2 + 1 00313 END IF 00314 * 00315 IF( IMAT.LT.6 ) THEN 00316 * 00317 * Set row and column IZERO to zero. 00318 * 00319 IF( IUPLO.EQ.1 ) THEN 00320 IOFF = ( IZERO-1 )*LDA 00321 DO 20 I = 1, IZERO - 1 00322 A( IOFF+I ) = ZERO 00323 20 CONTINUE 00324 IOFF = IOFF + IZERO 00325 DO 30 I = IZERO, N 00326 A( IOFF ) = ZERO 00327 IOFF = IOFF + LDA 00328 30 CONTINUE 00329 ELSE 00330 IOFF = IZERO 00331 DO 40 I = 1, IZERO - 1 00332 A( IOFF ) = ZERO 00333 IOFF = IOFF + LDA 00334 40 CONTINUE 00335 IOFF = IOFF - IZERO 00336 DO 50 I = IZERO, N 00337 A( IOFF+I ) = ZERO 00338 50 CONTINUE 00339 END IF 00340 ELSE 00341 IOFF = 0 00342 IF( IUPLO.EQ.1 ) THEN 00343 * 00344 * Set the first IZERO rows and columns to zero. 00345 * 00346 DO 70 J = 1, N 00347 I2 = MIN( J, IZERO ) 00348 DO 60 I = 1, I2 00349 A( IOFF+I ) = ZERO 00350 60 CONTINUE 00351 IOFF = IOFF + LDA 00352 70 CONTINUE 00353 ELSE 00354 * 00355 * Set the last IZERO rows and columns to zero. 00356 * 00357 DO 90 J = 1, N 00358 I1 = MAX( J, IZERO ) 00359 DO 80 I = I1, N 00360 A( IOFF+I ) = ZERO 00361 80 CONTINUE 00362 IOFF = IOFF + LDA 00363 90 CONTINUE 00364 END IF 00365 END IF 00366 ELSE 00367 IZERO = 0 00368 END IF 00369 * 00370 DO 150 IFACT = 1, NFACT 00371 * 00372 * Do first for FACT = 'F', then for other values. 00373 * 00374 FACT = FACTS( IFACT ) 00375 * 00376 * Compute the condition number for comparison with 00377 * the value returned by SSYSVX. 00378 * 00379 IF( ZEROT ) THEN 00380 IF( IFACT.EQ.1 ) 00381 $ GO TO 150 00382 RCONDC = ZERO 00383 * 00384 ELSE IF( IFACT.EQ.1 ) THEN 00385 * 00386 * Compute the 1-norm of A. 00387 * 00388 ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK ) 00389 * 00390 * Factor the matrix A. 00391 * 00392 CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 00393 CALL SSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK, 00394 $ LWORK, INFO ) 00395 * 00396 * Compute inv(A) and take its norm. 00397 * 00398 CALL SLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) 00399 LWORK = (N+NB+1)*(NB+3) 00400 CALL SSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK, 00401 $ LWORK, INFO ) 00402 AINVNM = SLANSY( '1', UPLO, N, AINV, LDA, RWORK ) 00403 * 00404 * Compute the 1-norm condition number of A. 00405 * 00406 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 00407 RCONDC = ONE 00408 ELSE 00409 RCONDC = ( ONE / ANORM ) / AINVNM 00410 END IF 00411 END IF 00412 * 00413 * Form an exact solution and set the right hand side. 00414 * 00415 SRNAMT = 'SLARHS' 00416 CALL SLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 00417 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED, 00418 $ INFO ) 00419 XTYPE = 'C' 00420 * 00421 * --- Test SSYSV --- 00422 * 00423 IF( IFACT.EQ.2 ) THEN 00424 CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 00425 CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 00426 * 00427 * Factor the matrix and solve the system using SSYSV. 00428 * 00429 SRNAMT = 'SSYSV ' 00430 CALL SSYSV( UPLO, N, NRHS, AFAC, LDA, IWORK, X, 00431 $ LDA, WORK, LWORK, INFO ) 00432 * 00433 * Adjust the expected value of INFO to account for 00434 * pivoting. 00435 * 00436 K = IZERO 00437 IF( K.GT.0 ) THEN 00438 100 CONTINUE 00439 IF( IWORK( K ).LT.0 ) THEN 00440 IF( IWORK( K ).NE.-K ) THEN 00441 K = -IWORK( K ) 00442 GO TO 100 00443 END IF 00444 ELSE IF( IWORK( K ).NE.K ) THEN 00445 K = IWORK( K ) 00446 GO TO 100 00447 END IF 00448 END IF 00449 * 00450 * Check error code from SSYSV . 00451 * 00452 IF( INFO.NE.K ) THEN 00453 CALL ALAERH( PATH, 'SSYSV ', INFO, K, UPLO, N, 00454 $ N, -1, -1, NRHS, IMAT, NFAIL, 00455 $ NERRS, NOUT ) 00456 GO TO 120 00457 ELSE IF( INFO.NE.0 ) THEN 00458 GO TO 120 00459 END IF 00460 * 00461 * Reconstruct matrix from factors and compute 00462 * residual. 00463 * 00464 CALL SSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK, 00465 $ AINV, LDA, RWORK, RESULT( 1 ) ) 00466 * 00467 * Compute residual of the computed solution. 00468 * 00469 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 00470 CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 00471 $ LDA, RWORK, RESULT( 2 ) ) 00472 * 00473 * Check solution from generated exact solution. 00474 * 00475 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 00476 $ RESULT( 3 ) ) 00477 NT = 3 00478 * 00479 * Print information about the tests that did not pass 00480 * the threshold. 00481 * 00482 DO 110 K = 1, NT 00483 IF( RESULT( K ).GE.THRESH ) THEN 00484 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00485 $ CALL ALADHD( NOUT, PATH ) 00486 WRITE( NOUT, FMT = 9999 )'SSYSV ', UPLO, N, 00487 $ IMAT, K, RESULT( K ) 00488 NFAIL = NFAIL + 1 00489 END IF 00490 110 CONTINUE 00491 NRUN = NRUN + NT 00492 120 CONTINUE 00493 END IF 00494 * 00495 * --- Test SSYSVX --- 00496 * 00497 IF( IFACT.EQ.2 ) 00498 $ CALL SLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA ) 00499 CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA ) 00500 * 00501 * Solve the system and compute the condition number and 00502 * error bounds using SSYSVX. 00503 * 00504 SRNAMT = 'SSYSVX' 00505 CALL SSYSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA, 00506 $ IWORK, B, LDA, X, LDA, RCOND, RWORK, 00507 $ RWORK( NRHS+1 ), WORK, LWORK, 00508 $ IWORK( N+1 ), INFO ) 00509 * 00510 * Adjust the expected value of INFO to account for 00511 * pivoting. 00512 * 00513 K = IZERO 00514 IF( K.GT.0 ) THEN 00515 130 CONTINUE 00516 IF( IWORK( K ).LT.0 ) THEN 00517 IF( IWORK( K ).NE.-K ) THEN 00518 K = -IWORK( K ) 00519 GO TO 130 00520 END IF 00521 ELSE IF( IWORK( K ).NE.K ) THEN 00522 K = IWORK( K ) 00523 GO TO 130 00524 END IF 00525 END IF 00526 * 00527 * Check the error code from SSYSVX. 00528 * 00529 IF( INFO.NE.K ) THEN 00530 CALL ALAERH( PATH, 'SSYSVX', INFO, K, FACT // UPLO, 00531 $ N, N, -1, -1, NRHS, IMAT, NFAIL, 00532 $ NERRS, NOUT ) 00533 GO TO 150 00534 END IF 00535 * 00536 IF( INFO.EQ.0 ) THEN 00537 IF( IFACT.GE.2 ) THEN 00538 * 00539 * Reconstruct matrix from factors and compute 00540 * residual. 00541 * 00542 CALL SSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK, 00543 $ AINV, LDA, RWORK( 2*NRHS+1 ), 00544 $ RESULT( 1 ) ) 00545 K1 = 1 00546 ELSE 00547 K1 = 2 00548 END IF 00549 * 00550 * Compute residual of the computed solution. 00551 * 00552 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 00553 CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 00554 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) ) 00555 * 00556 * Check solution from generated exact solution. 00557 * 00558 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 00559 $ RESULT( 3 ) ) 00560 * 00561 * Check the error bounds from iterative refinement. 00562 * 00563 CALL SPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA, 00564 $ XACT, LDA, RWORK, RWORK( NRHS+1 ), 00565 $ RESULT( 4 ) ) 00566 ELSE 00567 K1 = 6 00568 END IF 00569 * 00570 * Compare RCOND from SSYSVX with the computed value 00571 * in RCONDC. 00572 * 00573 RESULT( 6 ) = SGET06( RCOND, RCONDC ) 00574 * 00575 * Print information about the tests that did not pass 00576 * the threshold. 00577 * 00578 DO 140 K = K1, 6 00579 IF( RESULT( K ).GE.THRESH ) THEN 00580 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00581 $ CALL ALADHD( NOUT, PATH ) 00582 WRITE( NOUT, FMT = 9998 )'SSYSVX', FACT, UPLO, 00583 $ N, IMAT, K, RESULT( K ) 00584 NFAIL = NFAIL + 1 00585 END IF 00586 140 CONTINUE 00587 NRUN = NRUN + 7 - K1 00588 * 00589 * --- Test SSYSVXX --- 00590 * 00591 * Restore the matrices A and B. 00592 * 00593 IF( IFACT.EQ.2 ) 00594 $ CALL SLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA ) 00595 CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA ) 00596 * 00597 * Solve the system and compute the condition number 00598 * and error bounds using SSYSVXX. 00599 * 00600 SRNAMT = 'SSYSVXX' 00601 N_ERR_BNDS = 3 00602 EQUED = 'N' 00603 CALL SSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC, 00604 $ LDA, IWORK, EQUED, WORK( N+1 ), B, LDA, X, 00605 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS, 00606 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK, 00607 $ IWORK( N+1 ), INFO ) 00608 * 00609 * Adjust the expected value of INFO to account for 00610 * pivoting. 00611 * 00612 K = IZERO 00613 IF( K.GT.0 ) THEN 00614 135 CONTINUE 00615 IF( IWORK( K ).LT.0 ) THEN 00616 IF( IWORK( K ).NE.-K ) THEN 00617 K = -IWORK( K ) 00618 GO TO 135 00619 END IF 00620 ELSE IF( IWORK( K ).NE.K ) THEN 00621 K = IWORK( K ) 00622 GO TO 135 00623 END IF 00624 END IF 00625 * 00626 * Check the error code from SSYSVXX. 00627 * 00628 IF( INFO.NE.K .AND. INFO.LE.N ) THEN 00629 CALL ALAERH( PATH, 'SSYSVXX', INFO, K, 00630 $ FACT // UPLO, N, N, -1, -1, NRHS, IMAT, NFAIL, 00631 $ NERRS, NOUT ) 00632 GO TO 150 00633 END IF 00634 * 00635 IF( INFO.EQ.0 ) THEN 00636 IF( IFACT.GE.2 ) THEN 00637 * 00638 * Reconstruct matrix from factors and compute 00639 * residual. 00640 * 00641 CALL SSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK, 00642 $ AINV, LDA, RWORK(2*NRHS+1), 00643 $ RESULT( 1 ) ) 00644 K1 = 1 00645 ELSE 00646 K1 = 2 00647 END IF 00648 * 00649 * Compute residual of the computed solution. 00650 * 00651 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 00652 CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 00653 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) ) 00654 * 00655 * Check solution from generated exact solution. 00656 * 00657 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 00658 $ RESULT( 3 ) ) 00659 * 00660 * Check the error bounds from iterative refinement. 00661 * 00662 CALL SPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA, 00663 $ XACT, LDA, RWORK, RWORK( NRHS+1 ), 00664 $ RESULT( 4 ) ) 00665 ELSE 00666 K1 = 6 00667 END IF 00668 * 00669 * Compare RCOND from SSYSVXX with the computed value 00670 * in RCONDC. 00671 * 00672 RESULT( 6 ) = SGET06( RCOND, RCONDC ) 00673 * 00674 * Print information about the tests that did not pass 00675 * the threshold. 00676 * 00677 DO 85 K = K1, 6 00678 IF( RESULT( K ).GE.THRESH ) THEN 00679 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00680 $ CALL ALADHD( NOUT, PATH ) 00681 WRITE( NOUT, FMT = 9998 )'SSYSVXX', 00682 $ FACT, UPLO, N, IMAT, K, 00683 $ RESULT( K ) 00684 NFAIL = NFAIL + 1 00685 END IF 00686 85 CONTINUE 00687 NRUN = NRUN + 7 - K1 00688 * 00689 150 CONTINUE 00690 * 00691 160 CONTINUE 00692 170 CONTINUE 00693 180 CONTINUE 00694 * 00695 * Print a summary of the results. 00696 * 00697 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 00698 * 00699 00700 * Test Error Bounds from SSYSVXX 00701 00702 CALL SEBCHVXX(THRESH, PATH) 00703 00704 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2, 00705 $ ', test ', I2, ', ratio =', G12.5 ) 00706 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5, 00707 $ ', type ', I2, ', test ', I2, ', ratio =', G12.5 ) 00708 RETURN 00709 * 00710 * End of SDRVSY 00711 * 00712 END