![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DDRVST 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 DDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 00012 * NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1, 00013 * WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK, 00014 * IWORK, LIWORK, RESULT, INFO ) 00015 * 00016 * .. Scalar Arguments .. 00017 * INTEGER INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES, 00018 * $ NTYPES 00019 * DOUBLE PRECISION THRESH 00020 * .. 00021 * .. Array Arguments .. 00022 * LOGICAL DOTYPE( * ) 00023 * INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 00024 * DOUBLE PRECISION A( LDA, * ), D1( * ), D2( * ), D3( * ), 00025 * $ D4( * ), EVEIGS( * ), RESULT( * ), TAU( * ), 00026 * $ U( LDU, * ), V( LDU, * ), WA1( * ), WA2( * ), 00027 * $ WA3( * ), WORK( * ), Z( LDU, * ) 00028 * .. 00029 * 00030 * 00031 *> \par Purpose: 00032 * ============= 00033 *> 00034 *> \verbatim 00035 *> 00036 *> DDRVST checks the symmetric eigenvalue problem drivers. 00037 *> 00038 *> DSTEV computes all eigenvalues and, optionally, 00039 *> eigenvectors of a real symmetric tridiagonal matrix. 00040 *> 00041 *> DSTEVX computes selected eigenvalues and, optionally, 00042 *> eigenvectors of a real symmetric tridiagonal matrix. 00043 *> 00044 *> DSTEVR computes selected eigenvalues and, optionally, 00045 *> eigenvectors of a real symmetric tridiagonal matrix 00046 *> using the Relatively Robust Representation where it can. 00047 *> 00048 *> DSYEV computes all eigenvalues and, optionally, 00049 *> eigenvectors of a real symmetric matrix. 00050 *> 00051 *> DSYEVX computes selected eigenvalues and, optionally, 00052 *> eigenvectors of a real symmetric matrix. 00053 *> 00054 *> DSYEVR computes selected eigenvalues and, optionally, 00055 *> eigenvectors of a real symmetric matrix 00056 *> using the Relatively Robust Representation where it can. 00057 *> 00058 *> DSPEV computes all eigenvalues and, optionally, 00059 *> eigenvectors of a real symmetric matrix in packed 00060 *> storage. 00061 *> 00062 *> DSPEVX computes selected eigenvalues and, optionally, 00063 *> eigenvectors of a real symmetric matrix in packed 00064 *> storage. 00065 *> 00066 *> DSBEV computes all eigenvalues and, optionally, 00067 *> eigenvectors of a real symmetric band matrix. 00068 *> 00069 *> DSBEVX computes selected eigenvalues and, optionally, 00070 *> eigenvectors of a real symmetric band matrix. 00071 *> 00072 *> DSYEVD computes all eigenvalues and, optionally, 00073 *> eigenvectors of a real symmetric matrix using 00074 *> a divide and conquer algorithm. 00075 *> 00076 *> DSPEVD computes all eigenvalues and, optionally, 00077 *> eigenvectors of a real symmetric matrix in packed 00078 *> storage, using a divide and conquer algorithm. 00079 *> 00080 *> DSBEVD computes all eigenvalues and, optionally, 00081 *> eigenvectors of a real symmetric band matrix, 00082 *> using a divide and conquer algorithm. 00083 *> 00084 *> When DDRVST is called, a number of matrix "sizes" ("n's") and a 00085 *> number of matrix "types" are specified. For each size ("n") 00086 *> and each type of matrix, one matrix will be generated and used 00087 *> to test the appropriate drivers. For each matrix and each 00088 *> driver routine called, the following tests will be performed: 00089 *> 00090 *> (1) | A - Z D Z' | / ( |A| n ulp ) 00091 *> 00092 *> (2) | I - Z Z' | / ( n ulp ) 00093 *> 00094 *> (3) | D1 - D2 | / ( |D1| ulp ) 00095 *> 00096 *> where Z is the matrix of eigenvectors returned when the 00097 *> eigenvector option is given and D1 and D2 are the eigenvalues 00098 *> returned with and without the eigenvector option. 00099 *> 00100 *> The "sizes" are specified by an array NN(1:NSIZES); the value of 00101 *> each element NN(j) specifies one size. 00102 *> The "types" are specified by a logical array DOTYPE( 1:NTYPES ); 00103 *> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated. 00104 *> Currently, the list of possible types is: 00105 *> 00106 *> (1) The zero matrix. 00107 *> (2) The identity matrix. 00108 *> 00109 *> (3) A diagonal matrix with evenly spaced eigenvalues 00110 *> 1, ..., ULP and random signs. 00111 *> (ULP = (first number larger than 1) - 1 ) 00112 *> (4) A diagonal matrix with geometrically spaced eigenvalues 00113 *> 1, ..., ULP and random signs. 00114 *> (5) A diagonal matrix with "clustered" eigenvalues 00115 *> 1, ULP, ..., ULP and random signs. 00116 *> 00117 *> (6) Same as (4), but multiplied by SQRT( overflow threshold ) 00118 *> (7) Same as (4), but multiplied by SQRT( underflow threshold ) 00119 *> 00120 *> (8) A matrix of the form U' D U, where U is orthogonal and 00121 *> D has evenly spaced entries 1, ..., ULP with random signs 00122 *> on the diagonal. 00123 *> 00124 *> (9) A matrix of the form U' D U, where U is orthogonal and 00125 *> D has geometrically spaced entries 1, ..., ULP with random 00126 *> signs on the diagonal. 00127 *> 00128 *> (10) A matrix of the form U' D U, where U is orthogonal and 00129 *> D has "clustered" entries 1, ULP,..., ULP with random 00130 *> signs on the diagonal. 00131 *> 00132 *> (11) Same as (8), but multiplied by SQRT( overflow threshold ) 00133 *> (12) Same as (8), but multiplied by SQRT( underflow threshold ) 00134 *> 00135 *> (13) Symmetric matrix with random entries chosen from (-1,1). 00136 *> (14) Same as (13), but multiplied by SQRT( overflow threshold ) 00137 *> (15) Same as (13), but multiplied by SQRT( underflow threshold ) 00138 *> (16) A band matrix with half bandwidth randomly chosen between 00139 *> 0 and N-1, with evenly spaced eigenvalues 1, ..., ULP 00140 *> with random signs. 00141 *> (17) Same as (16), but multiplied by SQRT( overflow threshold ) 00142 *> (18) Same as (16), but multiplied by SQRT( underflow threshold ) 00143 *> \endverbatim 00144 * 00145 * Arguments: 00146 * ========== 00147 * 00148 *> \verbatim 00149 *> NSIZES INTEGER 00150 *> The number of sizes of matrices to use. If it is zero, 00151 *> DDRVST does nothing. It must be at least zero. 00152 *> Not modified. 00153 *> 00154 *> NN INTEGER array, dimension (NSIZES) 00155 *> An array containing the sizes to be used for the matrices. 00156 *> Zero values will be skipped. The values must be at least 00157 *> zero. 00158 *> Not modified. 00159 *> 00160 *> NTYPES INTEGER 00161 *> The number of elements in DOTYPE. If it is zero, DDRVST 00162 *> does nothing. It must be at least zero. If it is MAXTYP+1 00163 *> and NSIZES is 1, then an additional type, MAXTYP+1 is 00164 *> defined, which is to use whatever matrix is in A. This 00165 *> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and 00166 *> DOTYPE(MAXTYP+1) is .TRUE. . 00167 *> Not modified. 00168 *> 00169 *> DOTYPE LOGICAL array, dimension (NTYPES) 00170 *> If DOTYPE(j) is .TRUE., then for each size in NN a 00171 *> matrix of that size and of type j will be generated. 00172 *> If NTYPES is smaller than the maximum number of types 00173 *> defined (PARAMETER MAXTYP), then types NTYPES+1 through 00174 *> MAXTYP will not be generated. If NTYPES is larger 00175 *> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) 00176 *> will be ignored. 00177 *> Not modified. 00178 *> 00179 *> ISEED INTEGER array, dimension (4) 00180 *> On entry ISEED specifies the seed of the random number 00181 *> generator. The array elements should be between 0 and 4095; 00182 *> if not they will be reduced mod 4096. Also, ISEED(4) must 00183 *> be odd. The random number generator uses a linear 00184 *> congruential sequence limited to small integers, and so 00185 *> should produce machine independent random numbers. The 00186 *> values of ISEED are changed on exit, and can be used in the 00187 *> next call to DDRVST to continue the same random number 00188 *> sequence. 00189 *> Modified. 00190 *> 00191 *> THRESH DOUBLE PRECISION 00192 *> A test will count as "failed" if the "error", computed as 00193 *> described above, exceeds THRESH. Note that the error 00194 *> is scaled to be O(1), so THRESH should be a reasonably 00195 *> small multiple of 1, e.g., 10 or 100. In particular, 00196 *> it should not depend on the precision (single vs. double) 00197 *> or the size of the matrix. It must be at least zero. 00198 *> Not modified. 00199 *> 00200 *> NOUNIT INTEGER 00201 *> The FORTRAN unit number for printing out error messages 00202 *> (e.g., if a routine returns IINFO not equal to 0.) 00203 *> Not modified. 00204 *> 00205 *> A DOUBLE PRECISION array, dimension (LDA , max(NN)) 00206 *> Used to hold the matrix whose eigenvalues are to be 00207 *> computed. On exit, A contains the last matrix actually 00208 *> used. 00209 *> Modified. 00210 *> 00211 *> LDA INTEGER 00212 *> The leading dimension of A. It must be at 00213 *> least 1 and at least max( NN ). 00214 *> Not modified. 00215 *> 00216 *> D1 DOUBLE PRECISION array, dimension (max(NN)) 00217 *> The eigenvalues of A, as computed by DSTEQR simlutaneously 00218 *> with Z. On exit, the eigenvalues in D1 correspond with the 00219 *> matrix in A. 00220 *> Modified. 00221 *> 00222 *> D2 DOUBLE PRECISION array, dimension (max(NN)) 00223 *> The eigenvalues of A, as computed by DSTEQR if Z is not 00224 *> computed. On exit, the eigenvalues in D2 correspond with 00225 *> the matrix in A. 00226 *> Modified. 00227 *> 00228 *> D3 DOUBLE PRECISION array, dimension (max(NN)) 00229 *> The eigenvalues of A, as computed by DSTERF. On exit, the 00230 *> eigenvalues in D3 correspond with the matrix in A. 00231 *> Modified. 00232 *> 00233 *> D4 DOUBLE PRECISION array, dimension 00234 *> 00235 *> EVEIGS DOUBLE PRECISION array, dimension (max(NN)) 00236 *> The eigenvalues as computed by DSTEV('N', ... ) 00237 *> (I reserve the right to change this to the output of 00238 *> whichever algorithm computes the most accurate eigenvalues). 00239 *> 00240 *> WA1 DOUBLE PRECISION array, dimension 00241 *> 00242 *> WA2 DOUBLE PRECISION array, dimension 00243 *> 00244 *> WA3 DOUBLE PRECISION array, dimension 00245 *> 00246 *> U DOUBLE PRECISION array, dimension (LDU, max(NN)) 00247 *> The orthogonal matrix computed by DSYTRD + DORGTR. 00248 *> Modified. 00249 *> 00250 *> LDU INTEGER 00251 *> The leading dimension of U, Z, and V. It must be at 00252 *> least 1 and at least max( NN ). 00253 *> Not modified. 00254 *> 00255 *> V DOUBLE PRECISION array, dimension (LDU, max(NN)) 00256 *> The Housholder vectors computed by DSYTRD in reducing A to 00257 *> tridiagonal form. 00258 *> Modified. 00259 *> 00260 *> TAU DOUBLE PRECISION array, dimension (max(NN)) 00261 *> The Householder factors computed by DSYTRD in reducing A 00262 *> to tridiagonal form. 00263 *> Modified. 00264 *> 00265 *> Z DOUBLE PRECISION array, dimension (LDU, max(NN)) 00266 *> The orthogonal matrix of eigenvectors computed by DSTEQR, 00267 *> DPTEQR, and DSTEIN. 00268 *> Modified. 00269 *> 00270 *> WORK DOUBLE PRECISION array, dimension (LWORK) 00271 *> Workspace. 00272 *> Modified. 00273 *> 00274 *> LWORK INTEGER 00275 *> The number of entries in WORK. This must be at least 00276 *> 1 + 4 * Nmax + 2 * Nmax * lg Nmax + 4 * Nmax**2 00277 *> where Nmax = max( NN(j), 2 ) and lg = log base 2. 00278 *> Not modified. 00279 *> 00280 *> IWORK INTEGER array, 00281 *> dimension (6 + 6*Nmax + 5 * Nmax * lg Nmax ) 00282 *> where Nmax = max( NN(j), 2 ) and lg = log base 2. 00283 *> Workspace. 00284 *> Modified. 00285 *> 00286 *> RESULT DOUBLE PRECISION array, dimension (105) 00287 *> The values computed by the tests described above. 00288 *> The values are currently limited to 1/ulp, to avoid 00289 *> overflow. 00290 *> Modified. 00291 *> 00292 *> INFO INTEGER 00293 *> If 0, then everything ran OK. 00294 *> -1: NSIZES < 0 00295 *> -2: Some NN(j) < 0 00296 *> -3: NTYPES < 0 00297 *> -5: THRESH < 0 00298 *> -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ). 00299 *> -16: LDU < 1 or LDU < NMAX. 00300 *> -21: LWORK too small. 00301 *> If DLATMR, DLATMS, DSYTRD, DORGTR, DSTEQR, DSTERF, 00302 *> or DORMTR returns an error code, the 00303 *> absolute value of it is returned. 00304 *> Modified. 00305 *> 00306 *>----------------------------------------------------------------------- 00307 *> 00308 *> Some Local Variables and Parameters: 00309 *> ---- ----- --------- --- ---------- 00310 *> ZERO, ONE Real 0 and 1. 00311 *> MAXTYP The number of types defined. 00312 *> NTEST The number of tests performed, or which can 00313 *> be performed so far, for the current matrix. 00314 *> NTESTT The total number of tests performed so far. 00315 *> NMAX Largest value in NN. 00316 *> NMATS The number of matrices generated so far. 00317 *> NERRS The number of tests which have exceeded THRESH 00318 *> so far (computed by DLAFTS). 00319 *> COND, IMODE Values to be passed to the matrix generators. 00320 *> ANORM Norm of A; passed to matrix generators. 00321 *> 00322 *> OVFL, UNFL Overflow and underflow thresholds. 00323 *> ULP, ULPINV Finest relative precision and its inverse. 00324 *> RTOVFL, RTUNFL Square roots of the previous 2 values. 00325 *> The following four arrays decode JTYPE: 00326 *> KTYPE(j) The general type (1-10) for type "j". 00327 *> KMODE(j) The MODE value to be passed to the matrix 00328 *> generator for type "j". 00329 *> KMAGN(j) The order of magnitude ( O(1), 00330 *> O(overflow^(1/2) ), O(underflow^(1/2) ) 00331 *> 00332 *> The tests performed are: Routine tested 00333 *> 1= | A - U S U' | / ( |A| n ulp ) DSTEV('V', ... ) 00334 *> 2= | I - U U' | / ( n ulp ) DSTEV('V', ... ) 00335 *> 3= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEV('N', ... ) 00336 *> 4= | A - U S U' | / ( |A| n ulp ) DSTEVX('V','A', ... ) 00337 *> 5= | I - U U' | / ( n ulp ) DSTEVX('V','A', ... ) 00338 *> 6= |D(with Z) - EVEIGS| / (|D| ulp) DSTEVX('N','A', ... ) 00339 *> 7= | A - U S U' | / ( |A| n ulp ) DSTEVR('V','A', ... ) 00340 *> 8= | I - U U' | / ( n ulp ) DSTEVR('V','A', ... ) 00341 *> 9= |D(with Z) - EVEIGS| / (|D| ulp) DSTEVR('N','A', ... ) 00342 *> 10= | A - U S U' | / ( |A| n ulp ) DSTEVX('V','I', ... ) 00343 *> 11= | I - U U' | / ( n ulp ) DSTEVX('V','I', ... ) 00344 *> 12= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEVX('N','I', ... ) 00345 *> 13= | A - U S U' | / ( |A| n ulp ) DSTEVX('V','V', ... ) 00346 *> 14= | I - U U' | / ( n ulp ) DSTEVX('V','V', ... ) 00347 *> 15= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEVX('N','V', ... ) 00348 *> 16= | A - U S U' | / ( |A| n ulp ) DSTEVD('V', ... ) 00349 *> 17= | I - U U' | / ( n ulp ) DSTEVD('V', ... ) 00350 *> 18= |D(with Z) - EVEIGS| / (|D| ulp) DSTEVD('N', ... ) 00351 *> 19= | A - U S U' | / ( |A| n ulp ) DSTEVR('V','I', ... ) 00352 *> 20= | I - U U' | / ( n ulp ) DSTEVR('V','I', ... ) 00353 *> 21= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEVR('N','I', ... ) 00354 *> 22= | A - U S U' | / ( |A| n ulp ) DSTEVR('V','V', ... ) 00355 *> 23= | I - U U' | / ( n ulp ) DSTEVR('V','V', ... ) 00356 *> 24= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEVR('N','V', ... ) 00357 *> 00358 *> 25= | A - U S U' | / ( |A| n ulp ) DSYEV('L','V', ... ) 00359 *> 26= | I - U U' | / ( n ulp ) DSYEV('L','V', ... ) 00360 *> 27= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEV('L','N', ... ) 00361 *> 28= | A - U S U' | / ( |A| n ulp ) DSYEVX('L','V','A', ... ) 00362 *> 29= | I - U U' | / ( n ulp ) DSYEVX('L','V','A', ... ) 00363 *> 30= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVX('L','N','A', ... ) 00364 *> 31= | A - U S U' | / ( |A| n ulp ) DSYEVX('L','V','I', ... ) 00365 *> 32= | I - U U' | / ( n ulp ) DSYEVX('L','V','I', ... ) 00366 *> 33= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVX('L','N','I', ... ) 00367 *> 34= | A - U S U' | / ( |A| n ulp ) DSYEVX('L','V','V', ... ) 00368 *> 35= | I - U U' | / ( n ulp ) DSYEVX('L','V','V', ... ) 00369 *> 36= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVX('L','N','V', ... ) 00370 *> 37= | A - U S U' | / ( |A| n ulp ) DSPEV('L','V', ... ) 00371 *> 38= | I - U U' | / ( n ulp ) DSPEV('L','V', ... ) 00372 *> 39= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEV('L','N', ... ) 00373 *> 40= | A - U S U' | / ( |A| n ulp ) DSPEVX('L','V','A', ... ) 00374 *> 41= | I - U U' | / ( n ulp ) DSPEVX('L','V','A', ... ) 00375 *> 42= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVX('L','N','A', ... ) 00376 *> 43= | A - U S U' | / ( |A| n ulp ) DSPEVX('L','V','I', ... ) 00377 *> 44= | I - U U' | / ( n ulp ) DSPEVX('L','V','I', ... ) 00378 *> 45= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVX('L','N','I', ... ) 00379 *> 46= | A - U S U' | / ( |A| n ulp ) DSPEVX('L','V','V', ... ) 00380 *> 47= | I - U U' | / ( n ulp ) DSPEVX('L','V','V', ... ) 00381 *> 48= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVX('L','N','V', ... ) 00382 *> 49= | A - U S U' | / ( |A| n ulp ) DSBEV('L','V', ... ) 00383 *> 50= | I - U U' | / ( n ulp ) DSBEV('L','V', ... ) 00384 *> 51= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEV('L','N', ... ) 00385 *> 52= | A - U S U' | / ( |A| n ulp ) DSBEVX('L','V','A', ... ) 00386 *> 53= | I - U U' | / ( n ulp ) DSBEVX('L','V','A', ... ) 00387 *> 54= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVX('L','N','A', ... ) 00388 *> 55= | A - U S U' | / ( |A| n ulp ) DSBEVX('L','V','I', ... ) 00389 *> 56= | I - U U' | / ( n ulp ) DSBEVX('L','V','I', ... ) 00390 *> 57= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVX('L','N','I', ... ) 00391 *> 58= | A - U S U' | / ( |A| n ulp ) DSBEVX('L','V','V', ... ) 00392 *> 59= | I - U U' | / ( n ulp ) DSBEVX('L','V','V', ... ) 00393 *> 60= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVX('L','N','V', ... ) 00394 *> 61= | A - U S U' | / ( |A| n ulp ) DSYEVD('L','V', ... ) 00395 *> 62= | I - U U' | / ( n ulp ) DSYEVD('L','V', ... ) 00396 *> 63= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVD('L','N', ... ) 00397 *> 64= | A - U S U' | / ( |A| n ulp ) DSPEVD('L','V', ... ) 00398 *> 65= | I - U U' | / ( n ulp ) DSPEVD('L','V', ... ) 00399 *> 66= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVD('L','N', ... ) 00400 *> 67= | A - U S U' | / ( |A| n ulp ) DSBEVD('L','V', ... ) 00401 *> 68= | I - U U' | / ( n ulp ) DSBEVD('L','V', ... ) 00402 *> 69= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVD('L','N', ... ) 00403 *> 70= | A - U S U' | / ( |A| n ulp ) DSYEVR('L','V','A', ... ) 00404 *> 71= | I - U U' | / ( n ulp ) DSYEVR('L','V','A', ... ) 00405 *> 72= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVR('L','N','A', ... ) 00406 *> 73= | A - U S U' | / ( |A| n ulp ) DSYEVR('L','V','I', ... ) 00407 *> 74= | I - U U' | / ( n ulp ) DSYEVR('L','V','I', ... ) 00408 *> 75= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVR('L','N','I', ... ) 00409 *> 76= | A - U S U' | / ( |A| n ulp ) DSYEVR('L','V','V', ... ) 00410 *> 77= | I - U U' | / ( n ulp ) DSYEVR('L','V','V', ... ) 00411 *> 78= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVR('L','N','V', ... ) 00412 *> 00413 *> Tests 25 through 78 are repeated (as tests 79 through 132) 00414 *> with UPLO='U' 00415 *> 00416 *> To be added in 1999 00417 *> 00418 *> 79= | A - U S U' | / ( |A| n ulp ) DSPEVR('L','V','A', ... ) 00419 *> 80= | I - U U' | / ( n ulp ) DSPEVR('L','V','A', ... ) 00420 *> 81= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVR('L','N','A', ... ) 00421 *> 82= | A - U S U' | / ( |A| n ulp ) DSPEVR('L','V','I', ... ) 00422 *> 83= | I - U U' | / ( n ulp ) DSPEVR('L','V','I', ... ) 00423 *> 84= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVR('L','N','I', ... ) 00424 *> 85= | A - U S U' | / ( |A| n ulp ) DSPEVR('L','V','V', ... ) 00425 *> 86= | I - U U' | / ( n ulp ) DSPEVR('L','V','V', ... ) 00426 *> 87= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVR('L','N','V', ... ) 00427 *> 88= | A - U S U' | / ( |A| n ulp ) DSBEVR('L','V','A', ... ) 00428 *> 89= | I - U U' | / ( n ulp ) DSBEVR('L','V','A', ... ) 00429 *> 90= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVR('L','N','A', ... ) 00430 *> 91= | A - U S U' | / ( |A| n ulp ) DSBEVR('L','V','I', ... ) 00431 *> 92= | I - U U' | / ( n ulp ) DSBEVR('L','V','I', ... ) 00432 *> 93= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVR('L','N','I', ... ) 00433 *> 94= | A - U S U' | / ( |A| n ulp ) DSBEVR('L','V','V', ... ) 00434 *> 95= | I - U U' | / ( n ulp ) DSBEVR('L','V','V', ... ) 00435 *> 96= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVR('L','N','V', ... ) 00436 *> \endverbatim 00437 * 00438 * Authors: 00439 * ======== 00440 * 00441 *> \author Univ. of Tennessee 00442 *> \author Univ. of California Berkeley 00443 *> \author Univ. of Colorado Denver 00444 *> \author NAG Ltd. 00445 * 00446 *> \date November 2011 00447 * 00448 *> \ingroup double_eig 00449 * 00450 * ===================================================================== 00451 SUBROUTINE DDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 00452 $ NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1, 00453 $ WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK, 00454 $ IWORK, LIWORK, RESULT, INFO ) 00455 * 00456 * -- LAPACK test routine (version 3.4.0) -- 00457 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00458 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00459 * November 2011 00460 * 00461 * .. Scalar Arguments .. 00462 INTEGER INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES, 00463 $ NTYPES 00464 DOUBLE PRECISION THRESH 00465 * .. 00466 * .. Array Arguments .. 00467 LOGICAL DOTYPE( * ) 00468 INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 00469 DOUBLE PRECISION A( LDA, * ), D1( * ), D2( * ), D3( * ), 00470 $ D4( * ), EVEIGS( * ), RESULT( * ), TAU( * ), 00471 $ U( LDU, * ), V( LDU, * ), WA1( * ), WA2( * ), 00472 $ WA3( * ), WORK( * ), Z( LDU, * ) 00473 * .. 00474 * 00475 * ===================================================================== 00476 * 00477 * .. Parameters .. 00478 DOUBLE PRECISION ZERO, ONE, TWO, TEN 00479 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0, 00480 $ TEN = 10.0D0 ) 00481 DOUBLE PRECISION HALF 00482 PARAMETER ( HALF = 0.5D0 ) 00483 INTEGER MAXTYP 00484 PARAMETER ( MAXTYP = 18 ) 00485 * .. 00486 * .. Local Scalars .. 00487 LOGICAL BADNN 00488 CHARACTER UPLO 00489 INTEGER I, IDIAG, IHBW, IINFO, IL, IMODE, INDX, IROW, 00490 $ ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL, 00491 $ JSIZE, JTYPE, KD, LGN, LIWEDC, LWEDC, M, M2, 00492 $ M3, MTYPES, N, NERRS, NMATS, NMAX, NTEST, 00493 $ NTESTT 00494 DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL, 00495 $ RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL, 00496 $ VL, VU 00497 * .. 00498 * .. Local Arrays .. 00499 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ), 00500 $ ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ), 00501 $ KTYPE( MAXTYP ) 00502 * .. 00503 * .. External Functions .. 00504 DOUBLE PRECISION DLAMCH, DLARND, DSXT1 00505 EXTERNAL DLAMCH, DLARND, DSXT1 00506 * .. 00507 * .. External Subroutines .. 00508 EXTERNAL ALASVM, DLABAD, DLACPY, DLAFTS, DLASET, DLATMR, 00509 $ DLATMS, DSBEV, DSBEVD, DSBEVX, DSPEV, DSPEVD, 00510 $ DSPEVX, DSTEV, DSTEVD, DSTEVR, DSTEVX, DSTT21, 00511 $ DSTT22, DSYEV, DSYEVD, DSYEVR, DSYEVX, DSYT21, 00512 $ DSYT22, XERBLA 00513 * .. 00514 * .. Scalars in Common .. 00515 CHARACTER*32 SRNAMT 00516 * .. 00517 * .. Common blocks .. 00518 COMMON / SRNAMC / SRNAMT 00519 * .. 00520 * .. Intrinsic Functions .. 00521 INTRINSIC ABS, DBLE, INT, LOG, MAX, MIN, SQRT 00522 * .. 00523 * .. Data statements .. 00524 DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 3*9 / 00525 DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1, 00526 $ 2, 3, 1, 2, 3 / 00527 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, 00528 $ 0, 0, 4, 4, 4 / 00529 * .. 00530 * .. Executable Statements .. 00531 * 00532 * Keep ftrnchek happy 00533 * 00534 VL = ZERO 00535 VU = ZERO 00536 * 00537 * 1) Check for errors 00538 * 00539 NTESTT = 0 00540 INFO = 0 00541 * 00542 BADNN = .FALSE. 00543 NMAX = 1 00544 DO 10 J = 1, NSIZES 00545 NMAX = MAX( NMAX, NN( J ) ) 00546 IF( NN( J ).LT.0 ) 00547 $ BADNN = .TRUE. 00548 10 CONTINUE 00549 * 00550 * Check for errors 00551 * 00552 IF( NSIZES.LT.0 ) THEN 00553 INFO = -1 00554 ELSE IF( BADNN ) THEN 00555 INFO = -2 00556 ELSE IF( NTYPES.LT.0 ) THEN 00557 INFO = -3 00558 ELSE IF( LDA.LT.NMAX ) THEN 00559 INFO = -9 00560 ELSE IF( LDU.LT.NMAX ) THEN 00561 INFO = -16 00562 ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN 00563 INFO = -21 00564 END IF 00565 * 00566 IF( INFO.NE.0 ) THEN 00567 CALL XERBLA( 'DDRVST', -INFO ) 00568 RETURN 00569 END IF 00570 * 00571 * Quick return if nothing to do 00572 * 00573 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 ) 00574 $ RETURN 00575 * 00576 * More Important constants 00577 * 00578 UNFL = DLAMCH( 'Safe minimum' ) 00579 OVFL = DLAMCH( 'Overflow' ) 00580 CALL DLABAD( UNFL, OVFL ) 00581 ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) 00582 ULPINV = ONE / ULP 00583 RTUNFL = SQRT( UNFL ) 00584 RTOVFL = SQRT( OVFL ) 00585 * 00586 * Loop over sizes, types 00587 * 00588 DO 20 I = 1, 4 00589 ISEED2( I ) = ISEED( I ) 00590 ISEED3( I ) = ISEED( I ) 00591 20 CONTINUE 00592 * 00593 NERRS = 0 00594 NMATS = 0 00595 * 00596 * 00597 DO 1740 JSIZE = 1, NSIZES 00598 N = NN( JSIZE ) 00599 IF( N.GT.0 ) THEN 00600 LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) ) 00601 IF( 2**LGN.LT.N ) 00602 $ LGN = LGN + 1 00603 IF( 2**LGN.LT.N ) 00604 $ LGN = LGN + 1 00605 LWEDC = 1 + 4*N + 2*N*LGN + 4*N**2 00606 c LIWEDC = 6 + 6*N + 5*N*LGN 00607 LIWEDC = 3 + 5*N 00608 ELSE 00609 LWEDC = 9 00610 c LIWEDC = 12 00611 LIWEDC = 8 00612 END IF 00613 ANINV = ONE / DBLE( MAX( 1, N ) ) 00614 * 00615 IF( NSIZES.NE.1 ) THEN 00616 MTYPES = MIN( MAXTYP, NTYPES ) 00617 ELSE 00618 MTYPES = MIN( MAXTYP+1, NTYPES ) 00619 END IF 00620 * 00621 DO 1730 JTYPE = 1, MTYPES 00622 * 00623 IF( .NOT.DOTYPE( JTYPE ) ) 00624 $ GO TO 1730 00625 NMATS = NMATS + 1 00626 NTEST = 0 00627 * 00628 DO 30 J = 1, 4 00629 IOLDSD( J ) = ISEED( J ) 00630 30 CONTINUE 00631 * 00632 * 2) Compute "A" 00633 * 00634 * Control parameters: 00635 * 00636 * KMAGN KMODE KTYPE 00637 * =1 O(1) clustered 1 zero 00638 * =2 large clustered 2 identity 00639 * =3 small exponential (none) 00640 * =4 arithmetic diagonal, (w/ eigenvalues) 00641 * =5 random log symmetric, w/ eigenvalues 00642 * =6 random (none) 00643 * =7 random diagonal 00644 * =8 random symmetric 00645 * =9 band symmetric, w/ eigenvalues 00646 * 00647 IF( MTYPES.GT.MAXTYP ) 00648 $ GO TO 110 00649 * 00650 ITYPE = KTYPE( JTYPE ) 00651 IMODE = KMODE( JTYPE ) 00652 * 00653 * Compute norm 00654 * 00655 GO TO ( 40, 50, 60 )KMAGN( JTYPE ) 00656 * 00657 40 CONTINUE 00658 ANORM = ONE 00659 GO TO 70 00660 * 00661 50 CONTINUE 00662 ANORM = ( RTOVFL*ULP )*ANINV 00663 GO TO 70 00664 * 00665 60 CONTINUE 00666 ANORM = RTUNFL*N*ULPINV 00667 GO TO 70 00668 * 00669 70 CONTINUE 00670 * 00671 CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA ) 00672 IINFO = 0 00673 COND = ULPINV 00674 * 00675 * Special Matrices -- Identity & Jordan block 00676 * 00677 * Zero 00678 * 00679 IF( ITYPE.EQ.1 ) THEN 00680 IINFO = 0 00681 * 00682 ELSE IF( ITYPE.EQ.2 ) THEN 00683 * 00684 * Identity 00685 * 00686 DO 80 JCOL = 1, N 00687 A( JCOL, JCOL ) = ANORM 00688 80 CONTINUE 00689 * 00690 ELSE IF( ITYPE.EQ.4 ) THEN 00691 * 00692 * Diagonal Matrix, [Eigen]values Specified 00693 * 00694 CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND, 00695 $ ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ), 00696 $ IINFO ) 00697 * 00698 ELSE IF( ITYPE.EQ.5 ) THEN 00699 * 00700 * Symmetric, eigenvalues specified 00701 * 00702 CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND, 00703 $ ANORM, N, N, 'N', A, LDA, WORK( N+1 ), 00704 $ IINFO ) 00705 * 00706 ELSE IF( ITYPE.EQ.7 ) THEN 00707 * 00708 * Diagonal, random eigenvalues 00709 * 00710 IDUMMA( 1 ) = 1 00711 CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE, 00712 $ 'T', 'N', WORK( N+1 ), 1, ONE, 00713 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0, 00714 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00715 * 00716 ELSE IF( ITYPE.EQ.8 ) THEN 00717 * 00718 * Symmetric, random eigenvalues 00719 * 00720 IDUMMA( 1 ) = 1 00721 CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE, 00722 $ 'T', 'N', WORK( N+1 ), 1, ONE, 00723 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N, 00724 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00725 * 00726 ELSE IF( ITYPE.EQ.9 ) THEN 00727 * 00728 * Symmetric banded, eigenvalues specified 00729 * 00730 IHBW = INT( ( N-1 )*DLARND( 1, ISEED3 ) ) 00731 CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND, 00732 $ ANORM, IHBW, IHBW, 'Z', U, LDU, WORK( N+1 ), 00733 $ IINFO ) 00734 * 00735 * Store as dense matrix for most routines. 00736 * 00737 CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA ) 00738 DO 100 IDIAG = -IHBW, IHBW 00739 IROW = IHBW - IDIAG + 1 00740 J1 = MAX( 1, IDIAG+1 ) 00741 J2 = MIN( N, N+IDIAG ) 00742 DO 90 J = J1, J2 00743 I = J - IDIAG 00744 A( I, J ) = U( IROW, J ) 00745 90 CONTINUE 00746 100 CONTINUE 00747 ELSE 00748 IINFO = 1 00749 END IF 00750 * 00751 IF( IINFO.NE.0 ) THEN 00752 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE, 00753 $ IOLDSD 00754 INFO = ABS( IINFO ) 00755 RETURN 00756 END IF 00757 * 00758 110 CONTINUE 00759 * 00760 ABSTOL = UNFL + UNFL 00761 IF( N.LE.1 ) THEN 00762 IL = 1 00763 IU = N 00764 ELSE 00765 IL = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) ) 00766 IU = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) ) 00767 IF( IL.GT.IU ) THEN 00768 ITEMP = IL 00769 IL = IU 00770 IU = ITEMP 00771 END IF 00772 END IF 00773 * 00774 * 3) If matrix is tridiagonal, call DSTEV and DSTEVX. 00775 * 00776 IF( JTYPE.LE.7 ) THEN 00777 NTEST = 1 00778 DO 120 I = 1, N 00779 D1( I ) = DBLE( A( I, I ) ) 00780 120 CONTINUE 00781 DO 130 I = 1, N - 1 00782 D2( I ) = DBLE( A( I+1, I ) ) 00783 130 CONTINUE 00784 SRNAMT = 'DSTEV' 00785 CALL DSTEV( 'V', N, D1, D2, Z, LDU, WORK, IINFO ) 00786 IF( IINFO.NE.0 ) THEN 00787 WRITE( NOUNIT, FMT = 9999 )'DSTEV(V)', IINFO, N, 00788 $ JTYPE, IOLDSD 00789 INFO = ABS( IINFO ) 00790 IF( IINFO.LT.0 ) THEN 00791 RETURN 00792 ELSE 00793 RESULT( 1 ) = ULPINV 00794 RESULT( 2 ) = ULPINV 00795 RESULT( 3 ) = ULPINV 00796 GO TO 180 00797 END IF 00798 END IF 00799 * 00800 * Do tests 1 and 2. 00801 * 00802 DO 140 I = 1, N 00803 D3( I ) = DBLE( A( I, I ) ) 00804 140 CONTINUE 00805 DO 150 I = 1, N - 1 00806 D4( I ) = DBLE( A( I+1, I ) ) 00807 150 CONTINUE 00808 CALL DSTT21( N, 0, D3, D4, D1, D2, Z, LDU, WORK, 00809 $ RESULT( 1 ) ) 00810 * 00811 NTEST = 3 00812 DO 160 I = 1, N - 1 00813 D4( I ) = DBLE( A( I+1, I ) ) 00814 160 CONTINUE 00815 SRNAMT = 'DSTEV' 00816 CALL DSTEV( 'N', N, D3, D4, Z, LDU, WORK, IINFO ) 00817 IF( IINFO.NE.0 ) THEN 00818 WRITE( NOUNIT, FMT = 9999 )'DSTEV(N)', IINFO, N, 00819 $ JTYPE, IOLDSD 00820 INFO = ABS( IINFO ) 00821 IF( IINFO.LT.0 ) THEN 00822 RETURN 00823 ELSE 00824 RESULT( 3 ) = ULPINV 00825 GO TO 180 00826 END IF 00827 END IF 00828 * 00829 * Do test 3. 00830 * 00831 TEMP1 = ZERO 00832 TEMP2 = ZERO 00833 DO 170 J = 1, N 00834 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 00835 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 00836 170 CONTINUE 00837 RESULT( 3 ) = TEMP2 / MAX( UNFL, 00838 $ ULP*MAX( TEMP1, TEMP2 ) ) 00839 * 00840 180 CONTINUE 00841 * 00842 NTEST = 4 00843 DO 190 I = 1, N 00844 EVEIGS( I ) = D3( I ) 00845 D1( I ) = DBLE( A( I, I ) ) 00846 190 CONTINUE 00847 DO 200 I = 1, N - 1 00848 D2( I ) = DBLE( A( I+1, I ) ) 00849 200 CONTINUE 00850 SRNAMT = 'DSTEVX' 00851 CALL DSTEVX( 'V', 'A', N, D1, D2, VL, VU, IL, IU, ABSTOL, 00852 $ M, WA1, Z, LDU, WORK, IWORK, IWORK( 5*N+1 ), 00853 $ IINFO ) 00854 IF( IINFO.NE.0 ) THEN 00855 WRITE( NOUNIT, FMT = 9999 )'DSTEVX(V,A)', IINFO, N, 00856 $ JTYPE, IOLDSD 00857 INFO = ABS( IINFO ) 00858 IF( IINFO.LT.0 ) THEN 00859 RETURN 00860 ELSE 00861 RESULT( 4 ) = ULPINV 00862 RESULT( 5 ) = ULPINV 00863 RESULT( 6 ) = ULPINV 00864 GO TO 250 00865 END IF 00866 END IF 00867 IF( N.GT.0 ) THEN 00868 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 00869 ELSE 00870 TEMP3 = ZERO 00871 END IF 00872 * 00873 * Do tests 4 and 5. 00874 * 00875 DO 210 I = 1, N 00876 D3( I ) = DBLE( A( I, I ) ) 00877 210 CONTINUE 00878 DO 220 I = 1, N - 1 00879 D4( I ) = DBLE( A( I+1, I ) ) 00880 220 CONTINUE 00881 CALL DSTT21( N, 0, D3, D4, WA1, D2, Z, LDU, WORK, 00882 $ RESULT( 4 ) ) 00883 * 00884 NTEST = 6 00885 DO 230 I = 1, N - 1 00886 D4( I ) = DBLE( A( I+1, I ) ) 00887 230 CONTINUE 00888 SRNAMT = 'DSTEVX' 00889 CALL DSTEVX( 'N', 'A', N, D3, D4, VL, VU, IL, IU, ABSTOL, 00890 $ M2, WA2, Z, LDU, WORK, IWORK, 00891 $ IWORK( 5*N+1 ), IINFO ) 00892 IF( IINFO.NE.0 ) THEN 00893 WRITE( NOUNIT, FMT = 9999 )'DSTEVX(N,A)', IINFO, N, 00894 $ JTYPE, IOLDSD 00895 INFO = ABS( IINFO ) 00896 IF( IINFO.LT.0 ) THEN 00897 RETURN 00898 ELSE 00899 RESULT( 6 ) = ULPINV 00900 GO TO 250 00901 END IF 00902 END IF 00903 * 00904 * Do test 6. 00905 * 00906 TEMP1 = ZERO 00907 TEMP2 = ZERO 00908 DO 240 J = 1, N 00909 TEMP1 = MAX( TEMP1, ABS( WA2( J ) ), 00910 $ ABS( EVEIGS( J ) ) ) 00911 TEMP2 = MAX( TEMP2, ABS( WA2( J )-EVEIGS( J ) ) ) 00912 240 CONTINUE 00913 RESULT( 6 ) = TEMP2 / MAX( UNFL, 00914 $ ULP*MAX( TEMP1, TEMP2 ) ) 00915 * 00916 250 CONTINUE 00917 * 00918 NTEST = 7 00919 DO 260 I = 1, N 00920 D1( I ) = DBLE( A( I, I ) ) 00921 260 CONTINUE 00922 DO 270 I = 1, N - 1 00923 D2( I ) = DBLE( A( I+1, I ) ) 00924 270 CONTINUE 00925 SRNAMT = 'DSTEVR' 00926 CALL DSTEVR( 'V', 'A', N, D1, D2, VL, VU, IL, IU, ABSTOL, 00927 $ M, WA1, Z, LDU, IWORK, WORK, LWORK, 00928 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 00929 IF( IINFO.NE.0 ) THEN 00930 WRITE( NOUNIT, FMT = 9999 )'DSTEVR(V,A)', IINFO, N, 00931 $ JTYPE, IOLDSD 00932 INFO = ABS( IINFO ) 00933 IF( IINFO.LT.0 ) THEN 00934 RETURN 00935 ELSE 00936 RESULT( 7 ) = ULPINV 00937 RESULT( 8 ) = ULPINV 00938 GO TO 320 00939 END IF 00940 END IF 00941 IF( N.GT.0 ) THEN 00942 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 00943 ELSE 00944 TEMP3 = ZERO 00945 END IF 00946 * 00947 * Do tests 7 and 8. 00948 * 00949 DO 280 I = 1, N 00950 D3( I ) = DBLE( A( I, I ) ) 00951 280 CONTINUE 00952 DO 290 I = 1, N - 1 00953 D4( I ) = DBLE( A( I+1, I ) ) 00954 290 CONTINUE 00955 CALL DSTT21( N, 0, D3, D4, WA1, D2, Z, LDU, WORK, 00956 $ RESULT( 7 ) ) 00957 * 00958 NTEST = 9 00959 DO 300 I = 1, N - 1 00960 D4( I ) = DBLE( A( I+1, I ) ) 00961 300 CONTINUE 00962 SRNAMT = 'DSTEVR' 00963 CALL DSTEVR( 'N', 'A', N, D3, D4, VL, VU, IL, IU, ABSTOL, 00964 $ M2, WA2, Z, LDU, IWORK, WORK, LWORK, 00965 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 00966 IF( IINFO.NE.0 ) THEN 00967 WRITE( NOUNIT, FMT = 9999 )'DSTEVR(N,A)', IINFO, N, 00968 $ JTYPE, IOLDSD 00969 INFO = ABS( IINFO ) 00970 IF( IINFO.LT.0 ) THEN 00971 RETURN 00972 ELSE 00973 RESULT( 9 ) = ULPINV 00974 GO TO 320 00975 END IF 00976 END IF 00977 * 00978 * Do test 9. 00979 * 00980 TEMP1 = ZERO 00981 TEMP2 = ZERO 00982 DO 310 J = 1, N 00983 TEMP1 = MAX( TEMP1, ABS( WA2( J ) ), 00984 $ ABS( EVEIGS( J ) ) ) 00985 TEMP2 = MAX( TEMP2, ABS( WA2( J )-EVEIGS( J ) ) ) 00986 310 CONTINUE 00987 RESULT( 9 ) = TEMP2 / MAX( UNFL, 00988 $ ULP*MAX( TEMP1, TEMP2 ) ) 00989 * 00990 320 CONTINUE 00991 * 00992 * 00993 NTEST = 10 00994 DO 330 I = 1, N 00995 D1( I ) = DBLE( A( I, I ) ) 00996 330 CONTINUE 00997 DO 340 I = 1, N - 1 00998 D2( I ) = DBLE( A( I+1, I ) ) 00999 340 CONTINUE 01000 SRNAMT = 'DSTEVX' 01001 CALL DSTEVX( 'V', 'I', N, D1, D2, VL, VU, IL, IU, ABSTOL, 01002 $ M2, WA2, Z, LDU, WORK, IWORK, 01003 $ IWORK( 5*N+1 ), IINFO ) 01004 IF( IINFO.NE.0 ) THEN 01005 WRITE( NOUNIT, FMT = 9999 )'DSTEVX(V,I)', IINFO, N, 01006 $ JTYPE, IOLDSD 01007 INFO = ABS( IINFO ) 01008 IF( IINFO.LT.0 ) THEN 01009 RETURN 01010 ELSE 01011 RESULT( 10 ) = ULPINV 01012 RESULT( 11 ) = ULPINV 01013 RESULT( 12 ) = ULPINV 01014 GO TO 380 01015 END IF 01016 END IF 01017 * 01018 * Do tests 10 and 11. 01019 * 01020 DO 350 I = 1, N 01021 D3( I ) = DBLE( A( I, I ) ) 01022 350 CONTINUE 01023 DO 360 I = 1, N - 1 01024 D4( I ) = DBLE( A( I+1, I ) ) 01025 360 CONTINUE 01026 CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK, 01027 $ MAX( 1, M2 ), RESULT( 10 ) ) 01028 * 01029 * 01030 NTEST = 12 01031 DO 370 I = 1, N - 1 01032 D4( I ) = DBLE( A( I+1, I ) ) 01033 370 CONTINUE 01034 SRNAMT = 'DSTEVX' 01035 CALL DSTEVX( 'N', 'I', N, D3, D4, VL, VU, IL, IU, ABSTOL, 01036 $ M3, WA3, Z, LDU, WORK, IWORK, 01037 $ IWORK( 5*N+1 ), IINFO ) 01038 IF( IINFO.NE.0 ) THEN 01039 WRITE( NOUNIT, FMT = 9999 )'DSTEVX(N,I)', IINFO, N, 01040 $ JTYPE, IOLDSD 01041 INFO = ABS( IINFO ) 01042 IF( IINFO.LT.0 ) THEN 01043 RETURN 01044 ELSE 01045 RESULT( 12 ) = ULPINV 01046 GO TO 380 01047 END IF 01048 END IF 01049 * 01050 * Do test 12. 01051 * 01052 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 01053 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 01054 RESULT( 12 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, ULP*TEMP3 ) 01055 * 01056 380 CONTINUE 01057 * 01058 NTEST = 12 01059 IF( N.GT.0 ) THEN 01060 IF( IL.NE.1 ) THEN 01061 VL = WA1( IL ) - MAX( HALF* 01062 $ ( WA1( IL )-WA1( IL-1 ) ), TEN*ULP*TEMP3, 01063 $ TEN*RTUNFL ) 01064 ELSE 01065 VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ), 01066 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01067 END IF 01068 IF( IU.NE.N ) THEN 01069 VU = WA1( IU ) + MAX( HALF* 01070 $ ( WA1( IU+1 )-WA1( IU ) ), TEN*ULP*TEMP3, 01071 $ TEN*RTUNFL ) 01072 ELSE 01073 VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ), 01074 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01075 END IF 01076 ELSE 01077 VL = ZERO 01078 VU = ONE 01079 END IF 01080 * 01081 DO 390 I = 1, N 01082 D1( I ) = DBLE( A( I, I ) ) 01083 390 CONTINUE 01084 DO 400 I = 1, N - 1 01085 D2( I ) = DBLE( A( I+1, I ) ) 01086 400 CONTINUE 01087 SRNAMT = 'DSTEVX' 01088 CALL DSTEVX( 'V', 'V', N, D1, D2, VL, VU, IL, IU, ABSTOL, 01089 $ M2, WA2, Z, LDU, WORK, IWORK, 01090 $ IWORK( 5*N+1 ), IINFO ) 01091 IF( IINFO.NE.0 ) THEN 01092 WRITE( NOUNIT, FMT = 9999 )'DSTEVX(V,V)', IINFO, N, 01093 $ JTYPE, IOLDSD 01094 INFO = ABS( IINFO ) 01095 IF( IINFO.LT.0 ) THEN 01096 RETURN 01097 ELSE 01098 RESULT( 13 ) = ULPINV 01099 RESULT( 14 ) = ULPINV 01100 RESULT( 15 ) = ULPINV 01101 GO TO 440 01102 END IF 01103 END IF 01104 * 01105 IF( M2.EQ.0 .AND. N.GT.0 ) THEN 01106 RESULT( 13 ) = ULPINV 01107 RESULT( 14 ) = ULPINV 01108 RESULT( 15 ) = ULPINV 01109 GO TO 440 01110 END IF 01111 * 01112 * Do tests 13 and 14. 01113 * 01114 DO 410 I = 1, N 01115 D3( I ) = DBLE( A( I, I ) ) 01116 410 CONTINUE 01117 DO 420 I = 1, N - 1 01118 D4( I ) = DBLE( A( I+1, I ) ) 01119 420 CONTINUE 01120 CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK, 01121 $ MAX( 1, M2 ), RESULT( 13 ) ) 01122 * 01123 NTEST = 15 01124 DO 430 I = 1, N - 1 01125 D4( I ) = DBLE( A( I+1, I ) ) 01126 430 CONTINUE 01127 SRNAMT = 'DSTEVX' 01128 CALL DSTEVX( 'N', 'V', N, D3, D4, VL, VU, IL, IU, ABSTOL, 01129 $ M3, WA3, Z, LDU, WORK, IWORK, 01130 $ IWORK( 5*N+1 ), IINFO ) 01131 IF( IINFO.NE.0 ) THEN 01132 WRITE( NOUNIT, FMT = 9999 )'DSTEVX(N,V)', IINFO, N, 01133 $ JTYPE, IOLDSD 01134 INFO = ABS( IINFO ) 01135 IF( IINFO.LT.0 ) THEN 01136 RETURN 01137 ELSE 01138 RESULT( 15 ) = ULPINV 01139 GO TO 440 01140 END IF 01141 END IF 01142 * 01143 * Do test 15. 01144 * 01145 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 01146 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 01147 RESULT( 15 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP ) 01148 * 01149 440 CONTINUE 01150 * 01151 NTEST = 16 01152 DO 450 I = 1, N 01153 D1( I ) = DBLE( A( I, I ) ) 01154 450 CONTINUE 01155 DO 460 I = 1, N - 1 01156 D2( I ) = DBLE( A( I+1, I ) ) 01157 460 CONTINUE 01158 SRNAMT = 'DSTEVD' 01159 CALL DSTEVD( 'V', N, D1, D2, Z, LDU, WORK, LWEDC, IWORK, 01160 $ LIWEDC, IINFO ) 01161 IF( IINFO.NE.0 ) THEN 01162 WRITE( NOUNIT, FMT = 9999 )'DSTEVD(V)', IINFO, N, 01163 $ JTYPE, IOLDSD 01164 INFO = ABS( IINFO ) 01165 IF( IINFO.LT.0 ) THEN 01166 RETURN 01167 ELSE 01168 RESULT( 16 ) = ULPINV 01169 RESULT( 17 ) = ULPINV 01170 RESULT( 18 ) = ULPINV 01171 GO TO 510 01172 END IF 01173 END IF 01174 * 01175 * Do tests 16 and 17. 01176 * 01177 DO 470 I = 1, N 01178 D3( I ) = DBLE( A( I, I ) ) 01179 470 CONTINUE 01180 DO 480 I = 1, N - 1 01181 D4( I ) = DBLE( A( I+1, I ) ) 01182 480 CONTINUE 01183 CALL DSTT21( N, 0, D3, D4, D1, D2, Z, LDU, WORK, 01184 $ RESULT( 16 ) ) 01185 * 01186 NTEST = 18 01187 DO 490 I = 1, N - 1 01188 D4( I ) = DBLE( A( I+1, I ) ) 01189 490 CONTINUE 01190 SRNAMT = 'DSTEVD' 01191 CALL DSTEVD( 'N', N, D3, D4, Z, LDU, WORK, LWEDC, IWORK, 01192 $ LIWEDC, IINFO ) 01193 IF( IINFO.NE.0 ) THEN 01194 WRITE( NOUNIT, FMT = 9999 )'DSTEVD(N)', IINFO, N, 01195 $ JTYPE, IOLDSD 01196 INFO = ABS( IINFO ) 01197 IF( IINFO.LT.0 ) THEN 01198 RETURN 01199 ELSE 01200 RESULT( 18 ) = ULPINV 01201 GO TO 510 01202 END IF 01203 END IF 01204 * 01205 * Do test 18. 01206 * 01207 TEMP1 = ZERO 01208 TEMP2 = ZERO 01209 DO 500 J = 1, N 01210 TEMP1 = MAX( TEMP1, ABS( EVEIGS( J ) ), 01211 $ ABS( D3( J ) ) ) 01212 TEMP2 = MAX( TEMP2, ABS( EVEIGS( J )-D3( J ) ) ) 01213 500 CONTINUE 01214 RESULT( 18 ) = TEMP2 / MAX( UNFL, 01215 $ ULP*MAX( TEMP1, TEMP2 ) ) 01216 * 01217 510 CONTINUE 01218 * 01219 NTEST = 19 01220 DO 520 I = 1, N 01221 D1( I ) = DBLE( A( I, I ) ) 01222 520 CONTINUE 01223 DO 530 I = 1, N - 1 01224 D2( I ) = DBLE( A( I+1, I ) ) 01225 530 CONTINUE 01226 SRNAMT = 'DSTEVR' 01227 CALL DSTEVR( 'V', 'I', N, D1, D2, VL, VU, IL, IU, ABSTOL, 01228 $ M2, WA2, Z, LDU, IWORK, WORK, LWORK, 01229 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 01230 IF( IINFO.NE.0 ) THEN 01231 WRITE( NOUNIT, FMT = 9999 )'DSTEVR(V,I)', IINFO, N, 01232 $ JTYPE, IOLDSD 01233 INFO = ABS( IINFO ) 01234 IF( IINFO.LT.0 ) THEN 01235 RETURN 01236 ELSE 01237 RESULT( 19 ) = ULPINV 01238 RESULT( 20 ) = ULPINV 01239 RESULT( 21 ) = ULPINV 01240 GO TO 570 01241 END IF 01242 END IF 01243 * 01244 * DO tests 19 and 20. 01245 * 01246 DO 540 I = 1, N 01247 D3( I ) = DBLE( A( I, I ) ) 01248 540 CONTINUE 01249 DO 550 I = 1, N - 1 01250 D4( I ) = DBLE( A( I+1, I ) ) 01251 550 CONTINUE 01252 CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK, 01253 $ MAX( 1, M2 ), RESULT( 19 ) ) 01254 * 01255 * 01256 NTEST = 21 01257 DO 560 I = 1, N - 1 01258 D4( I ) = DBLE( A( I+1, I ) ) 01259 560 CONTINUE 01260 SRNAMT = 'DSTEVR' 01261 CALL DSTEVR( 'N', 'I', N, D3, D4, VL, VU, IL, IU, ABSTOL, 01262 $ M3, WA3, Z, LDU, IWORK, WORK, LWORK, 01263 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 01264 IF( IINFO.NE.0 ) THEN 01265 WRITE( NOUNIT, FMT = 9999 )'DSTEVR(N,I)', IINFO, N, 01266 $ JTYPE, IOLDSD 01267 INFO = ABS( IINFO ) 01268 IF( IINFO.LT.0 ) THEN 01269 RETURN 01270 ELSE 01271 RESULT( 21 ) = ULPINV 01272 GO TO 570 01273 END IF 01274 END IF 01275 * 01276 * Do test 21. 01277 * 01278 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 01279 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 01280 RESULT( 21 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, ULP*TEMP3 ) 01281 * 01282 570 CONTINUE 01283 * 01284 NTEST = 21 01285 IF( N.GT.0 ) THEN 01286 IF( IL.NE.1 ) THEN 01287 VL = WA1( IL ) - MAX( HALF* 01288 $ ( WA1( IL )-WA1( IL-1 ) ), TEN*ULP*TEMP3, 01289 $ TEN*RTUNFL ) 01290 ELSE 01291 VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ), 01292 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01293 END IF 01294 IF( IU.NE.N ) THEN 01295 VU = WA1( IU ) + MAX( HALF* 01296 $ ( WA1( IU+1 )-WA1( IU ) ), TEN*ULP*TEMP3, 01297 $ TEN*RTUNFL ) 01298 ELSE 01299 VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ), 01300 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01301 END IF 01302 ELSE 01303 VL = ZERO 01304 VU = ONE 01305 END IF 01306 * 01307 DO 580 I = 1, N 01308 D1( I ) = DBLE( A( I, I ) ) 01309 580 CONTINUE 01310 DO 590 I = 1, N - 1 01311 D2( I ) = DBLE( A( I+1, I ) ) 01312 590 CONTINUE 01313 SRNAMT = 'DSTEVR' 01314 CALL DSTEVR( 'V', 'V', N, D1, D2, VL, VU, IL, IU, ABSTOL, 01315 $ M2, WA2, Z, LDU, IWORK, WORK, LWORK, 01316 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 01317 IF( IINFO.NE.0 ) THEN 01318 WRITE( NOUNIT, FMT = 9999 )'DSTEVR(V,V)', IINFO, N, 01319 $ JTYPE, IOLDSD 01320 INFO = ABS( IINFO ) 01321 IF( IINFO.LT.0 ) THEN 01322 RETURN 01323 ELSE 01324 RESULT( 22 ) = ULPINV 01325 RESULT( 23 ) = ULPINV 01326 RESULT( 24 ) = ULPINV 01327 GO TO 630 01328 END IF 01329 END IF 01330 * 01331 IF( M2.EQ.0 .AND. N.GT.0 ) THEN 01332 RESULT( 22 ) = ULPINV 01333 RESULT( 23 ) = ULPINV 01334 RESULT( 24 ) = ULPINV 01335 GO TO 630 01336 END IF 01337 * 01338 * Do tests 22 and 23. 01339 * 01340 DO 600 I = 1, N 01341 D3( I ) = DBLE( A( I, I ) ) 01342 600 CONTINUE 01343 DO 610 I = 1, N - 1 01344 D4( I ) = DBLE( A( I+1, I ) ) 01345 610 CONTINUE 01346 CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK, 01347 $ MAX( 1, M2 ), RESULT( 22 ) ) 01348 * 01349 NTEST = 24 01350 DO 620 I = 1, N - 1 01351 D4( I ) = DBLE( A( I+1, I ) ) 01352 620 CONTINUE 01353 SRNAMT = 'DSTEVR' 01354 CALL DSTEVR( 'N', 'V', N, D3, D4, VL, VU, IL, IU, ABSTOL, 01355 $ M3, WA3, Z, LDU, IWORK, WORK, LWORK, 01356 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 01357 IF( IINFO.NE.0 ) THEN 01358 WRITE( NOUNIT, FMT = 9999 )'DSTEVR(N,V)', IINFO, N, 01359 $ JTYPE, IOLDSD 01360 INFO = ABS( IINFO ) 01361 IF( IINFO.LT.0 ) THEN 01362 RETURN 01363 ELSE 01364 RESULT( 24 ) = ULPINV 01365 GO TO 630 01366 END IF 01367 END IF 01368 * 01369 * Do test 24. 01370 * 01371 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 01372 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 01373 RESULT( 24 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP ) 01374 * 01375 630 CONTINUE 01376 * 01377 * 01378 * 01379 ELSE 01380 * 01381 DO 640 I = 1, 24 01382 RESULT( I ) = ZERO 01383 640 CONTINUE 01384 NTEST = 24 01385 END IF 01386 * 01387 * Perform remaining tests storing upper or lower triangular 01388 * part of matrix. 01389 * 01390 DO 1720 IUPLO = 0, 1 01391 IF( IUPLO.EQ.0 ) THEN 01392 UPLO = 'L' 01393 ELSE 01394 UPLO = 'U' 01395 END IF 01396 * 01397 * 4) Call DSYEV and DSYEVX. 01398 * 01399 CALL DLACPY( ' ', N, N, A, LDA, V, LDU ) 01400 * 01401 NTEST = NTEST + 1 01402 SRNAMT = 'DSYEV' 01403 CALL DSYEV( 'V', UPLO, N, A, LDU, D1, WORK, LWORK, 01404 $ IINFO ) 01405 IF( IINFO.NE.0 ) THEN 01406 WRITE( NOUNIT, FMT = 9999 )'DSYEV(V,' // UPLO // ')', 01407 $ IINFO, N, JTYPE, IOLDSD 01408 INFO = ABS( IINFO ) 01409 IF( IINFO.LT.0 ) THEN 01410 RETURN 01411 ELSE 01412 RESULT( NTEST ) = ULPINV 01413 RESULT( NTEST+1 ) = ULPINV 01414 RESULT( NTEST+2 ) = ULPINV 01415 GO TO 660 01416 END IF 01417 END IF 01418 * 01419 * Do tests 25 and 26 (or +54) 01420 * 01421 CALL DSYT21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z, 01422 $ LDU, TAU, WORK, RESULT( NTEST ) ) 01423 * 01424 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 01425 * 01426 NTEST = NTEST + 2 01427 SRNAMT = 'DSYEV' 01428 CALL DSYEV( 'N', UPLO, N, A, LDU, D3, WORK, LWORK, 01429 $ IINFO ) 01430 IF( IINFO.NE.0 ) THEN 01431 WRITE( NOUNIT, FMT = 9999 )'DSYEV(N,' // UPLO // ')', 01432 $ IINFO, N, JTYPE, IOLDSD 01433 INFO = ABS( IINFO ) 01434 IF( IINFO.LT.0 ) THEN 01435 RETURN 01436 ELSE 01437 RESULT( NTEST ) = ULPINV 01438 GO TO 660 01439 END IF 01440 END IF 01441 * 01442 * Do test 27 (or +54) 01443 * 01444 TEMP1 = ZERO 01445 TEMP2 = ZERO 01446 DO 650 J = 1, N 01447 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 01448 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 01449 650 CONTINUE 01450 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 01451 $ ULP*MAX( TEMP1, TEMP2 ) ) 01452 * 01453 660 CONTINUE 01454 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 01455 * 01456 NTEST = NTEST + 1 01457 * 01458 IF( N.GT.0 ) THEN 01459 TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) ) 01460 IF( IL.NE.1 ) THEN 01461 VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ), 01462 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01463 ELSE IF( N.GT.0 ) THEN 01464 VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ), 01465 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01466 END IF 01467 IF( IU.NE.N ) THEN 01468 VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ), 01469 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01470 ELSE IF( N.GT.0 ) THEN 01471 VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ), 01472 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01473 END IF 01474 ELSE 01475 TEMP3 = ZERO 01476 VL = ZERO 01477 VU = ONE 01478 END IF 01479 * 01480 SRNAMT = 'DSYEVX' 01481 CALL DSYEVX( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 01482 $ ABSTOL, M, WA1, Z, LDU, WORK, LWORK, IWORK, 01483 $ IWORK( 5*N+1 ), IINFO ) 01484 IF( IINFO.NE.0 ) THEN 01485 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,A,' // UPLO // 01486 $ ')', IINFO, N, JTYPE, IOLDSD 01487 INFO = ABS( IINFO ) 01488 IF( IINFO.LT.0 ) THEN 01489 RETURN 01490 ELSE 01491 RESULT( NTEST ) = ULPINV 01492 RESULT( NTEST+1 ) = ULPINV 01493 RESULT( NTEST+2 ) = ULPINV 01494 GO TO 680 01495 END IF 01496 END IF 01497 * 01498 * Do tests 28 and 29 (or +54) 01499 * 01500 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 01501 * 01502 CALL DSYT21( 1, UPLO, N, 0, A, LDU, D1, D2, Z, LDU, V, 01503 $ LDU, TAU, WORK, RESULT( NTEST ) ) 01504 * 01505 NTEST = NTEST + 2 01506 SRNAMT = 'DSYEVX' 01507 CALL DSYEVX( 'N', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 01508 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK, 01509 $ IWORK( 5*N+1 ), IINFO ) 01510 IF( IINFO.NE.0 ) THEN 01511 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(N,A,' // UPLO // 01512 $ ')', IINFO, N, JTYPE, IOLDSD 01513 INFO = ABS( IINFO ) 01514 IF( IINFO.LT.0 ) THEN 01515 RETURN 01516 ELSE 01517 RESULT( NTEST ) = ULPINV 01518 GO TO 680 01519 END IF 01520 END IF 01521 * 01522 * Do test 30 (or +54) 01523 * 01524 TEMP1 = ZERO 01525 TEMP2 = ZERO 01526 DO 670 J = 1, N 01527 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 01528 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 01529 670 CONTINUE 01530 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 01531 $ ULP*MAX( TEMP1, TEMP2 ) ) 01532 * 01533 680 CONTINUE 01534 * 01535 NTEST = NTEST + 1 01536 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 01537 SRNAMT = 'DSYEVX' 01538 CALL DSYEVX( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 01539 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK, 01540 $ IWORK( 5*N+1 ), IINFO ) 01541 IF( IINFO.NE.0 ) THEN 01542 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,I,' // UPLO // 01543 $ ')', IINFO, N, JTYPE, IOLDSD 01544 INFO = ABS( IINFO ) 01545 IF( IINFO.LT.0 ) THEN 01546 RETURN 01547 ELSE 01548 RESULT( NTEST ) = ULPINV 01549 RESULT( NTEST+1 ) = ULPINV 01550 RESULT( NTEST+2 ) = ULPINV 01551 GO TO 690 01552 END IF 01553 END IF 01554 * 01555 * Do tests 31 and 32 (or +54) 01556 * 01557 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 01558 * 01559 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 01560 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 01561 * 01562 NTEST = NTEST + 2 01563 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 01564 SRNAMT = 'DSYEVX' 01565 CALL DSYEVX( 'N', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 01566 $ ABSTOL, M3, WA3, Z, LDU, WORK, LWORK, IWORK, 01567 $ IWORK( 5*N+1 ), IINFO ) 01568 IF( IINFO.NE.0 ) THEN 01569 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(N,I,' // UPLO // 01570 $ ')', IINFO, N, JTYPE, IOLDSD 01571 INFO = ABS( IINFO ) 01572 IF( IINFO.LT.0 ) THEN 01573 RETURN 01574 ELSE 01575 RESULT( NTEST ) = ULPINV 01576 GO TO 690 01577 END IF 01578 END IF 01579 * 01580 * Do test 33 (or +54) 01581 * 01582 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 01583 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 01584 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 01585 $ MAX( UNFL, ULP*TEMP3 ) 01586 690 CONTINUE 01587 * 01588 NTEST = NTEST + 1 01589 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 01590 SRNAMT = 'DSYEVX' 01591 CALL DSYEVX( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 01592 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK, 01593 $ IWORK( 5*N+1 ), IINFO ) 01594 IF( IINFO.NE.0 ) THEN 01595 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,V,' // UPLO // 01596 $ ')', IINFO, N, JTYPE, IOLDSD 01597 INFO = ABS( IINFO ) 01598 IF( IINFO.LT.0 ) THEN 01599 RETURN 01600 ELSE 01601 RESULT( NTEST ) = ULPINV 01602 RESULT( NTEST+1 ) = ULPINV 01603 RESULT( NTEST+2 ) = ULPINV 01604 GO TO 700 01605 END IF 01606 END IF 01607 * 01608 * Do tests 34 and 35 (or +54) 01609 * 01610 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 01611 * 01612 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 01613 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 01614 * 01615 NTEST = NTEST + 2 01616 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 01617 SRNAMT = 'DSYEVX' 01618 CALL DSYEVX( 'N', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 01619 $ ABSTOL, M3, WA3, Z, LDU, WORK, LWORK, IWORK, 01620 $ IWORK( 5*N+1 ), IINFO ) 01621 IF( IINFO.NE.0 ) THEN 01622 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(N,V,' // UPLO // 01623 $ ')', IINFO, N, JTYPE, IOLDSD 01624 INFO = ABS( IINFO ) 01625 IF( IINFO.LT.0 ) THEN 01626 RETURN 01627 ELSE 01628 RESULT( NTEST ) = ULPINV 01629 GO TO 700 01630 END IF 01631 END IF 01632 * 01633 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 01634 RESULT( NTEST ) = ULPINV 01635 GO TO 700 01636 END IF 01637 * 01638 * Do test 36 (or +54) 01639 * 01640 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 01641 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 01642 IF( N.GT.0 ) THEN 01643 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 01644 ELSE 01645 TEMP3 = ZERO 01646 END IF 01647 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 01648 $ MAX( UNFL, TEMP3*ULP ) 01649 * 01650 700 CONTINUE 01651 * 01652 * 5) Call DSPEV and DSPEVX. 01653 * 01654 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 01655 * 01656 * Load array WORK with the upper or lower triangular 01657 * part of the matrix in packed form. 01658 * 01659 IF( IUPLO.EQ.1 ) THEN 01660 INDX = 1 01661 DO 720 J = 1, N 01662 DO 710 I = 1, J 01663 WORK( INDX ) = A( I, J ) 01664 INDX = INDX + 1 01665 710 CONTINUE 01666 720 CONTINUE 01667 ELSE 01668 INDX = 1 01669 DO 740 J = 1, N 01670 DO 730 I = J, N 01671 WORK( INDX ) = A( I, J ) 01672 INDX = INDX + 1 01673 730 CONTINUE 01674 740 CONTINUE 01675 END IF 01676 * 01677 NTEST = NTEST + 1 01678 SRNAMT = 'DSPEV' 01679 CALL DSPEV( 'V', UPLO, N, WORK, D1, Z, LDU, V, IINFO ) 01680 IF( IINFO.NE.0 ) THEN 01681 WRITE( NOUNIT, FMT = 9999 )'DSPEV(V,' // UPLO // ')', 01682 $ IINFO, N, JTYPE, IOLDSD 01683 INFO = ABS( IINFO ) 01684 IF( IINFO.LT.0 ) THEN 01685 RETURN 01686 ELSE 01687 RESULT( NTEST ) = ULPINV 01688 RESULT( NTEST+1 ) = ULPINV 01689 RESULT( NTEST+2 ) = ULPINV 01690 GO TO 800 01691 END IF 01692 END IF 01693 * 01694 * Do tests 37 and 38 (or +54) 01695 * 01696 CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 01697 $ LDU, TAU, WORK, RESULT( NTEST ) ) 01698 * 01699 IF( IUPLO.EQ.1 ) THEN 01700 INDX = 1 01701 DO 760 J = 1, N 01702 DO 750 I = 1, J 01703 WORK( INDX ) = A( I, J ) 01704 INDX = INDX + 1 01705 750 CONTINUE 01706 760 CONTINUE 01707 ELSE 01708 INDX = 1 01709 DO 780 J = 1, N 01710 DO 770 I = J, N 01711 WORK( INDX ) = A( I, J ) 01712 INDX = INDX + 1 01713 770 CONTINUE 01714 780 CONTINUE 01715 END IF 01716 * 01717 NTEST = NTEST + 2 01718 SRNAMT = 'DSPEV' 01719 CALL DSPEV( 'N', UPLO, N, WORK, D3, Z, LDU, V, IINFO ) 01720 IF( IINFO.NE.0 ) THEN 01721 WRITE( NOUNIT, FMT = 9999 )'DSPEV(N,' // UPLO // ')', 01722 $ IINFO, N, JTYPE, IOLDSD 01723 INFO = ABS( IINFO ) 01724 IF( IINFO.LT.0 ) THEN 01725 RETURN 01726 ELSE 01727 RESULT( NTEST ) = ULPINV 01728 GO TO 800 01729 END IF 01730 END IF 01731 * 01732 * Do test 39 (or +54) 01733 * 01734 TEMP1 = ZERO 01735 TEMP2 = ZERO 01736 DO 790 J = 1, N 01737 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 01738 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 01739 790 CONTINUE 01740 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 01741 $ ULP*MAX( TEMP1, TEMP2 ) ) 01742 * 01743 * Load array WORK with the upper or lower triangular part 01744 * of the matrix in packed form. 01745 * 01746 800 CONTINUE 01747 IF( IUPLO.EQ.1 ) THEN 01748 INDX = 1 01749 DO 820 J = 1, N 01750 DO 810 I = 1, J 01751 WORK( INDX ) = A( I, J ) 01752 INDX = INDX + 1 01753 810 CONTINUE 01754 820 CONTINUE 01755 ELSE 01756 INDX = 1 01757 DO 840 J = 1, N 01758 DO 830 I = J, N 01759 WORK( INDX ) = A( I, J ) 01760 INDX = INDX + 1 01761 830 CONTINUE 01762 840 CONTINUE 01763 END IF 01764 * 01765 NTEST = NTEST + 1 01766 * 01767 IF( N.GT.0 ) THEN 01768 TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) ) 01769 IF( IL.NE.1 ) THEN 01770 VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ), 01771 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01772 ELSE IF( N.GT.0 ) THEN 01773 VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ), 01774 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01775 END IF 01776 IF( IU.NE.N ) THEN 01777 VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ), 01778 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01779 ELSE IF( N.GT.0 ) THEN 01780 VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ), 01781 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01782 END IF 01783 ELSE 01784 TEMP3 = ZERO 01785 VL = ZERO 01786 VU = ONE 01787 END IF 01788 * 01789 SRNAMT = 'DSPEVX' 01790 CALL DSPEVX( 'V', 'A', UPLO, N, WORK, VL, VU, IL, IU, 01791 $ ABSTOL, M, WA1, Z, LDU, V, IWORK, 01792 $ IWORK( 5*N+1 ), IINFO ) 01793 IF( IINFO.NE.0 ) THEN 01794 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,A,' // UPLO // 01795 $ ')', IINFO, N, JTYPE, IOLDSD 01796 INFO = ABS( IINFO ) 01797 IF( IINFO.LT.0 ) THEN 01798 RETURN 01799 ELSE 01800 RESULT( NTEST ) = ULPINV 01801 RESULT( NTEST+1 ) = ULPINV 01802 RESULT( NTEST+2 ) = ULPINV 01803 GO TO 900 01804 END IF 01805 END IF 01806 * 01807 * Do tests 40 and 41 (or +54) 01808 * 01809 CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 01810 $ LDU, TAU, WORK, RESULT( NTEST ) ) 01811 * 01812 NTEST = NTEST + 2 01813 * 01814 IF( IUPLO.EQ.1 ) THEN 01815 INDX = 1 01816 DO 860 J = 1, N 01817 DO 850 I = 1, J 01818 WORK( INDX ) = A( I, J ) 01819 INDX = INDX + 1 01820 850 CONTINUE 01821 860 CONTINUE 01822 ELSE 01823 INDX = 1 01824 DO 880 J = 1, N 01825 DO 870 I = J, N 01826 WORK( INDX ) = A( I, J ) 01827 INDX = INDX + 1 01828 870 CONTINUE 01829 880 CONTINUE 01830 END IF 01831 * 01832 SRNAMT = 'DSPEVX' 01833 CALL DSPEVX( 'N', 'A', UPLO, N, WORK, VL, VU, IL, IU, 01834 $ ABSTOL, M2, WA2, Z, LDU, V, IWORK, 01835 $ IWORK( 5*N+1 ), IINFO ) 01836 IF( IINFO.NE.0 ) THEN 01837 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,A,' // UPLO // 01838 $ ')', IINFO, N, JTYPE, IOLDSD 01839 INFO = ABS( IINFO ) 01840 IF( IINFO.LT.0 ) THEN 01841 RETURN 01842 ELSE 01843 RESULT( NTEST ) = ULPINV 01844 GO TO 900 01845 END IF 01846 END IF 01847 * 01848 * Do test 42 (or +54) 01849 * 01850 TEMP1 = ZERO 01851 TEMP2 = ZERO 01852 DO 890 J = 1, N 01853 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 01854 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 01855 890 CONTINUE 01856 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 01857 $ ULP*MAX( TEMP1, TEMP2 ) ) 01858 * 01859 900 CONTINUE 01860 IF( IUPLO.EQ.1 ) THEN 01861 INDX = 1 01862 DO 920 J = 1, N 01863 DO 910 I = 1, J 01864 WORK( INDX ) = A( I, J ) 01865 INDX = INDX + 1 01866 910 CONTINUE 01867 920 CONTINUE 01868 ELSE 01869 INDX = 1 01870 DO 940 J = 1, N 01871 DO 930 I = J, N 01872 WORK( INDX ) = A( I, J ) 01873 INDX = INDX + 1 01874 930 CONTINUE 01875 940 CONTINUE 01876 END IF 01877 * 01878 NTEST = NTEST + 1 01879 * 01880 SRNAMT = 'DSPEVX' 01881 CALL DSPEVX( 'V', 'I', UPLO, N, WORK, VL, VU, IL, IU, 01882 $ ABSTOL, M2, WA2, Z, LDU, V, IWORK, 01883 $ IWORK( 5*N+1 ), IINFO ) 01884 IF( IINFO.NE.0 ) THEN 01885 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,I,' // UPLO // 01886 $ ')', IINFO, N, JTYPE, IOLDSD 01887 INFO = ABS( IINFO ) 01888 IF( IINFO.LT.0 ) THEN 01889 RETURN 01890 ELSE 01891 RESULT( NTEST ) = ULPINV 01892 RESULT( NTEST+1 ) = ULPINV 01893 RESULT( NTEST+2 ) = ULPINV 01894 GO TO 990 01895 END IF 01896 END IF 01897 * 01898 * Do tests 43 and 44 (or +54) 01899 * 01900 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 01901 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 01902 * 01903 NTEST = NTEST + 2 01904 * 01905 IF( IUPLO.EQ.1 ) THEN 01906 INDX = 1 01907 DO 960 J = 1, N 01908 DO 950 I = 1, J 01909 WORK( INDX ) = A( I, J ) 01910 INDX = INDX + 1 01911 950 CONTINUE 01912 960 CONTINUE 01913 ELSE 01914 INDX = 1 01915 DO 980 J = 1, N 01916 DO 970 I = J, N 01917 WORK( INDX ) = A( I, J ) 01918 INDX = INDX + 1 01919 970 CONTINUE 01920 980 CONTINUE 01921 END IF 01922 * 01923 SRNAMT = 'DSPEVX' 01924 CALL DSPEVX( 'N', 'I', UPLO, N, WORK, VL, VU, IL, IU, 01925 $ ABSTOL, M3, WA3, Z, LDU, V, IWORK, 01926 $ IWORK( 5*N+1 ), IINFO ) 01927 IF( IINFO.NE.0 ) THEN 01928 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,I,' // UPLO // 01929 $ ')', IINFO, N, JTYPE, IOLDSD 01930 INFO = ABS( IINFO ) 01931 IF( IINFO.LT.0 ) THEN 01932 RETURN 01933 ELSE 01934 RESULT( NTEST ) = ULPINV 01935 GO TO 990 01936 END IF 01937 END IF 01938 * 01939 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 01940 RESULT( NTEST ) = ULPINV 01941 GO TO 990 01942 END IF 01943 * 01944 * Do test 45 (or +54) 01945 * 01946 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 01947 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 01948 IF( N.GT.0 ) THEN 01949 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 01950 ELSE 01951 TEMP3 = ZERO 01952 END IF 01953 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 01954 $ MAX( UNFL, TEMP3*ULP ) 01955 * 01956 990 CONTINUE 01957 IF( IUPLO.EQ.1 ) THEN 01958 INDX = 1 01959 DO 1010 J = 1, N 01960 DO 1000 I = 1, J 01961 WORK( INDX ) = A( I, J ) 01962 INDX = INDX + 1 01963 1000 CONTINUE 01964 1010 CONTINUE 01965 ELSE 01966 INDX = 1 01967 DO 1030 J = 1, N 01968 DO 1020 I = J, N 01969 WORK( INDX ) = A( I, J ) 01970 INDX = INDX + 1 01971 1020 CONTINUE 01972 1030 CONTINUE 01973 END IF 01974 * 01975 NTEST = NTEST + 1 01976 * 01977 SRNAMT = 'DSPEVX' 01978 CALL DSPEVX( 'V', 'V', UPLO, N, WORK, VL, VU, IL, IU, 01979 $ ABSTOL, M2, WA2, Z, LDU, V, IWORK, 01980 $ IWORK( 5*N+1 ), IINFO ) 01981 IF( IINFO.NE.0 ) THEN 01982 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,V,' // UPLO // 01983 $ ')', IINFO, N, JTYPE, IOLDSD 01984 INFO = ABS( IINFO ) 01985 IF( IINFO.LT.0 ) THEN 01986 RETURN 01987 ELSE 01988 RESULT( NTEST ) = ULPINV 01989 RESULT( NTEST+1 ) = ULPINV 01990 RESULT( NTEST+2 ) = ULPINV 01991 GO TO 1080 01992 END IF 01993 END IF 01994 * 01995 * Do tests 46 and 47 (or +54) 01996 * 01997 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 01998 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 01999 * 02000 NTEST = NTEST + 2 02001 * 02002 IF( IUPLO.EQ.1 ) THEN 02003 INDX = 1 02004 DO 1050 J = 1, N 02005 DO 1040 I = 1, J 02006 WORK( INDX ) = A( I, J ) 02007 INDX = INDX + 1 02008 1040 CONTINUE 02009 1050 CONTINUE 02010 ELSE 02011 INDX = 1 02012 DO 1070 J = 1, N 02013 DO 1060 I = J, N 02014 WORK( INDX ) = A( I, J ) 02015 INDX = INDX + 1 02016 1060 CONTINUE 02017 1070 CONTINUE 02018 END IF 02019 * 02020 SRNAMT = 'DSPEVX' 02021 CALL DSPEVX( 'N', 'V', UPLO, N, WORK, VL, VU, IL, IU, 02022 $ ABSTOL, M3, WA3, Z, LDU, V, IWORK, 02023 $ IWORK( 5*N+1 ), IINFO ) 02024 IF( IINFO.NE.0 ) THEN 02025 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,V,' // UPLO // 02026 $ ')', IINFO, N, JTYPE, IOLDSD 02027 INFO = ABS( IINFO ) 02028 IF( IINFO.LT.0 ) THEN 02029 RETURN 02030 ELSE 02031 RESULT( NTEST ) = ULPINV 02032 GO TO 1080 02033 END IF 02034 END IF 02035 * 02036 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 02037 RESULT( NTEST ) = ULPINV 02038 GO TO 1080 02039 END IF 02040 * 02041 * Do test 48 (or +54) 02042 * 02043 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 02044 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 02045 IF( N.GT.0 ) THEN 02046 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 02047 ELSE 02048 TEMP3 = ZERO 02049 END IF 02050 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 02051 $ MAX( UNFL, TEMP3*ULP ) 02052 * 02053 1080 CONTINUE 02054 * 02055 * 6) Call DSBEV and DSBEVX. 02056 * 02057 IF( JTYPE.LE.7 ) THEN 02058 KD = 1 02059 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN 02060 KD = MAX( N-1, 0 ) 02061 ELSE 02062 KD = IHBW 02063 END IF 02064 * 02065 * Load array V with the upper or lower triangular part 02066 * of the matrix in band form. 02067 * 02068 IF( IUPLO.EQ.1 ) THEN 02069 DO 1100 J = 1, N 02070 DO 1090 I = MAX( 1, J-KD ), J 02071 V( KD+1+I-J, J ) = A( I, J ) 02072 1090 CONTINUE 02073 1100 CONTINUE 02074 ELSE 02075 DO 1120 J = 1, N 02076 DO 1110 I = J, MIN( N, J+KD ) 02077 V( 1+I-J, J ) = A( I, J ) 02078 1110 CONTINUE 02079 1120 CONTINUE 02080 END IF 02081 * 02082 NTEST = NTEST + 1 02083 SRNAMT = 'DSBEV' 02084 CALL DSBEV( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK, 02085 $ IINFO ) 02086 IF( IINFO.NE.0 ) THEN 02087 WRITE( NOUNIT, FMT = 9999 )'DSBEV(V,' // UPLO // ')', 02088 $ IINFO, N, JTYPE, IOLDSD 02089 INFO = ABS( IINFO ) 02090 IF( IINFO.LT.0 ) THEN 02091 RETURN 02092 ELSE 02093 RESULT( NTEST ) = ULPINV 02094 RESULT( NTEST+1 ) = ULPINV 02095 RESULT( NTEST+2 ) = ULPINV 02096 GO TO 1180 02097 END IF 02098 END IF 02099 * 02100 * Do tests 49 and 50 (or ... ) 02101 * 02102 CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 02103 $ LDU, TAU, WORK, RESULT( NTEST ) ) 02104 * 02105 IF( IUPLO.EQ.1 ) THEN 02106 DO 1140 J = 1, N 02107 DO 1130 I = MAX( 1, J-KD ), J 02108 V( KD+1+I-J, J ) = A( I, J ) 02109 1130 CONTINUE 02110 1140 CONTINUE 02111 ELSE 02112 DO 1160 J = 1, N 02113 DO 1150 I = J, MIN( N, J+KD ) 02114 V( 1+I-J, J ) = A( I, J ) 02115 1150 CONTINUE 02116 1160 CONTINUE 02117 END IF 02118 * 02119 NTEST = NTEST + 2 02120 SRNAMT = 'DSBEV' 02121 CALL DSBEV( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, WORK, 02122 $ IINFO ) 02123 IF( IINFO.NE.0 ) THEN 02124 WRITE( NOUNIT, FMT = 9999 )'DSBEV(N,' // UPLO // ')', 02125 $ IINFO, N, JTYPE, IOLDSD 02126 INFO = ABS( IINFO ) 02127 IF( IINFO.LT.0 ) THEN 02128 RETURN 02129 ELSE 02130 RESULT( NTEST ) = ULPINV 02131 GO TO 1180 02132 END IF 02133 END IF 02134 * 02135 * Do test 51 (or +54) 02136 * 02137 TEMP1 = ZERO 02138 TEMP2 = ZERO 02139 DO 1170 J = 1, N 02140 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 02141 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 02142 1170 CONTINUE 02143 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 02144 $ ULP*MAX( TEMP1, TEMP2 ) ) 02145 * 02146 * Load array V with the upper or lower triangular part 02147 * of the matrix in band form. 02148 * 02149 1180 CONTINUE 02150 IF( IUPLO.EQ.1 ) THEN 02151 DO 1200 J = 1, N 02152 DO 1190 I = MAX( 1, J-KD ), J 02153 V( KD+1+I-J, J ) = A( I, J ) 02154 1190 CONTINUE 02155 1200 CONTINUE 02156 ELSE 02157 DO 1220 J = 1, N 02158 DO 1210 I = J, MIN( N, J+KD ) 02159 V( 1+I-J, J ) = A( I, J ) 02160 1210 CONTINUE 02161 1220 CONTINUE 02162 END IF 02163 * 02164 NTEST = NTEST + 1 02165 SRNAMT = 'DSBEVX' 02166 CALL DSBEVX( 'V', 'A', UPLO, N, KD, V, LDU, U, LDU, VL, 02167 $ VU, IL, IU, ABSTOL, M, WA2, Z, LDU, WORK, 02168 $ IWORK, IWORK( 5*N+1 ), IINFO ) 02169 IF( IINFO.NE.0 ) THEN 02170 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,A,' // UPLO // 02171 $ ')', IINFO, N, JTYPE, IOLDSD 02172 INFO = ABS( IINFO ) 02173 IF( IINFO.LT.0 ) THEN 02174 RETURN 02175 ELSE 02176 RESULT( NTEST ) = ULPINV 02177 RESULT( NTEST+1 ) = ULPINV 02178 RESULT( NTEST+2 ) = ULPINV 02179 GO TO 1280 02180 END IF 02181 END IF 02182 * 02183 * Do tests 52 and 53 (or +54) 02184 * 02185 CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA2, D2, Z, LDU, V, 02186 $ LDU, TAU, WORK, RESULT( NTEST ) ) 02187 * 02188 NTEST = NTEST + 2 02189 * 02190 IF( IUPLO.EQ.1 ) THEN 02191 DO 1240 J = 1, N 02192 DO 1230 I = MAX( 1, J-KD ), J 02193 V( KD+1+I-J, J ) = A( I, J ) 02194 1230 CONTINUE 02195 1240 CONTINUE 02196 ELSE 02197 DO 1260 J = 1, N 02198 DO 1250 I = J, MIN( N, J+KD ) 02199 V( 1+I-J, J ) = A( I, J ) 02200 1250 CONTINUE 02201 1260 CONTINUE 02202 END IF 02203 * 02204 SRNAMT = 'DSBEVX' 02205 CALL DSBEVX( 'N', 'A', UPLO, N, KD, V, LDU, U, LDU, VL, 02206 $ VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK, 02207 $ IWORK, IWORK( 5*N+1 ), IINFO ) 02208 IF( IINFO.NE.0 ) THEN 02209 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(N,A,' // UPLO // 02210 $ ')', IINFO, N, JTYPE, IOLDSD 02211 INFO = ABS( IINFO ) 02212 IF( IINFO.LT.0 ) THEN 02213 RETURN 02214 ELSE 02215 RESULT( NTEST ) = ULPINV 02216 GO TO 1280 02217 END IF 02218 END IF 02219 * 02220 * Do test 54 (or +54) 02221 * 02222 TEMP1 = ZERO 02223 TEMP2 = ZERO 02224 DO 1270 J = 1, N 02225 TEMP1 = MAX( TEMP1, ABS( WA2( J ) ), ABS( WA3( J ) ) ) 02226 TEMP2 = MAX( TEMP2, ABS( WA2( J )-WA3( J ) ) ) 02227 1270 CONTINUE 02228 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 02229 $ ULP*MAX( TEMP1, TEMP2 ) ) 02230 * 02231 1280 CONTINUE 02232 NTEST = NTEST + 1 02233 IF( IUPLO.EQ.1 ) THEN 02234 DO 1300 J = 1, N 02235 DO 1290 I = MAX( 1, J-KD ), J 02236 V( KD+1+I-J, J ) = A( I, J ) 02237 1290 CONTINUE 02238 1300 CONTINUE 02239 ELSE 02240 DO 1320 J = 1, N 02241 DO 1310 I = J, MIN( N, J+KD ) 02242 V( 1+I-J, J ) = A( I, J ) 02243 1310 CONTINUE 02244 1320 CONTINUE 02245 END IF 02246 * 02247 SRNAMT = 'DSBEVX' 02248 CALL DSBEVX( 'V', 'I', UPLO, N, KD, V, LDU, U, LDU, VL, 02249 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 02250 $ IWORK, IWORK( 5*N+1 ), IINFO ) 02251 IF( IINFO.NE.0 ) THEN 02252 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,I,' // UPLO // 02253 $ ')', IINFO, N, JTYPE, IOLDSD 02254 INFO = ABS( IINFO ) 02255 IF( IINFO.LT.0 ) THEN 02256 RETURN 02257 ELSE 02258 RESULT( NTEST ) = ULPINV 02259 RESULT( NTEST+1 ) = ULPINV 02260 RESULT( NTEST+2 ) = ULPINV 02261 GO TO 1370 02262 END IF 02263 END IF 02264 * 02265 * Do tests 55 and 56 (or +54) 02266 * 02267 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 02268 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 02269 * 02270 NTEST = NTEST + 2 02271 * 02272 IF( IUPLO.EQ.1 ) THEN 02273 DO 1340 J = 1, N 02274 DO 1330 I = MAX( 1, J-KD ), J 02275 V( KD+1+I-J, J ) = A( I, J ) 02276 1330 CONTINUE 02277 1340 CONTINUE 02278 ELSE 02279 DO 1360 J = 1, N 02280 DO 1350 I = J, MIN( N, J+KD ) 02281 V( 1+I-J, J ) = A( I, J ) 02282 1350 CONTINUE 02283 1360 CONTINUE 02284 END IF 02285 * 02286 SRNAMT = 'DSBEVX' 02287 CALL DSBEVX( 'N', 'I', UPLO, N, KD, V, LDU, U, LDU, VL, 02288 $ VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK, 02289 $ IWORK, IWORK( 5*N+1 ), IINFO ) 02290 IF( IINFO.NE.0 ) THEN 02291 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(N,I,' // UPLO // 02292 $ ')', IINFO, N, JTYPE, IOLDSD 02293 INFO = ABS( IINFO ) 02294 IF( IINFO.LT.0 ) THEN 02295 RETURN 02296 ELSE 02297 RESULT( NTEST ) = ULPINV 02298 GO TO 1370 02299 END IF 02300 END IF 02301 * 02302 * Do test 57 (or +54) 02303 * 02304 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 02305 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 02306 IF( N.GT.0 ) THEN 02307 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 02308 ELSE 02309 TEMP3 = ZERO 02310 END IF 02311 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 02312 $ MAX( UNFL, TEMP3*ULP ) 02313 * 02314 1370 CONTINUE 02315 NTEST = NTEST + 1 02316 IF( IUPLO.EQ.1 ) THEN 02317 DO 1390 J = 1, N 02318 DO 1380 I = MAX( 1, J-KD ), J 02319 V( KD+1+I-J, J ) = A( I, J ) 02320 1380 CONTINUE 02321 1390 CONTINUE 02322 ELSE 02323 DO 1410 J = 1, N 02324 DO 1400 I = J, MIN( N, J+KD ) 02325 V( 1+I-J, J ) = A( I, J ) 02326 1400 CONTINUE 02327 1410 CONTINUE 02328 END IF 02329 * 02330 SRNAMT = 'DSBEVX' 02331 CALL DSBEVX( 'V', 'V', UPLO, N, KD, V, LDU, U, LDU, VL, 02332 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 02333 $ IWORK, IWORK( 5*N+1 ), IINFO ) 02334 IF( IINFO.NE.0 ) THEN 02335 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,V,' // UPLO // 02336 $ ')', IINFO, N, JTYPE, IOLDSD 02337 INFO = ABS( IINFO ) 02338 IF( IINFO.LT.0 ) THEN 02339 RETURN 02340 ELSE 02341 RESULT( NTEST ) = ULPINV 02342 RESULT( NTEST+1 ) = ULPINV 02343 RESULT( NTEST+2 ) = ULPINV 02344 GO TO 1460 02345 END IF 02346 END IF 02347 * 02348 * Do tests 58 and 59 (or +54) 02349 * 02350 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 02351 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 02352 * 02353 NTEST = NTEST + 2 02354 * 02355 IF( IUPLO.EQ.1 ) THEN 02356 DO 1430 J = 1, N 02357 DO 1420 I = MAX( 1, J-KD ), J 02358 V( KD+1+I-J, J ) = A( I, J ) 02359 1420 CONTINUE 02360 1430 CONTINUE 02361 ELSE 02362 DO 1450 J = 1, N 02363 DO 1440 I = J, MIN( N, J+KD ) 02364 V( 1+I-J, J ) = A( I, J ) 02365 1440 CONTINUE 02366 1450 CONTINUE 02367 END IF 02368 * 02369 SRNAMT = 'DSBEVX' 02370 CALL DSBEVX( 'N', 'V', UPLO, N, KD, V, LDU, U, LDU, VL, 02371 $ VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK, 02372 $ IWORK, IWORK( 5*N+1 ), IINFO ) 02373 IF( IINFO.NE.0 ) THEN 02374 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(N,V,' // UPLO // 02375 $ ')', IINFO, N, JTYPE, IOLDSD 02376 INFO = ABS( IINFO ) 02377 IF( IINFO.LT.0 ) THEN 02378 RETURN 02379 ELSE 02380 RESULT( NTEST ) = ULPINV 02381 GO TO 1460 02382 END IF 02383 END IF 02384 * 02385 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 02386 RESULT( NTEST ) = ULPINV 02387 GO TO 1460 02388 END IF 02389 * 02390 * Do test 60 (or +54) 02391 * 02392 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 02393 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 02394 IF( N.GT.0 ) THEN 02395 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 02396 ELSE 02397 TEMP3 = ZERO 02398 END IF 02399 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 02400 $ MAX( UNFL, TEMP3*ULP ) 02401 * 02402 1460 CONTINUE 02403 * 02404 * 7) Call DSYEVD 02405 * 02406 CALL DLACPY( ' ', N, N, A, LDA, V, LDU ) 02407 * 02408 NTEST = NTEST + 1 02409 SRNAMT = 'DSYEVD' 02410 CALL DSYEVD( 'V', UPLO, N, A, LDU, D1, WORK, LWEDC, 02411 $ IWORK, LIWEDC, IINFO ) 02412 IF( IINFO.NE.0 ) THEN 02413 WRITE( NOUNIT, FMT = 9999 )'DSYEVD(V,' // UPLO // 02414 $ ')', IINFO, N, JTYPE, IOLDSD 02415 INFO = ABS( IINFO ) 02416 IF( IINFO.LT.0 ) THEN 02417 RETURN 02418 ELSE 02419 RESULT( NTEST ) = ULPINV 02420 RESULT( NTEST+1 ) = ULPINV 02421 RESULT( NTEST+2 ) = ULPINV 02422 GO TO 1480 02423 END IF 02424 END IF 02425 * 02426 * Do tests 61 and 62 (or +54) 02427 * 02428 CALL DSYT21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z, 02429 $ LDU, TAU, WORK, RESULT( NTEST ) ) 02430 * 02431 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 02432 * 02433 NTEST = NTEST + 2 02434 SRNAMT = 'DSYEVD' 02435 CALL DSYEVD( 'N', UPLO, N, A, LDU, D3, WORK, LWEDC, 02436 $ IWORK, LIWEDC, IINFO ) 02437 IF( IINFO.NE.0 ) THEN 02438 WRITE( NOUNIT, FMT = 9999 )'DSYEVD(N,' // UPLO // 02439 $ ')', IINFO, N, JTYPE, IOLDSD 02440 INFO = ABS( IINFO ) 02441 IF( IINFO.LT.0 ) THEN 02442 RETURN 02443 ELSE 02444 RESULT( NTEST ) = ULPINV 02445 GO TO 1480 02446 END IF 02447 END IF 02448 * 02449 * Do test 63 (or +54) 02450 * 02451 TEMP1 = ZERO 02452 TEMP2 = ZERO 02453 DO 1470 J = 1, N 02454 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 02455 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 02456 1470 CONTINUE 02457 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 02458 $ ULP*MAX( TEMP1, TEMP2 ) ) 02459 * 02460 1480 CONTINUE 02461 * 02462 * 8) Call DSPEVD. 02463 * 02464 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 02465 * 02466 * Load array WORK with the upper or lower triangular 02467 * part of the matrix in packed form. 02468 * 02469 IF( IUPLO.EQ.1 ) THEN 02470 INDX = 1 02471 DO 1500 J = 1, N 02472 DO 1490 I = 1, J 02473 WORK( INDX ) = A( I, J ) 02474 INDX = INDX + 1 02475 1490 CONTINUE 02476 1500 CONTINUE 02477 ELSE 02478 INDX = 1 02479 DO 1520 J = 1, N 02480 DO 1510 I = J, N 02481 WORK( INDX ) = A( I, J ) 02482 INDX = INDX + 1 02483 1510 CONTINUE 02484 1520 CONTINUE 02485 END IF 02486 * 02487 NTEST = NTEST + 1 02488 SRNAMT = 'DSPEVD' 02489 CALL DSPEVD( 'V', UPLO, N, WORK, D1, Z, LDU, 02490 $ WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC, 02491 $ IINFO ) 02492 IF( IINFO.NE.0 ) THEN 02493 WRITE( NOUNIT, FMT = 9999 )'DSPEVD(V,' // UPLO // 02494 $ ')', IINFO, N, JTYPE, IOLDSD 02495 INFO = ABS( IINFO ) 02496 IF( IINFO.LT.0 ) THEN 02497 RETURN 02498 ELSE 02499 RESULT( NTEST ) = ULPINV 02500 RESULT( NTEST+1 ) = ULPINV 02501 RESULT( NTEST+2 ) = ULPINV 02502 GO TO 1580 02503 END IF 02504 END IF 02505 * 02506 * Do tests 64 and 65 (or +54) 02507 * 02508 CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 02509 $ LDU, TAU, WORK, RESULT( NTEST ) ) 02510 * 02511 IF( IUPLO.EQ.1 ) THEN 02512 INDX = 1 02513 DO 1540 J = 1, N 02514 DO 1530 I = 1, J 02515 * 02516 WORK( INDX ) = A( I, J ) 02517 INDX = INDX + 1 02518 1530 CONTINUE 02519 1540 CONTINUE 02520 ELSE 02521 INDX = 1 02522 DO 1560 J = 1, N 02523 DO 1550 I = J, N 02524 WORK( INDX ) = A( I, J ) 02525 INDX = INDX + 1 02526 1550 CONTINUE 02527 1560 CONTINUE 02528 END IF 02529 * 02530 NTEST = NTEST + 2 02531 SRNAMT = 'DSPEVD' 02532 CALL DSPEVD( 'N', UPLO, N, WORK, D3, Z, LDU, 02533 $ WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC, 02534 $ IINFO ) 02535 IF( IINFO.NE.0 ) THEN 02536 WRITE( NOUNIT, FMT = 9999 )'DSPEVD(N,' // UPLO // 02537 $ ')', IINFO, N, JTYPE, IOLDSD 02538 INFO = ABS( IINFO ) 02539 IF( IINFO.LT.0 ) THEN 02540 RETURN 02541 ELSE 02542 RESULT( NTEST ) = ULPINV 02543 GO TO 1580 02544 END IF 02545 END IF 02546 * 02547 * Do test 66 (or +54) 02548 * 02549 TEMP1 = ZERO 02550 TEMP2 = ZERO 02551 DO 1570 J = 1, N 02552 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 02553 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 02554 1570 CONTINUE 02555 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 02556 $ ULP*MAX( TEMP1, TEMP2 ) ) 02557 1580 CONTINUE 02558 * 02559 * 9) Call DSBEVD. 02560 * 02561 IF( JTYPE.LE.7 ) THEN 02562 KD = 1 02563 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN 02564 KD = MAX( N-1, 0 ) 02565 ELSE 02566 KD = IHBW 02567 END IF 02568 * 02569 * Load array V with the upper or lower triangular part 02570 * of the matrix in band form. 02571 * 02572 IF( IUPLO.EQ.1 ) THEN 02573 DO 1600 J = 1, N 02574 DO 1590 I = MAX( 1, J-KD ), J 02575 V( KD+1+I-J, J ) = A( I, J ) 02576 1590 CONTINUE 02577 1600 CONTINUE 02578 ELSE 02579 DO 1620 J = 1, N 02580 DO 1610 I = J, MIN( N, J+KD ) 02581 V( 1+I-J, J ) = A( I, J ) 02582 1610 CONTINUE 02583 1620 CONTINUE 02584 END IF 02585 * 02586 NTEST = NTEST + 1 02587 SRNAMT = 'DSBEVD' 02588 CALL DSBEVD( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK, 02589 $ LWEDC, IWORK, LIWEDC, IINFO ) 02590 IF( IINFO.NE.0 ) THEN 02591 WRITE( NOUNIT, FMT = 9999 )'DSBEVD(V,' // UPLO // 02592 $ ')', IINFO, N, JTYPE, IOLDSD 02593 INFO = ABS( IINFO ) 02594 IF( IINFO.LT.0 ) THEN 02595 RETURN 02596 ELSE 02597 RESULT( NTEST ) = ULPINV 02598 RESULT( NTEST+1 ) = ULPINV 02599 RESULT( NTEST+2 ) = ULPINV 02600 GO TO 1680 02601 END IF 02602 END IF 02603 * 02604 * Do tests 67 and 68 (or +54) 02605 * 02606 CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 02607 $ LDU, TAU, WORK, RESULT( NTEST ) ) 02608 * 02609 IF( IUPLO.EQ.1 ) THEN 02610 DO 1640 J = 1, N 02611 DO 1630 I = MAX( 1, J-KD ), J 02612 V( KD+1+I-J, J ) = A( I, J ) 02613 1630 CONTINUE 02614 1640 CONTINUE 02615 ELSE 02616 DO 1660 J = 1, N 02617 DO 1650 I = J, MIN( N, J+KD ) 02618 V( 1+I-J, J ) = A( I, J ) 02619 1650 CONTINUE 02620 1660 CONTINUE 02621 END IF 02622 * 02623 NTEST = NTEST + 2 02624 SRNAMT = 'DSBEVD' 02625 CALL DSBEVD( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, WORK, 02626 $ LWEDC, IWORK, LIWEDC, IINFO ) 02627 IF( IINFO.NE.0 ) THEN 02628 WRITE( NOUNIT, FMT = 9999 )'DSBEVD(N,' // UPLO // 02629 $ ')', IINFO, N, JTYPE, IOLDSD 02630 INFO = ABS( IINFO ) 02631 IF( IINFO.LT.0 ) THEN 02632 RETURN 02633 ELSE 02634 RESULT( NTEST ) = ULPINV 02635 GO TO 1680 02636 END IF 02637 END IF 02638 * 02639 * Do test 69 (or +54) 02640 * 02641 TEMP1 = ZERO 02642 TEMP2 = ZERO 02643 DO 1670 J = 1, N 02644 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 02645 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 02646 1670 CONTINUE 02647 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 02648 $ ULP*MAX( TEMP1, TEMP2 ) ) 02649 * 02650 1680 CONTINUE 02651 * 02652 * 02653 CALL DLACPY( ' ', N, N, A, LDA, V, LDU ) 02654 NTEST = NTEST + 1 02655 SRNAMT = 'DSYEVR' 02656 CALL DSYEVR( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 02657 $ ABSTOL, M, WA1, Z, LDU, IWORK, WORK, LWORK, 02658 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 02659 IF( IINFO.NE.0 ) THEN 02660 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,A,' // UPLO // 02661 $ ')', IINFO, N, JTYPE, IOLDSD 02662 INFO = ABS( IINFO ) 02663 IF( IINFO.LT.0 ) THEN 02664 RETURN 02665 ELSE 02666 RESULT( NTEST ) = ULPINV 02667 RESULT( NTEST+1 ) = ULPINV 02668 RESULT( NTEST+2 ) = ULPINV 02669 GO TO 1700 02670 END IF 02671 END IF 02672 * 02673 * Do tests 70 and 71 (or ... ) 02674 * 02675 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 02676 * 02677 CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 02678 $ LDU, TAU, WORK, RESULT( NTEST ) ) 02679 * 02680 NTEST = NTEST + 2 02681 SRNAMT = 'DSYEVR' 02682 CALL DSYEVR( 'N', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 02683 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 02684 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 02685 IF( IINFO.NE.0 ) THEN 02686 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(N,A,' // UPLO // 02687 $ ')', IINFO, N, JTYPE, IOLDSD 02688 INFO = ABS( IINFO ) 02689 IF( IINFO.LT.0 ) THEN 02690 RETURN 02691 ELSE 02692 RESULT( NTEST ) = ULPINV 02693 GO TO 1700 02694 END IF 02695 END IF 02696 * 02697 * Do test 72 (or ... ) 02698 * 02699 TEMP1 = ZERO 02700 TEMP2 = ZERO 02701 DO 1690 J = 1, N 02702 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 02703 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 02704 1690 CONTINUE 02705 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 02706 $ ULP*MAX( TEMP1, TEMP2 ) ) 02707 * 02708 1700 CONTINUE 02709 * 02710 NTEST = NTEST + 1 02711 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 02712 SRNAMT = 'DSYEVR' 02713 CALL DSYEVR( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 02714 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 02715 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 02716 IF( IINFO.NE.0 ) THEN 02717 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,I,' // UPLO // 02718 $ ')', IINFO, N, JTYPE, IOLDSD 02719 INFO = ABS( IINFO ) 02720 IF( IINFO.LT.0 ) THEN 02721 RETURN 02722 ELSE 02723 RESULT( NTEST ) = ULPINV 02724 RESULT( NTEST+1 ) = ULPINV 02725 RESULT( NTEST+2 ) = ULPINV 02726 GO TO 1710 02727 END IF 02728 END IF 02729 * 02730 * Do tests 73 and 74 (or +54) 02731 * 02732 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 02733 * 02734 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 02735 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 02736 * 02737 NTEST = NTEST + 2 02738 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 02739 SRNAMT = 'DSYEVR' 02740 CALL DSYEVR( 'N', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 02741 $ ABSTOL, M3, WA3, Z, LDU, IWORK, WORK, LWORK, 02742 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 02743 IF( IINFO.NE.0 ) THEN 02744 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(N,I,' // UPLO // 02745 $ ')', IINFO, N, JTYPE, IOLDSD 02746 INFO = ABS( IINFO ) 02747 IF( IINFO.LT.0 ) THEN 02748 RETURN 02749 ELSE 02750 RESULT( NTEST ) = ULPINV 02751 GO TO 1710 02752 END IF 02753 END IF 02754 * 02755 * Do test 75 (or +54) 02756 * 02757 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 02758 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 02759 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 02760 $ MAX( UNFL, ULP*TEMP3 ) 02761 1710 CONTINUE 02762 * 02763 NTEST = NTEST + 1 02764 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 02765 SRNAMT = 'DSYEVR' 02766 CALL DSYEVR( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 02767 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 02768 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 02769 IF( IINFO.NE.0 ) THEN 02770 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,V,' // UPLO // 02771 $ ')', IINFO, N, JTYPE, IOLDSD 02772 INFO = ABS( IINFO ) 02773 IF( IINFO.LT.0 ) THEN 02774 RETURN 02775 ELSE 02776 RESULT( NTEST ) = ULPINV 02777 RESULT( NTEST+1 ) = ULPINV 02778 RESULT( NTEST+2 ) = ULPINV 02779 GO TO 700 02780 END IF 02781 END IF 02782 * 02783 * Do tests 76 and 77 (or +54) 02784 * 02785 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 02786 * 02787 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 02788 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 02789 * 02790 NTEST = NTEST + 2 02791 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 02792 SRNAMT = 'DSYEVR' 02793 CALL DSYEVR( 'N', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 02794 $ ABSTOL, M3, WA3, Z, LDU, IWORK, WORK, LWORK, 02795 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 02796 IF( IINFO.NE.0 ) THEN 02797 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(N,V,' // UPLO // 02798 $ ')', IINFO, N, JTYPE, IOLDSD 02799 INFO = ABS( IINFO ) 02800 IF( IINFO.LT.0 ) THEN 02801 RETURN 02802 ELSE 02803 RESULT( NTEST ) = ULPINV 02804 GO TO 700 02805 END IF 02806 END IF 02807 * 02808 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 02809 RESULT( NTEST ) = ULPINV 02810 GO TO 700 02811 END IF 02812 * 02813 * Do test 78 (or +54) 02814 * 02815 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 02816 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 02817 IF( N.GT.0 ) THEN 02818 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 02819 ELSE 02820 TEMP3 = ZERO 02821 END IF 02822 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 02823 $ MAX( UNFL, TEMP3*ULP ) 02824 * 02825 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 02826 * 02827 1720 CONTINUE 02828 * 02829 * End of Loop -- Check for RESULT(j) > THRESH 02830 * 02831 NTESTT = NTESTT + NTEST 02832 * 02833 CALL DLAFTS( 'DST', N, N, JTYPE, NTEST, RESULT, IOLDSD, 02834 $ THRESH, NOUNIT, NERRS ) 02835 * 02836 1730 CONTINUE 02837 1740 CONTINUE 02838 * 02839 * Summary 02840 * 02841 CALL ALASVM( 'DST', NOUNIT, NERRS, NTESTT, 0 ) 02842 * 02843 9999 FORMAT( ' DDRVST: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', 02844 $ I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' ) 02845 * 02846 RETURN 02847 * 02848 * End of DDRVST 02849 * 02850 END