![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZCHKST 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 ZCHKST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 00012 * NOUNIT, A, LDA, AP, SD, SE, D1, D2, D3, D4, D5, 00013 * WA1, WA2, WA3, WR, U, LDU, V, VP, TAU, Z, WORK, 00014 * LWORK, RWORK, LRWORK, IWORK, LIWORK, RESULT, 00015 * INFO ) 00016 * 00017 * .. Scalar Arguments .. 00018 * INTEGER INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT, 00019 * $ NSIZES, NTYPES 00020 * DOUBLE PRECISION THRESH 00021 * .. 00022 * .. Array Arguments .. 00023 * LOGICAL DOTYPE( * ) 00024 * INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 00025 * DOUBLE PRECISION D1( * ), D2( * ), D3( * ), D4( * ), D5( * ), 00026 * $ RESULT( * ), RWORK( * ), SD( * ), SE( * ), 00027 * $ WA1( * ), WA2( * ), WA3( * ), WR( * ) 00028 * COMPLEX*16 A( LDA, * ), AP( * ), TAU( * ), U( LDU, * ), 00029 * $ V( LDU, * ), VP( * ), WORK( * ), Z( LDU, * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> ZCHKST checks the Hermitian eigenvalue problem routines. 00039 *> 00040 *> ZHETRD factors A as U S U* , where * means conjugate transpose, 00041 *> S is real symmetric tridiagonal, and U is unitary. 00042 *> ZHETRD can use either just the lower or just the upper triangle 00043 *> of A; ZCHKST checks both cases. 00044 *> U is represented as a product of Householder 00045 *> transformations, whose vectors are stored in the first 00046 *> n-1 columns of V, and whose scale factors are in TAU. 00047 *> 00048 *> ZHPTRD does the same as ZHETRD, except that A and V are stored 00049 *> in "packed" format. 00050 *> 00051 *> ZUNGTR constructs the matrix U from the contents of V and TAU. 00052 *> 00053 *> ZUPGTR constructs the matrix U from the contents of VP and TAU. 00054 *> 00055 *> ZSTEQR factors S as Z D1 Z* , where Z is the unitary 00056 *> matrix of eigenvectors and D1 is a diagonal matrix with 00057 *> the eigenvalues on the diagonal. D2 is the matrix of 00058 *> eigenvalues computed when Z is not computed. 00059 *> 00060 *> DSTERF computes D3, the matrix of eigenvalues, by the 00061 *> PWK method, which does not yield eigenvectors. 00062 *> 00063 *> ZPTEQR factors S as Z4 D4 Z4* , for a 00064 *> Hermitian positive definite tridiagonal matrix. 00065 *> D5 is the matrix of eigenvalues computed when Z is not 00066 *> computed. 00067 *> 00068 *> DSTEBZ computes selected eigenvalues. WA1, WA2, and 00069 *> WA3 will denote eigenvalues computed to high 00070 *> absolute accuracy, with different range options. 00071 *> WR will denote eigenvalues computed to high relative 00072 *> accuracy. 00073 *> 00074 *> ZSTEIN computes Y, the eigenvectors of S, given the 00075 *> eigenvalues. 00076 *> 00077 *> ZSTEDC factors S as Z D1 Z* , where Z is the unitary 00078 *> matrix of eigenvectors and D1 is a diagonal matrix with 00079 *> the eigenvalues on the diagonal ('I' option). It may also 00080 *> update an input unitary matrix, usually the output 00081 *> from ZHETRD/ZUNGTR or ZHPTRD/ZUPGTR ('V' option). It may 00082 *> also just compute eigenvalues ('N' option). 00083 *> 00084 *> ZSTEMR factors S as Z D1 Z* , where Z is the unitary 00085 *> matrix of eigenvectors and D1 is a diagonal matrix with 00086 *> the eigenvalues on the diagonal ('I' option). ZSTEMR 00087 *> uses the Relatively Robust Representation whenever possible. 00088 *> 00089 *> When ZCHKST is called, a number of matrix "sizes" ("n's") and a 00090 *> number of matrix "types" are specified. For each size ("n") 00091 *> and each type of matrix, one matrix will be generated and used 00092 *> to test the Hermitian eigenroutines. For each matrix, a number 00093 *> of tests will be performed: 00094 *> 00095 *> (1) | A - V S V* | / ( |A| n ulp ) ZHETRD( UPLO='U', ... ) 00096 *> 00097 *> (2) | I - UV* | / ( n ulp ) ZUNGTR( UPLO='U', ... ) 00098 *> 00099 *> (3) | A - V S V* | / ( |A| n ulp ) ZHETRD( UPLO='L', ... ) 00100 *> 00101 *> (4) | I - UV* | / ( n ulp ) ZUNGTR( UPLO='L', ... ) 00102 *> 00103 *> (5-8) Same as 1-4, but for ZHPTRD and ZUPGTR. 00104 *> 00105 *> (9) | S - Z D Z* | / ( |S| n ulp ) ZSTEQR('V',...) 00106 *> 00107 *> (10) | I - ZZ* | / ( n ulp ) ZSTEQR('V',...) 00108 *> 00109 *> (11) | D1 - D2 | / ( |D1| ulp ) ZSTEQR('N',...) 00110 *> 00111 *> (12) | D1 - D3 | / ( |D1| ulp ) DSTERF 00112 *> 00113 *> (13) 0 if the true eigenvalues (computed by sturm count) 00114 *> of S are within THRESH of 00115 *> those in D1. 2*THRESH if they are not. (Tested using 00116 *> DSTECH) 00117 *> 00118 *> For S positive definite, 00119 *> 00120 *> (14) | S - Z4 D4 Z4* | / ( |S| n ulp ) ZPTEQR('V',...) 00121 *> 00122 *> (15) | I - Z4 Z4* | / ( n ulp ) ZPTEQR('V',...) 00123 *> 00124 *> (16) | D4 - D5 | / ( 100 |D4| ulp ) ZPTEQR('N',...) 00125 *> 00126 *> When S is also diagonally dominant by the factor gamma < 1, 00127 *> 00128 *> (17) max | D4(i) - WR(i) | / ( |D4(i)| omega ) , 00129 *> i 00130 *> omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4 00131 *> DSTEBZ( 'A', 'E', ...) 00132 *> 00133 *> (18) | WA1 - D3 | / ( |D3| ulp ) DSTEBZ( 'A', 'E', ...) 00134 *> 00135 *> (19) ( max { min | WA2(i)-WA3(j) | } + 00136 *> i j 00137 *> max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp ) 00138 *> i j 00139 *> DSTEBZ( 'I', 'E', ...) 00140 *> 00141 *> (20) | S - Y WA1 Y* | / ( |S| n ulp ) DSTEBZ, ZSTEIN 00142 *> 00143 *> (21) | I - Y Y* | / ( n ulp ) DSTEBZ, ZSTEIN 00144 *> 00145 *> (22) | S - Z D Z* | / ( |S| n ulp ) ZSTEDC('I') 00146 *> 00147 *> (23) | I - ZZ* | / ( n ulp ) ZSTEDC('I') 00148 *> 00149 *> (24) | S - Z D Z* | / ( |S| n ulp ) ZSTEDC('V') 00150 *> 00151 *> (25) | I - ZZ* | / ( n ulp ) ZSTEDC('V') 00152 *> 00153 *> (26) | D1 - D2 | / ( |D1| ulp ) ZSTEDC('V') and 00154 *> ZSTEDC('N') 00155 *> 00156 *> Test 27 is disabled at the moment because ZSTEMR does not 00157 *> guarantee high relatvie accuracy. 00158 *> 00159 *> (27) max | D6(i) - WR(i) | / ( |D6(i)| omega ) , 00160 *> i 00161 *> omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4 00162 *> ZSTEMR('V', 'A') 00163 *> 00164 *> (28) max | D6(i) - WR(i) | / ( |D6(i)| omega ) , 00165 *> i 00166 *> omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4 00167 *> ZSTEMR('V', 'I') 00168 *> 00169 *> Tests 29 through 34 are disable at present because ZSTEMR 00170 *> does not handle partial specturm requests. 00171 *> 00172 *> (29) | S - Z D Z* | / ( |S| n ulp ) ZSTEMR('V', 'I') 00173 *> 00174 *> (30) | I - ZZ* | / ( n ulp ) ZSTEMR('V', 'I') 00175 *> 00176 *> (31) ( max { min | WA2(i)-WA3(j) | } + 00177 *> i j 00178 *> max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp ) 00179 *> i j 00180 *> ZSTEMR('N', 'I') vs. CSTEMR('V', 'I') 00181 *> 00182 *> (32) | S - Z D Z* | / ( |S| n ulp ) ZSTEMR('V', 'V') 00183 *> 00184 *> (33) | I - ZZ* | / ( n ulp ) ZSTEMR('V', 'V') 00185 *> 00186 *> (34) ( max { min | WA2(i)-WA3(j) | } + 00187 *> i j 00188 *> max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp ) 00189 *> i j 00190 *> ZSTEMR('N', 'V') vs. CSTEMR('V', 'V') 00191 *> 00192 *> (35) | S - Z D Z* | / ( |S| n ulp ) ZSTEMR('V', 'A') 00193 *> 00194 *> (36) | I - ZZ* | / ( n ulp ) ZSTEMR('V', 'A') 00195 *> 00196 *> (37) ( max { min | WA2(i)-WA3(j) | } + 00197 *> i j 00198 *> max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp ) 00199 *> i j 00200 *> ZSTEMR('N', 'A') vs. CSTEMR('V', 'A') 00201 *> 00202 *> The "sizes" are specified by an array NN(1:NSIZES); the value of 00203 *> each element NN(j) specifies one size. 00204 *> The "types" are specified by a logical array DOTYPE( 1:NTYPES ); 00205 *> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated. 00206 *> Currently, the list of possible types is: 00207 *> 00208 *> (1) The zero matrix. 00209 *> (2) The identity matrix. 00210 *> 00211 *> (3) A diagonal matrix with evenly spaced entries 00212 *> 1, ..., ULP and random signs. 00213 *> (ULP = (first number larger than 1) - 1 ) 00214 *> (4) A diagonal matrix with geometrically spaced entries 00215 *> 1, ..., ULP and random signs. 00216 *> (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP 00217 *> and random signs. 00218 *> 00219 *> (6) Same as (4), but multiplied by SQRT( overflow threshold ) 00220 *> (7) Same as (4), but multiplied by SQRT( underflow threshold ) 00221 *> 00222 *> (8) A matrix of the form U* D U, where U is unitary and 00223 *> D has evenly spaced entries 1, ..., ULP with random signs 00224 *> on the diagonal. 00225 *> 00226 *> (9) A matrix of the form U* D U, where U is unitary and 00227 *> D has geometrically spaced entries 1, ..., ULP with random 00228 *> signs on the diagonal. 00229 *> 00230 *> (10) A matrix of the form U* D U, where U is unitary and 00231 *> D has "clustered" entries 1, ULP,..., ULP with random 00232 *> signs on the diagonal. 00233 *> 00234 *> (11) Same as (8), but multiplied by SQRT( overflow threshold ) 00235 *> (12) Same as (8), but multiplied by SQRT( underflow threshold ) 00236 *> 00237 *> (13) Hermitian matrix with random entries chosen from (-1,1). 00238 *> (14) Same as (13), but multiplied by SQRT( overflow threshold ) 00239 *> (15) Same as (13), but multiplied by SQRT( underflow threshold ) 00240 *> (16) Same as (8), but diagonal elements are all positive. 00241 *> (17) Same as (9), but diagonal elements are all positive. 00242 *> (18) Same as (10), but diagonal elements are all positive. 00243 *> (19) Same as (16), but multiplied by SQRT( overflow threshold ) 00244 *> (20) Same as (16), but multiplied by SQRT( underflow threshold ) 00245 *> (21) A diagonally dominant tridiagonal matrix with geometrically 00246 *> spaced diagonal entries 1, ..., ULP. 00247 *> \endverbatim 00248 * 00249 * Arguments: 00250 * ========== 00251 * 00252 *> \param[in] NSIZES 00253 *> \verbatim 00254 *> NSIZES is INTEGER 00255 *> The number of sizes of matrices to use. If it is zero, 00256 *> ZCHKST does nothing. It must be at least zero. 00257 *> \endverbatim 00258 *> 00259 *> \param[in] NN 00260 *> \verbatim 00261 *> NN is INTEGER array, dimension (NSIZES) 00262 *> An array containing the sizes to be used for the matrices. 00263 *> Zero values will be skipped. The values must be at least 00264 *> zero. 00265 *> \endverbatim 00266 *> 00267 *> \param[in] NTYPES 00268 *> \verbatim 00269 *> NTYPES is INTEGER 00270 *> The number of elements in DOTYPE. If it is zero, ZCHKST 00271 *> does nothing. It must be at least zero. If it is MAXTYP+1 00272 *> and NSIZES is 1, then an additional type, MAXTYP+1 is 00273 *> defined, which is to use whatever matrix is in A. This 00274 *> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and 00275 *> DOTYPE(MAXTYP+1) is .TRUE. . 00276 *> \endverbatim 00277 *> 00278 *> \param[in] DOTYPE 00279 *> \verbatim 00280 *> DOTYPE is LOGICAL array, dimension (NTYPES) 00281 *> If DOTYPE(j) is .TRUE., then for each size in NN a 00282 *> matrix of that size and of type j will be generated. 00283 *> If NTYPES is smaller than the maximum number of types 00284 *> defined (PARAMETER MAXTYP), then types NTYPES+1 through 00285 *> MAXTYP will not be generated. If NTYPES is larger 00286 *> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) 00287 *> will be ignored. 00288 *> \endverbatim 00289 *> 00290 *> \param[in,out] ISEED 00291 *> \verbatim 00292 *> ISEED is INTEGER array, dimension (4) 00293 *> On entry ISEED specifies the seed of the random number 00294 *> generator. The array elements should be between 0 and 4095; 00295 *> if not they will be reduced mod 4096. Also, ISEED(4) must 00296 *> be odd. The random number generator uses a linear 00297 *> congruential sequence limited to small integers, and so 00298 *> should produce machine independent random numbers. The 00299 *> values of ISEED are changed on exit, and can be used in the 00300 *> next call to ZCHKST to continue the same random number 00301 *> sequence. 00302 *> \endverbatim 00303 *> 00304 *> \param[in] THRESH 00305 *> \verbatim 00306 *> THRESH is DOUBLE PRECISION 00307 *> A test will count as "failed" if the "error", computed as 00308 *> described above, exceeds THRESH. Note that the error 00309 *> is scaled to be O(1), so THRESH should be a reasonably 00310 *> small multiple of 1, e.g., 10 or 100. In particular, 00311 *> it should not depend on the precision (single vs. double) 00312 *> or the size of the matrix. It must be at least zero. 00313 *> \endverbatim 00314 *> 00315 *> \param[in] NOUNIT 00316 *> \verbatim 00317 *> NOUNIT is INTEGER 00318 *> The FORTRAN unit number for printing out error messages 00319 *> (e.g., if a routine returns IINFO not equal to 0.) 00320 *> \endverbatim 00321 *> 00322 *> \param[in,out] A 00323 *> \verbatim 00324 *> A is COMPLEX*16 array of 00325 *> dimension ( LDA , max(NN) ) 00326 *> Used to hold the matrix whose eigenvalues are to be 00327 *> computed. On exit, A contains the last matrix actually 00328 *> used. 00329 *> \endverbatim 00330 *> 00331 *> \param[in] LDA 00332 *> \verbatim 00333 *> LDA is INTEGER 00334 *> The leading dimension of A. It must be at 00335 *> least 1 and at least max( NN ). 00336 *> \endverbatim 00337 *> 00338 *> \param[out] AP 00339 *> \verbatim 00340 *> AP is COMPLEX*16 array of 00341 *> dimension( max(NN)*max(NN+1)/2 ) 00342 *> The matrix A stored in packed format. 00343 *> \endverbatim 00344 *> 00345 *> \param[out] SD 00346 *> \verbatim 00347 *> SD is DOUBLE PRECISION array of 00348 *> dimension( max(NN) ) 00349 *> The diagonal of the tridiagonal matrix computed by ZHETRD. 00350 *> On exit, SD and SE contain the tridiagonal form of the 00351 *> matrix in A. 00352 *> \endverbatim 00353 *> 00354 *> \param[out] SE 00355 *> \verbatim 00356 *> SE is DOUBLE PRECISION array of 00357 *> dimension( max(NN) ) 00358 *> The off-diagonal of the tridiagonal matrix computed by 00359 *> ZHETRD. On exit, SD and SE contain the tridiagonal form of 00360 *> the matrix in A. 00361 *> \endverbatim 00362 *> 00363 *> \param[out] D1 00364 *> \verbatim 00365 *> D1 is DOUBLE PRECISION array of 00366 *> dimension( max(NN) ) 00367 *> The eigenvalues of A, as computed by ZSTEQR simlutaneously 00368 *> with Z. On exit, the eigenvalues in D1 correspond with the 00369 *> matrix in A. 00370 *> \endverbatim 00371 *> 00372 *> \param[out] D2 00373 *> \verbatim 00374 *> D2 is DOUBLE PRECISION array of 00375 *> dimension( max(NN) ) 00376 *> The eigenvalues of A, as computed by ZSTEQR if Z is not 00377 *> computed. On exit, the eigenvalues in D2 correspond with 00378 *> the matrix in A. 00379 *> \endverbatim 00380 *> 00381 *> \param[out] D3 00382 *> \verbatim 00383 *> D3 is DOUBLE PRECISION array of 00384 *> dimension( max(NN) ) 00385 *> The eigenvalues of A, as computed by DSTERF. On exit, the 00386 *> eigenvalues in D3 correspond with the matrix in A. 00387 *> \endverbatim 00388 *> 00389 *> \param[out] D4 00390 *> \verbatim 00391 *> D4 is DOUBLE PRECISION array of 00392 *> dimension( max(NN) ) 00393 *> The eigenvalues of A, as computed by ZPTEQR(V). 00394 *> ZPTEQR factors S as Z4 D4 Z4* 00395 *> On exit, the eigenvalues in D4 correspond with the matrix in A. 00396 *> \endverbatim 00397 *> 00398 *> \param[out] D5 00399 *> \verbatim 00400 *> D5 is DOUBLE PRECISION array of 00401 *> dimension( max(NN) ) 00402 *> The eigenvalues of A, as computed by ZPTEQR(N) 00403 *> when Z is not computed. On exit, the 00404 *> eigenvalues in D4 correspond with the matrix in A. 00405 *> \endverbatim 00406 *> 00407 *> \param[out] WA1 00408 *> \verbatim 00409 *> WA1 is DOUBLE PRECISION array of 00410 *> dimension( max(NN) ) 00411 *> All eigenvalues of A, computed to high 00412 *> absolute accuracy, with different range options. 00413 *> as computed by DSTEBZ. 00414 *> \endverbatim 00415 *> 00416 *> \param[out] WA2 00417 *> \verbatim 00418 *> WA2 is DOUBLE PRECISION array of 00419 *> dimension( max(NN) ) 00420 *> Selected eigenvalues of A, computed to high 00421 *> absolute accuracy, with different range options. 00422 *> as computed by DSTEBZ. 00423 *> Choose random values for IL and IU, and ask for the 00424 *> IL-th through IU-th eigenvalues. 00425 *> \endverbatim 00426 *> 00427 *> \param[out] WA3 00428 *> \verbatim 00429 *> WA3 is DOUBLE PRECISION array of 00430 *> dimension( max(NN) ) 00431 *> Selected eigenvalues of A, computed to high 00432 *> absolute accuracy, with different range options. 00433 *> as computed by DSTEBZ. 00434 *> Determine the values VL and VU of the IL-th and IU-th 00435 *> eigenvalues and ask for all eigenvalues in this range. 00436 *> \endverbatim 00437 *> 00438 *> \param[out] WR 00439 *> \verbatim 00440 *> WR is DOUBLE PRECISION array of 00441 *> dimension( max(NN) ) 00442 *> All eigenvalues of A, computed to high 00443 *> absolute accuracy, with different options. 00444 *> as computed by DSTEBZ. 00445 *> \endverbatim 00446 *> 00447 *> \param[out] U 00448 *> \verbatim 00449 *> U is COMPLEX*16 array of 00450 *> dimension( LDU, max(NN) ). 00451 *> The unitary matrix computed by ZHETRD + ZUNGTR. 00452 *> \endverbatim 00453 *> 00454 *> \param[in] LDU 00455 *> \verbatim 00456 *> LDU is INTEGER 00457 *> The leading dimension of U, Z, and V. It must be at least 1 00458 *> and at least max( NN ). 00459 *> \endverbatim 00460 *> 00461 *> \param[out] V 00462 *> \verbatim 00463 *> V is COMPLEX*16 array of 00464 *> dimension( LDU, max(NN) ). 00465 *> The Housholder vectors computed by ZHETRD in reducing A to 00466 *> tridiagonal form. The vectors computed with UPLO='U' are 00467 *> in the upper triangle, and the vectors computed with UPLO='L' 00468 *> are in the lower triangle. (As described in ZHETRD, the 00469 *> sub- and superdiagonal are not set to 1, although the 00470 *> true Householder vector has a 1 in that position. The 00471 *> routines that use V, such as ZUNGTR, set those entries to 00472 *> 1 before using them, and then restore them later.) 00473 *> \endverbatim 00474 *> 00475 *> \param[out] VP 00476 *> \verbatim 00477 *> VP is COMPLEX*16 array of 00478 *> dimension( max(NN)*max(NN+1)/2 ) 00479 *> The matrix V stored in packed format. 00480 *> \endverbatim 00481 *> 00482 *> \param[out] TAU 00483 *> \verbatim 00484 *> TAU is COMPLEX*16 array of 00485 *> dimension( max(NN) ) 00486 *> The Householder factors computed by ZHETRD in reducing A 00487 *> to tridiagonal form. 00488 *> \endverbatim 00489 *> 00490 *> \param[out] Z 00491 *> \verbatim 00492 *> Z is COMPLEX*16 array of 00493 *> dimension( LDU, max(NN) ). 00494 *> The unitary matrix of eigenvectors computed by ZSTEQR, 00495 *> ZPTEQR, and ZSTEIN. 00496 *> \endverbatim 00497 *> 00498 *> \param[out] WORK 00499 *> \verbatim 00500 *> WORK is COMPLEX*16 array of 00501 *> dimension( LWORK ) 00502 *> \endverbatim 00503 *> 00504 *> \param[in] LWORK 00505 *> \verbatim 00506 *> LWORK is INTEGER 00507 *> The number of entries in WORK. This must be at least 00508 *> 1 + 4 * Nmax + 2 * Nmax * lg Nmax + 3 * Nmax**2 00509 *> where Nmax = max( NN(j), 2 ) and lg = log base 2. 00510 *> \endverbatim 00511 *> 00512 *> \param[out] IWORK 00513 *> \verbatim 00514 *> IWORK is INTEGER array, 00515 *> Workspace. 00516 *> \endverbatim 00517 *> 00518 *> \param[out] LIWORK 00519 *> \verbatim 00520 *> LIWORK is INTEGER 00521 *> The number of entries in IWORK. This must be at least 00522 *> 6 + 6*Nmax + 5 * Nmax * lg Nmax 00523 *> where Nmax = max( NN(j), 2 ) and lg = log base 2. 00524 *> \endverbatim 00525 *> 00526 *> \param[out] RWORK 00527 *> \verbatim 00528 *> RWORK is DOUBLE PRECISION array 00529 *> \endverbatim 00530 *> 00531 *> \param[in] LRWORK 00532 *> \verbatim 00533 *> LRWORK is INTEGER 00534 *> The number of entries in LRWORK (dimension( ??? ) 00535 *> \endverbatim 00536 *> 00537 *> \param[out] RESULT 00538 *> \verbatim 00539 *> RESULT is DOUBLE PRECISION array, dimension (26) 00540 *> The values computed by the tests described above. 00541 *> The values are currently limited to 1/ulp, to avoid 00542 *> overflow. 00543 *> \endverbatim 00544 *> 00545 *> \param[out] INFO 00546 *> \verbatim 00547 *> INFO is INTEGER 00548 *> If 0, then everything ran OK. 00549 *> -1: NSIZES < 0 00550 *> -2: Some NN(j) < 0 00551 *> -3: NTYPES < 0 00552 *> -5: THRESH < 0 00553 *> -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ). 00554 *> -23: LDU < 1 or LDU < NMAX. 00555 *> -29: LWORK too small. 00556 *> If ZLATMR, CLATMS, ZHETRD, ZUNGTR, ZSTEQR, DSTERF, 00557 *> or ZUNMC2 returns an error code, the 00558 *> absolute value of it is returned. 00559 *> 00560 *>----------------------------------------------------------------------- 00561 *> 00562 *> Some Local Variables and Parameters: 00563 *> ---- ----- --------- --- ---------- 00564 *> ZERO, ONE Real 0 and 1. 00565 *> MAXTYP The number of types defined. 00566 *> NTEST The number of tests performed, or which can 00567 *> be performed so far, for the current matrix. 00568 *> NTESTT The total number of tests performed so far. 00569 *> NBLOCK Blocksize as returned by ENVIR. 00570 *> NMAX Largest value in NN. 00571 *> NMATS The number of matrices generated so far. 00572 *> NERRS The number of tests which have exceeded THRESH 00573 *> so far. 00574 *> COND, IMODE Values to be passed to the matrix generators. 00575 *> ANORM Norm of A; passed to matrix generators. 00576 *> 00577 *> OVFL, UNFL Overflow and underflow thresholds. 00578 *> ULP, ULPINV Finest relative precision and its inverse. 00579 *> RTOVFL, RTUNFL Square roots of the previous 2 values. 00580 *> The following four arrays decode JTYPE: 00581 *> KTYPE(j) The general type (1-10) for type "j". 00582 *> KMODE(j) The MODE value to be passed to the matrix 00583 *> generator for type "j". 00584 *> KMAGN(j) The order of magnitude ( O(1), 00585 *> O(overflow^(1/2) ), O(underflow^(1/2) ) 00586 *> \endverbatim 00587 * 00588 * Authors: 00589 * ======== 00590 * 00591 *> \author Univ. of Tennessee 00592 *> \author Univ. of California Berkeley 00593 *> \author Univ. of Colorado Denver 00594 *> \author NAG Ltd. 00595 * 00596 *> \date November 2011 00597 * 00598 *> \ingroup complex16_eig 00599 * 00600 * ===================================================================== 00601 SUBROUTINE ZCHKST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 00602 $ NOUNIT, A, LDA, AP, SD, SE, D1, D2, D3, D4, D5, 00603 $ WA1, WA2, WA3, WR, U, LDU, V, VP, TAU, Z, WORK, 00604 $ LWORK, RWORK, LRWORK, IWORK, LIWORK, RESULT, 00605 $ INFO ) 00606 * 00607 * -- LAPACK test routine (version 3.4.0) -- 00608 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00609 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00610 * November 2011 00611 * 00612 * .. Scalar Arguments .. 00613 INTEGER INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT, 00614 $ NSIZES, NTYPES 00615 DOUBLE PRECISION THRESH 00616 * .. 00617 * .. Array Arguments .. 00618 LOGICAL DOTYPE( * ) 00619 INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 00620 DOUBLE PRECISION D1( * ), D2( * ), D3( * ), D4( * ), D5( * ), 00621 $ RESULT( * ), RWORK( * ), SD( * ), SE( * ), 00622 $ WA1( * ), WA2( * ), WA3( * ), WR( * ) 00623 COMPLEX*16 A( LDA, * ), AP( * ), TAU( * ), U( LDU, * ), 00624 $ V( LDU, * ), VP( * ), WORK( * ), Z( LDU, * ) 00625 * .. 00626 * 00627 * ===================================================================== 00628 * 00629 * .. Parameters .. 00630 DOUBLE PRECISION ZERO, ONE, TWO, EIGHT, TEN, HUN 00631 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0, 00632 $ EIGHT = 8.0D0, TEN = 10.0D0, HUN = 100.0D0 ) 00633 COMPLEX*16 CZERO, CONE 00634 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), 00635 $ CONE = ( 1.0D+0, 0.0D+0 ) ) 00636 DOUBLE PRECISION HALF 00637 PARAMETER ( HALF = ONE / TWO ) 00638 INTEGER MAXTYP 00639 PARAMETER ( MAXTYP = 21 ) 00640 LOGICAL CRANGE 00641 PARAMETER ( CRANGE = .FALSE. ) 00642 LOGICAL CREL 00643 PARAMETER ( CREL = .FALSE. ) 00644 * .. 00645 * .. Local Scalars .. 00646 LOGICAL BADNN, TRYRAC 00647 INTEGER I, IINFO, IL, IMODE, INDE, INDRWK, ITEMP, 00648 $ ITYPE, IU, J, JC, JR, JSIZE, JTYPE, LGN, 00649 $ LIWEDC, LOG2UI, LRWEDC, LWEDC, M, M2, M3, 00650 $ MTYPES, N, NAP, NBLOCK, NERRS, NMATS, NMAX, 00651 $ NSPLIT, NTEST, NTESTT 00652 DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL, 00653 $ RTUNFL, TEMP1, TEMP2, TEMP3, TEMP4, ULP, 00654 $ ULPINV, UNFL, VL, VU 00655 * .. 00656 * .. Local Arrays .. 00657 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ), 00658 $ KMAGN( MAXTYP ), KMODE( MAXTYP ), 00659 $ KTYPE( MAXTYP ) 00660 DOUBLE PRECISION DUMMA( 1 ) 00661 * .. 00662 * .. External Functions .. 00663 INTEGER ILAENV 00664 DOUBLE PRECISION DLAMCH, DLARND, DSXT1 00665 EXTERNAL ILAENV, DLAMCH, DLARND, DSXT1 00666 * .. 00667 * .. External Subroutines .. 00668 EXTERNAL DCOPY, DLABAD, DLASUM, DSTEBZ, DSTECH, DSTERF, 00669 $ XERBLA, ZCOPY, ZHET21, ZHETRD, ZHPT21, ZHPTRD, 00670 $ ZLACPY, ZLASET, ZLATMR, ZLATMS, ZPTEQR, ZSTEDC, 00671 $ ZSTEMR, ZSTEIN, ZSTEQR, ZSTT21, ZSTT22, ZUNGTR, 00672 $ ZUPGTR 00673 * .. 00674 * .. Intrinsic Functions .. 00675 INTRINSIC ABS, DBLE, DCONJG, INT, LOG, MAX, MIN, SQRT 00676 * .. 00677 * .. Data statements .. 00678 DATA KTYPE / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8, 00679 $ 8, 8, 9, 9, 9, 9, 9, 10 / 00680 DATA KMAGN / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1, 00681 $ 2, 3, 1, 1, 1, 2, 3, 1 / 00682 DATA KMODE / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, 00683 $ 0, 0, 4, 3, 1, 4, 4, 3 / 00684 * .. 00685 * .. Executable Statements .. 00686 * 00687 * Keep ftnchek happy 00688 IDUMMA( 1 ) = 1 00689 * 00690 * Check for errors 00691 * 00692 NTESTT = 0 00693 INFO = 0 00694 * 00695 * Important constants 00696 * 00697 BADNN = .FALSE. 00698 TRYRAC = .TRUE. 00699 NMAX = 1 00700 DO 10 J = 1, NSIZES 00701 NMAX = MAX( NMAX, NN( J ) ) 00702 IF( NN( J ).LT.0 ) 00703 $ BADNN = .TRUE. 00704 10 CONTINUE 00705 * 00706 NBLOCK = ILAENV( 1, 'ZHETRD', 'L', NMAX, -1, -1, -1 ) 00707 NBLOCK = MIN( NMAX, MAX( 1, NBLOCK ) ) 00708 * 00709 * Check for errors 00710 * 00711 IF( NSIZES.LT.0 ) THEN 00712 INFO = -1 00713 ELSE IF( BADNN ) THEN 00714 INFO = -2 00715 ELSE IF( NTYPES.LT.0 ) THEN 00716 INFO = -3 00717 ELSE IF( LDA.LT.NMAX ) THEN 00718 INFO = -9 00719 ELSE IF( LDU.LT.NMAX ) THEN 00720 INFO = -23 00721 ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN 00722 INFO = -29 00723 END IF 00724 * 00725 IF( INFO.NE.0 ) THEN 00726 CALL XERBLA( 'ZCHKST', -INFO ) 00727 RETURN 00728 END IF 00729 * 00730 * Quick return if possible 00731 * 00732 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 ) 00733 $ RETURN 00734 * 00735 * More Important constants 00736 * 00737 UNFL = DLAMCH( 'Safe minimum' ) 00738 OVFL = ONE / UNFL 00739 CALL DLABAD( UNFL, OVFL ) 00740 ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) 00741 ULPINV = ONE / ULP 00742 LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) 00743 RTUNFL = SQRT( UNFL ) 00744 RTOVFL = SQRT( OVFL ) 00745 * 00746 * Loop over sizes, types 00747 * 00748 DO 20 I = 1, 4 00749 ISEED2( I ) = ISEED( I ) 00750 20 CONTINUE 00751 NERRS = 0 00752 NMATS = 0 00753 * 00754 DO 310 JSIZE = 1, NSIZES 00755 N = NN( JSIZE ) 00756 IF( N.GT.0 ) THEN 00757 LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) ) 00758 IF( 2**LGN.LT.N ) 00759 $ LGN = LGN + 1 00760 IF( 2**LGN.LT.N ) 00761 $ LGN = LGN + 1 00762 LWEDC = 1 + 4*N + 2*N*LGN + 4*N**2 00763 LRWEDC = 1 + 3*N + 2*N*LGN + 4*N**2 00764 LIWEDC = 6 + 6*N + 5*N*LGN 00765 ELSE 00766 LWEDC = 8 00767 LRWEDC = 7 00768 LIWEDC = 12 00769 END IF 00770 NAP = ( N*( N+1 ) ) / 2 00771 ANINV = ONE / DBLE( MAX( 1, N ) ) 00772 * 00773 IF( NSIZES.NE.1 ) THEN 00774 MTYPES = MIN( MAXTYP, NTYPES ) 00775 ELSE 00776 MTYPES = MIN( MAXTYP+1, NTYPES ) 00777 END IF 00778 * 00779 DO 300 JTYPE = 1, MTYPES 00780 IF( .NOT.DOTYPE( JTYPE ) ) 00781 $ GO TO 300 00782 NMATS = NMATS + 1 00783 NTEST = 0 00784 * 00785 DO 30 J = 1, 4 00786 IOLDSD( J ) = ISEED( J ) 00787 30 CONTINUE 00788 * 00789 * Compute "A" 00790 * 00791 * Control parameters: 00792 * 00793 * KMAGN KMODE KTYPE 00794 * =1 O(1) clustered 1 zero 00795 * =2 large clustered 2 identity 00796 * =3 small exponential (none) 00797 * =4 arithmetic diagonal, (w/ eigenvalues) 00798 * =5 random log Hermitian, w/ eigenvalues 00799 * =6 random (none) 00800 * =7 random diagonal 00801 * =8 random Hermitian 00802 * =9 positive definite 00803 * =10 diagonally dominant tridiagonal 00804 * 00805 IF( MTYPES.GT.MAXTYP ) 00806 $ GO TO 100 00807 * 00808 ITYPE = KTYPE( JTYPE ) 00809 IMODE = KMODE( JTYPE ) 00810 * 00811 * Compute norm 00812 * 00813 GO TO ( 40, 50, 60 )KMAGN( JTYPE ) 00814 * 00815 40 CONTINUE 00816 ANORM = ONE 00817 GO TO 70 00818 * 00819 50 CONTINUE 00820 ANORM = ( RTOVFL*ULP )*ANINV 00821 GO TO 70 00822 * 00823 60 CONTINUE 00824 ANORM = RTUNFL*N*ULPINV 00825 GO TO 70 00826 * 00827 70 CONTINUE 00828 * 00829 CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA ) 00830 IINFO = 0 00831 IF( JTYPE.LE.15 ) THEN 00832 COND = ULPINV 00833 ELSE 00834 COND = ULPINV*ANINV / TEN 00835 END IF 00836 * 00837 * Special Matrices -- Identity & Jordan block 00838 * 00839 * Zero 00840 * 00841 IF( ITYPE.EQ.1 ) THEN 00842 IINFO = 0 00843 * 00844 ELSE IF( ITYPE.EQ.2 ) THEN 00845 * 00846 * Identity 00847 * 00848 DO 80 JC = 1, N 00849 A( JC, JC ) = ANORM 00850 80 CONTINUE 00851 * 00852 ELSE IF( ITYPE.EQ.4 ) THEN 00853 * 00854 * Diagonal Matrix, [Eigen]values Specified 00855 * 00856 CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 00857 $ ANORM, 0, 0, 'N', A, LDA, WORK, IINFO ) 00858 * 00859 * 00860 ELSE IF( ITYPE.EQ.5 ) THEN 00861 * 00862 * Hermitian, eigenvalues specified 00863 * 00864 CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 00865 $ ANORM, N, N, 'N', A, LDA, WORK, IINFO ) 00866 * 00867 ELSE IF( ITYPE.EQ.7 ) THEN 00868 * 00869 * Diagonal, random eigenvalues 00870 * 00871 CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE, 00872 $ 'T', 'N', WORK( N+1 ), 1, ONE, 00873 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0, 00874 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00875 * 00876 ELSE IF( ITYPE.EQ.8 ) THEN 00877 * 00878 * Hermitian, random eigenvalues 00879 * 00880 CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE, 00881 $ 'T', 'N', WORK( N+1 ), 1, ONE, 00882 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N, 00883 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00884 * 00885 ELSE IF( ITYPE.EQ.9 ) THEN 00886 * 00887 * Positive definite, eigenvalues specified. 00888 * 00889 CALL ZLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE, COND, 00890 $ ANORM, N, N, 'N', A, LDA, WORK, IINFO ) 00891 * 00892 ELSE IF( ITYPE.EQ.10 ) THEN 00893 * 00894 * Positive definite tridiagonal, eigenvalues specified. 00895 * 00896 CALL ZLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE, COND, 00897 $ ANORM, 1, 1, 'N', A, LDA, WORK, IINFO ) 00898 DO 90 I = 2, N 00899 TEMP1 = ABS( A( I-1, I ) ) 00900 TEMP2 = SQRT( ABS( A( I-1, I-1 )*A( I, I ) ) ) 00901 IF( TEMP1.GT.HALF*TEMP2 ) THEN 00902 A( I-1, I ) = A( I-1, I )* 00903 $ ( HALF*TEMP2 / ( UNFL+TEMP1 ) ) 00904 A( I, I-1 ) = DCONJG( A( I-1, I ) ) 00905 END IF 00906 90 CONTINUE 00907 * 00908 ELSE 00909 * 00910 IINFO = 1 00911 END IF 00912 * 00913 IF( IINFO.NE.0 ) THEN 00914 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE, 00915 $ IOLDSD 00916 INFO = ABS( IINFO ) 00917 RETURN 00918 END IF 00919 * 00920 100 CONTINUE 00921 * 00922 * Call ZHETRD and ZUNGTR to compute S and U from 00923 * upper triangle. 00924 * 00925 CALL ZLACPY( 'U', N, N, A, LDA, V, LDU ) 00926 * 00927 NTEST = 1 00928 CALL ZHETRD( 'U', N, V, LDU, SD, SE, TAU, WORK, LWORK, 00929 $ IINFO ) 00930 * 00931 IF( IINFO.NE.0 ) THEN 00932 WRITE( NOUNIT, FMT = 9999 )'ZHETRD(U)', IINFO, N, JTYPE, 00933 $ IOLDSD 00934 INFO = ABS( IINFO ) 00935 IF( IINFO.LT.0 ) THEN 00936 RETURN 00937 ELSE 00938 RESULT( 1 ) = ULPINV 00939 GO TO 280 00940 END IF 00941 END IF 00942 * 00943 CALL ZLACPY( 'U', N, N, V, LDU, U, LDU ) 00944 * 00945 NTEST = 2 00946 CALL ZUNGTR( 'U', N, U, LDU, TAU, WORK, LWORK, IINFO ) 00947 IF( IINFO.NE.0 ) THEN 00948 WRITE( NOUNIT, FMT = 9999 )'ZUNGTR(U)', IINFO, N, JTYPE, 00949 $ IOLDSD 00950 INFO = ABS( IINFO ) 00951 IF( IINFO.LT.0 ) THEN 00952 RETURN 00953 ELSE 00954 RESULT( 2 ) = ULPINV 00955 GO TO 280 00956 END IF 00957 END IF 00958 * 00959 * Do tests 1 and 2 00960 * 00961 CALL ZHET21( 2, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V, 00962 $ LDU, TAU, WORK, RWORK, RESULT( 1 ) ) 00963 CALL ZHET21( 3, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V, 00964 $ LDU, TAU, WORK, RWORK, RESULT( 2 ) ) 00965 * 00966 * Call ZHETRD and ZUNGTR to compute S and U from 00967 * lower triangle, do tests. 00968 * 00969 CALL ZLACPY( 'L', N, N, A, LDA, V, LDU ) 00970 * 00971 NTEST = 3 00972 CALL ZHETRD( 'L', N, V, LDU, SD, SE, TAU, WORK, LWORK, 00973 $ IINFO ) 00974 * 00975 IF( IINFO.NE.0 ) THEN 00976 WRITE( NOUNIT, FMT = 9999 )'ZHETRD(L)', IINFO, N, JTYPE, 00977 $ IOLDSD 00978 INFO = ABS( IINFO ) 00979 IF( IINFO.LT.0 ) THEN 00980 RETURN 00981 ELSE 00982 RESULT( 3 ) = ULPINV 00983 GO TO 280 00984 END IF 00985 END IF 00986 * 00987 CALL ZLACPY( 'L', N, N, V, LDU, U, LDU ) 00988 * 00989 NTEST = 4 00990 CALL ZUNGTR( 'L', N, U, LDU, TAU, WORK, LWORK, IINFO ) 00991 IF( IINFO.NE.0 ) THEN 00992 WRITE( NOUNIT, FMT = 9999 )'ZUNGTR(L)', IINFO, N, JTYPE, 00993 $ IOLDSD 00994 INFO = ABS( IINFO ) 00995 IF( IINFO.LT.0 ) THEN 00996 RETURN 00997 ELSE 00998 RESULT( 4 ) = ULPINV 00999 GO TO 280 01000 END IF 01001 END IF 01002 * 01003 CALL ZHET21( 2, 'Lower', N, 1, A, LDA, SD, SE, U, LDU, V, 01004 $ LDU, TAU, WORK, RWORK, RESULT( 3 ) ) 01005 CALL ZHET21( 3, 'Lower', N, 1, A, LDA, SD, SE, U, LDU, V, 01006 $ LDU, TAU, WORK, RWORK, RESULT( 4 ) ) 01007 * 01008 * Store the upper triangle of A in AP 01009 * 01010 I = 0 01011 DO 120 JC = 1, N 01012 DO 110 JR = 1, JC 01013 I = I + 1 01014 AP( I ) = A( JR, JC ) 01015 110 CONTINUE 01016 120 CONTINUE 01017 * 01018 * Call ZHPTRD and ZUPGTR to compute S and U from AP 01019 * 01020 CALL ZCOPY( NAP, AP, 1, VP, 1 ) 01021 * 01022 NTEST = 5 01023 CALL ZHPTRD( 'U', N, VP, SD, SE, TAU, IINFO ) 01024 * 01025 IF( IINFO.NE.0 ) THEN 01026 WRITE( NOUNIT, FMT = 9999 )'ZHPTRD(U)', IINFO, N, JTYPE, 01027 $ IOLDSD 01028 INFO = ABS( IINFO ) 01029 IF( IINFO.LT.0 ) THEN 01030 RETURN 01031 ELSE 01032 RESULT( 5 ) = ULPINV 01033 GO TO 280 01034 END IF 01035 END IF 01036 * 01037 NTEST = 6 01038 CALL ZUPGTR( 'U', N, VP, TAU, U, LDU, WORK, IINFO ) 01039 IF( IINFO.NE.0 ) THEN 01040 WRITE( NOUNIT, FMT = 9999 )'ZUPGTR(U)', IINFO, N, JTYPE, 01041 $ IOLDSD 01042 INFO = ABS( IINFO ) 01043 IF( IINFO.LT.0 ) THEN 01044 RETURN 01045 ELSE 01046 RESULT( 6 ) = ULPINV 01047 GO TO 280 01048 END IF 01049 END IF 01050 * 01051 * Do tests 5 and 6 01052 * 01053 CALL ZHPT21( 2, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU, 01054 $ WORK, RWORK, RESULT( 5 ) ) 01055 CALL ZHPT21( 3, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU, 01056 $ WORK, RWORK, RESULT( 6 ) ) 01057 * 01058 * Store the lower triangle of A in AP 01059 * 01060 I = 0 01061 DO 140 JC = 1, N 01062 DO 130 JR = JC, N 01063 I = I + 1 01064 AP( I ) = A( JR, JC ) 01065 130 CONTINUE 01066 140 CONTINUE 01067 * 01068 * Call ZHPTRD and ZUPGTR to compute S and U from AP 01069 * 01070 CALL ZCOPY( NAP, AP, 1, VP, 1 ) 01071 * 01072 NTEST = 7 01073 CALL ZHPTRD( 'L', N, VP, SD, SE, TAU, IINFO ) 01074 * 01075 IF( IINFO.NE.0 ) THEN 01076 WRITE( NOUNIT, FMT = 9999 )'ZHPTRD(L)', IINFO, N, JTYPE, 01077 $ IOLDSD 01078 INFO = ABS( IINFO ) 01079 IF( IINFO.LT.0 ) THEN 01080 RETURN 01081 ELSE 01082 RESULT( 7 ) = ULPINV 01083 GO TO 280 01084 END IF 01085 END IF 01086 * 01087 NTEST = 8 01088 CALL ZUPGTR( 'L', N, VP, TAU, U, LDU, WORK, IINFO ) 01089 IF( IINFO.NE.0 ) THEN 01090 WRITE( NOUNIT, FMT = 9999 )'ZUPGTR(L)', IINFO, N, JTYPE, 01091 $ IOLDSD 01092 INFO = ABS( IINFO ) 01093 IF( IINFO.LT.0 ) THEN 01094 RETURN 01095 ELSE 01096 RESULT( 8 ) = ULPINV 01097 GO TO 280 01098 END IF 01099 END IF 01100 * 01101 CALL ZHPT21( 2, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU, 01102 $ WORK, RWORK, RESULT( 7 ) ) 01103 CALL ZHPT21( 3, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU, 01104 $ WORK, RWORK, RESULT( 8 ) ) 01105 * 01106 * Call ZSTEQR to compute D1, D2, and Z, do tests. 01107 * 01108 * Compute D1 and Z 01109 * 01110 CALL DCOPY( N, SD, 1, D1, 1 ) 01111 IF( N.GT.0 ) 01112 $ CALL DCOPY( N-1, SE, 1, RWORK, 1 ) 01113 CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU ) 01114 * 01115 NTEST = 9 01116 CALL ZSTEQR( 'V', N, D1, RWORK, Z, LDU, RWORK( N+1 ), 01117 $ IINFO ) 01118 IF( IINFO.NE.0 ) THEN 01119 WRITE( NOUNIT, FMT = 9999 )'ZSTEQR(V)', IINFO, N, JTYPE, 01120 $ IOLDSD 01121 INFO = ABS( IINFO ) 01122 IF( IINFO.LT.0 ) THEN 01123 RETURN 01124 ELSE 01125 RESULT( 9 ) = ULPINV 01126 GO TO 280 01127 END IF 01128 END IF 01129 * 01130 * Compute D2 01131 * 01132 CALL DCOPY( N, SD, 1, D2, 1 ) 01133 IF( N.GT.0 ) 01134 $ CALL DCOPY( N-1, SE, 1, RWORK, 1 ) 01135 * 01136 NTEST = 11 01137 CALL ZSTEQR( 'N', N, D2, RWORK, WORK, LDU, RWORK( N+1 ), 01138 $ IINFO ) 01139 IF( IINFO.NE.0 ) THEN 01140 WRITE( NOUNIT, FMT = 9999 )'ZSTEQR(N)', IINFO, N, JTYPE, 01141 $ IOLDSD 01142 INFO = ABS( IINFO ) 01143 IF( IINFO.LT.0 ) THEN 01144 RETURN 01145 ELSE 01146 RESULT( 11 ) = ULPINV 01147 GO TO 280 01148 END IF 01149 END IF 01150 * 01151 * Compute D3 (using PWK method) 01152 * 01153 CALL DCOPY( N, SD, 1, D3, 1 ) 01154 IF( N.GT.0 ) 01155 $ CALL DCOPY( N-1, SE, 1, RWORK, 1 ) 01156 * 01157 NTEST = 12 01158 CALL DSTERF( N, D3, RWORK, IINFO ) 01159 IF( IINFO.NE.0 ) THEN 01160 WRITE( NOUNIT, FMT = 9999 )'DSTERF', IINFO, N, JTYPE, 01161 $ IOLDSD 01162 INFO = ABS( IINFO ) 01163 IF( IINFO.LT.0 ) THEN 01164 RETURN 01165 ELSE 01166 RESULT( 12 ) = ULPINV 01167 GO TO 280 01168 END IF 01169 END IF 01170 * 01171 * Do Tests 9 and 10 01172 * 01173 CALL ZSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK, 01174 $ RESULT( 9 ) ) 01175 * 01176 * Do Tests 11 and 12 01177 * 01178 TEMP1 = ZERO 01179 TEMP2 = ZERO 01180 TEMP3 = ZERO 01181 TEMP4 = ZERO 01182 * 01183 DO 150 J = 1, N 01184 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) ) 01185 TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) ) 01186 TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) ) 01187 TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) ) 01188 150 CONTINUE 01189 * 01190 RESULT( 11 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) ) 01191 RESULT( 12 ) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) ) 01192 * 01193 * Do Test 13 -- Sturm Sequence Test of Eigenvalues 01194 * Go up by factors of two until it succeeds 01195 * 01196 NTEST = 13 01197 TEMP1 = THRESH*( HALF-ULP ) 01198 * 01199 DO 160 J = 0, LOG2UI 01200 CALL DSTECH( N, SD, SE, D1, TEMP1, RWORK, IINFO ) 01201 IF( IINFO.EQ.0 ) 01202 $ GO TO 170 01203 TEMP1 = TEMP1*TWO 01204 160 CONTINUE 01205 * 01206 170 CONTINUE 01207 RESULT( 13 ) = TEMP1 01208 * 01209 * For positive definite matrices ( JTYPE.GT.15 ) call ZPTEQR 01210 * and do tests 14, 15, and 16 . 01211 * 01212 IF( JTYPE.GT.15 ) THEN 01213 * 01214 * Compute D4 and Z4 01215 * 01216 CALL DCOPY( N, SD, 1, D4, 1 ) 01217 IF( N.GT.0 ) 01218 $ CALL DCOPY( N-1, SE, 1, RWORK, 1 ) 01219 CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU ) 01220 * 01221 NTEST = 14 01222 CALL ZPTEQR( 'V', N, D4, RWORK, Z, LDU, RWORK( N+1 ), 01223 $ IINFO ) 01224 IF( IINFO.NE.0 ) THEN 01225 WRITE( NOUNIT, FMT = 9999 )'ZPTEQR(V)', IINFO, N, 01226 $ JTYPE, IOLDSD 01227 INFO = ABS( IINFO ) 01228 IF( IINFO.LT.0 ) THEN 01229 RETURN 01230 ELSE 01231 RESULT( 14 ) = ULPINV 01232 GO TO 280 01233 END IF 01234 END IF 01235 * 01236 * Do Tests 14 and 15 01237 * 01238 CALL ZSTT21( N, 0, SD, SE, D4, DUMMA, Z, LDU, WORK, 01239 $ RWORK, RESULT( 14 ) ) 01240 * 01241 * Compute D5 01242 * 01243 CALL DCOPY( N, SD, 1, D5, 1 ) 01244 IF( N.GT.0 ) 01245 $ CALL DCOPY( N-1, SE, 1, RWORK, 1 ) 01246 * 01247 NTEST = 16 01248 CALL ZPTEQR( 'N', N, D5, RWORK, Z, LDU, RWORK( N+1 ), 01249 $ IINFO ) 01250 IF( IINFO.NE.0 ) THEN 01251 WRITE( NOUNIT, FMT = 9999 )'ZPTEQR(N)', IINFO, N, 01252 $ JTYPE, IOLDSD 01253 INFO = ABS( IINFO ) 01254 IF( IINFO.LT.0 ) THEN 01255 RETURN 01256 ELSE 01257 RESULT( 16 ) = ULPINV 01258 GO TO 280 01259 END IF 01260 END IF 01261 * 01262 * Do Test 16 01263 * 01264 TEMP1 = ZERO 01265 TEMP2 = ZERO 01266 DO 180 J = 1, N 01267 TEMP1 = MAX( TEMP1, ABS( D4( J ) ), ABS( D5( J ) ) ) 01268 TEMP2 = MAX( TEMP2, ABS( D4( J )-D5( J ) ) ) 01269 180 CONTINUE 01270 * 01271 RESULT( 16 ) = TEMP2 / MAX( UNFL, 01272 $ HUN*ULP*MAX( TEMP1, TEMP2 ) ) 01273 ELSE 01274 RESULT( 14 ) = ZERO 01275 RESULT( 15 ) = ZERO 01276 RESULT( 16 ) = ZERO 01277 END IF 01278 * 01279 * Call DSTEBZ with different options and do tests 17-18. 01280 * 01281 * If S is positive definite and diagonally dominant, 01282 * ask for all eigenvalues with high relative accuracy. 01283 * 01284 VL = ZERO 01285 VU = ZERO 01286 IL = 0 01287 IU = 0 01288 IF( JTYPE.EQ.21 ) THEN 01289 NTEST = 17 01290 ABSTOL = UNFL + UNFL 01291 CALL DSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE, 01292 $ M, NSPLIT, WR, IWORK( 1 ), IWORK( N+1 ), 01293 $ RWORK, IWORK( 2*N+1 ), IINFO ) 01294 IF( IINFO.NE.0 ) THEN 01295 WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(A,rel)', IINFO, N, 01296 $ JTYPE, IOLDSD 01297 INFO = ABS( IINFO ) 01298 IF( IINFO.LT.0 ) THEN 01299 RETURN 01300 ELSE 01301 RESULT( 17 ) = ULPINV 01302 GO TO 280 01303 END IF 01304 END IF 01305 * 01306 * Do test 17 01307 * 01308 TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) / 01309 $ ( ONE-HALF )**4 01310 * 01311 TEMP1 = ZERO 01312 DO 190 J = 1, N 01313 TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) / 01314 $ ( ABSTOL+ABS( D4( J ) ) ) ) 01315 190 CONTINUE 01316 * 01317 RESULT( 17 ) = TEMP1 / TEMP2 01318 ELSE 01319 RESULT( 17 ) = ZERO 01320 END IF 01321 * 01322 * Now ask for all eigenvalues with high absolute accuracy. 01323 * 01324 NTEST = 18 01325 ABSTOL = UNFL + UNFL 01326 CALL DSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE, M, 01327 $ NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), RWORK, 01328 $ IWORK( 2*N+1 ), IINFO ) 01329 IF( IINFO.NE.0 ) THEN 01330 WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(A)', IINFO, N, JTYPE, 01331 $ IOLDSD 01332 INFO = ABS( IINFO ) 01333 IF( IINFO.LT.0 ) THEN 01334 RETURN 01335 ELSE 01336 RESULT( 18 ) = ULPINV 01337 GO TO 280 01338 END IF 01339 END IF 01340 * 01341 * Do test 18 01342 * 01343 TEMP1 = ZERO 01344 TEMP2 = ZERO 01345 DO 200 J = 1, N 01346 TEMP1 = MAX( TEMP1, ABS( D3( J ) ), ABS( WA1( J ) ) ) 01347 TEMP2 = MAX( TEMP2, ABS( D3( J )-WA1( J ) ) ) 01348 200 CONTINUE 01349 * 01350 RESULT( 18 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) ) 01351 * 01352 * Choose random values for IL and IU, and ask for the 01353 * IL-th through IU-th eigenvalues. 01354 * 01355 NTEST = 19 01356 IF( N.LE.1 ) THEN 01357 IL = 1 01358 IU = N 01359 ELSE 01360 IL = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) ) 01361 IU = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) ) 01362 IF( IU.LT.IL ) THEN 01363 ITEMP = IU 01364 IU = IL 01365 IL = ITEMP 01366 END IF 01367 END IF 01368 * 01369 CALL DSTEBZ( 'I', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE, 01370 $ M2, NSPLIT, WA2, IWORK( 1 ), IWORK( N+1 ), 01371 $ RWORK, IWORK( 2*N+1 ), IINFO ) 01372 IF( IINFO.NE.0 ) THEN 01373 WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(I)', IINFO, N, JTYPE, 01374 $ IOLDSD 01375 INFO = ABS( IINFO ) 01376 IF( IINFO.LT.0 ) THEN 01377 RETURN 01378 ELSE 01379 RESULT( 19 ) = ULPINV 01380 GO TO 280 01381 END IF 01382 END IF 01383 * 01384 * Determine the values VL and VU of the IL-th and IU-th 01385 * eigenvalues and ask for all eigenvalues in this range. 01386 * 01387 IF( N.GT.0 ) THEN 01388 IF( IL.NE.1 ) THEN 01389 VL = WA1( IL ) - MAX( HALF*( WA1( IL )-WA1( IL-1 ) ), 01390 $ ULP*ANORM, TWO*RTUNFL ) 01391 ELSE 01392 VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ), 01393 $ ULP*ANORM, TWO*RTUNFL ) 01394 END IF 01395 IF( IU.NE.N ) THEN 01396 VU = WA1( IU ) + MAX( HALF*( WA1( IU+1 )-WA1( IU ) ), 01397 $ ULP*ANORM, TWO*RTUNFL ) 01398 ELSE 01399 VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ), 01400 $ ULP*ANORM, TWO*RTUNFL ) 01401 END IF 01402 ELSE 01403 VL = ZERO 01404 VU = ONE 01405 END IF 01406 * 01407 CALL DSTEBZ( 'V', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE, 01408 $ M3, NSPLIT, WA3, IWORK( 1 ), IWORK( N+1 ), 01409 $ RWORK, IWORK( 2*N+1 ), IINFO ) 01410 IF( IINFO.NE.0 ) THEN 01411 WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(V)', IINFO, N, JTYPE, 01412 $ IOLDSD 01413 INFO = ABS( IINFO ) 01414 IF( IINFO.LT.0 ) THEN 01415 RETURN 01416 ELSE 01417 RESULT( 19 ) = ULPINV 01418 GO TO 280 01419 END IF 01420 END IF 01421 * 01422 IF( M3.EQ.0 .AND. N.NE.0 ) THEN 01423 RESULT( 19 ) = ULPINV 01424 GO TO 280 01425 END IF 01426 * 01427 * Do test 19 01428 * 01429 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 01430 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 01431 IF( N.GT.0 ) THEN 01432 TEMP3 = MAX( ABS( WA1( N ) ), ABS( WA1( 1 ) ) ) 01433 ELSE 01434 TEMP3 = ZERO 01435 END IF 01436 * 01437 RESULT( 19 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP ) 01438 * 01439 * Call ZSTEIN to compute eigenvectors corresponding to 01440 * eigenvalues in WA1. (First call DSTEBZ again, to make sure 01441 * it returns these eigenvalues in the correct order.) 01442 * 01443 NTEST = 21 01444 CALL DSTEBZ( 'A', 'B', N, VL, VU, IL, IU, ABSTOL, SD, SE, M, 01445 $ NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), RWORK, 01446 $ IWORK( 2*N+1 ), IINFO ) 01447 IF( IINFO.NE.0 ) THEN 01448 WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(A,B)', IINFO, N, 01449 $ JTYPE, IOLDSD 01450 INFO = ABS( IINFO ) 01451 IF( IINFO.LT.0 ) THEN 01452 RETURN 01453 ELSE 01454 RESULT( 20 ) = ULPINV 01455 RESULT( 21 ) = ULPINV 01456 GO TO 280 01457 END IF 01458 END IF 01459 * 01460 CALL ZSTEIN( N, SD, SE, M, WA1, IWORK( 1 ), IWORK( N+1 ), Z, 01461 $ LDU, RWORK, IWORK( 2*N+1 ), IWORK( 3*N+1 ), 01462 $ IINFO ) 01463 IF( IINFO.NE.0 ) THEN 01464 WRITE( NOUNIT, FMT = 9999 )'ZSTEIN', IINFO, N, JTYPE, 01465 $ IOLDSD 01466 INFO = ABS( IINFO ) 01467 IF( IINFO.LT.0 ) THEN 01468 RETURN 01469 ELSE 01470 RESULT( 20 ) = ULPINV 01471 RESULT( 21 ) = ULPINV 01472 GO TO 280 01473 END IF 01474 END IF 01475 * 01476 * Do tests 20 and 21 01477 * 01478 CALL ZSTT21( N, 0, SD, SE, WA1, DUMMA, Z, LDU, WORK, RWORK, 01479 $ RESULT( 20 ) ) 01480 * 01481 * Call ZSTEDC(I) to compute D1 and Z, do tests. 01482 * 01483 * Compute D1 and Z 01484 * 01485 INDE = 1 01486 INDRWK = INDE + N 01487 CALL DCOPY( N, SD, 1, D1, 1 ) 01488 IF( N.GT.0 ) 01489 $ CALL DCOPY( N-1, SE, 1, RWORK( INDE ), 1 ) 01490 CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU ) 01491 * 01492 NTEST = 22 01493 CALL ZSTEDC( 'I', N, D1, RWORK( INDE ), Z, LDU, WORK, LWEDC, 01494 $ RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO ) 01495 IF( IINFO.NE.0 ) THEN 01496 WRITE( NOUNIT, FMT = 9999 )'ZSTEDC(I)', IINFO, N, JTYPE, 01497 $ IOLDSD 01498 INFO = ABS( IINFO ) 01499 IF( IINFO.LT.0 ) THEN 01500 RETURN 01501 ELSE 01502 RESULT( 22 ) = ULPINV 01503 GO TO 280 01504 END IF 01505 END IF 01506 * 01507 * Do Tests 22 and 23 01508 * 01509 CALL ZSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK, 01510 $ RESULT( 22 ) ) 01511 * 01512 * Call ZSTEDC(V) to compute D1 and Z, do tests. 01513 * 01514 * Compute D1 and Z 01515 * 01516 CALL DCOPY( N, SD, 1, D1, 1 ) 01517 IF( N.GT.0 ) 01518 $ CALL DCOPY( N-1, SE, 1, RWORK( INDE ), 1 ) 01519 CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU ) 01520 * 01521 NTEST = 24 01522 CALL ZSTEDC( 'V', N, D1, RWORK( INDE ), Z, LDU, WORK, LWEDC, 01523 $ RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO ) 01524 IF( IINFO.NE.0 ) THEN 01525 WRITE( NOUNIT, FMT = 9999 )'ZSTEDC(V)', IINFO, N, JTYPE, 01526 $ IOLDSD 01527 INFO = ABS( IINFO ) 01528 IF( IINFO.LT.0 ) THEN 01529 RETURN 01530 ELSE 01531 RESULT( 24 ) = ULPINV 01532 GO TO 280 01533 END IF 01534 END IF 01535 * 01536 * Do Tests 24 and 25 01537 * 01538 CALL ZSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK, 01539 $ RESULT( 24 ) ) 01540 * 01541 * Call ZSTEDC(N) to compute D2, do tests. 01542 * 01543 * Compute D2 01544 * 01545 CALL DCOPY( N, SD, 1, D2, 1 ) 01546 IF( N.GT.0 ) 01547 $ CALL DCOPY( N-1, SE, 1, RWORK( INDE ), 1 ) 01548 CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU ) 01549 * 01550 NTEST = 26 01551 CALL ZSTEDC( 'N', N, D2, RWORK( INDE ), Z, LDU, WORK, LWEDC, 01552 $ RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO ) 01553 IF( IINFO.NE.0 ) THEN 01554 WRITE( NOUNIT, FMT = 9999 )'ZSTEDC(N)', IINFO, N, JTYPE, 01555 $ IOLDSD 01556 INFO = ABS( IINFO ) 01557 IF( IINFO.LT.0 ) THEN 01558 RETURN 01559 ELSE 01560 RESULT( 26 ) = ULPINV 01561 GO TO 280 01562 END IF 01563 END IF 01564 * 01565 * Do Test 26 01566 * 01567 TEMP1 = ZERO 01568 TEMP2 = ZERO 01569 * 01570 DO 210 J = 1, N 01571 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) ) 01572 TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) ) 01573 210 CONTINUE 01574 * 01575 RESULT( 26 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) ) 01576 * 01577 * Only test ZSTEMR if IEEE compliant 01578 * 01579 IF( ILAENV( 10, 'ZSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 .AND. 01580 $ ILAENV( 11, 'ZSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 ) THEN 01581 * 01582 * Call ZSTEMR, do test 27 (relative eigenvalue accuracy) 01583 * 01584 * If S is positive definite and diagonally dominant, 01585 * ask for all eigenvalues with high relative accuracy. 01586 * 01587 VL = ZERO 01588 VU = ZERO 01589 IL = 0 01590 IU = 0 01591 IF( JTYPE.EQ.21 .AND. CREL ) THEN 01592 NTEST = 27 01593 ABSTOL = UNFL + UNFL 01594 CALL ZSTEMR( 'V', 'A', N, SD, SE, VL, VU, IL, IU, 01595 $ M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC, 01596 $ RWORK, LRWORK, IWORK( 2*N+1 ), LWORK-2*N, 01597 $ IINFO ) 01598 IF( IINFO.NE.0 ) THEN 01599 WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(V,A,rel)', 01600 $ IINFO, N, JTYPE, IOLDSD 01601 INFO = ABS( IINFO ) 01602 IF( IINFO.LT.0 ) THEN 01603 RETURN 01604 ELSE 01605 RESULT( 27 ) = ULPINV 01606 GO TO 270 01607 END IF 01608 END IF 01609 * 01610 * Do test 27 01611 * 01612 TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) / 01613 $ ( ONE-HALF )**4 01614 * 01615 TEMP1 = ZERO 01616 DO 220 J = 1, N 01617 TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) / 01618 $ ( ABSTOL+ABS( D4( J ) ) ) ) 01619 220 CONTINUE 01620 * 01621 RESULT( 27 ) = TEMP1 / TEMP2 01622 * 01623 IL = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) ) 01624 IU = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) ) 01625 IF( IU.LT.IL ) THEN 01626 ITEMP = IU 01627 IU = IL 01628 IL = ITEMP 01629 END IF 01630 * 01631 IF( CRANGE ) THEN 01632 NTEST = 28 01633 ABSTOL = UNFL + UNFL 01634 CALL ZSTEMR( 'V', 'I', N, SD, SE, VL, VU, IL, IU, 01635 $ M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC, 01636 $ RWORK, LRWORK, IWORK( 2*N+1 ), 01637 $ LWORK-2*N, IINFO ) 01638 * 01639 IF( IINFO.NE.0 ) THEN 01640 WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(V,I,rel)', 01641 $ IINFO, N, JTYPE, IOLDSD 01642 INFO = ABS( IINFO ) 01643 IF( IINFO.LT.0 ) THEN 01644 RETURN 01645 ELSE 01646 RESULT( 28 ) = ULPINV 01647 GO TO 270 01648 END IF 01649 END IF 01650 * 01651 * 01652 * Do test 28 01653 * 01654 TEMP2 = TWO*( TWO*N-ONE )*ULP* 01655 $ ( ONE+EIGHT*HALF**2 ) / ( ONE-HALF )**4 01656 * 01657 TEMP1 = ZERO 01658 DO 230 J = IL, IU 01659 TEMP1 = MAX( TEMP1, ABS( WR( J-IL+1 )-D4( N-J+ 01660 $ 1 ) ) / ( ABSTOL+ABS( WR( J-IL+1 ) ) ) ) 01661 230 CONTINUE 01662 * 01663 RESULT( 28 ) = TEMP1 / TEMP2 01664 ELSE 01665 RESULT( 28 ) = ZERO 01666 END IF 01667 ELSE 01668 RESULT( 27 ) = ZERO 01669 RESULT( 28 ) = ZERO 01670 END IF 01671 * 01672 * Call ZSTEMR(V,I) to compute D1 and Z, do tests. 01673 * 01674 * Compute D1 and Z 01675 * 01676 CALL DCOPY( N, SD, 1, D5, 1 ) 01677 IF( N.GT.0 ) 01678 $ CALL DCOPY( N-1, SE, 1, RWORK, 1 ) 01679 CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU ) 01680 * 01681 IF( CRANGE ) THEN 01682 NTEST = 29 01683 IL = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) ) 01684 IU = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) ) 01685 IF( IU.LT.IL ) THEN 01686 ITEMP = IU 01687 IU = IL 01688 IL = ITEMP 01689 END IF 01690 CALL ZSTEMR( 'V', 'I', N, D5, RWORK, VL, VU, IL, IU, 01691 $ M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC, 01692 $ RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ), 01693 $ LIWORK-2*N, IINFO ) 01694 IF( IINFO.NE.0 ) THEN 01695 WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(V,I)', IINFO, 01696 $ N, JTYPE, IOLDSD 01697 INFO = ABS( IINFO ) 01698 IF( IINFO.LT.0 ) THEN 01699 RETURN 01700 ELSE 01701 RESULT( 29 ) = ULPINV 01702 GO TO 280 01703 END IF 01704 END IF 01705 * 01706 * Do Tests 29 and 30 01707 * 01708 * 01709 * Call ZSTEMR to compute D2, do tests. 01710 * 01711 * Compute D2 01712 * 01713 CALL DCOPY( N, SD, 1, D5, 1 ) 01714 IF( N.GT.0 ) 01715 $ CALL DCOPY( N-1, SE, 1, RWORK, 1 ) 01716 * 01717 NTEST = 31 01718 CALL ZSTEMR( 'N', 'I', N, D5, RWORK, VL, VU, IL, IU, 01719 $ M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC, 01720 $ RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ), 01721 $ LIWORK-2*N, IINFO ) 01722 IF( IINFO.NE.0 ) THEN 01723 WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(N,I)', IINFO, 01724 $ N, JTYPE, IOLDSD 01725 INFO = ABS( IINFO ) 01726 IF( IINFO.LT.0 ) THEN 01727 RETURN 01728 ELSE 01729 RESULT( 31 ) = ULPINV 01730 GO TO 280 01731 END IF 01732 END IF 01733 * 01734 * Do Test 31 01735 * 01736 TEMP1 = ZERO 01737 TEMP2 = ZERO 01738 * 01739 DO 240 J = 1, IU - IL + 1 01740 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), 01741 $ ABS( D2( J ) ) ) 01742 TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) ) 01743 240 CONTINUE 01744 * 01745 RESULT( 31 ) = TEMP2 / MAX( UNFL, 01746 $ ULP*MAX( TEMP1, TEMP2 ) ) 01747 * 01748 * 01749 * Call ZSTEMR(V,V) to compute D1 and Z, do tests. 01750 * 01751 * Compute D1 and Z 01752 * 01753 CALL DCOPY( N, SD, 1, D5, 1 ) 01754 IF( N.GT.0 ) 01755 $ CALL DCOPY( N-1, SE, 1, RWORK, 1 ) 01756 CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU ) 01757 * 01758 NTEST = 32 01759 * 01760 IF( N.GT.0 ) THEN 01761 IF( IL.NE.1 ) THEN 01762 VL = D2( IL ) - MAX( HALF* 01763 $ ( D2( IL )-D2( IL-1 ) ), ULP*ANORM, 01764 $ TWO*RTUNFL ) 01765 ELSE 01766 VL = D2( 1 ) - MAX( HALF*( D2( N )-D2( 1 ) ), 01767 $ ULP*ANORM, TWO*RTUNFL ) 01768 END IF 01769 IF( IU.NE.N ) THEN 01770 VU = D2( IU ) + MAX( HALF* 01771 $ ( D2( IU+1 )-D2( IU ) ), ULP*ANORM, 01772 $ TWO*RTUNFL ) 01773 ELSE 01774 VU = D2( N ) + MAX( HALF*( D2( N )-D2( 1 ) ), 01775 $ ULP*ANORM, TWO*RTUNFL ) 01776 END IF 01777 ELSE 01778 VL = ZERO 01779 VU = ONE 01780 END IF 01781 * 01782 CALL ZSTEMR( 'V', 'V', N, D5, RWORK, VL, VU, IL, IU, 01783 $ M, D1, Z, LDU, M, IWORK( 1 ), TRYRAC, 01784 $ RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ), 01785 $ LIWORK-2*N, IINFO ) 01786 IF( IINFO.NE.0 ) THEN 01787 WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(V,V)', IINFO, 01788 $ N, JTYPE, IOLDSD 01789 INFO = ABS( IINFO ) 01790 IF( IINFO.LT.0 ) THEN 01791 RETURN 01792 ELSE 01793 RESULT( 32 ) = ULPINV 01794 GO TO 280 01795 END IF 01796 END IF 01797 * 01798 * Do Tests 32 and 33 01799 * 01800 CALL ZSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, 01801 $ M, RWORK, RESULT( 32 ) ) 01802 * 01803 * Call ZSTEMR to compute D2, do tests. 01804 * 01805 * Compute D2 01806 * 01807 CALL DCOPY( N, SD, 1, D5, 1 ) 01808 IF( N.GT.0 ) 01809 $ CALL DCOPY( N-1, SE, 1, RWORK, 1 ) 01810 * 01811 NTEST = 34 01812 CALL ZSTEMR( 'N', 'V', N, D5, RWORK, VL, VU, IL, IU, 01813 $ M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC, 01814 $ RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ), 01815 $ LIWORK-2*N, IINFO ) 01816 IF( IINFO.NE.0 ) THEN 01817 WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(N,V)', IINFO, 01818 $ N, JTYPE, IOLDSD 01819 INFO = ABS( IINFO ) 01820 IF( IINFO.LT.0 ) THEN 01821 RETURN 01822 ELSE 01823 RESULT( 34 ) = ULPINV 01824 GO TO 280 01825 END IF 01826 END IF 01827 * 01828 * Do Test 34 01829 * 01830 TEMP1 = ZERO 01831 TEMP2 = ZERO 01832 * 01833 DO 250 J = 1, IU - IL + 1 01834 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), 01835 $ ABS( D2( J ) ) ) 01836 TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) ) 01837 250 CONTINUE 01838 * 01839 RESULT( 34 ) = TEMP2 / MAX( UNFL, 01840 $ ULP*MAX( TEMP1, TEMP2 ) ) 01841 ELSE 01842 RESULT( 29 ) = ZERO 01843 RESULT( 30 ) = ZERO 01844 RESULT( 31 ) = ZERO 01845 RESULT( 32 ) = ZERO 01846 RESULT( 33 ) = ZERO 01847 RESULT( 34 ) = ZERO 01848 END IF 01849 * 01850 * 01851 * Call ZSTEMR(V,A) to compute D1 and Z, do tests. 01852 * 01853 * Compute D1 and Z 01854 * 01855 CALL DCOPY( N, SD, 1, D5, 1 ) 01856 IF( N.GT.0 ) 01857 $ CALL DCOPY( N-1, SE, 1, RWORK, 1 ) 01858 * 01859 NTEST = 35 01860 * 01861 CALL ZSTEMR( 'V', 'A', N, D5, RWORK, VL, VU, IL, IU, 01862 $ M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC, 01863 $ RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ), 01864 $ LIWORK-2*N, IINFO ) 01865 IF( IINFO.NE.0 ) THEN 01866 WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(V,A)', IINFO, N, 01867 $ JTYPE, IOLDSD 01868 INFO = ABS( IINFO ) 01869 IF( IINFO.LT.0 ) THEN 01870 RETURN 01871 ELSE 01872 RESULT( 35 ) = ULPINV 01873 GO TO 280 01874 END IF 01875 END IF 01876 * 01877 * Do Tests 35 and 36 01878 * 01879 CALL ZSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, M, 01880 $ RWORK, RESULT( 35 ) ) 01881 * 01882 * Call ZSTEMR to compute D2, do tests. 01883 * 01884 * Compute D2 01885 * 01886 CALL DCOPY( N, SD, 1, D5, 1 ) 01887 IF( N.GT.0 ) 01888 $ CALL DCOPY( N-1, SE, 1, RWORK, 1 ) 01889 * 01890 NTEST = 37 01891 CALL ZSTEMR( 'N', 'A', N, D5, RWORK, VL, VU, IL, IU, 01892 $ M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC, 01893 $ RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ), 01894 $ LIWORK-2*N, IINFO ) 01895 IF( IINFO.NE.0 ) THEN 01896 WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(N,A)', IINFO, N, 01897 $ JTYPE, IOLDSD 01898 INFO = ABS( IINFO ) 01899 IF( IINFO.LT.0 ) THEN 01900 RETURN 01901 ELSE 01902 RESULT( 37 ) = ULPINV 01903 GO TO 280 01904 END IF 01905 END IF 01906 * 01907 * Do Test 34 01908 * 01909 TEMP1 = ZERO 01910 TEMP2 = ZERO 01911 * 01912 DO 260 J = 1, N 01913 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) ) 01914 TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) ) 01915 260 CONTINUE 01916 * 01917 RESULT( 37 ) = TEMP2 / MAX( UNFL, 01918 $ ULP*MAX( TEMP1, TEMP2 ) ) 01919 END IF 01920 270 CONTINUE 01921 280 CONTINUE 01922 NTESTT = NTESTT + NTEST 01923 * 01924 * End of Loop -- Check for RESULT(j) > THRESH 01925 * 01926 * 01927 * Print out tests which fail. 01928 * 01929 DO 290 JR = 1, NTEST 01930 IF( RESULT( JR ).GE.THRESH ) THEN 01931 * 01932 * If this is the first test to fail, 01933 * print a header to the data file. 01934 * 01935 IF( NERRS.EQ.0 ) THEN 01936 WRITE( NOUNIT, FMT = 9998 )'ZST' 01937 WRITE( NOUNIT, FMT = 9997 ) 01938 WRITE( NOUNIT, FMT = 9996 ) 01939 WRITE( NOUNIT, FMT = 9995 )'Hermitian' 01940 WRITE( NOUNIT, FMT = 9994 ) 01941 * 01942 * Tests performed 01943 * 01944 WRITE( NOUNIT, FMT = 9987 ) 01945 END IF 01946 NERRS = NERRS + 1 01947 IF( RESULT( JR ).LT.10000.0D0 ) THEN 01948 WRITE( NOUNIT, FMT = 9989 )N, JTYPE, IOLDSD, JR, 01949 $ RESULT( JR ) 01950 ELSE 01951 WRITE( NOUNIT, FMT = 9988 )N, JTYPE, IOLDSD, JR, 01952 $ RESULT( JR ) 01953 END IF 01954 END IF 01955 290 CONTINUE 01956 300 CONTINUE 01957 310 CONTINUE 01958 * 01959 * Summary 01960 * 01961 CALL DLASUM( 'ZST', NOUNIT, NERRS, NTESTT ) 01962 RETURN 01963 * 01964 9999 FORMAT( ' ZCHKST: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', 01965 $ I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' ) 01966 * 01967 9998 FORMAT( / 1X, A3, ' -- Complex Hermitian eigenvalue problem' ) 01968 9997 FORMAT( ' Matrix types (see ZCHKST for details): ' ) 01969 * 01970 9996 FORMAT( / ' Special Matrices:', 01971 $ / ' 1=Zero matrix. ', 01972 $ ' 5=Diagonal: clustered entries.', 01973 $ / ' 2=Identity matrix. ', 01974 $ ' 6=Diagonal: large, evenly spaced.', 01975 $ / ' 3=Diagonal: evenly spaced entries. ', 01976 $ ' 7=Diagonal: small, evenly spaced.', 01977 $ / ' 4=Diagonal: geometr. spaced entries.' ) 01978 9995 FORMAT( ' Dense ', A, ' Matrices:', 01979 $ / ' 8=Evenly spaced eigenvals. ', 01980 $ ' 12=Small, evenly spaced eigenvals.', 01981 $ / ' 9=Geometrically spaced eigenvals. ', 01982 $ ' 13=Matrix with random O(1) entries.', 01983 $ / ' 10=Clustered eigenvalues. ', 01984 $ ' 14=Matrix with large random entries.', 01985 $ / ' 11=Large, evenly spaced eigenvals. ', 01986 $ ' 15=Matrix with small random entries.' ) 01987 9994 FORMAT( ' 16=Positive definite, evenly spaced eigenvalues', 01988 $ / ' 17=Positive definite, geometrically spaced eigenvlaues', 01989 $ / ' 18=Positive definite, clustered eigenvalues', 01990 $ / ' 19=Positive definite, small evenly spaced eigenvalues', 01991 $ / ' 20=Positive definite, large evenly spaced eigenvalues', 01992 $ / ' 21=Diagonally dominant tridiagonal, geometrically', 01993 $ ' spaced eigenvalues' ) 01994 * 01995 9989 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=', 01996 $ 4( I4, ',' ), ' result ', I3, ' is', 0P, F8.2 ) 01997 9988 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=', 01998 $ 4( I4, ',' ), ' result ', I3, ' is', 1P, D10.3 ) 01999 * 02000 9987 FORMAT( / 'Test performed: see ZCHKST for details.', / ) 02001 * End of ZCHKST 02002 * 02003 END