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