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