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