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