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