![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SDRVGG 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 SDRVGG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 00012 * THRSHN, NOUNIT, A, LDA, B, S, T, S2, T2, Q, 00013 * LDQ, Z, ALPHR1, ALPHI1, BETA1, ALPHR2, ALPHI2, 00014 * BETA2, VL, VR, WORK, LWORK, RESULT, INFO ) 00015 * 00016 * .. Scalar Arguments .. 00017 * INTEGER INFO, LDA, LDQ, LWORK, NOUNIT, NSIZES, NTYPES 00018 * REAL THRESH, THRSHN 00019 * .. 00020 * .. Array Arguments .. 00021 * LOGICAL DOTYPE( * ) 00022 * INTEGER ISEED( 4 ), NN( * ) 00023 * REAL A( LDA, * ), ALPHI1( * ), ALPHI2( * ), 00024 * $ ALPHR1( * ), ALPHR2( * ), B( LDA, * ), 00025 * $ BETA1( * ), BETA2( * ), Q( LDQ, * ), 00026 * $ RESULT( * ), S( LDA, * ), S2( LDA, * ), 00027 * $ T( LDA, * ), T2( LDA, * ), VL( LDQ, * ), 00028 * $ VR( LDQ, * ), WORK( * ), Z( LDQ, * ) 00029 * .. 00030 * 00031 * 00032 *> \par Purpose: 00033 * ============= 00034 *> 00035 *> \verbatim 00036 *> 00037 *> SDRVGG checks the nonsymmetric generalized eigenvalue driver 00038 *> routines. 00039 *> T T T 00040 *> SGEGS factors A and B as Q S Z and Q T Z , where means 00041 *> transpose, T is upper triangular, S is in generalized Schur form 00042 *> (block upper triangular, with 1x1 and 2x2 blocks on the diagonal, 00043 *> the 2x2 blocks corresponding to complex conjugate pairs of 00044 *> generalized eigenvalues), and Q and Z are orthogonal. It also 00045 *> computes the generalized eigenvalues (alpha(1),beta(1)), ..., 00046 *> (alpha(n),beta(n)), where alpha(j)=S(j,j) and beta(j)=P(j,j) -- 00047 *> thus, w(j) = alpha(j)/beta(j) is a root of the generalized 00048 *> eigenvalue problem 00049 *> 00050 *> det( A - w(j) B ) = 0 00051 *> 00052 *> and m(j) = beta(j)/alpha(j) is a root of the essentially equivalent 00053 *> problem 00054 *> 00055 *> det( m(j) A - B ) = 0 00056 *> 00057 *> SGEGV computes the generalized eigenvalues (alpha(1),beta(1)), ..., 00058 *> (alpha(n),beta(n)), the matrix L whose columns contain the 00059 *> generalized left eigenvectors l, and the matrix R whose columns 00060 *> contain the generalized right eigenvectors r for the pair (A,B). 00061 *> 00062 *> When SDRVGG is called, a number of matrix "sizes" ("n's") and a 00063 *> number of matrix "types" are specified. For each size ("n") 00064 *> and each type of matrix, one matrix will be generated and used 00065 *> to test the nonsymmetric eigenroutines. For each matrix, 7 00066 *> tests will be performed and compared with the threshhold THRESH: 00067 *> 00068 *> Results from SGEGS: 00069 *> 00070 *> T 00071 *> (1) | A - Q S Z | / ( |A| n ulp ) 00072 *> 00073 *> T 00074 *> (2) | B - Q T Z | / ( |B| n ulp ) 00075 *> 00076 *> T 00077 *> (3) | I - QQ | / ( n ulp ) 00078 *> 00079 *> T 00080 *> (4) | I - ZZ | / ( n ulp ) 00081 *> 00082 *> (5) maximum over j of D(j) where: 00083 *> 00084 *> if alpha(j) is real: 00085 *> |alpha(j) - S(j,j)| |beta(j) - T(j,j)| 00086 *> D(j) = ------------------------ + ----------------------- 00087 *> max(|alpha(j)|,|S(j,j)|) max(|beta(j)|,|T(j,j)|) 00088 *> 00089 *> if alpha(j) is complex: 00090 *> | det( s S - w T ) | 00091 *> D(j) = --------------------------------------------------- 00092 *> ulp max( s norm(S), |w| norm(T) )*norm( s S - w T ) 00093 *> 00094 *> and S and T are here the 2 x 2 diagonal blocks of S and T 00095 *> corresponding to the j-th eigenvalue. 00096 *> 00097 *> Results from SGEGV: 00098 *> 00099 *> (6) max over all left eigenvalue/-vector pairs (beta/alpha,l) of 00100 *> 00101 *> | l**H * (beta A - alpha B) | / ( ulp max( |beta A|, |alpha B| ) ) 00102 *> 00103 *> where l**H is the conjugate tranpose of l. 00104 *> 00105 *> (7) max over all right eigenvalue/-vector pairs (beta/alpha,r) of 00106 *> 00107 *> | (beta A - alpha B) r | / ( ulp max( |beta A|, |alpha B| ) ) 00108 *> 00109 *> Test Matrices 00110 *> ---- -------- 00111 *> 00112 *> The sizes of the test matrices are specified by an array 00113 *> NN(1:NSIZES); the value of each element NN(j) specifies one size. 00114 *> The "types" are specified by a logical array DOTYPE( 1:NTYPES ); if 00115 *> DOTYPE(j) is .TRUE., then matrix type "j" will be generated. 00116 *> Currently, the list of possible types is: 00117 *> 00118 *> (1) ( 0, 0 ) (a pair of zero matrices) 00119 *> 00120 *> (2) ( I, 0 ) (an identity and a zero matrix) 00121 *> 00122 *> (3) ( 0, I ) (an identity and a zero matrix) 00123 *> 00124 *> (4) ( I, I ) (a pair of identity matrices) 00125 *> 00126 *> t t 00127 *> (5) ( J , J ) (a pair of transposed Jordan blocks) 00128 *> 00129 *> t ( I 0 ) 00130 *> (6) ( X, Y ) where X = ( J 0 ) and Y = ( t ) 00131 *> ( 0 I ) ( 0 J ) 00132 *> and I is a k x k identity and J a (k+1)x(k+1) 00133 *> Jordan block; k=(N-1)/2 00134 *> 00135 *> (7) ( D, I ) where D is diag( 0, 1,..., N-1 ) (a diagonal 00136 *> matrix with those diagonal entries.) 00137 *> (8) ( I, D ) 00138 *> 00139 *> (9) ( big*D, small*I ) where "big" is near overflow and small=1/big 00140 *> 00141 *> (10) ( small*D, big*I ) 00142 *> 00143 *> (11) ( big*I, small*D ) 00144 *> 00145 *> (12) ( small*I, big*D ) 00146 *> 00147 *> (13) ( big*D, big*I ) 00148 *> 00149 *> (14) ( small*D, small*I ) 00150 *> 00151 *> (15) ( D1, D2 ) where D1 is diag( 0, 0, 1, ..., N-3, 0 ) and 00152 *> D2 is diag( 0, N-3, N-4,..., 1, 0, 0 ) 00153 *> t t 00154 *> (16) Q ( J , J ) Z where Q and Z are random orthogonal matrices. 00155 *> 00156 *> (17) Q ( T1, T2 ) Z where T1 and T2 are upper triangular matrices 00157 *> with random O(1) entries above the diagonal 00158 *> and diagonal entries diag(T1) = 00159 *> ( 0, 0, 1, ..., N-3, 0 ) and diag(T2) = 00160 *> ( 0, N-3, N-4,..., 1, 0, 0 ) 00161 *> 00162 *> (18) Q ( T1, T2 ) Z diag(T1) = ( 0, 0, 1, 1, s, ..., s, 0 ) 00163 *> diag(T2) = ( 0, 1, 0, 1,..., 1, 0 ) 00164 *> s = machine precision. 00165 *> 00166 *> (19) Q ( T1, T2 ) Z diag(T1)=( 0,0,1,1, 1-d, ..., 1-(N-5)*d=s, 0 ) 00167 *> diag(T2) = ( 0, 1, 0, 1, ..., 1, 0 ) 00168 *> 00169 *> N-5 00170 *> (20) Q ( T1, T2 ) Z diag(T1)=( 0, 0, 1, 1, a, ..., a =s, 0 ) 00171 *> diag(T2) = ( 0, 1, 0, 1, ..., 1, 0, 0 ) 00172 *> 00173 *> (21) Q ( T1, T2 ) Z diag(T1)=( 0, 0, 1, r1, r2, ..., r(N-4), 0 ) 00174 *> diag(T2) = ( 0, 1, 0, 1, ..., 1, 0, 0 ) 00175 *> where r1,..., r(N-4) are random. 00176 *> 00177 *> (22) Q ( big*T1, small*T2 ) Z diag(T1) = ( 0, 0, 1, ..., N-3, 0 ) 00178 *> diag(T2) = ( 0, 1, ..., 1, 0, 0 ) 00179 *> 00180 *> (23) Q ( small*T1, big*T2 ) Z diag(T1) = ( 0, 0, 1, ..., N-3, 0 ) 00181 *> diag(T2) = ( 0, 1, ..., 1, 0, 0 ) 00182 *> 00183 *> (24) Q ( small*T1, small*T2 ) Z diag(T1) = ( 0, 0, 1, ..., N-3, 0 ) 00184 *> diag(T2) = ( 0, 1, ..., 1, 0, 0 ) 00185 *> 00186 *> (25) Q ( big*T1, big*T2 ) Z diag(T1) = ( 0, 0, 1, ..., N-3, 0 ) 00187 *> diag(T2) = ( 0, 1, ..., 1, 0, 0 ) 00188 *> 00189 *> (26) Q ( T1, T2 ) Z where T1 and T2 are random upper-triangular 00190 *> matrices. 00191 *> \endverbatim 00192 * 00193 * Arguments: 00194 * ========== 00195 * 00196 *> \param[in] NSIZES 00197 *> \verbatim 00198 *> NSIZES is INTEGER 00199 *> The number of sizes of matrices to use. If it is zero, 00200 *> SDRVGG does nothing. It must be at least zero. 00201 *> \endverbatim 00202 *> 00203 *> \param[in] NN 00204 *> \verbatim 00205 *> NN is INTEGER array, dimension (NSIZES) 00206 *> An array containing the sizes to be used for the matrices. 00207 *> Zero values will be skipped. The values must be at least 00208 *> zero. 00209 *> \endverbatim 00210 *> 00211 *> \param[in] NTYPES 00212 *> \verbatim 00213 *> NTYPES is INTEGER 00214 *> The number of elements in DOTYPE. If it is zero, SDRVGG 00215 *> does nothing. It must be at least zero. If it is MAXTYP+1 00216 *> and NSIZES is 1, then an additional type, MAXTYP+1 is 00217 *> defined, which is to use whatever matrix is in A. This 00218 *> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and 00219 *> DOTYPE(MAXTYP+1) is .TRUE. . 00220 *> \endverbatim 00221 *> 00222 *> \param[in] DOTYPE 00223 *> \verbatim 00224 *> DOTYPE is LOGICAL array, dimension (NTYPES) 00225 *> If DOTYPE(j) is .TRUE., then for each size in NN a 00226 *> matrix of that size and of type j will be generated. 00227 *> If NTYPES is smaller than the maximum number of types 00228 *> defined (PARAMETER MAXTYP), then types NTYPES+1 through 00229 *> MAXTYP will not be generated. If NTYPES is larger 00230 *> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) 00231 *> will be ignored. 00232 *> \endverbatim 00233 *> 00234 *> \param[in,out] ISEED 00235 *> \verbatim 00236 *> ISEED is INTEGER array, dimension (4) 00237 *> On entry ISEED specifies the seed of the random number 00238 *> generator. The array elements should be between 0 and 4095; 00239 *> if not they will be reduced mod 4096. Also, ISEED(4) must 00240 *> be odd. The random number generator uses a linear 00241 *> congruential sequence limited to small integers, and so 00242 *> should produce machine independent random numbers. The 00243 *> values of ISEED are changed on exit, and can be used in the 00244 *> next call to SDRVGG to continue the same random number 00245 *> sequence. 00246 *> \endverbatim 00247 *> 00248 *> \param[in] THRESH 00249 *> \verbatim 00250 *> THRESH is REAL 00251 *> A test will count as "failed" if the "error", computed as 00252 *> described above, exceeds THRESH. Note that the error is 00253 *> scaled to be O(1), so THRESH should be a reasonably small 00254 *> multiple of 1, e.g., 10 or 100. In particular, it should 00255 *> not depend on the precision (single vs. double) or the size 00256 *> of the matrix. It must be at least zero. 00257 *> \endverbatim 00258 *> 00259 *> \param[in] THRSHN 00260 *> \verbatim 00261 *> THRSHN is REAL 00262 *> Threshhold for reporting eigenvector normalization error. 00263 *> If the normalization of any eigenvector differs from 1 by 00264 *> more than THRSHN*ulp, then a special error message will be 00265 *> printed. (This is handled separately from the other tests, 00266 *> since only a compiler or programming error should cause an 00267 *> error message, at least if THRSHN is at least 5--10.) 00268 *> \endverbatim 00269 *> 00270 *> \param[in] NOUNIT 00271 *> \verbatim 00272 *> NOUNIT is INTEGER 00273 *> The FORTRAN unit number for printing out error messages 00274 *> (e.g., if a routine returns IINFO not equal to 0.) 00275 *> \endverbatim 00276 *> 00277 *> \param[in,out] A 00278 *> \verbatim 00279 *> A is REAL array, dimension 00280 *> (LDA, max(NN)) 00281 *> Used to hold the original A matrix. Used as input only 00282 *> if NTYPES=MAXTYP+1, DOTYPE(1:MAXTYP)=.FALSE., and 00283 *> DOTYPE(MAXTYP+1)=.TRUE. 00284 *> \endverbatim 00285 *> 00286 *> \param[in] LDA 00287 *> \verbatim 00288 *> LDA is INTEGER 00289 *> The leading dimension of A, B, S, T, S2, and T2. 00290 *> It must be at least 1 and at least max( NN ). 00291 *> \endverbatim 00292 *> 00293 *> \param[in,out] B 00294 *> \verbatim 00295 *> B is REAL array, dimension 00296 *> (LDA, max(NN)) 00297 *> Used to hold the original B matrix. Used as input only 00298 *> if NTYPES=MAXTYP+1, DOTYPE(1:MAXTYP)=.FALSE., and 00299 *> DOTYPE(MAXTYP+1)=.TRUE. 00300 *> \endverbatim 00301 *> 00302 *> \param[out] S 00303 *> \verbatim 00304 *> S is REAL array, dimension (LDA, max(NN)) 00305 *> The Schur form matrix computed from A by SGEGS. On exit, S 00306 *> contains the Schur form matrix corresponding to the matrix 00307 *> in A. 00308 *> \endverbatim 00309 *> 00310 *> \param[out] T 00311 *> \verbatim 00312 *> T is REAL array, dimension (LDA, max(NN)) 00313 *> The upper triangular matrix computed from B by SGEGS. 00314 *> \endverbatim 00315 *> 00316 *> \param[out] S2 00317 *> \verbatim 00318 *> S2 is REAL array, dimension (LDA, max(NN)) 00319 *> The matrix computed from A by SGEGV. This will be the 00320 *> Schur form of some matrix related to A, but will not, in 00321 *> general, be the same as S. 00322 *> \endverbatim 00323 *> 00324 *> \param[out] T2 00325 *> \verbatim 00326 *> T2 is REAL array, dimension (LDA, max(NN)) 00327 *> The matrix computed from B by SGEGV. This will be the 00328 *> Schur form of some matrix related to B, but will not, in 00329 *> general, be the same as T. 00330 *> \endverbatim 00331 *> 00332 *> \param[out] Q 00333 *> \verbatim 00334 *> Q is REAL array, dimension (LDQ, max(NN)) 00335 *> The (left) orthogonal matrix computed by SGEGS. 00336 *> \endverbatim 00337 *> 00338 *> \param[in] LDQ 00339 *> \verbatim 00340 *> LDQ is INTEGER 00341 *> The leading dimension of Q, Z, VL, and VR. It must 00342 *> be at least 1 and at least max( NN ). 00343 *> \endverbatim 00344 *> 00345 *> \param[out] Z 00346 *> \verbatim 00347 *> Z is REAL array of 00348 *> dimension( LDQ, max(NN) ) 00349 *> The (right) orthogonal matrix computed by SGEGS. 00350 *> \endverbatim 00351 *> 00352 *> \param[out] ALPHR1 00353 *> \verbatim 00354 *> ALPHR1 is REAL array, dimension (max(NN)) 00355 *> \endverbatim 00356 *> 00357 *> \param[out] ALPHI1 00358 *> \verbatim 00359 *> ALPHI1 is REAL array, dimension (max(NN)) 00360 *> \endverbatim 00361 *> 00362 *> \param[out] BETA1 00363 *> \verbatim 00364 *> BETA1 is REAL array, dimension (max(NN)) 00365 *> 00366 *> The generalized eigenvalues of (A,B) computed by SGEGS. 00367 *> ( ALPHR1(k)+ALPHI1(k)*i ) / BETA1(k) is the k-th 00368 *> generalized eigenvalue of the matrices in A and B. 00369 *> \endverbatim 00370 *> 00371 *> \param[out] ALPHR2 00372 *> \verbatim 00373 *> ALPHR2 is REAL array, dimension (max(NN)) 00374 *> \endverbatim 00375 *> 00376 *> \param[out] ALPHI2 00377 *> \verbatim 00378 *> ALPHI2 is REAL array, dimension (max(NN)) 00379 *> \endverbatim 00380 *> 00381 *> \param[out] BETA2 00382 *> \verbatim 00383 *> BETA2 is REAL array, dimension (max(NN)) 00384 *> 00385 *> The generalized eigenvalues of (A,B) computed by SGEGV. 00386 *> ( ALPHR2(k)+ALPHI2(k)*i ) / BETA2(k) is the k-th 00387 *> generalized eigenvalue of the matrices in A and B. 00388 *> \endverbatim 00389 *> 00390 *> \param[out] VL 00391 *> \verbatim 00392 *> VL is REAL array, dimension (LDQ, max(NN)) 00393 *> The (block lower triangular) left eigenvector matrix for 00394 *> the matrices in A and B. (See STGEVC for the format.) 00395 *> \endverbatim 00396 *> 00397 *> \param[out] VR 00398 *> \verbatim 00399 *> VR is REAL array, dimension (LDQ, max(NN)) 00400 *> The (block upper triangular) right eigenvector matrix for 00401 *> the matrices in A and B. (See STGEVC for the format.) 00402 *> \endverbatim 00403 *> 00404 *> \param[out] WORK 00405 *> \verbatim 00406 *> WORK is REAL array, dimension (LWORK) 00407 *> \endverbatim 00408 *> 00409 *> \param[in] LWORK 00410 *> \verbatim 00411 *> LWORK is INTEGER 00412 *> The number of entries in WORK. This must be at least 00413 *> 2*N + MAX( 6*N, N*(NB+1), (k+1)*(2*k+N+1) ), where 00414 *> "k" is the sum of the blocksize and number-of-shifts for 00415 *> SHGEQZ, and NB is the greatest of the blocksizes for 00416 *> SGEQRF, SORMQR, and SORGQR. (The blocksizes and the 00417 *> number-of-shifts are retrieved through calls to ILAENV.) 00418 *> \endverbatim 00419 *> 00420 *> \param[out] RESULT 00421 *> \verbatim 00422 *> RESULT is REAL array, dimension (15) 00423 *> The values computed by the tests described above. 00424 *> The values are currently limited to 1/ulp, to avoid 00425 *> overflow. 00426 *> \endverbatim 00427 *> 00428 *> \param[out] INFO 00429 *> \verbatim 00430 *> INFO is INTEGER 00431 *> = 0: successful exit 00432 *> < 0: if INFO = -i, the i-th argument had an illegal value. 00433 *> > 0: A routine returned an error code. INFO is the 00434 *> absolute value of the INFO value returned. 00435 *> \endverbatim 00436 * 00437 * Authors: 00438 * ======== 00439 * 00440 *> \author Univ. of Tennessee 00441 *> \author Univ. of California Berkeley 00442 *> \author Univ. of Colorado Denver 00443 *> \author NAG Ltd. 00444 * 00445 *> \date November 2011 00446 * 00447 *> \ingroup single_eig 00448 * 00449 * ===================================================================== 00450 SUBROUTINE SDRVGG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 00451 $ THRSHN, NOUNIT, A, LDA, B, S, T, S2, T2, Q, 00452 $ LDQ, Z, ALPHR1, ALPHI1, BETA1, ALPHR2, ALPHI2, 00453 $ BETA2, VL, VR, WORK, LWORK, RESULT, INFO ) 00454 * 00455 * -- LAPACK test routine (version 3.4.0) -- 00456 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00457 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00458 * November 2011 00459 * 00460 * .. Scalar Arguments .. 00461 INTEGER INFO, LDA, LDQ, LWORK, NOUNIT, NSIZES, NTYPES 00462 REAL THRESH, THRSHN 00463 * .. 00464 * .. Array Arguments .. 00465 LOGICAL DOTYPE( * ) 00466 INTEGER ISEED( 4 ), NN( * ) 00467 REAL A( LDA, * ), ALPHI1( * ), ALPHI2( * ), 00468 $ ALPHR1( * ), ALPHR2( * ), B( LDA, * ), 00469 $ BETA1( * ), BETA2( * ), Q( LDQ, * ), 00470 $ RESULT( * ), S( LDA, * ), S2( LDA, * ), 00471 $ T( LDA, * ), T2( LDA, * ), VL( LDQ, * ), 00472 $ VR( LDQ, * ), WORK( * ), Z( LDQ, * ) 00473 * .. 00474 * 00475 * ===================================================================== 00476 * 00477 * .. Parameters .. 00478 REAL ZERO, ONE 00479 PARAMETER ( ZERO = 0.0, ONE = 1.0 ) 00480 INTEGER MAXTYP 00481 PARAMETER ( MAXTYP = 26 ) 00482 * .. 00483 * .. Local Scalars .. 00484 LOGICAL BADNN, ILABAD 00485 INTEGER I1, IADD, IINFO, IN, J, JC, JR, JSIZE, JTYPE, 00486 $ LWKOPT, MTYPES, N, N1, NB, NBZ, NERRS, NMATS, 00487 $ NMAX, NS, NTEST, NTESTT 00488 REAL SAFMAX, SAFMIN, TEMP1, TEMP2, ULP, ULPINV 00489 * .. 00490 * .. Local Arrays .. 00491 INTEGER IASIGN( MAXTYP ), IBSIGN( MAXTYP ), 00492 $ IOLDSD( 4 ), KADD( 6 ), KAMAGN( MAXTYP ), 00493 $ KATYPE( MAXTYP ), KAZERO( MAXTYP ), 00494 $ KBMAGN( MAXTYP ), KBTYPE( MAXTYP ), 00495 $ KBZERO( MAXTYP ), KCLASS( MAXTYP ), 00496 $ KTRIAN( MAXTYP ), KZ1( 6 ), KZ2( 6 ) 00497 REAL DUMMA( 4 ), RMAGN( 0: 3 ) 00498 * .. 00499 * .. External Functions .. 00500 INTEGER ILAENV 00501 REAL SLAMCH, SLARND 00502 EXTERNAL ILAENV, SLAMCH, SLARND 00503 * .. 00504 * .. External Subroutines .. 00505 EXTERNAL ALASVM, SGEGS, SGEGV, SGET51, SGET52, SGET53, 00506 $ SLABAD, SLACPY, SLARFG, SLASET, SLATM4, SORM2R, 00507 $ XERBLA 00508 * .. 00509 * .. Intrinsic Functions .. 00510 INTRINSIC ABS, MAX, MIN, REAL, SIGN 00511 * .. 00512 * .. Data statements .. 00513 DATA KCLASS / 15*1, 10*2, 1*3 / 00514 DATA KZ1 / 0, 1, 2, 1, 3, 3 / 00515 DATA KZ2 / 0, 0, 1, 2, 1, 1 / 00516 DATA KADD / 0, 0, 0, 0, 3, 2 / 00517 DATA KATYPE / 0, 1, 0, 1, 2, 3, 4, 1, 4, 4, 1, 1, 4, 00518 $ 4, 4, 2, 4, 5, 8, 7, 9, 4*4, 0 / 00519 DATA KBTYPE / 0, 0, 1, 1, 2, -3, 1, 4, 1, 1, 4, 4, 00520 $ 1, 1, -4, 2, -4, 8*8, 0 / 00521 DATA KAZERO / 6*1, 2, 1, 2*2, 2*1, 2*2, 3, 1, 3, 00522 $ 4*5, 4*3, 1 / 00523 DATA KBZERO / 6*1, 1, 2, 2*1, 2*2, 2*1, 4, 1, 4, 00524 $ 4*6, 4*4, 1 / 00525 DATA KAMAGN / 8*1, 2, 3, 2, 3, 2, 3, 7*1, 2, 3, 3, 00526 $ 2, 1 / 00527 DATA KBMAGN / 8*1, 3, 2, 3, 2, 2, 3, 7*1, 3, 2, 3, 00528 $ 2, 1 / 00529 DATA KTRIAN / 16*0, 10*1 / 00530 DATA IASIGN / 6*0, 2, 0, 2*2, 2*0, 3*2, 0, 2, 3*0, 00531 $ 5*2, 0 / 00532 DATA IBSIGN / 7*0, 2, 2*0, 2*2, 2*0, 2, 0, 2, 9*0 / 00533 * .. 00534 * .. Executable Statements .. 00535 * 00536 * Check for errors 00537 * 00538 INFO = 0 00539 * 00540 BADNN = .FALSE. 00541 NMAX = 1 00542 DO 10 J = 1, NSIZES 00543 NMAX = MAX( NMAX, NN( J ) ) 00544 IF( NN( J ).LT.0 ) 00545 $ BADNN = .TRUE. 00546 10 CONTINUE 00547 * 00548 * Maximum blocksize and shift -- we assume that blocksize and number 00549 * of shifts are monotone increasing functions of N. 00550 * 00551 NB = MAX( 1, ILAENV( 1, 'SGEQRF', ' ', NMAX, NMAX, -1, -1 ), 00552 $ ILAENV( 1, 'SORMQR', 'LT', NMAX, NMAX, NMAX, -1 ), 00553 $ ILAENV( 1, 'SORGQR', ' ', NMAX, NMAX, NMAX, -1 ) ) 00554 NBZ = ILAENV( 1, 'SHGEQZ', 'SII', NMAX, 1, NMAX, 0 ) 00555 NS = ILAENV( 4, 'SHGEQZ', 'SII', NMAX, 1, NMAX, 0 ) 00556 I1 = NBZ + NS 00557 LWKOPT = 2*NMAX + MAX( 6*NMAX, NMAX*( NB+1 ), 00558 $ ( 2*I1+NMAX+1 )*( I1+1 ) ) 00559 * 00560 * Check for errors 00561 * 00562 IF( NSIZES.LT.0 ) THEN 00563 INFO = -1 00564 ELSE IF( BADNN ) THEN 00565 INFO = -2 00566 ELSE IF( NTYPES.LT.0 ) THEN 00567 INFO = -3 00568 ELSE IF( THRESH.LT.ZERO ) THEN 00569 INFO = -6 00570 ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN 00571 INFO = -10 00572 ELSE IF( LDQ.LE.1 .OR. LDQ.LT.NMAX ) THEN 00573 INFO = -19 00574 ELSE IF( LWKOPT.GT.LWORK ) THEN 00575 INFO = -30 00576 END IF 00577 * 00578 IF( INFO.NE.0 ) THEN 00579 CALL XERBLA( 'SDRVGG', -INFO ) 00580 RETURN 00581 END IF 00582 * 00583 * Quick return if possible 00584 * 00585 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 ) 00586 $ RETURN 00587 * 00588 SAFMIN = SLAMCH( 'Safe minimum' ) 00589 ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) 00590 SAFMIN = SAFMIN / ULP 00591 SAFMAX = ONE / SAFMIN 00592 CALL SLABAD( SAFMIN, SAFMAX ) 00593 ULPINV = ONE / ULP 00594 * 00595 * The values RMAGN(2:3) depend on N, see below. 00596 * 00597 RMAGN( 0 ) = ZERO 00598 RMAGN( 1 ) = ONE 00599 * 00600 * Loop over sizes, types 00601 * 00602 NTESTT = 0 00603 NERRS = 0 00604 NMATS = 0 00605 * 00606 DO 170 JSIZE = 1, NSIZES 00607 N = NN( JSIZE ) 00608 N1 = MAX( 1, N ) 00609 RMAGN( 2 ) = SAFMAX*ULP / REAL( N1 ) 00610 RMAGN( 3 ) = SAFMIN*ULPINV*N1 00611 * 00612 IF( NSIZES.NE.1 ) THEN 00613 MTYPES = MIN( MAXTYP, NTYPES ) 00614 ELSE 00615 MTYPES = MIN( MAXTYP+1, NTYPES ) 00616 END IF 00617 * 00618 DO 160 JTYPE = 1, MTYPES 00619 IF( .NOT.DOTYPE( JTYPE ) ) 00620 $ GO TO 160 00621 NMATS = NMATS + 1 00622 NTEST = 0 00623 * 00624 * Save ISEED in case of an error. 00625 * 00626 DO 20 J = 1, 4 00627 IOLDSD( J ) = ISEED( J ) 00628 20 CONTINUE 00629 * 00630 * Initialize RESULT 00631 * 00632 DO 30 J = 1, 15 00633 RESULT( J ) = ZERO 00634 30 CONTINUE 00635 * 00636 * Compute A and B 00637 * 00638 * Description of control parameters: 00639 * 00640 * KCLASS: =1 means w/o rotation, =2 means w/ rotation, 00641 * =3 means random. 00642 * KATYPE: the "type" to be passed to SLATM4 for computing A. 00643 * KAZERO: the pattern of zeros on the diagonal for A: 00644 * =1: ( xxx ), =2: (0, xxx ) =3: ( 0, 0, xxx, 0 ), 00645 * =4: ( 0, xxx, 0, 0 ), =5: ( 0, 0, 1, xxx, 0 ), 00646 * =6: ( 0, 1, 0, xxx, 0 ). (xxx means a string of 00647 * non-zero entries.) 00648 * KAMAGN: the magnitude of the matrix: =0: zero, =1: O(1), 00649 * =2: large, =3: small. 00650 * IASIGN: 1 if the diagonal elements of A are to be 00651 * multiplied by a random magnitude 1 number, =2 if 00652 * randomly chosen diagonal blocks are to be rotated 00653 * to form 2x2 blocks. 00654 * KBTYPE, KBZERO, KBMAGN, IBSIGN: the same, but for B. 00655 * KTRIAN: =0: don't fill in the upper triangle, =1: do. 00656 * KZ1, KZ2, KADD: used to implement KAZERO and KBZERO. 00657 * RMAGN: used to implement KAMAGN and KBMAGN. 00658 * 00659 IF( MTYPES.GT.MAXTYP ) 00660 $ GO TO 110 00661 IINFO = 0 00662 IF( KCLASS( JTYPE ).LT.3 ) THEN 00663 * 00664 * Generate A (w/o rotation) 00665 * 00666 IF( ABS( KATYPE( JTYPE ) ).EQ.3 ) THEN 00667 IN = 2*( ( N-1 ) / 2 ) + 1 00668 IF( IN.NE.N ) 00669 $ CALL SLASET( 'Full', N, N, ZERO, ZERO, A, LDA ) 00670 ELSE 00671 IN = N 00672 END IF 00673 CALL SLATM4( KATYPE( JTYPE ), IN, KZ1( KAZERO( JTYPE ) ), 00674 $ KZ2( KAZERO( JTYPE ) ), IASIGN( JTYPE ), 00675 $ RMAGN( KAMAGN( JTYPE ) ), ULP, 00676 $ RMAGN( KTRIAN( JTYPE )*KAMAGN( JTYPE ) ), 2, 00677 $ ISEED, A, LDA ) 00678 IADD = KADD( KAZERO( JTYPE ) ) 00679 IF( IADD.GT.0 .AND. IADD.LE.N ) 00680 $ A( IADD, IADD ) = ONE 00681 * 00682 * Generate B (w/o rotation) 00683 * 00684 IF( ABS( KBTYPE( JTYPE ) ).EQ.3 ) THEN 00685 IN = 2*( ( N-1 ) / 2 ) + 1 00686 IF( IN.NE.N ) 00687 $ CALL SLASET( 'Full', N, N, ZERO, ZERO, B, LDA ) 00688 ELSE 00689 IN = N 00690 END IF 00691 CALL SLATM4( KBTYPE( JTYPE ), IN, KZ1( KBZERO( JTYPE ) ), 00692 $ KZ2( KBZERO( JTYPE ) ), IBSIGN( JTYPE ), 00693 $ RMAGN( KBMAGN( JTYPE ) ), ONE, 00694 $ RMAGN( KTRIAN( JTYPE )*KBMAGN( JTYPE ) ), 2, 00695 $ ISEED, B, LDA ) 00696 IADD = KADD( KBZERO( JTYPE ) ) 00697 IF( IADD.NE.0 .AND. IADD.LE.N ) 00698 $ B( IADD, IADD ) = ONE 00699 * 00700 IF( KCLASS( JTYPE ).EQ.2 .AND. N.GT.0 ) THEN 00701 * 00702 * Include rotations 00703 * 00704 * Generate Q, Z as Householder transformations times 00705 * a diagonal matrix. 00706 * 00707 DO 50 JC = 1, N - 1 00708 DO 40 JR = JC, N 00709 Q( JR, JC ) = SLARND( 3, ISEED ) 00710 Z( JR, JC ) = SLARND( 3, ISEED ) 00711 40 CONTINUE 00712 CALL SLARFG( N+1-JC, Q( JC, JC ), Q( JC+1, JC ), 1, 00713 $ WORK( JC ) ) 00714 WORK( 2*N+JC ) = SIGN( ONE, Q( JC, JC ) ) 00715 Q( JC, JC ) = ONE 00716 CALL SLARFG( N+1-JC, Z( JC, JC ), Z( JC+1, JC ), 1, 00717 $ WORK( N+JC ) ) 00718 WORK( 3*N+JC ) = SIGN( ONE, Z( JC, JC ) ) 00719 Z( JC, JC ) = ONE 00720 50 CONTINUE 00721 Q( N, N ) = ONE 00722 WORK( N ) = ZERO 00723 WORK( 3*N ) = SIGN( ONE, SLARND( 2, ISEED ) ) 00724 Z( N, N ) = ONE 00725 WORK( 2*N ) = ZERO 00726 WORK( 4*N ) = SIGN( ONE, SLARND( 2, ISEED ) ) 00727 * 00728 * Apply the diagonal matrices 00729 * 00730 DO 70 JC = 1, N 00731 DO 60 JR = 1, N 00732 A( JR, JC ) = WORK( 2*N+JR )*WORK( 3*N+JC )* 00733 $ A( JR, JC ) 00734 B( JR, JC ) = WORK( 2*N+JR )*WORK( 3*N+JC )* 00735 $ B( JR, JC ) 00736 60 CONTINUE 00737 70 CONTINUE 00738 CALL SORM2R( 'L', 'N', N, N, N-1, Q, LDQ, WORK, A, 00739 $ LDA, WORK( 2*N+1 ), IINFO ) 00740 IF( IINFO.NE.0 ) 00741 $ GO TO 100 00742 CALL SORM2R( 'R', 'T', N, N, N-1, Z, LDQ, WORK( N+1 ), 00743 $ A, LDA, WORK( 2*N+1 ), IINFO ) 00744 IF( IINFO.NE.0 ) 00745 $ GO TO 100 00746 CALL SORM2R( 'L', 'N', N, N, N-1, Q, LDQ, WORK, B, 00747 $ LDA, WORK( 2*N+1 ), IINFO ) 00748 IF( IINFO.NE.0 ) 00749 $ GO TO 100 00750 CALL SORM2R( 'R', 'T', N, N, N-1, Z, LDQ, WORK( N+1 ), 00751 $ B, LDA, WORK( 2*N+1 ), IINFO ) 00752 IF( IINFO.NE.0 ) 00753 $ GO TO 100 00754 END IF 00755 ELSE 00756 * 00757 * Random matrices 00758 * 00759 DO 90 JC = 1, N 00760 DO 80 JR = 1, N 00761 A( JR, JC ) = RMAGN( KAMAGN( JTYPE ) )* 00762 $ SLARND( 2, ISEED ) 00763 B( JR, JC ) = RMAGN( KBMAGN( JTYPE ) )* 00764 $ SLARND( 2, ISEED ) 00765 80 CONTINUE 00766 90 CONTINUE 00767 END IF 00768 * 00769 100 CONTINUE 00770 * 00771 IF( IINFO.NE.0 ) THEN 00772 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE, 00773 $ IOLDSD 00774 INFO = ABS( IINFO ) 00775 RETURN 00776 END IF 00777 * 00778 110 CONTINUE 00779 * 00780 * Call SGEGS to compute H, T, Q, Z, alpha, and beta. 00781 * 00782 CALL SLACPY( ' ', N, N, A, LDA, S, LDA ) 00783 CALL SLACPY( ' ', N, N, B, LDA, T, LDA ) 00784 NTEST = 1 00785 RESULT( 1 ) = ULPINV 00786 * 00787 CALL SGEGS( 'V', 'V', N, S, LDA, T, LDA, ALPHR1, ALPHI1, 00788 $ BETA1, Q, LDQ, Z, LDQ, WORK, LWORK, IINFO ) 00789 IF( IINFO.NE.0 ) THEN 00790 WRITE( NOUNIT, FMT = 9999 )'SGEGS', IINFO, N, JTYPE, 00791 $ IOLDSD 00792 INFO = ABS( IINFO ) 00793 GO TO 140 00794 END IF 00795 * 00796 NTEST = 4 00797 * 00798 * Do tests 1--4 00799 * 00800 CALL SGET51( 1, N, A, LDA, S, LDA, Q, LDQ, Z, LDQ, WORK, 00801 $ RESULT( 1 ) ) 00802 CALL SGET51( 1, N, B, LDA, T, LDA, Q, LDQ, Z, LDQ, WORK, 00803 $ RESULT( 2 ) ) 00804 CALL SGET51( 3, N, B, LDA, T, LDA, Q, LDQ, Q, LDQ, WORK, 00805 $ RESULT( 3 ) ) 00806 CALL SGET51( 3, N, B, LDA, T, LDA, Z, LDQ, Z, LDQ, WORK, 00807 $ RESULT( 4 ) ) 00808 * 00809 * Do test 5: compare eigenvalues with diagonals. 00810 * Also check Schur form of A. 00811 * 00812 TEMP1 = ZERO 00813 * 00814 DO 120 J = 1, N 00815 ILABAD = .FALSE. 00816 IF( ALPHI1( J ).EQ.ZERO ) THEN 00817 TEMP2 = ( ABS( ALPHR1( J )-S( J, J ) ) / 00818 $ MAX( SAFMIN, ABS( ALPHR1( J ) ), ABS( S( J, 00819 $ J ) ) )+ABS( BETA1( J )-T( J, J ) ) / 00820 $ MAX( SAFMIN, ABS( BETA1( J ) ), ABS( T( J, 00821 $ J ) ) ) ) / ULP 00822 IF( J.LT.N ) THEN 00823 IF( S( J+1, J ).NE.ZERO ) 00824 $ ILABAD = .TRUE. 00825 END IF 00826 IF( J.GT.1 ) THEN 00827 IF( S( J, J-1 ).NE.ZERO ) 00828 $ ILABAD = .TRUE. 00829 END IF 00830 ELSE 00831 IF( ALPHI1( J ).GT.ZERO ) THEN 00832 I1 = J 00833 ELSE 00834 I1 = J - 1 00835 END IF 00836 IF( I1.LE.0 .OR. I1.GE.N ) THEN 00837 ILABAD = .TRUE. 00838 ELSE IF( I1.LT.N-1 ) THEN 00839 IF( S( I1+2, I1+1 ).NE.ZERO ) 00840 $ ILABAD = .TRUE. 00841 ELSE IF( I1.GT.1 ) THEN 00842 IF( S( I1, I1-1 ).NE.ZERO ) 00843 $ ILABAD = .TRUE. 00844 END IF 00845 IF( .NOT.ILABAD ) THEN 00846 CALL SGET53( S( I1, I1 ), LDA, T( I1, I1 ), LDA, 00847 $ BETA1( J ), ALPHR1( J ), ALPHI1( J ), 00848 $ TEMP2, IINFO ) 00849 IF( IINFO.GE.3 ) THEN 00850 WRITE( NOUNIT, FMT = 9997 )IINFO, J, N, JTYPE, 00851 $ IOLDSD 00852 INFO = ABS( IINFO ) 00853 END IF 00854 ELSE 00855 TEMP2 = ULPINV 00856 END IF 00857 END IF 00858 TEMP1 = MAX( TEMP1, TEMP2 ) 00859 IF( ILABAD ) THEN 00860 WRITE( NOUNIT, FMT = 9996 )J, N, JTYPE, IOLDSD 00861 END IF 00862 120 CONTINUE 00863 RESULT( 5 ) = TEMP1 00864 * 00865 * Call SGEGV to compute S2, T2, VL, and VR, do tests. 00866 * 00867 * Eigenvalues and Eigenvectors 00868 * 00869 CALL SLACPY( ' ', N, N, A, LDA, S2, LDA ) 00870 CALL SLACPY( ' ', N, N, B, LDA, T2, LDA ) 00871 NTEST = 6 00872 RESULT( 6 ) = ULPINV 00873 * 00874 CALL SGEGV( 'V', 'V', N, S2, LDA, T2, LDA, ALPHR2, ALPHI2, 00875 $ BETA2, VL, LDQ, VR, LDQ, WORK, LWORK, IINFO ) 00876 IF( IINFO.NE.0 ) THEN 00877 WRITE( NOUNIT, FMT = 9999 )'SGEGV', IINFO, N, JTYPE, 00878 $ IOLDSD 00879 INFO = ABS( IINFO ) 00880 GO TO 140 00881 END IF 00882 * 00883 NTEST = 7 00884 * 00885 * Do Tests 6 and 7 00886 * 00887 CALL SGET52( .TRUE., N, A, LDA, B, LDA, VL, LDQ, ALPHR2, 00888 $ ALPHI2, BETA2, WORK, DUMMA( 1 ) ) 00889 RESULT( 6 ) = DUMMA( 1 ) 00890 IF( DUMMA( 2 ).GT.THRSHN ) THEN 00891 WRITE( NOUNIT, FMT = 9998 )'Left', 'SGEGV', DUMMA( 2 ), 00892 $ N, JTYPE, IOLDSD 00893 END IF 00894 * 00895 CALL SGET52( .FALSE., N, A, LDA, B, LDA, VR, LDQ, ALPHR2, 00896 $ ALPHI2, BETA2, WORK, DUMMA( 1 ) ) 00897 RESULT( 7 ) = DUMMA( 1 ) 00898 IF( DUMMA( 2 ).GT.THRESH ) THEN 00899 WRITE( NOUNIT, FMT = 9998 )'Right', 'SGEGV', DUMMA( 2 ), 00900 $ N, JTYPE, IOLDSD 00901 END IF 00902 * 00903 * Check form of Complex eigenvalues. 00904 * 00905 DO 130 J = 1, N 00906 ILABAD = .FALSE. 00907 IF( ALPHI2( J ).GT.ZERO ) THEN 00908 IF( J.EQ.N ) THEN 00909 ILABAD = .TRUE. 00910 ELSE IF( ALPHI2( J+1 ).GE.ZERO ) THEN 00911 ILABAD = .TRUE. 00912 END IF 00913 ELSE IF( ALPHI2( J ).LT.ZERO ) THEN 00914 IF( J.EQ.1 ) THEN 00915 ILABAD = .TRUE. 00916 ELSE IF( ALPHI2( J-1 ).LE.ZERO ) THEN 00917 ILABAD = .TRUE. 00918 END IF 00919 END IF 00920 IF( ILABAD ) THEN 00921 WRITE( NOUNIT, FMT = 9996 )J, N, JTYPE, IOLDSD 00922 END IF 00923 130 CONTINUE 00924 * 00925 * End of Loop -- Check for RESULT(j) > THRESH 00926 * 00927 140 CONTINUE 00928 * 00929 NTESTT = NTESTT + NTEST 00930 * 00931 * Print out tests which fail. 00932 * 00933 DO 150 JR = 1, NTEST 00934 IF( RESULT( JR ).GE.THRESH ) THEN 00935 * 00936 * If this is the first test to fail, 00937 * print a header to the data file. 00938 * 00939 IF( NERRS.EQ.0 ) THEN 00940 WRITE( NOUNIT, FMT = 9995 )'SGG' 00941 * 00942 * Matrix types 00943 * 00944 WRITE( NOUNIT, FMT = 9994 ) 00945 WRITE( NOUNIT, FMT = 9993 ) 00946 WRITE( NOUNIT, FMT = 9992 )'Orthogonal' 00947 * 00948 * Tests performed 00949 * 00950 WRITE( NOUNIT, FMT = 9991 )'orthogonal', '''', 00951 $ 'transpose', ( '''', J = 1, 5 ) 00952 * 00953 END IF 00954 NERRS = NERRS + 1 00955 IF( RESULT( JR ).LT.10000.0 ) THEN 00956 WRITE( NOUNIT, FMT = 9990 )N, JTYPE, IOLDSD, JR, 00957 $ RESULT( JR ) 00958 ELSE 00959 WRITE( NOUNIT, FMT = 9989 )N, JTYPE, IOLDSD, JR, 00960 $ RESULT( JR ) 00961 END IF 00962 END IF 00963 150 CONTINUE 00964 * 00965 160 CONTINUE 00966 170 CONTINUE 00967 * 00968 * Summary 00969 * 00970 CALL ALASVM( 'SGG', NOUNIT, NERRS, NTESTT, 0 ) 00971 RETURN 00972 * 00973 9999 FORMAT( ' SDRVGG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', 00974 $ I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' ) 00975 * 00976 9998 FORMAT( ' SDRVGG: ', A, ' Eigenvectors from ', A, ' incorrectly ', 00977 $ 'normalized.', / ' Bits of error=', 0P, G10.3, ',', 9X, 00978 $ 'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, 00979 $ ')' ) 00980 * 00981 9997 FORMAT( ' SDRVGG: SGET53 returned INFO=', I1, ' for eigenvalue ', 00982 $ I6, '.', / 9X, 'N=', I6, ', JTYPE=', I6, ', ISEED=(', 00983 $ 3( I5, ',' ), I5, ')' ) 00984 * 00985 9996 FORMAT( ' SDRVGG: S not in Schur form at eigenvalue ', I6, '.', 00986 $ / 9X, 'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), 00987 $ I5, ')' ) 00988 * 00989 9995 FORMAT( / 1X, A3, ' -- Real Generalized eigenvalue problem driver' 00990 $ ) 00991 * 00992 9994 FORMAT( ' Matrix types (see SDRVGG for details): ' ) 00993 * 00994 9993 FORMAT( ' Special Matrices:', 23X, 00995 $ '(J''=transposed Jordan block)', 00996 $ / ' 1=(0,0) 2=(I,0) 3=(0,I) 4=(I,I) 5=(J'',J'') ', 00997 $ '6=(diag(J'',I), diag(I,J''))', / ' Diagonal Matrices: ( ', 00998 $ 'D=diag(0,1,2,...) )', / ' 7=(D,I) 9=(large*D, small*I', 00999 $ ') 11=(large*I, small*D) 13=(large*D, large*I)', / 01000 $ ' 8=(I,D) 10=(small*D, large*I) 12=(small*I, large*D) ', 01001 $ ' 14=(small*D, small*I)', / ' 15=(D, reversed D)' ) 01002 9992 FORMAT( ' Matrices Rotated by Random ', A, ' Matrices U, V:', 01003 $ / ' 16=Transposed Jordan Blocks 19=geometric ', 01004 $ 'alpha, beta=0,1', / ' 17=arithm. alpha&beta ', 01005 $ ' 20=arithmetic alpha, beta=0,1', / ' 18=clustered ', 01006 $ 'alpha, beta=0,1 21=random alpha, beta=0,1', 01007 $ / ' Large & Small Matrices:', / ' 22=(large, small) ', 01008 $ '23=(small,large) 24=(small,small) 25=(large,large)', 01009 $ / ' 26=random O(1) matrices.' ) 01010 * 01011 9991 FORMAT( / ' Tests performed: (S is Schur, T is triangular, ', 01012 $ 'Q and Z are ', A, ',', / 20X, 01013 $ 'l and r are the appropriate left and right', / 19X, 01014 $ 'eigenvectors, resp., a is alpha, b is beta, and', / 19X, A, 01015 $ ' means ', A, '.)', / ' 1 = | A - Q S Z', A, 01016 $ ' | / ( |A| n ulp ) 2 = | B - Q T Z', A, 01017 $ ' | / ( |B| n ulp )', / ' 3 = | I - QQ', A, 01018 $ ' | / ( n ulp ) 4 = | I - ZZ', A, 01019 $ ' | / ( n ulp )', / 01020 $ ' 5 = difference between (alpha,beta) and diagonals of', 01021 $ ' (S,T)', / ' 6 = max | ( b A - a B )', A, 01022 $ ' l | / const. 7 = max | ( b A - a B ) r | / const.', 01023 $ / 1X ) 01024 9990 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=', 01025 $ 4( I4, ',' ), ' result ', I3, ' is', 0P, F8.2 ) 01026 9989 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=', 01027 $ 4( I4, ',' ), ' result ', I3, ' is', 1P, E10.3 ) 01028 * 01029 * End of SDRVGG 01030 * 01031 END