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