![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CDRVST 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 CDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 00012 * NOUNIT, A, LDA, D1, D2, D3, WA1, WA2, WA3, U, 00013 * LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK, 00014 * IWORK, LIWORK, RESULT, INFO ) 00015 * 00016 * .. Scalar Arguments .. 00017 * INTEGER INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT, 00018 * $ NSIZES, NTYPES 00019 * REAL THRESH 00020 * .. 00021 * .. Array Arguments .. 00022 * LOGICAL DOTYPE( * ) 00023 * INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 00024 * REAL D1( * ), D2( * ), D3( * ), RESULT( * ), 00025 * $ RWORK( * ), WA1( * ), WA2( * ), WA3( * ) 00026 * COMPLEX A( LDA, * ), TAU( * ), U( LDU, * ), 00027 * $ V( LDU, * ), WORK( * ), Z( LDU, * ) 00028 * .. 00029 * 00030 * 00031 *> \par Purpose: 00032 * ============= 00033 *> 00034 *> \verbatim 00035 *> 00036 *> CDRVST checks the Hermitian eigenvalue problem drivers. 00037 *> 00038 *> CHEEVD computes all eigenvalues and, optionally, 00039 *> eigenvectors of a complex Hermitian matrix, 00040 *> using a divide-and-conquer algorithm. 00041 *> 00042 *> CHEEVX computes selected eigenvalues and, optionally, 00043 *> eigenvectors of a complex Hermitian matrix. 00044 *> 00045 *> CHEEVR computes selected eigenvalues and, optionally, 00046 *> eigenvectors of a complex Hermitian matrix 00047 *> using the Relatively Robust Representation where it can. 00048 *> 00049 *> CHPEVD computes all eigenvalues and, optionally, 00050 *> eigenvectors of a complex Hermitian matrix in packed 00051 *> storage, using a divide-and-conquer algorithm. 00052 *> 00053 *> CHPEVX computes selected eigenvalues and, optionally, 00054 *> eigenvectors of a complex Hermitian matrix in packed 00055 *> storage. 00056 *> 00057 *> CHBEVD computes all eigenvalues and, optionally, 00058 *> eigenvectors of a complex Hermitian band matrix, 00059 *> using a divide-and-conquer algorithm. 00060 *> 00061 *> CHBEVX computes selected eigenvalues and, optionally, 00062 *> eigenvectors of a complex Hermitian band matrix. 00063 *> 00064 *> CHEEV computes all eigenvalues and, optionally, 00065 *> eigenvectors of a complex Hermitian matrix. 00066 *> 00067 *> CHPEV computes all eigenvalues and, optionally, 00068 *> eigenvectors of a complex Hermitian matrix in packed 00069 *> storage. 00070 *> 00071 *> CHBEV computes all eigenvalues and, optionally, 00072 *> eigenvectors of a complex Hermitian band matrix. 00073 *> 00074 *> When CDRVST is called, a number of matrix "sizes" ("n's") and a 00075 *> number of matrix "types" are specified. For each size ("n") 00076 *> and each type of matrix, one matrix will be generated and used 00077 *> to test the appropriate drivers. For each matrix and each 00078 *> driver routine called, the following tests will be performed: 00079 *> 00080 *> (1) | A - Z D Z' | / ( |A| n ulp ) 00081 *> 00082 *> (2) | I - Z Z' | / ( n ulp ) 00083 *> 00084 *> (3) | D1 - D2 | / ( |D1| ulp ) 00085 *> 00086 *> where Z is the matrix of eigenvectors returned when the 00087 *> eigenvector option is given and D1 and D2 are the eigenvalues 00088 *> returned with and without the eigenvector option. 00089 *> 00090 *> The "sizes" are specified by an array NN(1:NSIZES); the value of 00091 *> each element NN(j) specifies one size. 00092 *> The "types" are specified by a logical array DOTYPE( 1:NTYPES ); 00093 *> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated. 00094 *> Currently, the list of possible types is: 00095 *> 00096 *> (1) The zero matrix. 00097 *> (2) The identity matrix. 00098 *> 00099 *> (3) A diagonal matrix with evenly spaced entries 00100 *> 1, ..., ULP and random signs. 00101 *> (ULP = (first number larger than 1) - 1 ) 00102 *> (4) A diagonal matrix with geometrically spaced entries 00103 *> 1, ..., ULP and random signs. 00104 *> (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP 00105 *> and random signs. 00106 *> 00107 *> (6) Same as (4), but multiplied by SQRT( overflow threshold ) 00108 *> (7) Same as (4), but multiplied by SQRT( underflow threshold ) 00109 *> 00110 *> (8) A matrix of the form U* D U, where U is unitary and 00111 *> D has evenly spaced entries 1, ..., ULP with random signs 00112 *> on the diagonal. 00113 *> 00114 *> (9) A matrix of the form U* D U, where U is unitary and 00115 *> D has geometrically spaced entries 1, ..., ULP with random 00116 *> signs on the diagonal. 00117 *> 00118 *> (10) A matrix of the form U* D U, where U is unitary and 00119 *> D has "clustered" entries 1, ULP,..., ULP with random 00120 *> signs on the diagonal. 00121 *> 00122 *> (11) Same as (8), but multiplied by SQRT( overflow threshold ) 00123 *> (12) Same as (8), but multiplied by SQRT( underflow threshold ) 00124 *> 00125 *> (13) Symmetric matrix with random entries chosen from (-1,1). 00126 *> (14) Same as (13), but multiplied by SQRT( overflow threshold ) 00127 *> (15) Same as (13), but multiplied by SQRT( underflow threshold ) 00128 *> (16) A band matrix with half bandwidth randomly chosen between 00129 *> 0 and N-1, with evenly spaced eigenvalues 1, ..., ULP 00130 *> with random signs. 00131 *> (17) Same as (16), but multiplied by SQRT( overflow threshold ) 00132 *> (18) Same as (16), but multiplied by SQRT( underflow threshold ) 00133 *> \endverbatim 00134 * 00135 * Arguments: 00136 * ========== 00137 * 00138 *> \verbatim 00139 *> NSIZES INTEGER 00140 *> The number of sizes of matrices to use. If it is zero, 00141 *> CDRVST does nothing. It must be at least zero. 00142 *> Not modified. 00143 *> 00144 *> NN INTEGER array, dimension (NSIZES) 00145 *> An array containing the sizes to be used for the matrices. 00146 *> Zero values will be skipped. The values must be at least 00147 *> zero. 00148 *> Not modified. 00149 *> 00150 *> NTYPES INTEGER 00151 *> The number of elements in DOTYPE. If it is zero, CDRVST 00152 *> does nothing. It must be at least zero. If it is MAXTYP+1 00153 *> and NSIZES is 1, then an additional type, MAXTYP+1 is 00154 *> defined, which is to use whatever matrix is in A. This 00155 *> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and 00156 *> DOTYPE(MAXTYP+1) is .TRUE. . 00157 *> Not modified. 00158 *> 00159 *> DOTYPE LOGICAL array, dimension (NTYPES) 00160 *> If DOTYPE(j) is .TRUE., then for each size in NN a 00161 *> matrix of that size and of type j will be generated. 00162 *> If NTYPES is smaller than the maximum number of types 00163 *> defined (PARAMETER MAXTYP), then types NTYPES+1 through 00164 *> MAXTYP will not be generated. If NTYPES is larger 00165 *> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) 00166 *> will be ignored. 00167 *> Not modified. 00168 *> 00169 *> ISEED INTEGER array, dimension (4) 00170 *> On entry ISEED specifies the seed of the random number 00171 *> generator. The array elements should be between 0 and 4095; 00172 *> if not they will be reduced mod 4096. Also, ISEED(4) must 00173 *> be odd. The random number generator uses a linear 00174 *> congruential sequence limited to small integers, and so 00175 *> should produce machine independent random numbers. The 00176 *> values of ISEED are changed on exit, and can be used in the 00177 *> next call to CDRVST to continue the same random number 00178 *> sequence. 00179 *> Modified. 00180 *> 00181 *> THRESH REAL 00182 *> A test will count as "failed" if the "error", computed as 00183 *> described above, exceeds THRESH. Note that the error 00184 *> is scaled to be O(1), so THRESH should be a reasonably 00185 *> small multiple of 1, e.g., 10 or 100. In particular, 00186 *> it should not depend on the precision (single vs. double) 00187 *> or the size of the matrix. It must be at least zero. 00188 *> Not modified. 00189 *> 00190 *> NOUNIT INTEGER 00191 *> The FORTRAN unit number for printing out error messages 00192 *> (e.g., if a routine returns IINFO not equal to 0.) 00193 *> Not modified. 00194 *> 00195 *> A COMPLEX array, dimension (LDA , max(NN)) 00196 *> Used to hold the matrix whose eigenvalues are to be 00197 *> computed. On exit, A contains the last matrix actually 00198 *> used. 00199 *> Modified. 00200 *> 00201 *> LDA INTEGER 00202 *> The leading dimension of A. It must be at 00203 *> least 1 and at least max( NN ). 00204 *> Not modified. 00205 *> 00206 *> D1 REAL array, dimension (max(NN)) 00207 *> The eigenvalues of A, as computed by CSTEQR simlutaneously 00208 *> with Z. On exit, the eigenvalues in D1 correspond with the 00209 *> matrix in A. 00210 *> Modified. 00211 *> 00212 *> D2 REAL array, dimension (max(NN)) 00213 *> The eigenvalues of A, as computed by CSTEQR if Z is not 00214 *> computed. On exit, the eigenvalues in D2 correspond with 00215 *> the matrix in A. 00216 *> Modified. 00217 *> 00218 *> D3 REAL array, dimension (max(NN)) 00219 *> The eigenvalues of A, as computed by SSTERF. On exit, the 00220 *> eigenvalues in D3 correspond with the matrix in A. 00221 *> Modified. 00222 *> 00223 *> WA1 REAL array, dimension 00224 *> 00225 *> WA2 REAL array, dimension 00226 *> 00227 *> WA3 REAL array, dimension 00228 *> 00229 *> U COMPLEX array, dimension (LDU, max(NN)) 00230 *> The unitary matrix computed by CHETRD + CUNGC3. 00231 *> Modified. 00232 *> 00233 *> LDU INTEGER 00234 *> The leading dimension of U, Z, and V. It must be at 00235 *> least 1 and at least max( NN ). 00236 *> Not modified. 00237 *> 00238 *> V COMPLEX array, dimension (LDU, max(NN)) 00239 *> The Housholder vectors computed by CHETRD in reducing A to 00240 *> tridiagonal form. 00241 *> Modified. 00242 *> 00243 *> TAU COMPLEX array, dimension (max(NN)) 00244 *> The Householder factors computed by CHETRD in reducing A 00245 *> to tridiagonal form. 00246 *> Modified. 00247 *> 00248 *> Z COMPLEX array, dimension (LDU, max(NN)) 00249 *> The unitary matrix of eigenvectors computed by CHEEVD, 00250 *> CHEEVX, CHPEVD, CHPEVX, CHBEVD, and CHBEVX. 00251 *> Modified. 00252 *> 00253 *> WORK - COMPLEX array of dimension ( LWORK ) 00254 *> Workspace. 00255 *> Modified. 00256 *> 00257 *> LWORK - INTEGER 00258 *> The number of entries in WORK. This must be at least 00259 *> 2*max( NN(j), 2 )**2. 00260 *> Not modified. 00261 *> 00262 *> RWORK REAL array, dimension (3*max(NN)) 00263 *> Workspace. 00264 *> Modified. 00265 *> 00266 *> LRWORK - INTEGER 00267 *> The number of entries in RWORK. 00268 *> 00269 *> IWORK INTEGER array, dimension (6*max(NN)) 00270 *> Workspace. 00271 *> Modified. 00272 *> 00273 *> LIWORK - INTEGER 00274 *> The number of entries in IWORK. 00275 *> 00276 *> RESULT REAL array, dimension (??) 00277 *> The values computed by the tests described above. 00278 *> The values are currently limited to 1/ulp, to avoid 00279 *> overflow. 00280 *> Modified. 00281 *> 00282 *> INFO INTEGER 00283 *> If 0, then everything ran OK. 00284 *> -1: NSIZES < 0 00285 *> -2: Some NN(j) < 0 00286 *> -3: NTYPES < 0 00287 *> -5: THRESH < 0 00288 *> -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ). 00289 *> -16: LDU < 1 or LDU < NMAX. 00290 *> -21: LWORK too small. 00291 *> If SLATMR, SLATMS, CHETRD, SORGC3, CSTEQR, SSTERF, 00292 *> or SORMC2 returns an error code, the 00293 *> absolute value of it is returned. 00294 *> Modified. 00295 *> 00296 *>----------------------------------------------------------------------- 00297 *> 00298 *> Some Local Variables and Parameters: 00299 *> ---- ----- --------- --- ---------- 00300 *> ZERO, ONE Real 0 and 1. 00301 *> MAXTYP The number of types defined. 00302 *> NTEST The number of tests performed, or which can 00303 *> be performed so far, for the current matrix. 00304 *> NTESTT The total number of tests performed so far. 00305 *> NMAX Largest value in NN. 00306 *> NMATS The number of matrices generated so far. 00307 *> NERRS The number of tests which have exceeded THRESH 00308 *> so far (computed by SLAFTS). 00309 *> COND, IMODE Values to be passed to the matrix generators. 00310 *> ANORM Norm of A; passed to matrix generators. 00311 *> 00312 *> OVFL, UNFL Overflow and underflow thresholds. 00313 *> ULP, ULPINV Finest relative precision and its inverse. 00314 *> RTOVFL, RTUNFL Square roots of the previous 2 values. 00315 *> The following four arrays decode JTYPE: 00316 *> KTYPE(j) The general type (1-10) for type "j". 00317 *> KMODE(j) The MODE value to be passed to the matrix 00318 *> generator for type "j". 00319 *> KMAGN(j) The order of magnitude ( O(1), 00320 *> O(overflow^(1/2) ), O(underflow^(1/2) ) 00321 *> \endverbatim 00322 * 00323 * Authors: 00324 * ======== 00325 * 00326 *> \author Univ. of Tennessee 00327 *> \author Univ. of California Berkeley 00328 *> \author Univ. of Colorado Denver 00329 *> \author NAG Ltd. 00330 * 00331 *> \date November 2011 00332 * 00333 *> \ingroup complex_eig 00334 * 00335 * ===================================================================== 00336 SUBROUTINE CDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 00337 $ NOUNIT, A, LDA, D1, D2, D3, WA1, WA2, WA3, U, 00338 $ LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK, 00339 $ IWORK, LIWORK, RESULT, INFO ) 00340 * 00341 * -- LAPACK test routine (version 3.4.0) -- 00342 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00343 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00344 * November 2011 00345 * 00346 * .. Scalar Arguments .. 00347 INTEGER INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT, 00348 $ NSIZES, NTYPES 00349 REAL THRESH 00350 * .. 00351 * .. Array Arguments .. 00352 LOGICAL DOTYPE( * ) 00353 INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 00354 REAL D1( * ), D2( * ), D3( * ), RESULT( * ), 00355 $ RWORK( * ), WA1( * ), WA2( * ), WA3( * ) 00356 COMPLEX A( LDA, * ), TAU( * ), U( LDU, * ), 00357 $ V( LDU, * ), WORK( * ), Z( LDU, * ) 00358 * .. 00359 * 00360 * ===================================================================== 00361 * 00362 * 00363 * .. Parameters .. 00364 REAL ZERO, ONE, TWO, TEN 00365 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0, 00366 $ TEN = 10.0E+0 ) 00367 REAL HALF 00368 PARAMETER ( HALF = ONE / TWO ) 00369 COMPLEX CZERO, CONE 00370 PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ), 00371 $ CONE = ( 1.0E+0, 0.0E+0 ) ) 00372 INTEGER MAXTYP 00373 PARAMETER ( MAXTYP = 18 ) 00374 * .. 00375 * .. Local Scalars .. 00376 LOGICAL BADNN 00377 CHARACTER UPLO 00378 INTEGER I, IDIAG, IHBW, IINFO, IL, IMODE, INDWRK, INDX, 00379 $ IROW, ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL, 00380 $ JSIZE, JTYPE, KD, LGN, LIWEDC, LRWEDC, LWEDC, 00381 $ M, M2, M3, MTYPES, N, NERRS, NMATS, NMAX, 00382 $ NTEST, NTESTT 00383 REAL ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL, 00384 $ RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL, 00385 $ VL, VU 00386 * .. 00387 * .. Local Arrays .. 00388 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ), 00389 $ ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ), 00390 $ KTYPE( MAXTYP ) 00391 * .. 00392 * .. External Functions .. 00393 REAL SLAMCH, SLARND, SSXT1 00394 EXTERNAL SLAMCH, SLARND, SSXT1 00395 * .. 00396 * .. External Subroutines .. 00397 EXTERNAL ALASVM, CHBEV, CHBEVD, CHBEVX, CHEEV, CHEEVD, 00398 $ CHEEVR, CHEEVX, CHET21, CHET22, CHPEV, CHPEVD, 00399 $ CHPEVX, CLACPY, CLASET, CLATMR, CLATMS, SLABAD, 00400 $ SLAFTS, XERBLA 00401 * .. 00402 * .. Intrinsic Functions .. 00403 INTRINSIC ABS, INT, LOG, MAX, MIN, REAL, SQRT 00404 * .. 00405 * .. Data statements .. 00406 DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 3*9 / 00407 DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1, 00408 $ 2, 3, 1, 2, 3 / 00409 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, 00410 $ 0, 0, 4, 4, 4 / 00411 * .. 00412 * .. Executable Statements .. 00413 * 00414 * 1) Check for errors 00415 * 00416 NTESTT = 0 00417 INFO = 0 00418 * 00419 BADNN = .FALSE. 00420 NMAX = 1 00421 DO 10 J = 1, NSIZES 00422 NMAX = MAX( NMAX, NN( J ) ) 00423 IF( NN( J ).LT.0 ) 00424 $ BADNN = .TRUE. 00425 10 CONTINUE 00426 * 00427 * Check for errors 00428 * 00429 IF( NSIZES.LT.0 ) THEN 00430 INFO = -1 00431 ELSE IF( BADNN ) THEN 00432 INFO = -2 00433 ELSE IF( NTYPES.LT.0 ) THEN 00434 INFO = -3 00435 ELSE IF( LDA.LT.NMAX ) THEN 00436 INFO = -9 00437 ELSE IF( LDU.LT.NMAX ) THEN 00438 INFO = -16 00439 ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN 00440 INFO = -22 00441 END IF 00442 * 00443 IF( INFO.NE.0 ) THEN 00444 CALL XERBLA( 'CDRVST', -INFO ) 00445 RETURN 00446 END IF 00447 * 00448 * Quick return if nothing to do 00449 * 00450 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 ) 00451 $ RETURN 00452 * 00453 * More Important constants 00454 * 00455 UNFL = SLAMCH( 'Safe minimum' ) 00456 OVFL = SLAMCH( 'Overflow' ) 00457 CALL SLABAD( UNFL, OVFL ) 00458 ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) 00459 ULPINV = ONE / ULP 00460 RTUNFL = SQRT( UNFL ) 00461 RTOVFL = SQRT( OVFL ) 00462 * 00463 * Loop over sizes, types 00464 * 00465 DO 20 I = 1, 4 00466 ISEED2( I ) = ISEED( I ) 00467 ISEED3( I ) = ISEED( I ) 00468 20 CONTINUE 00469 * 00470 NERRS = 0 00471 NMATS = 0 00472 * 00473 DO 1220 JSIZE = 1, NSIZES 00474 N = NN( JSIZE ) 00475 IF( N.GT.0 ) THEN 00476 LGN = INT( LOG( REAL( N ) ) / LOG( TWO ) ) 00477 IF( 2**LGN.LT.N ) 00478 $ LGN = LGN + 1 00479 IF( 2**LGN.LT.N ) 00480 $ LGN = LGN + 1 00481 LWEDC = MAX( 2*N+N*N, 2*N*N ) 00482 LRWEDC = 1 + 4*N + 2*N*LGN + 3*N**2 00483 LIWEDC = 3 + 5*N 00484 ELSE 00485 LWEDC = 2 00486 LRWEDC = 8 00487 LIWEDC = 8 00488 END IF 00489 ANINV = ONE / REAL( MAX( 1, N ) ) 00490 * 00491 IF( NSIZES.NE.1 ) THEN 00492 MTYPES = MIN( MAXTYP, NTYPES ) 00493 ELSE 00494 MTYPES = MIN( MAXTYP+1, NTYPES ) 00495 END IF 00496 * 00497 DO 1210 JTYPE = 1, MTYPES 00498 IF( .NOT.DOTYPE( JTYPE ) ) 00499 $ GO TO 1210 00500 NMATS = NMATS + 1 00501 NTEST = 0 00502 * 00503 DO 30 J = 1, 4 00504 IOLDSD( J ) = ISEED( J ) 00505 30 CONTINUE 00506 * 00507 * 2) Compute "A" 00508 * 00509 * Control parameters: 00510 * 00511 * KMAGN KMODE KTYPE 00512 * =1 O(1) clustered 1 zero 00513 * =2 large clustered 2 identity 00514 * =3 small exponential (none) 00515 * =4 arithmetic diagonal, (w/ eigenvalues) 00516 * =5 random log Hermitian, w/ eigenvalues 00517 * =6 random (none) 00518 * =7 random diagonal 00519 * =8 random Hermitian 00520 * =9 band Hermitian, w/ eigenvalues 00521 * 00522 IF( MTYPES.GT.MAXTYP ) 00523 $ GO TO 110 00524 * 00525 ITYPE = KTYPE( JTYPE ) 00526 IMODE = KMODE( JTYPE ) 00527 * 00528 * Compute norm 00529 * 00530 GO TO ( 40, 50, 60 )KMAGN( JTYPE ) 00531 * 00532 40 CONTINUE 00533 ANORM = ONE 00534 GO TO 70 00535 * 00536 50 CONTINUE 00537 ANORM = ( RTOVFL*ULP )*ANINV 00538 GO TO 70 00539 * 00540 60 CONTINUE 00541 ANORM = RTUNFL*N*ULPINV 00542 GO TO 70 00543 * 00544 70 CONTINUE 00545 * 00546 CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA ) 00547 IINFO = 0 00548 COND = ULPINV 00549 * 00550 * Special Matrices -- Identity & Jordan block 00551 * 00552 * Zero 00553 * 00554 IF( ITYPE.EQ.1 ) THEN 00555 IINFO = 0 00556 * 00557 ELSE IF( ITYPE.EQ.2 ) THEN 00558 * 00559 * Identity 00560 * 00561 DO 80 JCOL = 1, N 00562 A( JCOL, JCOL ) = ANORM 00563 80 CONTINUE 00564 * 00565 ELSE IF( ITYPE.EQ.4 ) THEN 00566 * 00567 * Diagonal Matrix, [Eigen]values Specified 00568 * 00569 CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 00570 $ ANORM, 0, 0, 'N', A, LDA, WORK, IINFO ) 00571 * 00572 ELSE IF( ITYPE.EQ.5 ) THEN 00573 * 00574 * Hermitian, eigenvalues specified 00575 * 00576 CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 00577 $ ANORM, N, N, 'N', A, LDA, WORK, IINFO ) 00578 * 00579 ELSE IF( ITYPE.EQ.7 ) THEN 00580 * 00581 * Diagonal, random eigenvalues 00582 * 00583 CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE, 00584 $ 'T', 'N', WORK( N+1 ), 1, ONE, 00585 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0, 00586 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00587 * 00588 ELSE IF( ITYPE.EQ.8 ) THEN 00589 * 00590 * Hermitian, random eigenvalues 00591 * 00592 CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE, 00593 $ 'T', 'N', WORK( N+1 ), 1, ONE, 00594 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N, 00595 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00596 * 00597 ELSE IF( ITYPE.EQ.9 ) THEN 00598 * 00599 * Hermitian banded, eigenvalues specified 00600 * 00601 IHBW = INT( ( N-1 )*SLARND( 1, ISEED3 ) ) 00602 CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 00603 $ ANORM, IHBW, IHBW, 'Z', U, LDU, WORK, 00604 $ IINFO ) 00605 * 00606 * Store as dense matrix for most routines. 00607 * 00608 CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA ) 00609 DO 100 IDIAG = -IHBW, IHBW 00610 IROW = IHBW - IDIAG + 1 00611 J1 = MAX( 1, IDIAG+1 ) 00612 J2 = MIN( N, N+IDIAG ) 00613 DO 90 J = J1, J2 00614 I = J - IDIAG 00615 A( I, J ) = U( IROW, J ) 00616 90 CONTINUE 00617 100 CONTINUE 00618 ELSE 00619 IINFO = 1 00620 END IF 00621 * 00622 IF( IINFO.NE.0 ) THEN 00623 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE, 00624 $ IOLDSD 00625 INFO = ABS( IINFO ) 00626 RETURN 00627 END IF 00628 * 00629 110 CONTINUE 00630 * 00631 ABSTOL = UNFL + UNFL 00632 IF( N.LE.1 ) THEN 00633 IL = 1 00634 IU = N 00635 ELSE 00636 IL = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) ) 00637 IU = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) ) 00638 IF( IL.GT.IU ) THEN 00639 ITEMP = IL 00640 IL = IU 00641 IU = ITEMP 00642 END IF 00643 END IF 00644 * 00645 * Perform tests storing upper or lower triangular 00646 * part of matrix. 00647 * 00648 DO 1200 IUPLO = 0, 1 00649 IF( IUPLO.EQ.0 ) THEN 00650 UPLO = 'L' 00651 ELSE 00652 UPLO = 'U' 00653 END IF 00654 * 00655 * Call CHEEVD and CHEEVX. 00656 * 00657 CALL CLACPY( ' ', N, N, A, LDA, V, LDU ) 00658 * 00659 NTEST = NTEST + 1 00660 CALL CHEEVD( 'V', UPLO, N, A, LDU, D1, WORK, LWEDC, 00661 $ RWORK, LRWEDC, IWORK, LIWEDC, IINFO ) 00662 IF( IINFO.NE.0 ) THEN 00663 WRITE( NOUNIT, FMT = 9999 )'CHEEVD(V,' // UPLO // 00664 $ ')', IINFO, N, JTYPE, IOLDSD 00665 INFO = ABS( IINFO ) 00666 IF( IINFO.LT.0 ) THEN 00667 RETURN 00668 ELSE 00669 RESULT( NTEST ) = ULPINV 00670 RESULT( NTEST+1 ) = ULPINV 00671 RESULT( NTEST+2 ) = ULPINV 00672 GO TO 130 00673 END IF 00674 END IF 00675 * 00676 * Do tests 1 and 2. 00677 * 00678 CALL CHET21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z, 00679 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 00680 * 00681 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 00682 * 00683 NTEST = NTEST + 2 00684 CALL CHEEVD( 'N', UPLO, N, A, LDU, D3, WORK, LWEDC, 00685 $ RWORK, LRWEDC, IWORK, LIWEDC, IINFO ) 00686 IF( IINFO.NE.0 ) THEN 00687 WRITE( NOUNIT, FMT = 9999 )'CHEEVD(N,' // UPLO // 00688 $ ')', IINFO, N, JTYPE, IOLDSD 00689 INFO = ABS( IINFO ) 00690 IF( IINFO.LT.0 ) THEN 00691 RETURN 00692 ELSE 00693 RESULT( NTEST ) = ULPINV 00694 GO TO 130 00695 END IF 00696 END IF 00697 * 00698 * Do test 3. 00699 * 00700 TEMP1 = ZERO 00701 TEMP2 = ZERO 00702 DO 120 J = 1, N 00703 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 00704 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 00705 120 CONTINUE 00706 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 00707 $ ULP*MAX( TEMP1, TEMP2 ) ) 00708 * 00709 130 CONTINUE 00710 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 00711 * 00712 NTEST = NTEST + 1 00713 * 00714 IF( N.GT.0 ) THEN 00715 TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) ) 00716 IF( IL.NE.1 ) THEN 00717 VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ), 00718 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 00719 ELSE IF( N.GT.0 ) THEN 00720 VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ), 00721 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 00722 END IF 00723 IF( IU.NE.N ) THEN 00724 VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ), 00725 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 00726 ELSE IF( N.GT.0 ) THEN 00727 VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ), 00728 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 00729 END IF 00730 ELSE 00731 TEMP3 = ZERO 00732 VL = ZERO 00733 VU = ONE 00734 END IF 00735 * 00736 CALL CHEEVX( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 00737 $ ABSTOL, M, WA1, Z, LDU, WORK, LWORK, RWORK, 00738 $ IWORK, IWORK( 5*N+1 ), IINFO ) 00739 IF( IINFO.NE.0 ) THEN 00740 WRITE( NOUNIT, FMT = 9999 )'CHEEVX(V,A,' // 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 RESULT( NTEST+1 ) = ULPINV 00748 RESULT( NTEST+2 ) = ULPINV 00749 GO TO 150 00750 END IF 00751 END IF 00752 * 00753 * Do tests 4 and 5. 00754 * 00755 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 00756 * 00757 CALL CHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 00758 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 00759 * 00760 NTEST = NTEST + 2 00761 CALL CHEEVX( 'N', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 00762 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK, 00763 $ IWORK, IWORK( 5*N+1 ), IINFO ) 00764 IF( IINFO.NE.0 ) THEN 00765 WRITE( NOUNIT, FMT = 9999 )'CHEEVX(N,A,' // UPLO // 00766 $ ')', IINFO, N, JTYPE, IOLDSD 00767 INFO = ABS( IINFO ) 00768 IF( IINFO.LT.0 ) THEN 00769 RETURN 00770 ELSE 00771 RESULT( NTEST ) = ULPINV 00772 GO TO 150 00773 END IF 00774 END IF 00775 * 00776 * Do test 6. 00777 * 00778 TEMP1 = ZERO 00779 TEMP2 = ZERO 00780 DO 140 J = 1, N 00781 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 00782 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 00783 140 CONTINUE 00784 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 00785 $ ULP*MAX( TEMP1, TEMP2 ) ) 00786 * 00787 150 CONTINUE 00788 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 00789 * 00790 NTEST = NTEST + 1 00791 * 00792 CALL CHEEVX( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 00793 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK, 00794 $ IWORK, IWORK( 5*N+1 ), IINFO ) 00795 IF( IINFO.NE.0 ) THEN 00796 WRITE( NOUNIT, FMT = 9999 )'CHEEVX(V,I,' // UPLO // 00797 $ ')', IINFO, N, JTYPE, IOLDSD 00798 INFO = ABS( IINFO ) 00799 IF( IINFO.LT.0 ) THEN 00800 RETURN 00801 ELSE 00802 RESULT( NTEST ) = ULPINV 00803 GO TO 160 00804 END IF 00805 END IF 00806 * 00807 * Do tests 7 and 8. 00808 * 00809 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 00810 * 00811 CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 00812 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 00813 * 00814 NTEST = NTEST + 2 00815 * 00816 CALL CHEEVX( 'N', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 00817 $ ABSTOL, M3, WA3, Z, LDU, WORK, LWORK, RWORK, 00818 $ IWORK, IWORK( 5*N+1 ), IINFO ) 00819 IF( IINFO.NE.0 ) THEN 00820 WRITE( NOUNIT, FMT = 9999 )'CHEEVX(N,I,' // UPLO // 00821 $ ')', IINFO, N, JTYPE, IOLDSD 00822 INFO = ABS( IINFO ) 00823 IF( IINFO.LT.0 ) THEN 00824 RETURN 00825 ELSE 00826 RESULT( NTEST ) = ULPINV 00827 GO TO 160 00828 END IF 00829 END IF 00830 * 00831 * Do test 9. 00832 * 00833 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 00834 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 00835 IF( N.GT.0 ) THEN 00836 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 00837 ELSE 00838 TEMP3 = ZERO 00839 END IF 00840 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 00841 $ MAX( UNFL, TEMP3*ULP ) 00842 * 00843 160 CONTINUE 00844 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 00845 * 00846 NTEST = NTEST + 1 00847 * 00848 CALL CHEEVX( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 00849 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK, 00850 $ IWORK, IWORK( 5*N+1 ), IINFO ) 00851 IF( IINFO.NE.0 ) THEN 00852 WRITE( NOUNIT, FMT = 9999 )'CHEEVX(V,V,' // UPLO // 00853 $ ')', IINFO, N, JTYPE, IOLDSD 00854 INFO = ABS( IINFO ) 00855 IF( IINFO.LT.0 ) THEN 00856 RETURN 00857 ELSE 00858 RESULT( NTEST ) = ULPINV 00859 GO TO 170 00860 END IF 00861 END IF 00862 * 00863 * Do tests 10 and 11. 00864 * 00865 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 00866 * 00867 CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 00868 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 00869 * 00870 NTEST = NTEST + 2 00871 * 00872 CALL CHEEVX( 'N', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 00873 $ ABSTOL, M3, WA3, Z, LDU, WORK, LWORK, RWORK, 00874 $ IWORK, IWORK( 5*N+1 ), IINFO ) 00875 IF( IINFO.NE.0 ) THEN 00876 WRITE( NOUNIT, FMT = 9999 )'CHEEVX(N,V,' // UPLO // 00877 $ ')', IINFO, N, JTYPE, IOLDSD 00878 INFO = ABS( IINFO ) 00879 IF( IINFO.LT.0 ) THEN 00880 RETURN 00881 ELSE 00882 RESULT( NTEST ) = ULPINV 00883 GO TO 170 00884 END IF 00885 END IF 00886 * 00887 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 00888 RESULT( NTEST ) = ULPINV 00889 GO TO 170 00890 END IF 00891 * 00892 * Do test 12. 00893 * 00894 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 00895 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 00896 IF( N.GT.0 ) THEN 00897 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 00898 ELSE 00899 TEMP3 = ZERO 00900 END IF 00901 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 00902 $ MAX( UNFL, TEMP3*ULP ) 00903 * 00904 170 CONTINUE 00905 * 00906 * Call CHPEVD and CHPEVX. 00907 * 00908 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 00909 * 00910 * Load array WORK with the upper or lower triangular 00911 * part of the matrix in packed form. 00912 * 00913 IF( IUPLO.EQ.1 ) THEN 00914 INDX = 1 00915 DO 190 J = 1, N 00916 DO 180 I = 1, J 00917 WORK( INDX ) = A( I, J ) 00918 INDX = INDX + 1 00919 180 CONTINUE 00920 190 CONTINUE 00921 ELSE 00922 INDX = 1 00923 DO 210 J = 1, N 00924 DO 200 I = J, N 00925 WORK( INDX ) = A( I, J ) 00926 INDX = INDX + 1 00927 200 CONTINUE 00928 210 CONTINUE 00929 END IF 00930 * 00931 NTEST = NTEST + 1 00932 INDWRK = N*( N+1 ) / 2 + 1 00933 CALL CHPEVD( 'V', UPLO, N, WORK, D1, Z, LDU, 00934 $ WORK( INDWRK ), LWEDC, RWORK, LRWEDC, IWORK, 00935 $ LIWEDC, IINFO ) 00936 IF( IINFO.NE.0 ) THEN 00937 WRITE( NOUNIT, FMT = 9999 )'CHPEVD(V,' // UPLO // 00938 $ ')', IINFO, N, JTYPE, IOLDSD 00939 INFO = ABS( IINFO ) 00940 IF( IINFO.LT.0 ) THEN 00941 RETURN 00942 ELSE 00943 RESULT( NTEST ) = ULPINV 00944 RESULT( NTEST+1 ) = ULPINV 00945 RESULT( NTEST+2 ) = ULPINV 00946 GO TO 270 00947 END IF 00948 END IF 00949 * 00950 * Do tests 13 and 14. 00951 * 00952 CALL CHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 00953 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 00954 * 00955 IF( IUPLO.EQ.1 ) THEN 00956 INDX = 1 00957 DO 230 J = 1, N 00958 DO 220 I = 1, J 00959 WORK( INDX ) = A( I, J ) 00960 INDX = INDX + 1 00961 220 CONTINUE 00962 230 CONTINUE 00963 ELSE 00964 INDX = 1 00965 DO 250 J = 1, N 00966 DO 240 I = J, N 00967 WORK( INDX ) = A( I, J ) 00968 INDX = INDX + 1 00969 240 CONTINUE 00970 250 CONTINUE 00971 END IF 00972 * 00973 NTEST = NTEST + 2 00974 INDWRK = N*( N+1 ) / 2 + 1 00975 CALL CHPEVD( 'N', UPLO, N, WORK, D3, Z, LDU, 00976 $ WORK( INDWRK ), LWEDC, RWORK, LRWEDC, IWORK, 00977 $ LIWEDC, IINFO ) 00978 IF( IINFO.NE.0 ) THEN 00979 WRITE( NOUNIT, FMT = 9999 )'CHPEVD(N,' // UPLO // 00980 $ ')', IINFO, N, JTYPE, IOLDSD 00981 INFO = ABS( IINFO ) 00982 IF( IINFO.LT.0 ) THEN 00983 RETURN 00984 ELSE 00985 RESULT( NTEST ) = ULPINV 00986 GO TO 270 00987 END IF 00988 END IF 00989 * 00990 * Do test 15. 00991 * 00992 TEMP1 = ZERO 00993 TEMP2 = ZERO 00994 DO 260 J = 1, N 00995 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 00996 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 00997 260 CONTINUE 00998 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 00999 $ ULP*MAX( TEMP1, TEMP2 ) ) 01000 * 01001 * Load array WORK with the upper or lower triangular part 01002 * of the matrix in packed form. 01003 * 01004 270 CONTINUE 01005 IF( IUPLO.EQ.1 ) THEN 01006 INDX = 1 01007 DO 290 J = 1, N 01008 DO 280 I = 1, J 01009 WORK( INDX ) = A( I, J ) 01010 INDX = INDX + 1 01011 280 CONTINUE 01012 290 CONTINUE 01013 ELSE 01014 INDX = 1 01015 DO 310 J = 1, N 01016 DO 300 I = J, N 01017 WORK( INDX ) = A( I, J ) 01018 INDX = INDX + 1 01019 300 CONTINUE 01020 310 CONTINUE 01021 END IF 01022 * 01023 NTEST = NTEST + 1 01024 * 01025 IF( N.GT.0 ) THEN 01026 TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) ) 01027 IF( IL.NE.1 ) THEN 01028 VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ), 01029 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01030 ELSE IF( N.GT.0 ) THEN 01031 VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ), 01032 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01033 END IF 01034 IF( IU.NE.N ) THEN 01035 VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ), 01036 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01037 ELSE IF( N.GT.0 ) THEN 01038 VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ), 01039 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 01040 END IF 01041 ELSE 01042 TEMP3 = ZERO 01043 VL = ZERO 01044 VU = ONE 01045 END IF 01046 * 01047 CALL CHPEVX( 'V', 'A', UPLO, N, WORK, VL, VU, IL, IU, 01048 $ ABSTOL, M, WA1, Z, LDU, V, RWORK, IWORK, 01049 $ IWORK( 5*N+1 ), IINFO ) 01050 IF( IINFO.NE.0 ) THEN 01051 WRITE( NOUNIT, FMT = 9999 )'CHPEVX(V,A,' // UPLO // 01052 $ ')', IINFO, N, JTYPE, IOLDSD 01053 INFO = ABS( IINFO ) 01054 IF( IINFO.LT.0 ) THEN 01055 RETURN 01056 ELSE 01057 RESULT( NTEST ) = ULPINV 01058 RESULT( NTEST+1 ) = ULPINV 01059 RESULT( NTEST+2 ) = ULPINV 01060 GO TO 370 01061 END IF 01062 END IF 01063 * 01064 * Do tests 16 and 17. 01065 * 01066 CALL CHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 01067 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 01068 * 01069 NTEST = NTEST + 2 01070 * 01071 IF( IUPLO.EQ.1 ) THEN 01072 INDX = 1 01073 DO 330 J = 1, N 01074 DO 320 I = 1, J 01075 WORK( INDX ) = A( I, J ) 01076 INDX = INDX + 1 01077 320 CONTINUE 01078 330 CONTINUE 01079 ELSE 01080 INDX = 1 01081 DO 350 J = 1, N 01082 DO 340 I = J, N 01083 WORK( INDX ) = A( I, J ) 01084 INDX = INDX + 1 01085 340 CONTINUE 01086 350 CONTINUE 01087 END IF 01088 * 01089 CALL CHPEVX( 'N', 'A', UPLO, N, WORK, VL, VU, IL, IU, 01090 $ ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK, 01091 $ IWORK( 5*N+1 ), IINFO ) 01092 IF( IINFO.NE.0 ) THEN 01093 WRITE( NOUNIT, FMT = 9999 )'CHPEVX(N,A,' // UPLO // 01094 $ ')', 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 370 01101 END IF 01102 END IF 01103 * 01104 * Do test 18. 01105 * 01106 TEMP1 = ZERO 01107 TEMP2 = ZERO 01108 DO 360 J = 1, N 01109 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 01110 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 01111 360 CONTINUE 01112 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 01113 $ ULP*MAX( TEMP1, TEMP2 ) ) 01114 * 01115 370 CONTINUE 01116 NTEST = NTEST + 1 01117 IF( IUPLO.EQ.1 ) THEN 01118 INDX = 1 01119 DO 390 J = 1, N 01120 DO 380 I = 1, J 01121 WORK( INDX ) = A( I, J ) 01122 INDX = INDX + 1 01123 380 CONTINUE 01124 390 CONTINUE 01125 ELSE 01126 INDX = 1 01127 DO 410 J = 1, N 01128 DO 400 I = J, N 01129 WORK( INDX ) = A( I, J ) 01130 INDX = INDX + 1 01131 400 CONTINUE 01132 410 CONTINUE 01133 END IF 01134 * 01135 CALL CHPEVX( 'V', 'I', UPLO, N, WORK, VL, VU, IL, IU, 01136 $ ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK, 01137 $ IWORK( 5*N+1 ), IINFO ) 01138 IF( IINFO.NE.0 ) THEN 01139 WRITE( NOUNIT, FMT = 9999 )'CHPEVX(V,I,' // UPLO // 01140 $ ')', IINFO, N, JTYPE, IOLDSD 01141 INFO = ABS( IINFO ) 01142 IF( IINFO.LT.0 ) THEN 01143 RETURN 01144 ELSE 01145 RESULT( NTEST ) = ULPINV 01146 RESULT( NTEST+1 ) = ULPINV 01147 RESULT( NTEST+2 ) = ULPINV 01148 GO TO 460 01149 END IF 01150 END IF 01151 * 01152 * Do tests 19 and 20. 01153 * 01154 CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 01155 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 01156 * 01157 NTEST = NTEST + 2 01158 * 01159 IF( IUPLO.EQ.1 ) THEN 01160 INDX = 1 01161 DO 430 J = 1, N 01162 DO 420 I = 1, J 01163 WORK( INDX ) = A( I, J ) 01164 INDX = INDX + 1 01165 420 CONTINUE 01166 430 CONTINUE 01167 ELSE 01168 INDX = 1 01169 DO 450 J = 1, N 01170 DO 440 I = J, N 01171 WORK( INDX ) = A( I, J ) 01172 INDX = INDX + 1 01173 440 CONTINUE 01174 450 CONTINUE 01175 END IF 01176 * 01177 CALL CHPEVX( 'N', 'I', UPLO, N, WORK, VL, VU, IL, IU, 01178 $ ABSTOL, M3, WA3, Z, LDU, V, RWORK, IWORK, 01179 $ IWORK( 5*N+1 ), IINFO ) 01180 IF( IINFO.NE.0 ) THEN 01181 WRITE( NOUNIT, FMT = 9999 )'CHPEVX(N,I,' // UPLO // 01182 $ ')', IINFO, N, JTYPE, IOLDSD 01183 INFO = ABS( IINFO ) 01184 IF( IINFO.LT.0 ) THEN 01185 RETURN 01186 ELSE 01187 RESULT( NTEST ) = ULPINV 01188 GO TO 460 01189 END IF 01190 END IF 01191 * 01192 * Do test 21. 01193 * 01194 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 01195 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 01196 IF( N.GT.0 ) THEN 01197 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 01198 ELSE 01199 TEMP3 = ZERO 01200 END IF 01201 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 01202 $ MAX( UNFL, TEMP3*ULP ) 01203 * 01204 460 CONTINUE 01205 NTEST = NTEST + 1 01206 IF( IUPLO.EQ.1 ) THEN 01207 INDX = 1 01208 DO 480 J = 1, N 01209 DO 470 I = 1, J 01210 WORK( INDX ) = A( I, J ) 01211 INDX = INDX + 1 01212 470 CONTINUE 01213 480 CONTINUE 01214 ELSE 01215 INDX = 1 01216 DO 500 J = 1, N 01217 DO 490 I = J, N 01218 WORK( INDX ) = A( I, J ) 01219 INDX = INDX + 1 01220 490 CONTINUE 01221 500 CONTINUE 01222 END IF 01223 * 01224 CALL CHPEVX( 'V', 'V', UPLO, N, WORK, VL, VU, IL, IU, 01225 $ ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK, 01226 $ IWORK( 5*N+1 ), IINFO ) 01227 IF( IINFO.NE.0 ) THEN 01228 WRITE( NOUNIT, FMT = 9999 )'CHPEVX(V,V,' // UPLO // 01229 $ ')', IINFO, N, JTYPE, IOLDSD 01230 INFO = ABS( IINFO ) 01231 IF( IINFO.LT.0 ) THEN 01232 RETURN 01233 ELSE 01234 RESULT( NTEST ) = ULPINV 01235 RESULT( NTEST+1 ) = ULPINV 01236 RESULT( NTEST+2 ) = ULPINV 01237 GO TO 550 01238 END IF 01239 END IF 01240 * 01241 * Do tests 22 and 23. 01242 * 01243 CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 01244 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 01245 * 01246 NTEST = NTEST + 2 01247 * 01248 IF( IUPLO.EQ.1 ) THEN 01249 INDX = 1 01250 DO 520 J = 1, N 01251 DO 510 I = 1, J 01252 WORK( INDX ) = A( I, J ) 01253 INDX = INDX + 1 01254 510 CONTINUE 01255 520 CONTINUE 01256 ELSE 01257 INDX = 1 01258 DO 540 J = 1, N 01259 DO 530 I = J, N 01260 WORK( INDX ) = A( I, J ) 01261 INDX = INDX + 1 01262 530 CONTINUE 01263 540 CONTINUE 01264 END IF 01265 * 01266 CALL CHPEVX( 'N', 'V', UPLO, N, WORK, VL, VU, IL, IU, 01267 $ ABSTOL, M3, WA3, Z, LDU, V, RWORK, IWORK, 01268 $ IWORK( 5*N+1 ), IINFO ) 01269 IF( IINFO.NE.0 ) THEN 01270 WRITE( NOUNIT, FMT = 9999 )'CHPEVX(N,V,' // UPLO // 01271 $ ')', IINFO, N, JTYPE, IOLDSD 01272 INFO = ABS( IINFO ) 01273 IF( IINFO.LT.0 ) THEN 01274 RETURN 01275 ELSE 01276 RESULT( NTEST ) = ULPINV 01277 GO TO 550 01278 END IF 01279 END IF 01280 * 01281 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 01282 RESULT( NTEST ) = ULPINV 01283 GO TO 550 01284 END IF 01285 * 01286 * Do test 24. 01287 * 01288 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 01289 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 01290 IF( N.GT.0 ) THEN 01291 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 01292 ELSE 01293 TEMP3 = ZERO 01294 END IF 01295 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 01296 $ MAX( UNFL, TEMP3*ULP ) 01297 * 01298 550 CONTINUE 01299 * 01300 * Call CHBEVD and CHBEVX. 01301 * 01302 IF( JTYPE.LE.7 ) THEN 01303 KD = 0 01304 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN 01305 KD = MAX( N-1, 0 ) 01306 ELSE 01307 KD = IHBW 01308 END IF 01309 * 01310 * Load array V with the upper or lower triangular part 01311 * of the matrix in band form. 01312 * 01313 IF( IUPLO.EQ.1 ) THEN 01314 DO 570 J = 1, N 01315 DO 560 I = MAX( 1, J-KD ), J 01316 V( KD+1+I-J, J ) = A( I, J ) 01317 560 CONTINUE 01318 570 CONTINUE 01319 ELSE 01320 DO 590 J = 1, N 01321 DO 580 I = J, MIN( N, J+KD ) 01322 V( 1+I-J, J ) = A( I, J ) 01323 580 CONTINUE 01324 590 CONTINUE 01325 END IF 01326 * 01327 NTEST = NTEST + 1 01328 CALL CHBEVD( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK, 01329 $ LWEDC, RWORK, LRWEDC, IWORK, LIWEDC, IINFO ) 01330 IF( IINFO.NE.0 ) THEN 01331 WRITE( NOUNIT, FMT = 9998 )'CHBEVD(V,' // UPLO // 01332 $ ')', IINFO, N, KD, JTYPE, IOLDSD 01333 INFO = ABS( IINFO ) 01334 IF( IINFO.LT.0 ) THEN 01335 RETURN 01336 ELSE 01337 RESULT( NTEST ) = ULPINV 01338 RESULT( NTEST+1 ) = ULPINV 01339 RESULT( NTEST+2 ) = ULPINV 01340 GO TO 650 01341 END IF 01342 END IF 01343 * 01344 * Do tests 25 and 26. 01345 * 01346 CALL CHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 01347 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 01348 * 01349 IF( IUPLO.EQ.1 ) THEN 01350 DO 610 J = 1, N 01351 DO 600 I = MAX( 1, J-KD ), J 01352 V( KD+1+I-J, J ) = A( I, J ) 01353 600 CONTINUE 01354 610 CONTINUE 01355 ELSE 01356 DO 630 J = 1, N 01357 DO 620 I = J, MIN( N, J+KD ) 01358 V( 1+I-J, J ) = A( I, J ) 01359 620 CONTINUE 01360 630 CONTINUE 01361 END IF 01362 * 01363 NTEST = NTEST + 2 01364 CALL CHBEVD( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, WORK, 01365 $ LWEDC, RWORK, LRWEDC, IWORK, LIWEDC, IINFO ) 01366 IF( IINFO.NE.0 ) THEN 01367 WRITE( NOUNIT, FMT = 9998 )'CHBEVD(N,' // UPLO // 01368 $ ')', IINFO, N, KD, JTYPE, IOLDSD 01369 INFO = ABS( IINFO ) 01370 IF( IINFO.LT.0 ) THEN 01371 RETURN 01372 ELSE 01373 RESULT( NTEST ) = ULPINV 01374 GO TO 650 01375 END IF 01376 END IF 01377 * 01378 * Do test 27. 01379 * 01380 TEMP1 = ZERO 01381 TEMP2 = ZERO 01382 DO 640 J = 1, N 01383 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 01384 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 01385 640 CONTINUE 01386 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 01387 $ ULP*MAX( TEMP1, TEMP2 ) ) 01388 * 01389 * Load array V with the upper or lower triangular part 01390 * of the matrix in band form. 01391 * 01392 650 CONTINUE 01393 IF( IUPLO.EQ.1 ) THEN 01394 DO 670 J = 1, N 01395 DO 660 I = MAX( 1, J-KD ), J 01396 V( KD+1+I-J, J ) = A( I, J ) 01397 660 CONTINUE 01398 670 CONTINUE 01399 ELSE 01400 DO 690 J = 1, N 01401 DO 680 I = J, MIN( N, J+KD ) 01402 V( 1+I-J, J ) = A( I, J ) 01403 680 CONTINUE 01404 690 CONTINUE 01405 END IF 01406 * 01407 NTEST = NTEST + 1 01408 CALL CHBEVX( 'V', 'A', UPLO, N, KD, V, LDU, U, LDU, VL, 01409 $ VU, IL, IU, ABSTOL, M, WA1, Z, LDU, WORK, 01410 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 01411 IF( IINFO.NE.0 ) THEN 01412 WRITE( NOUNIT, FMT = 9999 )'CHBEVX(V,A,' // UPLO // 01413 $ ')', IINFO, N, KD, JTYPE, IOLDSD 01414 INFO = ABS( IINFO ) 01415 IF( IINFO.LT.0 ) THEN 01416 RETURN 01417 ELSE 01418 RESULT( NTEST ) = ULPINV 01419 RESULT( NTEST+1 ) = ULPINV 01420 RESULT( NTEST+2 ) = ULPINV 01421 GO TO 750 01422 END IF 01423 END IF 01424 * 01425 * Do tests 28 and 29. 01426 * 01427 CALL CHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 01428 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 01429 * 01430 NTEST = NTEST + 2 01431 * 01432 IF( IUPLO.EQ.1 ) THEN 01433 DO 710 J = 1, N 01434 DO 700 I = MAX( 1, J-KD ), J 01435 V( KD+1+I-J, J ) = A( I, J ) 01436 700 CONTINUE 01437 710 CONTINUE 01438 ELSE 01439 DO 730 J = 1, N 01440 DO 720 I = J, MIN( N, J+KD ) 01441 V( 1+I-J, J ) = A( I, J ) 01442 720 CONTINUE 01443 730 CONTINUE 01444 END IF 01445 * 01446 CALL CHBEVX( 'N', 'A', UPLO, N, KD, V, LDU, U, LDU, VL, 01447 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 01448 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 01449 IF( IINFO.NE.0 ) THEN 01450 WRITE( NOUNIT, FMT = 9998 )'CHBEVX(N,A,' // UPLO // 01451 $ ')', IINFO, N, KD, JTYPE, IOLDSD 01452 INFO = ABS( IINFO ) 01453 IF( IINFO.LT.0 ) THEN 01454 RETURN 01455 ELSE 01456 RESULT( NTEST ) = ULPINV 01457 GO TO 750 01458 END IF 01459 END IF 01460 * 01461 * Do test 30. 01462 * 01463 TEMP1 = ZERO 01464 TEMP2 = ZERO 01465 DO 740 J = 1, N 01466 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 01467 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 01468 740 CONTINUE 01469 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 01470 $ ULP*MAX( TEMP1, TEMP2 ) ) 01471 * 01472 * Load array V with the upper or lower triangular part 01473 * of the matrix in band form. 01474 * 01475 750 CONTINUE 01476 NTEST = NTEST + 1 01477 IF( IUPLO.EQ.1 ) THEN 01478 DO 770 J = 1, N 01479 DO 760 I = MAX( 1, J-KD ), J 01480 V( KD+1+I-J, J ) = A( I, J ) 01481 760 CONTINUE 01482 770 CONTINUE 01483 ELSE 01484 DO 790 J = 1, N 01485 DO 780 I = J, MIN( N, J+KD ) 01486 V( 1+I-J, J ) = A( I, J ) 01487 780 CONTINUE 01488 790 CONTINUE 01489 END IF 01490 * 01491 CALL CHBEVX( 'V', 'I', UPLO, N, KD, V, LDU, U, LDU, VL, 01492 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 01493 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 01494 IF( IINFO.NE.0 ) THEN 01495 WRITE( NOUNIT, FMT = 9998 )'CHBEVX(V,I,' // UPLO // 01496 $ ')', IINFO, N, KD, JTYPE, IOLDSD 01497 INFO = ABS( IINFO ) 01498 IF( IINFO.LT.0 ) THEN 01499 RETURN 01500 ELSE 01501 RESULT( NTEST ) = ULPINV 01502 RESULT( NTEST+1 ) = ULPINV 01503 RESULT( NTEST+2 ) = ULPINV 01504 GO TO 840 01505 END IF 01506 END IF 01507 * 01508 * Do tests 31 and 32. 01509 * 01510 CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 01511 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 01512 * 01513 NTEST = NTEST + 2 01514 * 01515 IF( IUPLO.EQ.1 ) THEN 01516 DO 810 J = 1, N 01517 DO 800 I = MAX( 1, J-KD ), J 01518 V( KD+1+I-J, J ) = A( I, J ) 01519 800 CONTINUE 01520 810 CONTINUE 01521 ELSE 01522 DO 830 J = 1, N 01523 DO 820 I = J, MIN( N, J+KD ) 01524 V( 1+I-J, J ) = A( I, J ) 01525 820 CONTINUE 01526 830 CONTINUE 01527 END IF 01528 CALL CHBEVX( 'N', 'I', UPLO, N, KD, V, LDU, U, LDU, VL, 01529 $ VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK, 01530 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 01531 IF( IINFO.NE.0 ) THEN 01532 WRITE( NOUNIT, FMT = 9998 )'CHBEVX(N,I,' // UPLO // 01533 $ ')', IINFO, N, KD, JTYPE, IOLDSD 01534 INFO = ABS( IINFO ) 01535 IF( IINFO.LT.0 ) THEN 01536 RETURN 01537 ELSE 01538 RESULT( NTEST ) = ULPINV 01539 GO TO 840 01540 END IF 01541 END IF 01542 * 01543 * Do test 33. 01544 * 01545 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 01546 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 01547 IF( N.GT.0 ) THEN 01548 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 01549 ELSE 01550 TEMP3 = ZERO 01551 END IF 01552 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 01553 $ MAX( UNFL, TEMP3*ULP ) 01554 * 01555 * Load array V with the upper or lower triangular part 01556 * of the matrix in band form. 01557 * 01558 840 CONTINUE 01559 NTEST = NTEST + 1 01560 IF( IUPLO.EQ.1 ) THEN 01561 DO 860 J = 1, N 01562 DO 850 I = MAX( 1, J-KD ), J 01563 V( KD+1+I-J, J ) = A( I, J ) 01564 850 CONTINUE 01565 860 CONTINUE 01566 ELSE 01567 DO 880 J = 1, N 01568 DO 870 I = J, MIN( N, J+KD ) 01569 V( 1+I-J, J ) = A( I, J ) 01570 870 CONTINUE 01571 880 CONTINUE 01572 END IF 01573 CALL CHBEVX( 'V', 'V', UPLO, N, KD, V, LDU, U, LDU, VL, 01574 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 01575 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 01576 IF( IINFO.NE.0 ) THEN 01577 WRITE( NOUNIT, FMT = 9998 )'CHBEVX(V,V,' // UPLO // 01578 $ ')', IINFO, N, KD, JTYPE, IOLDSD 01579 INFO = ABS( IINFO ) 01580 IF( IINFO.LT.0 ) THEN 01581 RETURN 01582 ELSE 01583 RESULT( NTEST ) = ULPINV 01584 RESULT( NTEST+1 ) = ULPINV 01585 RESULT( NTEST+2 ) = ULPINV 01586 GO TO 930 01587 END IF 01588 END IF 01589 * 01590 * Do tests 34 and 35. 01591 * 01592 CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 01593 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 01594 * 01595 NTEST = NTEST + 2 01596 * 01597 IF( IUPLO.EQ.1 ) THEN 01598 DO 900 J = 1, N 01599 DO 890 I = MAX( 1, J-KD ), J 01600 V( KD+1+I-J, J ) = A( I, J ) 01601 890 CONTINUE 01602 900 CONTINUE 01603 ELSE 01604 DO 920 J = 1, N 01605 DO 910 I = J, MIN( N, J+KD ) 01606 V( 1+I-J, J ) = A( I, J ) 01607 910 CONTINUE 01608 920 CONTINUE 01609 END IF 01610 CALL CHBEVX( 'N', 'V', UPLO, N, KD, V, LDU, U, LDU, VL, 01611 $ VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK, 01612 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 01613 IF( IINFO.NE.0 ) THEN 01614 WRITE( NOUNIT, FMT = 9998 )'CHBEVX(N,V,' // UPLO // 01615 $ ')', IINFO, N, KD, JTYPE, IOLDSD 01616 INFO = ABS( IINFO ) 01617 IF( IINFO.LT.0 ) THEN 01618 RETURN 01619 ELSE 01620 RESULT( NTEST ) = ULPINV 01621 GO TO 930 01622 END IF 01623 END IF 01624 * 01625 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 01626 RESULT( NTEST ) = ULPINV 01627 GO TO 930 01628 END IF 01629 * 01630 * Do test 36. 01631 * 01632 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 01633 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 01634 IF( N.GT.0 ) THEN 01635 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 01636 ELSE 01637 TEMP3 = ZERO 01638 END IF 01639 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 01640 $ MAX( UNFL, TEMP3*ULP ) 01641 * 01642 930 CONTINUE 01643 * 01644 * Call CHEEV 01645 * 01646 CALL CLACPY( ' ', N, N, A, LDA, V, LDU ) 01647 * 01648 NTEST = NTEST + 1 01649 CALL CHEEV( 'V', UPLO, N, A, LDU, D1, WORK, LWORK, RWORK, 01650 $ IINFO ) 01651 IF( IINFO.NE.0 ) THEN 01652 WRITE( NOUNIT, FMT = 9999 )'CHEEV(V,' // UPLO // ')', 01653 $ IINFO, N, JTYPE, IOLDSD 01654 INFO = ABS( IINFO ) 01655 IF( IINFO.LT.0 ) THEN 01656 RETURN 01657 ELSE 01658 RESULT( NTEST ) = ULPINV 01659 RESULT( NTEST+1 ) = ULPINV 01660 RESULT( NTEST+2 ) = ULPINV 01661 GO TO 950 01662 END IF 01663 END IF 01664 * 01665 * Do tests 37 and 38 01666 * 01667 CALL CHET21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z, 01668 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 01669 * 01670 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 01671 * 01672 NTEST = NTEST + 2 01673 CALL CHEEV( 'N', UPLO, N, A, LDU, D3, WORK, LWORK, RWORK, 01674 $ IINFO ) 01675 IF( IINFO.NE.0 ) THEN 01676 WRITE( NOUNIT, FMT = 9999 )'CHEEV(N,' // UPLO // ')', 01677 $ IINFO, N, JTYPE, IOLDSD 01678 INFO = ABS( IINFO ) 01679 IF( IINFO.LT.0 ) THEN 01680 RETURN 01681 ELSE 01682 RESULT( NTEST ) = ULPINV 01683 GO TO 950 01684 END IF 01685 END IF 01686 * 01687 * Do test 39 01688 * 01689 TEMP1 = ZERO 01690 TEMP2 = ZERO 01691 DO 940 J = 1, N 01692 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 01693 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 01694 940 CONTINUE 01695 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 01696 $ ULP*MAX( TEMP1, TEMP2 ) ) 01697 * 01698 950 CONTINUE 01699 * 01700 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 01701 * 01702 * Call CHPEV 01703 * 01704 * Load array WORK with the upper or lower triangular 01705 * part of the matrix in packed form. 01706 * 01707 IF( IUPLO.EQ.1 ) THEN 01708 INDX = 1 01709 DO 970 J = 1, N 01710 DO 960 I = 1, J 01711 WORK( INDX ) = A( I, J ) 01712 INDX = INDX + 1 01713 960 CONTINUE 01714 970 CONTINUE 01715 ELSE 01716 INDX = 1 01717 DO 990 J = 1, N 01718 DO 980 I = J, N 01719 WORK( INDX ) = A( I, J ) 01720 INDX = INDX + 1 01721 980 CONTINUE 01722 990 CONTINUE 01723 END IF 01724 * 01725 NTEST = NTEST + 1 01726 INDWRK = N*( N+1 ) / 2 + 1 01727 CALL CHPEV( 'V', UPLO, N, WORK, D1, Z, LDU, 01728 $ WORK( INDWRK ), RWORK, IINFO ) 01729 IF( IINFO.NE.0 ) THEN 01730 WRITE( NOUNIT, FMT = 9999 )'CHPEV(V,' // UPLO // ')', 01731 $ IINFO, N, JTYPE, IOLDSD 01732 INFO = ABS( IINFO ) 01733 IF( IINFO.LT.0 ) THEN 01734 RETURN 01735 ELSE 01736 RESULT( NTEST ) = ULPINV 01737 RESULT( NTEST+1 ) = ULPINV 01738 RESULT( NTEST+2 ) = ULPINV 01739 GO TO 1050 01740 END IF 01741 END IF 01742 * 01743 * Do tests 40 and 41. 01744 * 01745 CALL CHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 01746 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 01747 * 01748 IF( IUPLO.EQ.1 ) THEN 01749 INDX = 1 01750 DO 1010 J = 1, N 01751 DO 1000 I = 1, J 01752 WORK( INDX ) = A( I, J ) 01753 INDX = INDX + 1 01754 1000 CONTINUE 01755 1010 CONTINUE 01756 ELSE 01757 INDX = 1 01758 DO 1030 J = 1, N 01759 DO 1020 I = J, N 01760 WORK( INDX ) = A( I, J ) 01761 INDX = INDX + 1 01762 1020 CONTINUE 01763 1030 CONTINUE 01764 END IF 01765 * 01766 NTEST = NTEST + 2 01767 INDWRK = N*( N+1 ) / 2 + 1 01768 CALL CHPEV( 'N', UPLO, N, WORK, D3, Z, LDU, 01769 $ WORK( INDWRK ), RWORK, IINFO ) 01770 IF( IINFO.NE.0 ) THEN 01771 WRITE( NOUNIT, FMT = 9999 )'CHPEV(N,' // UPLO // ')', 01772 $ IINFO, N, JTYPE, IOLDSD 01773 INFO = ABS( IINFO ) 01774 IF( IINFO.LT.0 ) THEN 01775 RETURN 01776 ELSE 01777 RESULT( NTEST ) = ULPINV 01778 GO TO 1050 01779 END IF 01780 END IF 01781 * 01782 * Do test 42 01783 * 01784 TEMP1 = ZERO 01785 TEMP2 = ZERO 01786 DO 1040 J = 1, N 01787 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 01788 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 01789 1040 CONTINUE 01790 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 01791 $ ULP*MAX( TEMP1, TEMP2 ) ) 01792 * 01793 1050 CONTINUE 01794 * 01795 * Call CHBEV 01796 * 01797 IF( JTYPE.LE.7 ) THEN 01798 KD = 0 01799 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN 01800 KD = MAX( N-1, 0 ) 01801 ELSE 01802 KD = IHBW 01803 END IF 01804 * 01805 * Load array V with the upper or lower triangular part 01806 * of the matrix in band form. 01807 * 01808 IF( IUPLO.EQ.1 ) THEN 01809 DO 1070 J = 1, N 01810 DO 1060 I = MAX( 1, J-KD ), J 01811 V( KD+1+I-J, J ) = A( I, J ) 01812 1060 CONTINUE 01813 1070 CONTINUE 01814 ELSE 01815 DO 1090 J = 1, N 01816 DO 1080 I = J, MIN( N, J+KD ) 01817 V( 1+I-J, J ) = A( I, J ) 01818 1080 CONTINUE 01819 1090 CONTINUE 01820 END IF 01821 * 01822 NTEST = NTEST + 1 01823 CALL CHBEV( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK, 01824 $ RWORK, IINFO ) 01825 IF( IINFO.NE.0 ) THEN 01826 WRITE( NOUNIT, FMT = 9998 )'CHBEV(V,' // UPLO // ')', 01827 $ IINFO, N, KD, JTYPE, IOLDSD 01828 INFO = ABS( IINFO ) 01829 IF( IINFO.LT.0 ) THEN 01830 RETURN 01831 ELSE 01832 RESULT( NTEST ) = ULPINV 01833 RESULT( NTEST+1 ) = ULPINV 01834 RESULT( NTEST+2 ) = ULPINV 01835 GO TO 1140 01836 END IF 01837 END IF 01838 * 01839 * Do tests 43 and 44. 01840 * 01841 CALL CHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 01842 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 01843 * 01844 IF( IUPLO.EQ.1 ) THEN 01845 DO 1110 J = 1, N 01846 DO 1100 I = MAX( 1, J-KD ), J 01847 V( KD+1+I-J, J ) = A( I, J ) 01848 1100 CONTINUE 01849 1110 CONTINUE 01850 ELSE 01851 DO 1130 J = 1, N 01852 DO 1120 I = J, MIN( N, J+KD ) 01853 V( 1+I-J, J ) = A( I, J ) 01854 1120 CONTINUE 01855 1130 CONTINUE 01856 END IF 01857 * 01858 NTEST = NTEST + 2 01859 CALL CHBEV( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, WORK, 01860 $ RWORK, IINFO ) 01861 IF( IINFO.NE.0 ) THEN 01862 WRITE( NOUNIT, FMT = 9998 )'CHBEV(N,' // UPLO // ')', 01863 $ IINFO, N, KD, JTYPE, IOLDSD 01864 INFO = ABS( IINFO ) 01865 IF( IINFO.LT.0 ) THEN 01866 RETURN 01867 ELSE 01868 RESULT( NTEST ) = ULPINV 01869 GO TO 1140 01870 END IF 01871 END IF 01872 * 01873 1140 CONTINUE 01874 * 01875 * Do test 45. 01876 * 01877 TEMP1 = ZERO 01878 TEMP2 = ZERO 01879 DO 1150 J = 1, N 01880 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 01881 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 01882 1150 CONTINUE 01883 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 01884 $ ULP*MAX( TEMP1, TEMP2 ) ) 01885 * 01886 CALL CLACPY( ' ', N, N, A, LDA, V, LDU ) 01887 NTEST = NTEST + 1 01888 CALL CHEEVR( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 01889 $ ABSTOL, M, WA1, Z, LDU, IWORK, WORK, LWORK, 01890 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 01891 $ IINFO ) 01892 IF( IINFO.NE.0 ) THEN 01893 WRITE( NOUNIT, FMT = 9999 )'CHEEVR(V,A,' // UPLO // 01894 $ ')', IINFO, N, JTYPE, IOLDSD 01895 INFO = ABS( IINFO ) 01896 IF( IINFO.LT.0 ) THEN 01897 RETURN 01898 ELSE 01899 RESULT( NTEST ) = ULPINV 01900 RESULT( NTEST+1 ) = ULPINV 01901 RESULT( NTEST+2 ) = ULPINV 01902 GO TO 1170 01903 END IF 01904 END IF 01905 * 01906 * Do tests 45 and 46 (or ... ) 01907 * 01908 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 01909 * 01910 CALL CHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 01911 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 01912 * 01913 NTEST = NTEST + 2 01914 CALL CHEEVR( 'N', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 01915 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 01916 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 01917 $ IINFO ) 01918 IF( IINFO.NE.0 ) THEN 01919 WRITE( NOUNIT, FMT = 9999 )'CHEEVR(N,A,' // UPLO // 01920 $ ')', IINFO, N, JTYPE, IOLDSD 01921 INFO = ABS( IINFO ) 01922 IF( IINFO.LT.0 ) THEN 01923 RETURN 01924 ELSE 01925 RESULT( NTEST ) = ULPINV 01926 GO TO 1170 01927 END IF 01928 END IF 01929 * 01930 * Do test 47 (or ... ) 01931 * 01932 TEMP1 = ZERO 01933 TEMP2 = ZERO 01934 DO 1160 J = 1, N 01935 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 01936 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 01937 1160 CONTINUE 01938 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 01939 $ ULP*MAX( TEMP1, TEMP2 ) ) 01940 * 01941 1170 CONTINUE 01942 * 01943 NTEST = NTEST + 1 01944 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 01945 CALL CHEEVR( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 01946 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 01947 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 01948 $ IINFO ) 01949 IF( IINFO.NE.0 ) THEN 01950 WRITE( NOUNIT, FMT = 9999 )'CHEEVR(V,I,' // UPLO // 01951 $ ')', IINFO, N, JTYPE, IOLDSD 01952 INFO = ABS( IINFO ) 01953 IF( IINFO.LT.0 ) THEN 01954 RETURN 01955 ELSE 01956 RESULT( NTEST ) = ULPINV 01957 RESULT( NTEST+1 ) = ULPINV 01958 RESULT( NTEST+2 ) = ULPINV 01959 GO TO 1180 01960 END IF 01961 END IF 01962 * 01963 * Do tests 48 and 49 (or +??) 01964 * 01965 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 01966 * 01967 CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 01968 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 01969 * 01970 NTEST = NTEST + 2 01971 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 01972 CALL CHEEVR( 'N', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 01973 $ ABSTOL, M3, WA3, Z, LDU, IWORK, WORK, LWORK, 01974 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 01975 $ IINFO ) 01976 IF( IINFO.NE.0 ) THEN 01977 WRITE( NOUNIT, FMT = 9999 )'CHEEVR(N,I,' // UPLO // 01978 $ ')', IINFO, N, JTYPE, IOLDSD 01979 INFO = ABS( IINFO ) 01980 IF( IINFO.LT.0 ) THEN 01981 RETURN 01982 ELSE 01983 RESULT( NTEST ) = ULPINV 01984 GO TO 1180 01985 END IF 01986 END IF 01987 * 01988 * Do test 50 (or +??) 01989 * 01990 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 01991 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 01992 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 01993 $ MAX( UNFL, ULP*TEMP3 ) 01994 1180 CONTINUE 01995 * 01996 NTEST = NTEST + 1 01997 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 01998 CALL CHEEVR( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 01999 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 02000 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 02001 $ IINFO ) 02002 IF( IINFO.NE.0 ) THEN 02003 WRITE( NOUNIT, FMT = 9999 )'CHEEVR(V,V,' // UPLO // 02004 $ ')', IINFO, N, JTYPE, IOLDSD 02005 INFO = ABS( IINFO ) 02006 IF( IINFO.LT.0 ) THEN 02007 RETURN 02008 ELSE 02009 RESULT( NTEST ) = ULPINV 02010 RESULT( NTEST+1 ) = ULPINV 02011 RESULT( NTEST+2 ) = ULPINV 02012 GO TO 1190 02013 END IF 02014 END IF 02015 * 02016 * Do tests 51 and 52 (or +??) 02017 * 02018 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 02019 * 02020 CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 02021 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 02022 * 02023 NTEST = NTEST + 2 02024 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 02025 CALL CHEEVR( 'N', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 02026 $ ABSTOL, M3, WA3, Z, LDU, IWORK, WORK, LWORK, 02027 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 02028 $ IINFO ) 02029 IF( IINFO.NE.0 ) THEN 02030 WRITE( NOUNIT, FMT = 9999 )'CHEEVR(N,V,' // UPLO // 02031 $ ')', IINFO, N, JTYPE, IOLDSD 02032 INFO = ABS( IINFO ) 02033 IF( IINFO.LT.0 ) THEN 02034 RETURN 02035 ELSE 02036 RESULT( NTEST ) = ULPINV 02037 GO TO 1190 02038 END IF 02039 END IF 02040 * 02041 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 02042 RESULT( NTEST ) = ULPINV 02043 GO TO 1190 02044 END IF 02045 * 02046 * Do test 52 (or +??) 02047 * 02048 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 02049 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 02050 IF( N.GT.0 ) THEN 02051 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 02052 ELSE 02053 TEMP3 = ZERO 02054 END IF 02055 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 02056 $ MAX( UNFL, TEMP3*ULP ) 02057 * 02058 CALL CLACPY( ' ', N, N, V, LDU, A, LDA ) 02059 * 02060 * 02061 * 02062 * 02063 * Load array V with the upper or lower triangular part 02064 * of the matrix in band form. 02065 * 02066 1190 CONTINUE 02067 * 02068 1200 CONTINUE 02069 * 02070 * End of Loop -- Check for RESULT(j) > THRESH 02071 * 02072 NTESTT = NTESTT + NTEST 02073 CALL SLAFTS( 'CST', N, N, JTYPE, NTEST, RESULT, IOLDSD, 02074 $ THRESH, NOUNIT, NERRS ) 02075 * 02076 1210 CONTINUE 02077 1220 CONTINUE 02078 * 02079 * Summary 02080 * 02081 CALL ALASVM( 'CST', NOUNIT, NERRS, NTESTT, 0 ) 02082 * 02083 9999 FORMAT( ' CDRVST: ', A, ' returned INFO=', I6, / 9X, 'N=', I6, 02084 $ ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' ) 02085 9998 FORMAT( ' CDRVST: ', A, ' returned INFO=', I6, / 9X, 'N=', I6, 02086 $ ', KD=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, 02087 $ ')' ) 02088 * 02089 RETURN 02090 * 02091 * End of CDRVST 02092 * 02093 END