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