![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SDRVSG 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 SDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 00012 * NOUNIT, A, LDA, B, LDB, D, Z, LDZ, AB, BB, AP, 00013 * BP, WORK, NWORK, IWORK, LIWORK, RESULT, INFO ) 00014 * 00015 * .. Scalar Arguments .. 00016 * INTEGER INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES, 00017 * $ NTYPES, NWORK 00018 * REAL THRESH 00019 * .. 00020 * .. Array Arguments .. 00021 * LOGICAL DOTYPE( * ) 00022 * INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 00023 * REAL A( LDA, * ), AB( LDA, * ), AP( * ), 00024 * $ B( LDB, * ), BB( LDB, * ), BP( * ), D( * ), 00025 * $ RESULT( * ), WORK( * ), Z( LDZ, * ) 00026 * .. 00027 * 00028 * 00029 *> \par Purpose: 00030 * ============= 00031 *> 00032 *> \verbatim 00033 *> 00034 *> SDRVSG checks the real symmetric generalized eigenproblem 00035 *> drivers. 00036 *> 00037 *> SSYGV computes all eigenvalues and, optionally, 00038 *> eigenvectors of a real symmetric-definite generalized 00039 *> eigenproblem. 00040 *> 00041 *> SSYGVD computes all eigenvalues and, optionally, 00042 *> eigenvectors of a real symmetric-definite generalized 00043 *> eigenproblem using a divide and conquer algorithm. 00044 *> 00045 *> SSYGVX computes selected eigenvalues and, optionally, 00046 *> eigenvectors of a real symmetric-definite generalized 00047 *> eigenproblem. 00048 *> 00049 *> SSPGV computes all eigenvalues and, optionally, 00050 *> eigenvectors of a real symmetric-definite generalized 00051 *> eigenproblem in packed storage. 00052 *> 00053 *> SSPGVD computes all eigenvalues and, optionally, 00054 *> eigenvectors of a real symmetric-definite generalized 00055 *> eigenproblem in packed storage using a divide and 00056 *> conquer algorithm. 00057 *> 00058 *> SSPGVX computes selected eigenvalues and, optionally, 00059 *> eigenvectors of a real symmetric-definite generalized 00060 *> eigenproblem in packed storage. 00061 *> 00062 *> SSBGV computes all eigenvalues and, optionally, 00063 *> eigenvectors of a real symmetric-definite banded 00064 *> generalized eigenproblem. 00065 *> 00066 *> SSBGVD computes all eigenvalues and, optionally, 00067 *> eigenvectors of a real symmetric-definite banded 00068 *> generalized eigenproblem using a divide and conquer 00069 *> algorithm. 00070 *> 00071 *> SSBGVX computes selected eigenvalues and, optionally, 00072 *> eigenvectors of a real symmetric-definite banded 00073 *> generalized eigenproblem. 00074 *> 00075 *> When SDRVSG 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 A of the given type will be 00078 *> generated; a random well-conditioned matrix B is also generated 00079 *> and the pair (A,B) is used to test the drivers. 00080 *> 00081 *> For each pair (A,B), the following tests are performed: 00082 *> 00083 *> (1) SSYGV with ITYPE = 1 and UPLO ='U': 00084 *> 00085 *> | A Z - B Z D | / ( |A| |Z| n ulp ) 00086 *> 00087 *> (2) as (1) but calling SSPGV 00088 *> (3) as (1) but calling SSBGV 00089 *> (4) as (1) but with UPLO = 'L' 00090 *> (5) as (4) but calling SSPGV 00091 *> (6) as (4) but calling SSBGV 00092 *> 00093 *> (7) SSYGV with ITYPE = 2 and UPLO ='U': 00094 *> 00095 *> | A B Z - Z D | / ( |A| |Z| n ulp ) 00096 *> 00097 *> (8) as (7) but calling SSPGV 00098 *> (9) as (7) but with UPLO = 'L' 00099 *> (10) as (9) but calling SSPGV 00100 *> 00101 *> (11) SSYGV with ITYPE = 3 and UPLO ='U': 00102 *> 00103 *> | B A Z - Z D | / ( |A| |Z| n ulp ) 00104 *> 00105 *> (12) as (11) but calling SSPGV 00106 *> (13) as (11) but with UPLO = 'L' 00107 *> (14) as (13) but calling SSPGV 00108 *> 00109 *> SSYGVD, SSPGVD and SSBGVD performed the same 14 tests. 00110 *> 00111 *> SSYGVX, SSPGVX and SSBGVX performed the above 14 tests with 00112 *> the parameter RANGE = 'A', 'N' and 'I', respectively. 00113 *> 00114 *> The "sizes" are specified by an array NN(1:NSIZES); the value 00115 *> of each element NN(j) specifies one size. 00116 *> The "types" are specified by a logical array DOTYPE( 1:NTYPES ); 00117 *> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated. 00118 *> This type is used for the matrix A which has half-bandwidth KA. 00119 *> B is generated as a well-conditioned positive definite matrix 00120 *> with half-bandwidth KB (<= KA). 00121 *> Currently, the list of possible types for A is: 00122 *> 00123 *> (1) The zero matrix. 00124 *> (2) The identity matrix. 00125 *> 00126 *> (3) A diagonal matrix with evenly spaced entries 00127 *> 1, ..., ULP and random signs. 00128 *> (ULP = (first number larger than 1) - 1 ) 00129 *> (4) A diagonal matrix with geometrically spaced entries 00130 *> 1, ..., ULP and random signs. 00131 *> (5) A diagonal matrix with "clustered" entries 00132 *> 1, ULP, ..., ULP and random signs. 00133 *> 00134 *> (6) Same as (4), but multiplied by SQRT( overflow threshold ) 00135 *> (7) Same as (4), but multiplied by SQRT( underflow threshold ) 00136 *> 00137 *> (8) A matrix of the form U* D U, where U is orthogonal and 00138 *> D has evenly spaced entries 1, ..., ULP with random signs 00139 *> on the diagonal. 00140 *> 00141 *> (9) A matrix of the form U* D U, where U is orthogonal and 00142 *> D has geometrically spaced entries 1, ..., ULP with random 00143 *> signs on the diagonal. 00144 *> 00145 *> (10) A matrix of the form U* D U, where U is orthogonal and 00146 *> D has "clustered" entries 1, ULP,..., ULP with random 00147 *> signs on the diagonal. 00148 *> 00149 *> (11) Same as (8), but multiplied by SQRT( overflow threshold ) 00150 *> (12) Same as (8), but multiplied by SQRT( underflow threshold ) 00151 *> 00152 *> (13) symmetric matrix with random entries chosen from (-1,1). 00153 *> (14) Same as (13), but multiplied by SQRT( overflow threshold ) 00154 *> (15) Same as (13), but multiplied by SQRT( underflow threshold) 00155 *> 00156 *> (16) Same as (8), but with KA = 1 and KB = 1 00157 *> (17) Same as (8), but with KA = 2 and KB = 1 00158 *> (18) Same as (8), but with KA = 2 and KB = 2 00159 *> (19) Same as (8), but with KA = 3 and KB = 1 00160 *> (20) Same as (8), but with KA = 3 and KB = 2 00161 *> (21) Same as (8), but with KA = 3 and KB = 3 00162 *> \endverbatim 00163 * 00164 * Arguments: 00165 * ========== 00166 * 00167 *> \verbatim 00168 *> NSIZES INTEGER 00169 *> The number of sizes of matrices to use. If it is zero, 00170 *> SDRVSG does nothing. It must be at least zero. 00171 *> Not modified. 00172 *> 00173 *> NN INTEGER array, dimension (NSIZES) 00174 *> An array containing the sizes to be used for the matrices. 00175 *> Zero values will be skipped. The values must be at least 00176 *> zero. 00177 *> Not modified. 00178 *> 00179 *> NTYPES INTEGER 00180 *> The number of elements in DOTYPE. If it is zero, SDRVSG 00181 *> does nothing. It must be at least zero. If it is MAXTYP+1 00182 *> and NSIZES is 1, then an additional type, MAXTYP+1 is 00183 *> defined, which is to use whatever matrix is in A. This 00184 *> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and 00185 *> DOTYPE(MAXTYP+1) is .TRUE. . 00186 *> Not modified. 00187 *> 00188 *> DOTYPE LOGICAL array, dimension (NTYPES) 00189 *> If DOTYPE(j) is .TRUE., then for each size in NN a 00190 *> matrix of that size and of type j will be generated. 00191 *> If NTYPES is smaller than the maximum number of types 00192 *> defined (PARAMETER MAXTYP), then types NTYPES+1 through 00193 *> MAXTYP will not be generated. If NTYPES is larger 00194 *> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) 00195 *> will be ignored. 00196 *> Not modified. 00197 *> 00198 *> ISEED INTEGER array, dimension (4) 00199 *> On entry ISEED specifies the seed of the random number 00200 *> generator. The array elements should be between 0 and 4095; 00201 *> if not they will be reduced mod 4096. Also, ISEED(4) must 00202 *> be odd. The random number generator uses a linear 00203 *> congruential sequence limited to small integers, and so 00204 *> should produce machine independent random numbers. The 00205 *> values of ISEED are changed on exit, and can be used in the 00206 *> next call to SDRVSG to continue the same random number 00207 *> sequence. 00208 *> Modified. 00209 *> 00210 *> THRESH REAL 00211 *> A test will count as "failed" if the "error", computed as 00212 *> described above, exceeds THRESH. Note that the error 00213 *> is scaled to be O(1), so THRESH should be a reasonably 00214 *> small multiple of 1, e.g., 10 or 100. In particular, 00215 *> it should not depend on the precision (single vs. double) 00216 *> or the size of the matrix. It must be at least zero. 00217 *> Not modified. 00218 *> 00219 *> NOUNIT INTEGER 00220 *> The FORTRAN unit number for printing out error messages 00221 *> (e.g., if a routine returns IINFO not equal to 0.) 00222 *> Not modified. 00223 *> 00224 *> A REAL array, dimension (LDA , max(NN)) 00225 *> Used to hold the matrix whose eigenvalues are to be 00226 *> computed. On exit, A contains the last matrix actually 00227 *> used. 00228 *> Modified. 00229 *> 00230 *> LDA INTEGER 00231 *> The leading dimension of A and AB. It must be at 00232 *> least 1 and at least max( NN ). 00233 *> Not modified. 00234 *> 00235 *> B REAL array, dimension (LDB , max(NN)) 00236 *> Used to hold the symmetric positive definite matrix for 00237 *> the generailzed problem. 00238 *> On exit, B contains the last matrix actually 00239 *> used. 00240 *> Modified. 00241 *> 00242 *> LDB INTEGER 00243 *> The leading dimension of B and BB. It must be at 00244 *> least 1 and at least max( NN ). 00245 *> Not modified. 00246 *> 00247 *> D REAL array, dimension (max(NN)) 00248 *> The eigenvalues of A. On exit, the eigenvalues in D 00249 *> correspond with the matrix in A. 00250 *> Modified. 00251 *> 00252 *> Z REAL array, dimension (LDZ, max(NN)) 00253 *> The matrix of eigenvectors. 00254 *> Modified. 00255 *> 00256 *> LDZ INTEGER 00257 *> The leading dimension of Z. It must be at least 1 and 00258 *> at least max( NN ). 00259 *> Not modified. 00260 *> 00261 *> AB REAL array, dimension (LDA, max(NN)) 00262 *> Workspace. 00263 *> Modified. 00264 *> 00265 *> BB REAL array, dimension (LDB, max(NN)) 00266 *> Workspace. 00267 *> Modified. 00268 *> 00269 *> AP REAL array, dimension (max(NN)**2) 00270 *> Workspace. 00271 *> Modified. 00272 *> 00273 *> BP REAL array, dimension (max(NN)**2) 00274 *> Workspace. 00275 *> Modified. 00276 *> 00277 *> WORK REAL array, dimension (NWORK) 00278 *> Workspace. 00279 *> Modified. 00280 *> 00281 *> NWORK INTEGER 00282 *> The number of entries in WORK. This must be at least 00283 *> 1+5*N+2*N*lg(N)+3*N**2 where N = max( NN(j) ) and 00284 *> lg( N ) = smallest integer k such that 2**k >= N. 00285 *> Not modified. 00286 *> 00287 *> IWORK INTEGER array, dimension (LIWORK) 00288 *> Workspace. 00289 *> Modified. 00290 *> 00291 *> LIWORK INTEGER 00292 *> The number of entries in WORK. This must be at least 6*N. 00293 *> Not modified. 00294 *> 00295 *> RESULT REAL array, dimension (70) 00296 *> The values computed by the 70 tests described above. 00297 *> Modified. 00298 *> 00299 *> INFO INTEGER 00300 *> If 0, then everything ran OK. 00301 *> -1: NSIZES < 0 00302 *> -2: Some NN(j) < 0 00303 *> -3: NTYPES < 0 00304 *> -5: THRESH < 0 00305 *> -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ). 00306 *> -16: LDZ < 1 or LDZ < NMAX. 00307 *> -21: NWORK too small. 00308 *> -23: LIWORK too small. 00309 *> If SLATMR, SLATMS, SSYGV, SSPGV, SSBGV, SSYGVD, SSPGVD, 00310 *> SSBGVD, SSYGVX, SSPGVX or SSBGVX returns an error code, 00311 *> the absolute value of it is returned. 00312 *> Modified. 00313 *> 00314 *> ---------------------------------------------------------------------- 00315 *> 00316 *> Some Local Variables and Parameters: 00317 *> ---- ----- --------- --- ---------- 00318 *> ZERO, ONE Real 0 and 1. 00319 *> MAXTYP The number of types defined. 00320 *> NTEST The number of tests that have been run 00321 *> on this matrix. 00322 *> NTESTT The total number of tests for this call. 00323 *> NMAX Largest value in NN. 00324 *> NMATS The number of matrices generated so far. 00325 *> NERRS The number of tests which have exceeded THRESH 00326 *> so far (computed by SLAFTS). 00327 *> COND, IMODE Values to be passed to the matrix generators. 00328 *> ANORM Norm of A; passed to matrix generators. 00329 *> 00330 *> OVFL, UNFL Overflow and underflow thresholds. 00331 *> ULP, ULPINV Finest relative precision and its inverse. 00332 *> RTOVFL, RTUNFL Square roots of the previous 2 values. 00333 *> The following four arrays decode JTYPE: 00334 *> KTYPE(j) The general type (1-10) for type "j". 00335 *> KMODE(j) The MODE value to be passed to the matrix 00336 *> generator for type "j". 00337 *> KMAGN(j) The order of magnitude ( O(1), 00338 *> O(overflow^(1/2) ), O(underflow^(1/2) ) 00339 *> \endverbatim 00340 * 00341 * Authors: 00342 * ======== 00343 * 00344 *> \author Univ. of Tennessee 00345 *> \author Univ. of California Berkeley 00346 *> \author Univ. of Colorado Denver 00347 *> \author NAG Ltd. 00348 * 00349 *> \date November 2011 00350 * 00351 *> \ingroup single_eig 00352 * 00353 * ===================================================================== 00354 SUBROUTINE SDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 00355 $ NOUNIT, A, LDA, B, LDB, D, Z, LDZ, AB, BB, AP, 00356 $ BP, WORK, NWORK, IWORK, LIWORK, RESULT, INFO ) 00357 * 00358 * -- LAPACK test routine (version 3.4.0) -- 00359 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00360 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00361 * November 2011 00362 * 00363 * .. Scalar Arguments .. 00364 INTEGER INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES, 00365 $ NTYPES, NWORK 00366 REAL THRESH 00367 * .. 00368 * .. Array Arguments .. 00369 LOGICAL DOTYPE( * ) 00370 INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 00371 REAL A( LDA, * ), AB( LDA, * ), AP( * ), 00372 $ B( LDB, * ), BB( LDB, * ), BP( * ), D( * ), 00373 $ RESULT( * ), WORK( * ), Z( LDZ, * ) 00374 * .. 00375 * 00376 * ===================================================================== 00377 * 00378 * .. Parameters .. 00379 REAL ZERO, ONE, TEN 00380 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TEN = 10.0E0 ) 00381 INTEGER MAXTYP 00382 PARAMETER ( MAXTYP = 21 ) 00383 * .. 00384 * .. Local Scalars .. 00385 LOGICAL BADNN 00386 CHARACTER UPLO 00387 INTEGER I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP, 00388 $ ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB, 00389 $ KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST, 00390 $ NTESTT 00391 REAL ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL, 00392 $ RTUNFL, ULP, ULPINV, UNFL, VL, VU 00393 * .. 00394 * .. Local Arrays .. 00395 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ), 00396 $ KMAGN( MAXTYP ), KMODE( MAXTYP ), 00397 $ KTYPE( MAXTYP ) 00398 * .. 00399 * .. External Functions .. 00400 LOGICAL LSAME 00401 REAL SLAMCH, SLARND 00402 EXTERNAL LSAME, SLAMCH, SLARND 00403 * .. 00404 * .. External Subroutines .. 00405 EXTERNAL SLABAD, SLACPY, SLAFTS, SLASET, SLASUM, SLATMR, 00406 $ SLATMS, SSBGV, SSBGVD, SSBGVX, SSGT01, SSPGV, 00407 $ SSPGVD, SSPGVX, SSYGV, SSYGVD, SSYGVX, XERBLA 00408 * .. 00409 * .. Intrinsic Functions .. 00410 INTRINSIC ABS, MAX, MIN, REAL, SQRT 00411 * .. 00412 * .. Data statements .. 00413 DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 6*9 / 00414 DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1, 00415 $ 2, 3, 6*1 / 00416 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, 00417 $ 0, 0, 6*4 / 00418 * .. 00419 * .. Executable Statements .. 00420 * 00421 * 1) Check for errors 00422 * 00423 NTESTT = 0 00424 INFO = 0 00425 * 00426 BADNN = .FALSE. 00427 NMAX = 0 00428 DO 10 J = 1, NSIZES 00429 NMAX = MAX( NMAX, NN( J ) ) 00430 IF( NN( J ).LT.0 ) 00431 $ BADNN = .TRUE. 00432 10 CONTINUE 00433 * 00434 * Check for errors 00435 * 00436 IF( NSIZES.LT.0 ) THEN 00437 INFO = -1 00438 ELSE IF( BADNN ) THEN 00439 INFO = -2 00440 ELSE IF( NTYPES.LT.0 ) THEN 00441 INFO = -3 00442 ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN 00443 INFO = -9 00444 ELSE IF( LDZ.LE.1 .OR. LDZ.LT.NMAX ) THEN 00445 INFO = -16 00446 ELSE IF( 2*MAX( NMAX, 3 )**2.GT.NWORK ) THEN 00447 INFO = -21 00448 ELSE IF( 2*MAX( NMAX, 3 )**2.GT.LIWORK ) THEN 00449 INFO = -23 00450 END IF 00451 * 00452 IF( INFO.NE.0 ) THEN 00453 CALL XERBLA( 'SDRVSG', -INFO ) 00454 RETURN 00455 END IF 00456 * 00457 * Quick return if possible 00458 * 00459 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 ) 00460 $ RETURN 00461 * 00462 * More Important constants 00463 * 00464 UNFL = SLAMCH( 'Safe minimum' ) 00465 OVFL = SLAMCH( 'Overflow' ) 00466 CALL SLABAD( UNFL, OVFL ) 00467 ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) 00468 ULPINV = ONE / ULP 00469 RTUNFL = SQRT( UNFL ) 00470 RTOVFL = SQRT( OVFL ) 00471 * 00472 DO 20 I = 1, 4 00473 ISEED2( I ) = ISEED( I ) 00474 20 CONTINUE 00475 * 00476 * Loop over sizes, types 00477 * 00478 NERRS = 0 00479 NMATS = 0 00480 * 00481 DO 650 JSIZE = 1, NSIZES 00482 N = NN( JSIZE ) 00483 ANINV = ONE / REAL( MAX( 1, N ) ) 00484 * 00485 IF( NSIZES.NE.1 ) THEN 00486 MTYPES = MIN( MAXTYP, NTYPES ) 00487 ELSE 00488 MTYPES = MIN( MAXTYP+1, NTYPES ) 00489 END IF 00490 * 00491 KA9 = 0 00492 KB9 = 0 00493 DO 640 JTYPE = 1, MTYPES 00494 IF( .NOT.DOTYPE( JTYPE ) ) 00495 $ GO TO 640 00496 NMATS = NMATS + 1 00497 NTEST = 0 00498 * 00499 DO 30 J = 1, 4 00500 IOLDSD( J ) = ISEED( J ) 00501 30 CONTINUE 00502 * 00503 * 2) Compute "A" 00504 * 00505 * Control parameters: 00506 * 00507 * KMAGN KMODE KTYPE 00508 * =1 O(1) clustered 1 zero 00509 * =2 large clustered 2 identity 00510 * =3 small exponential (none) 00511 * =4 arithmetic diagonal, w/ eigenvalues 00512 * =5 random log hermitian, w/ eigenvalues 00513 * =6 random (none) 00514 * =7 random diagonal 00515 * =8 random hermitian 00516 * =9 banded, w/ eigenvalues 00517 * 00518 IF( MTYPES.GT.MAXTYP ) 00519 $ GO TO 90 00520 * 00521 ITYPE = KTYPE( JTYPE ) 00522 IMODE = KMODE( JTYPE ) 00523 * 00524 * Compute norm 00525 * 00526 GO TO ( 40, 50, 60 )KMAGN( JTYPE ) 00527 * 00528 40 CONTINUE 00529 ANORM = ONE 00530 GO TO 70 00531 * 00532 50 CONTINUE 00533 ANORM = ( RTOVFL*ULP )*ANINV 00534 GO TO 70 00535 * 00536 60 CONTINUE 00537 ANORM = RTUNFL*N*ULPINV 00538 GO TO 70 00539 * 00540 70 CONTINUE 00541 * 00542 IINFO = 0 00543 COND = ULPINV 00544 * 00545 * Special Matrices -- Identity & Jordan block 00546 * 00547 IF( ITYPE.EQ.1 ) THEN 00548 * 00549 * Zero 00550 * 00551 KA = 0 00552 KB = 0 00553 CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA ) 00554 * 00555 ELSE IF( ITYPE.EQ.2 ) THEN 00556 * 00557 * Identity 00558 * 00559 KA = 0 00560 KB = 0 00561 CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA ) 00562 DO 80 JCOL = 1, N 00563 A( JCOL, JCOL ) = ANORM 00564 80 CONTINUE 00565 * 00566 ELSE IF( ITYPE.EQ.4 ) THEN 00567 * 00568 * Diagonal Matrix, [Eigen]values Specified 00569 * 00570 KA = 0 00571 KB = 0 00572 CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND, 00573 $ ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ), 00574 $ IINFO ) 00575 * 00576 ELSE IF( ITYPE.EQ.5 ) THEN 00577 * 00578 * symmetric, eigenvalues specified 00579 * 00580 KA = MAX( 0, N-1 ) 00581 KB = KA 00582 CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND, 00583 $ ANORM, N, N, 'N', A, LDA, WORK( N+1 ), 00584 $ IINFO ) 00585 * 00586 ELSE IF( ITYPE.EQ.7 ) THEN 00587 * 00588 * Diagonal, random eigenvalues 00589 * 00590 KA = 0 00591 KB = 0 00592 CALL SLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE, 00593 $ 'T', 'N', WORK( N+1 ), 1, ONE, 00594 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0, 00595 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00596 * 00597 ELSE IF( ITYPE.EQ.8 ) THEN 00598 * 00599 * symmetric, random eigenvalues 00600 * 00601 KA = MAX( 0, N-1 ) 00602 KB = KA 00603 CALL SLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, ONE, 00604 $ 'T', 'N', WORK( N+1 ), 1, ONE, 00605 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N, 00606 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00607 * 00608 ELSE IF( ITYPE.EQ.9 ) THEN 00609 * 00610 * symmetric banded, eigenvalues specified 00611 * 00612 * The following values are used for the half-bandwidths: 00613 * 00614 * ka = 1 kb = 1 00615 * ka = 2 kb = 1 00616 * ka = 2 kb = 2 00617 * ka = 3 kb = 1 00618 * ka = 3 kb = 2 00619 * ka = 3 kb = 3 00620 * 00621 KB9 = KB9 + 1 00622 IF( KB9.GT.KA9 ) THEN 00623 KA9 = KA9 + 1 00624 KB9 = 1 00625 END IF 00626 KA = MAX( 0, MIN( N-1, KA9 ) ) 00627 KB = MAX( 0, MIN( N-1, KB9 ) ) 00628 CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND, 00629 $ ANORM, KA, KA, 'N', A, LDA, WORK( N+1 ), 00630 $ IINFO ) 00631 * 00632 ELSE 00633 * 00634 IINFO = 1 00635 END IF 00636 * 00637 IF( IINFO.NE.0 ) THEN 00638 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE, 00639 $ IOLDSD 00640 INFO = ABS( IINFO ) 00641 RETURN 00642 END IF 00643 * 00644 90 CONTINUE 00645 * 00646 ABSTOL = UNFL + UNFL 00647 IF( N.LE.1 ) THEN 00648 IL = 1 00649 IU = N 00650 ELSE 00651 IL = 1 + ( N-1 )*SLARND( 1, ISEED2 ) 00652 IU = 1 + ( N-1 )*SLARND( 1, ISEED2 ) 00653 IF( IL.GT.IU ) THEN 00654 ITEMP = IL 00655 IL = IU 00656 IU = ITEMP 00657 END IF 00658 END IF 00659 * 00660 * 3) Call SSYGV, SSPGV, SSBGV, SSYGVD, SSPGVD, SSBGVD, 00661 * SSYGVX, SSPGVX, and SSBGVX, do tests. 00662 * 00663 * loop over the three generalized problems 00664 * IBTYPE = 1: A*x = (lambda)*B*x 00665 * IBTYPE = 2: A*B*x = (lambda)*x 00666 * IBTYPE = 3: B*A*x = (lambda)*x 00667 * 00668 DO 630 IBTYPE = 1, 3 00669 * 00670 * loop over the setting UPLO 00671 * 00672 DO 620 IBUPLO = 1, 2 00673 IF( IBUPLO.EQ.1 ) 00674 $ UPLO = 'U' 00675 IF( IBUPLO.EQ.2 ) 00676 $ UPLO = 'L' 00677 * 00678 * Generate random well-conditioned positive definite 00679 * matrix B, of bandwidth not greater than that of A. 00680 * 00681 CALL SLATMS( N, N, 'U', ISEED, 'P', WORK, 5, TEN, ONE, 00682 $ KB, KB, UPLO, B, LDB, WORK( N+1 ), 00683 $ IINFO ) 00684 * 00685 * Test SSYGV 00686 * 00687 NTEST = NTEST + 1 00688 * 00689 CALL SLACPY( ' ', N, N, A, LDA, Z, LDZ ) 00690 CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB ) 00691 * 00692 CALL SSYGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D, 00693 $ WORK, NWORK, IINFO ) 00694 IF( IINFO.NE.0 ) THEN 00695 WRITE( NOUNIT, FMT = 9999 )'SSYGV(V,' // UPLO // 00696 $ ')', IINFO, N, JTYPE, IOLDSD 00697 INFO = ABS( IINFO ) 00698 IF( IINFO.LT.0 ) THEN 00699 RETURN 00700 ELSE 00701 RESULT( NTEST ) = ULPINV 00702 GO TO 100 00703 END IF 00704 END IF 00705 * 00706 * Do Test 00707 * 00708 CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 00709 $ LDZ, D, WORK, RESULT( NTEST ) ) 00710 * 00711 * Test SSYGVD 00712 * 00713 NTEST = NTEST + 1 00714 * 00715 CALL SLACPY( ' ', N, N, A, LDA, Z, LDZ ) 00716 CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB ) 00717 * 00718 CALL SSYGVD( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D, 00719 $ WORK, NWORK, IWORK, LIWORK, IINFO ) 00720 IF( IINFO.NE.0 ) THEN 00721 WRITE( NOUNIT, FMT = 9999 )'SSYGVD(V,' // UPLO // 00722 $ ')', IINFO, N, JTYPE, IOLDSD 00723 INFO = ABS( IINFO ) 00724 IF( IINFO.LT.0 ) THEN 00725 RETURN 00726 ELSE 00727 RESULT( NTEST ) = ULPINV 00728 GO TO 100 00729 END IF 00730 END IF 00731 * 00732 * Do Test 00733 * 00734 CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 00735 $ LDZ, D, WORK, RESULT( NTEST ) ) 00736 * 00737 * Test SSYGVX 00738 * 00739 NTEST = NTEST + 1 00740 * 00741 CALL SLACPY( ' ', N, N, A, LDA, AB, LDA ) 00742 CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB ) 00743 * 00744 CALL SSYGVX( IBTYPE, 'V', 'A', UPLO, N, AB, LDA, BB, 00745 $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z, 00746 $ LDZ, WORK, NWORK, IWORK( N+1 ), IWORK, 00747 $ IINFO ) 00748 IF( IINFO.NE.0 ) THEN 00749 WRITE( NOUNIT, FMT = 9999 )'SSYGVX(V,A' // UPLO // 00750 $ ')', IINFO, N, JTYPE, IOLDSD 00751 INFO = ABS( IINFO ) 00752 IF( IINFO.LT.0 ) THEN 00753 RETURN 00754 ELSE 00755 RESULT( NTEST ) = ULPINV 00756 GO TO 100 00757 END IF 00758 END IF 00759 * 00760 * Do Test 00761 * 00762 CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 00763 $ LDZ, D, WORK, RESULT( NTEST ) ) 00764 * 00765 NTEST = NTEST + 1 00766 * 00767 CALL SLACPY( ' ', N, N, A, LDA, AB, LDA ) 00768 CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB ) 00769 * 00770 * since we do not know the exact eigenvalues of this 00771 * eigenpair, we just set VL and VU as constants. 00772 * It is quite possible that there are no eigenvalues 00773 * in this interval. 00774 * 00775 VL = ZERO 00776 VU = ANORM 00777 CALL SSYGVX( IBTYPE, 'V', 'V', UPLO, N, AB, LDA, BB, 00778 $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z, 00779 $ LDZ, WORK, NWORK, IWORK( N+1 ), IWORK, 00780 $ IINFO ) 00781 IF( IINFO.NE.0 ) THEN 00782 WRITE( NOUNIT, FMT = 9999 )'SSYGVX(V,V,' // 00783 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 00784 INFO = ABS( IINFO ) 00785 IF( IINFO.LT.0 ) THEN 00786 RETURN 00787 ELSE 00788 RESULT( NTEST ) = ULPINV 00789 GO TO 100 00790 END IF 00791 END IF 00792 * 00793 * Do Test 00794 * 00795 CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 00796 $ LDZ, D, WORK, RESULT( NTEST ) ) 00797 * 00798 NTEST = NTEST + 1 00799 * 00800 CALL SLACPY( ' ', N, N, A, LDA, AB, LDA ) 00801 CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB ) 00802 * 00803 CALL SSYGVX( IBTYPE, 'V', 'I', UPLO, N, AB, LDA, BB, 00804 $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z, 00805 $ LDZ, WORK, NWORK, IWORK( N+1 ), IWORK, 00806 $ IINFO ) 00807 IF( IINFO.NE.0 ) THEN 00808 WRITE( NOUNIT, FMT = 9999 )'SSYGVX(V,I,' // 00809 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 00810 INFO = ABS( IINFO ) 00811 IF( IINFO.LT.0 ) THEN 00812 RETURN 00813 ELSE 00814 RESULT( NTEST ) = ULPINV 00815 GO TO 100 00816 END IF 00817 END IF 00818 * 00819 * Do Test 00820 * 00821 CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 00822 $ LDZ, D, WORK, RESULT( NTEST ) ) 00823 * 00824 100 CONTINUE 00825 * 00826 * Test SSPGV 00827 * 00828 NTEST = NTEST + 1 00829 * 00830 * Copy the matrices into packed storage. 00831 * 00832 IF( LSAME( UPLO, 'U' ) ) THEN 00833 IJ = 1 00834 DO 120 J = 1, N 00835 DO 110 I = 1, J 00836 AP( IJ ) = A( I, J ) 00837 BP( IJ ) = B( I, J ) 00838 IJ = IJ + 1 00839 110 CONTINUE 00840 120 CONTINUE 00841 ELSE 00842 IJ = 1 00843 DO 140 J = 1, N 00844 DO 130 I = J, N 00845 AP( IJ ) = A( I, J ) 00846 BP( IJ ) = B( I, J ) 00847 IJ = IJ + 1 00848 130 CONTINUE 00849 140 CONTINUE 00850 END IF 00851 * 00852 CALL SSPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ, 00853 $ WORK, IINFO ) 00854 IF( IINFO.NE.0 ) THEN 00855 WRITE( NOUNIT, FMT = 9999 )'SSPGV(V,' // UPLO // 00856 $ ')', IINFO, N, JTYPE, IOLDSD 00857 INFO = ABS( IINFO ) 00858 IF( IINFO.LT.0 ) THEN 00859 RETURN 00860 ELSE 00861 RESULT( NTEST ) = ULPINV 00862 GO TO 310 00863 END IF 00864 END IF 00865 * 00866 * Do Test 00867 * 00868 CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 00869 $ LDZ, D, WORK, RESULT( NTEST ) ) 00870 * 00871 * Test SSPGVD 00872 * 00873 NTEST = NTEST + 1 00874 * 00875 * Copy the matrices into packed storage. 00876 * 00877 IF( LSAME( UPLO, 'U' ) ) THEN 00878 IJ = 1 00879 DO 160 J = 1, N 00880 DO 150 I = 1, J 00881 AP( IJ ) = A( I, J ) 00882 BP( IJ ) = B( I, J ) 00883 IJ = IJ + 1 00884 150 CONTINUE 00885 160 CONTINUE 00886 ELSE 00887 IJ = 1 00888 DO 180 J = 1, N 00889 DO 170 I = J, N 00890 AP( IJ ) = A( I, J ) 00891 BP( IJ ) = B( I, J ) 00892 IJ = IJ + 1 00893 170 CONTINUE 00894 180 CONTINUE 00895 END IF 00896 * 00897 CALL SSPGVD( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ, 00898 $ WORK, NWORK, IWORK, LIWORK, IINFO ) 00899 IF( IINFO.NE.0 ) THEN 00900 WRITE( NOUNIT, FMT = 9999 )'SSPGVD(V,' // UPLO // 00901 $ ')', IINFO, N, JTYPE, IOLDSD 00902 INFO = ABS( IINFO ) 00903 IF( IINFO.LT.0 ) THEN 00904 RETURN 00905 ELSE 00906 RESULT( NTEST ) = ULPINV 00907 GO TO 310 00908 END IF 00909 END IF 00910 * 00911 * Do Test 00912 * 00913 CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 00914 $ LDZ, D, WORK, RESULT( NTEST ) ) 00915 * 00916 * Test SSPGVX 00917 * 00918 NTEST = NTEST + 1 00919 * 00920 * Copy the matrices into packed storage. 00921 * 00922 IF( LSAME( UPLO, 'U' ) ) THEN 00923 IJ = 1 00924 DO 200 J = 1, N 00925 DO 190 I = 1, J 00926 AP( IJ ) = A( I, J ) 00927 BP( IJ ) = B( I, J ) 00928 IJ = IJ + 1 00929 190 CONTINUE 00930 200 CONTINUE 00931 ELSE 00932 IJ = 1 00933 DO 220 J = 1, N 00934 DO 210 I = J, N 00935 AP( IJ ) = A( I, J ) 00936 BP( IJ ) = B( I, J ) 00937 IJ = IJ + 1 00938 210 CONTINUE 00939 220 CONTINUE 00940 END IF 00941 * 00942 CALL SSPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL, 00943 $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK, 00944 $ IWORK( N+1 ), IWORK, INFO ) 00945 IF( IINFO.NE.0 ) THEN 00946 WRITE( NOUNIT, FMT = 9999 )'SSPGVX(V,A' // UPLO // 00947 $ ')', IINFO, N, JTYPE, IOLDSD 00948 INFO = ABS( IINFO ) 00949 IF( IINFO.LT.0 ) THEN 00950 RETURN 00951 ELSE 00952 RESULT( NTEST ) = ULPINV 00953 GO TO 310 00954 END IF 00955 END IF 00956 * 00957 * Do Test 00958 * 00959 CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 00960 $ LDZ, D, WORK, RESULT( NTEST ) ) 00961 * 00962 NTEST = NTEST + 1 00963 * 00964 * Copy the matrices into packed storage. 00965 * 00966 IF( LSAME( UPLO, 'U' ) ) THEN 00967 IJ = 1 00968 DO 240 J = 1, N 00969 DO 230 I = 1, J 00970 AP( IJ ) = A( I, J ) 00971 BP( IJ ) = B( I, J ) 00972 IJ = IJ + 1 00973 230 CONTINUE 00974 240 CONTINUE 00975 ELSE 00976 IJ = 1 00977 DO 260 J = 1, N 00978 DO 250 I = J, N 00979 AP( IJ ) = A( I, J ) 00980 BP( IJ ) = B( I, J ) 00981 IJ = IJ + 1 00982 250 CONTINUE 00983 260 CONTINUE 00984 END IF 00985 * 00986 VL = ZERO 00987 VU = ANORM 00988 CALL SSPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL, 00989 $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK, 00990 $ IWORK( N+1 ), IWORK, INFO ) 00991 IF( IINFO.NE.0 ) THEN 00992 WRITE( NOUNIT, FMT = 9999 )'SSPGVX(V,V' // UPLO // 00993 $ ')', IINFO, N, JTYPE, IOLDSD 00994 INFO = ABS( IINFO ) 00995 IF( IINFO.LT.0 ) THEN 00996 RETURN 00997 ELSE 00998 RESULT( NTEST ) = ULPINV 00999 GO TO 310 01000 END IF 01001 END IF 01002 * 01003 * Do Test 01004 * 01005 CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 01006 $ LDZ, D, WORK, RESULT( NTEST ) ) 01007 * 01008 NTEST = NTEST + 1 01009 * 01010 * Copy the matrices into packed storage. 01011 * 01012 IF( LSAME( UPLO, 'U' ) ) THEN 01013 IJ = 1 01014 DO 280 J = 1, N 01015 DO 270 I = 1, J 01016 AP( IJ ) = A( I, J ) 01017 BP( IJ ) = B( I, J ) 01018 IJ = IJ + 1 01019 270 CONTINUE 01020 280 CONTINUE 01021 ELSE 01022 IJ = 1 01023 DO 300 J = 1, N 01024 DO 290 I = J, N 01025 AP( IJ ) = A( I, J ) 01026 BP( IJ ) = B( I, J ) 01027 IJ = IJ + 1 01028 290 CONTINUE 01029 300 CONTINUE 01030 END IF 01031 * 01032 CALL SSPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL, 01033 $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK, 01034 $ IWORK( N+1 ), IWORK, INFO ) 01035 IF( IINFO.NE.0 ) THEN 01036 WRITE( NOUNIT, FMT = 9999 )'SSPGVX(V,I' // UPLO // 01037 $ ')', IINFO, N, JTYPE, IOLDSD 01038 INFO = ABS( IINFO ) 01039 IF( IINFO.LT.0 ) THEN 01040 RETURN 01041 ELSE 01042 RESULT( NTEST ) = ULPINV 01043 GO TO 310 01044 END IF 01045 END IF 01046 * 01047 * Do Test 01048 * 01049 CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 01050 $ LDZ, D, WORK, RESULT( NTEST ) ) 01051 * 01052 310 CONTINUE 01053 * 01054 IF( IBTYPE.EQ.1 ) THEN 01055 * 01056 * TEST SSBGV 01057 * 01058 NTEST = NTEST + 1 01059 * 01060 * Copy the matrices into band storage. 01061 * 01062 IF( LSAME( UPLO, 'U' ) ) THEN 01063 DO 340 J = 1, N 01064 DO 320 I = MAX( 1, J-KA ), J 01065 AB( KA+1+I-J, J ) = A( I, J ) 01066 320 CONTINUE 01067 DO 330 I = MAX( 1, J-KB ), J 01068 BB( KB+1+I-J, J ) = B( I, J ) 01069 330 CONTINUE 01070 340 CONTINUE 01071 ELSE 01072 DO 370 J = 1, N 01073 DO 350 I = J, MIN( N, J+KA ) 01074 AB( 1+I-J, J ) = A( I, J ) 01075 350 CONTINUE 01076 DO 360 I = J, MIN( N, J+KB ) 01077 BB( 1+I-J, J ) = B( I, J ) 01078 360 CONTINUE 01079 370 CONTINUE 01080 END IF 01081 * 01082 CALL SSBGV( 'V', UPLO, N, KA, KB, AB, LDA, BB, LDB, 01083 $ D, Z, LDZ, WORK, IINFO ) 01084 IF( IINFO.NE.0 ) THEN 01085 WRITE( NOUNIT, FMT = 9999 )'SSBGV(V,' // 01086 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 01087 INFO = ABS( IINFO ) 01088 IF( IINFO.LT.0 ) THEN 01089 RETURN 01090 ELSE 01091 RESULT( NTEST ) = ULPINV 01092 GO TO 620 01093 END IF 01094 END IF 01095 * 01096 * Do Test 01097 * 01098 CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 01099 $ LDZ, D, WORK, RESULT( NTEST ) ) 01100 * 01101 * TEST SSBGVD 01102 * 01103 NTEST = NTEST + 1 01104 * 01105 * Copy the matrices into band storage. 01106 * 01107 IF( LSAME( UPLO, 'U' ) ) THEN 01108 DO 400 J = 1, N 01109 DO 380 I = MAX( 1, J-KA ), J 01110 AB( KA+1+I-J, J ) = A( I, J ) 01111 380 CONTINUE 01112 DO 390 I = MAX( 1, J-KB ), J 01113 BB( KB+1+I-J, J ) = B( I, J ) 01114 390 CONTINUE 01115 400 CONTINUE 01116 ELSE 01117 DO 430 J = 1, N 01118 DO 410 I = J, MIN( N, J+KA ) 01119 AB( 1+I-J, J ) = A( I, J ) 01120 410 CONTINUE 01121 DO 420 I = J, MIN( N, J+KB ) 01122 BB( 1+I-J, J ) = B( I, J ) 01123 420 CONTINUE 01124 430 CONTINUE 01125 END IF 01126 * 01127 CALL SSBGVD( 'V', UPLO, N, KA, KB, AB, LDA, BB, 01128 $ LDB, D, Z, LDZ, WORK, NWORK, IWORK, 01129 $ LIWORK, IINFO ) 01130 IF( IINFO.NE.0 ) THEN 01131 WRITE( NOUNIT, FMT = 9999 )'SSBGVD(V,' // 01132 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 01133 INFO = ABS( IINFO ) 01134 IF( IINFO.LT.0 ) THEN 01135 RETURN 01136 ELSE 01137 RESULT( NTEST ) = ULPINV 01138 GO TO 620 01139 END IF 01140 END IF 01141 * 01142 * Do Test 01143 * 01144 CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 01145 $ LDZ, D, WORK, RESULT( NTEST ) ) 01146 * 01147 * Test SSBGVX 01148 * 01149 NTEST = NTEST + 1 01150 * 01151 * Copy the matrices into band storage. 01152 * 01153 IF( LSAME( UPLO, 'U' ) ) THEN 01154 DO 460 J = 1, N 01155 DO 440 I = MAX( 1, J-KA ), J 01156 AB( KA+1+I-J, J ) = A( I, J ) 01157 440 CONTINUE 01158 DO 450 I = MAX( 1, J-KB ), J 01159 BB( KB+1+I-J, J ) = B( I, J ) 01160 450 CONTINUE 01161 460 CONTINUE 01162 ELSE 01163 DO 490 J = 1, N 01164 DO 470 I = J, MIN( N, J+KA ) 01165 AB( 1+I-J, J ) = A( I, J ) 01166 470 CONTINUE 01167 DO 480 I = J, MIN( N, J+KB ) 01168 BB( 1+I-J, J ) = B( I, J ) 01169 480 CONTINUE 01170 490 CONTINUE 01171 END IF 01172 * 01173 CALL SSBGVX( 'V', 'A', UPLO, N, KA, KB, AB, LDA, 01174 $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL, 01175 $ IU, ABSTOL, M, D, Z, LDZ, WORK, 01176 $ IWORK( N+1 ), IWORK, IINFO ) 01177 IF( IINFO.NE.0 ) THEN 01178 WRITE( NOUNIT, FMT = 9999 )'SSBGVX(V,A' // 01179 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 01180 INFO = ABS( IINFO ) 01181 IF( IINFO.LT.0 ) THEN 01182 RETURN 01183 ELSE 01184 RESULT( NTEST ) = ULPINV 01185 GO TO 620 01186 END IF 01187 END IF 01188 * 01189 * Do Test 01190 * 01191 CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 01192 $ LDZ, D, WORK, RESULT( NTEST ) ) 01193 * 01194 * 01195 NTEST = NTEST + 1 01196 * 01197 * Copy the matrices into band storage. 01198 * 01199 IF( LSAME( UPLO, 'U' ) ) THEN 01200 DO 520 J = 1, N 01201 DO 500 I = MAX( 1, J-KA ), J 01202 AB( KA+1+I-J, J ) = A( I, J ) 01203 500 CONTINUE 01204 DO 510 I = MAX( 1, J-KB ), J 01205 BB( KB+1+I-J, J ) = B( I, J ) 01206 510 CONTINUE 01207 520 CONTINUE 01208 ELSE 01209 DO 550 J = 1, N 01210 DO 530 I = J, MIN( N, J+KA ) 01211 AB( 1+I-J, J ) = A( I, J ) 01212 530 CONTINUE 01213 DO 540 I = J, MIN( N, J+KB ) 01214 BB( 1+I-J, J ) = B( I, J ) 01215 540 CONTINUE 01216 550 CONTINUE 01217 END IF 01218 * 01219 VL = ZERO 01220 VU = ANORM 01221 CALL SSBGVX( 'V', 'V', UPLO, N, KA, KB, AB, LDA, 01222 $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL, 01223 $ IU, ABSTOL, M, D, Z, LDZ, WORK, 01224 $ IWORK( N+1 ), IWORK, IINFO ) 01225 IF( IINFO.NE.0 ) THEN 01226 WRITE( NOUNIT, FMT = 9999 )'SSBGVX(V,V' // 01227 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 01228 INFO = ABS( IINFO ) 01229 IF( IINFO.LT.0 ) THEN 01230 RETURN 01231 ELSE 01232 RESULT( NTEST ) = ULPINV 01233 GO TO 620 01234 END IF 01235 END IF 01236 * 01237 * Do Test 01238 * 01239 CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 01240 $ LDZ, D, WORK, RESULT( NTEST ) ) 01241 * 01242 NTEST = NTEST + 1 01243 * 01244 * Copy the matrices into band storage. 01245 * 01246 IF( LSAME( UPLO, 'U' ) ) THEN 01247 DO 580 J = 1, N 01248 DO 560 I = MAX( 1, J-KA ), J 01249 AB( KA+1+I-J, J ) = A( I, J ) 01250 560 CONTINUE 01251 DO 570 I = MAX( 1, J-KB ), J 01252 BB( KB+1+I-J, J ) = B( I, J ) 01253 570 CONTINUE 01254 580 CONTINUE 01255 ELSE 01256 DO 610 J = 1, N 01257 DO 590 I = J, MIN( N, J+KA ) 01258 AB( 1+I-J, J ) = A( I, J ) 01259 590 CONTINUE 01260 DO 600 I = J, MIN( N, J+KB ) 01261 BB( 1+I-J, J ) = B( I, J ) 01262 600 CONTINUE 01263 610 CONTINUE 01264 END IF 01265 * 01266 CALL SSBGVX( 'V', 'I', UPLO, N, KA, KB, AB, LDA, 01267 $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL, 01268 $ IU, ABSTOL, M, D, Z, LDZ, WORK, 01269 $ IWORK( N+1 ), IWORK, IINFO ) 01270 IF( IINFO.NE.0 ) THEN 01271 WRITE( NOUNIT, FMT = 9999 )'SSBGVX(V,I' // 01272 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 01273 INFO = ABS( IINFO ) 01274 IF( IINFO.LT.0 ) THEN 01275 RETURN 01276 ELSE 01277 RESULT( NTEST ) = ULPINV 01278 GO TO 620 01279 END IF 01280 END IF 01281 * 01282 * Do Test 01283 * 01284 CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 01285 $ LDZ, D, WORK, RESULT( NTEST ) ) 01286 * 01287 END IF 01288 * 01289 620 CONTINUE 01290 630 CONTINUE 01291 * 01292 * End of Loop -- Check for RESULT(j) > THRESH 01293 * 01294 NTESTT = NTESTT + NTEST 01295 CALL SLAFTS( 'SSG', N, N, JTYPE, NTEST, RESULT, IOLDSD, 01296 $ THRESH, NOUNIT, NERRS ) 01297 640 CONTINUE 01298 650 CONTINUE 01299 * 01300 * Summary 01301 * 01302 CALL SLASUM( 'SSG', NOUNIT, NERRS, NTESTT ) 01303 * 01304 RETURN 01305 * 01306 * End of SDRVSG 01307 * 01308 9999 FORMAT( ' SDRVSG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', 01309 $ I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' ) 01310 END