1*> \brief \b DDRVST 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE DDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 12* NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1, 13* WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK, 14* IWORK, LIWORK, RESULT, INFO ) 15* 16* .. Scalar Arguments .. 17* INTEGER INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES, 18* $ NTYPES 19* DOUBLE PRECISION THRESH 20* .. 21* .. Array Arguments .. 22* LOGICAL DOTYPE( * ) 23* INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 24* DOUBLE PRECISION A( LDA, * ), D1( * ), D2( * ), D3( * ), 25* $ D4( * ), EVEIGS( * ), RESULT( * ), TAU( * ), 26* $ U( LDU, * ), V( LDU, * ), WA1( * ), WA2( * ), 27* $ WA3( * ), WORK( * ), Z( LDU, * ) 28* .. 29* 30* 31*> \par Purpose: 32* ============= 33*> 34*> \verbatim 35*> 36*> DDRVST checks the symmetric eigenvalue problem drivers. 37*> 38*> DSTEV computes all eigenvalues and, optionally, 39*> eigenvectors of a real symmetric tridiagonal matrix. 40*> 41*> DSTEVX computes selected eigenvalues and, optionally, 42*> eigenvectors of a real symmetric tridiagonal matrix. 43*> 44*> DSTEVR computes selected eigenvalues and, optionally, 45*> eigenvectors of a real symmetric tridiagonal matrix 46*> using the Relatively Robust Representation where it can. 47*> 48*> DSYEV computes all eigenvalues and, optionally, 49*> eigenvectors of a real symmetric matrix. 50*> 51*> DSYEVX computes selected eigenvalues and, optionally, 52*> eigenvectors of a real symmetric matrix. 53*> 54*> DSYEVR computes selected eigenvalues and, optionally, 55*> eigenvectors of a real symmetric matrix 56*> using the Relatively Robust Representation where it can. 57*> 58*> DSPEV computes all eigenvalues and, optionally, 59*> eigenvectors of a real symmetric matrix in packed 60*> storage. 61*> 62*> DSPEVX computes selected eigenvalues and, optionally, 63*> eigenvectors of a real symmetric matrix in packed 64*> storage. 65*> 66*> DSBEV computes all eigenvalues and, optionally, 67*> eigenvectors of a real symmetric band matrix. 68*> 69*> DSBEVX computes selected eigenvalues and, optionally, 70*> eigenvectors of a real symmetric band matrix. 71*> 72*> DSYEVD computes all eigenvalues and, optionally, 73*> eigenvectors of a real symmetric matrix using 74*> a divide and conquer algorithm. 75*> 76*> DSPEVD computes all eigenvalues and, optionally, 77*> eigenvectors of a real symmetric matrix in packed 78*> storage, using a divide and conquer algorithm. 79*> 80*> DSBEVD computes all eigenvalues and, optionally, 81*> eigenvectors of a real symmetric band matrix, 82*> using a divide and conquer algorithm. 83*> 84*> When DDRVST is called, a number of matrix "sizes" ("n's") and a 85*> number of matrix "types" are specified. For each size ("n") 86*> and each type of matrix, one matrix will be generated and used 87*> to test the appropriate drivers. For each matrix and each 88*> driver routine called, the following tests will be performed: 89*> 90*> (1) | A - Z D Z' | / ( |A| n ulp ) 91*> 92*> (2) | I - Z Z' | / ( n ulp ) 93*> 94*> (3) | D1 - D2 | / ( |D1| ulp ) 95*> 96*> where Z is the matrix of eigenvectors returned when the 97*> eigenvector option is given and D1 and D2 are the eigenvalues 98*> returned with and without the eigenvector option. 99*> 100*> The "sizes" are specified by an array NN(1:NSIZES); the value of 101*> each element NN(j) specifies one size. 102*> The "types" are specified by a logical array DOTYPE( 1:NTYPES ); 103*> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated. 104*> Currently, the list of possible types is: 105*> 106*> (1) The zero matrix. 107*> (2) The identity matrix. 108*> 109*> (3) A diagonal matrix with evenly spaced eigenvalues 110*> 1, ..., ULP and random signs. 111*> (ULP = (first number larger than 1) - 1 ) 112*> (4) A diagonal matrix with geometrically spaced eigenvalues 113*> 1, ..., ULP and random signs. 114*> (5) A diagonal matrix with "clustered" eigenvalues 115*> 1, ULP, ..., ULP and random signs. 116*> 117*> (6) Same as (4), but multiplied by SQRT( overflow threshold ) 118*> (7) Same as (4), but multiplied by SQRT( underflow threshold ) 119*> 120*> (8) A matrix of the form U' D U, where U is orthogonal and 121*> D has evenly spaced entries 1, ..., ULP with random signs 122*> on the diagonal. 123*> 124*> (9) A matrix of the form U' D U, where U is orthogonal and 125*> D has geometrically spaced entries 1, ..., ULP with random 126*> signs on the diagonal. 127*> 128*> (10) A matrix of the form U' D U, where U is orthogonal and 129*> D has "clustered" entries 1, ULP,..., ULP with random 130*> signs on the diagonal. 131*> 132*> (11) Same as (8), but multiplied by SQRT( overflow threshold ) 133*> (12) Same as (8), but multiplied by SQRT( underflow threshold ) 134*> 135*> (13) Symmetric matrix with random entries chosen from (-1,1). 136*> (14) Same as (13), but multiplied by SQRT( overflow threshold ) 137*> (15) Same as (13), but multiplied by SQRT( underflow threshold ) 138*> (16) A band matrix with half bandwidth randomly chosen between 139*> 0 and N-1, with evenly spaced eigenvalues 1, ..., ULP 140*> with random signs. 141*> (17) Same as (16), but multiplied by SQRT( overflow threshold ) 142*> (18) Same as (16), but multiplied by SQRT( underflow threshold ) 143*> \endverbatim 144* 145* Arguments: 146* ========== 147* 148*> \verbatim 149*> NSIZES INTEGER 150*> The number of sizes of matrices to use. If it is zero, 151*> DDRVST does nothing. It must be at least zero. 152*> Not modified. 153*> 154*> NN INTEGER array, dimension (NSIZES) 155*> An array containing the sizes to be used for the matrices. 156*> Zero values will be skipped. The values must be at least 157*> zero. 158*> Not modified. 159*> 160*> NTYPES INTEGER 161*> The number of elements in DOTYPE. If it is zero, DDRVST 162*> does nothing. It must be at least zero. If it is MAXTYP+1 163*> and NSIZES is 1, then an additional type, MAXTYP+1 is 164*> defined, which is to use whatever matrix is in A. This 165*> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and 166*> DOTYPE(MAXTYP+1) is .TRUE. . 167*> Not modified. 168*> 169*> DOTYPE LOGICAL array, dimension (NTYPES) 170*> If DOTYPE(j) is .TRUE., then for each size in NN a 171*> matrix of that size and of type j will be generated. 172*> If NTYPES is smaller than the maximum number of types 173*> defined (PARAMETER MAXTYP), then types NTYPES+1 through 174*> MAXTYP will not be generated. If NTYPES is larger 175*> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) 176*> will be ignored. 177*> Not modified. 178*> 179*> ISEED INTEGER array, dimension (4) 180*> On entry ISEED specifies the seed of the random number 181*> generator. The array elements should be between 0 and 4095; 182*> if not they will be reduced mod 4096. Also, ISEED(4) must 183*> be odd. The random number generator uses a linear 184*> congruential sequence limited to small integers, and so 185*> should produce machine independent random numbers. The 186*> values of ISEED are changed on exit, and can be used in the 187*> next call to DDRVST to continue the same random number 188*> sequence. 189*> Modified. 190*> 191*> THRESH DOUBLE PRECISION 192*> A test will count as "failed" if the "error", computed as 193*> described above, exceeds THRESH. Note that the error 194*> is scaled to be O(1), so THRESH should be a reasonably 195*> small multiple of 1, e.g., 10 or 100. In particular, 196*> it should not depend on the precision (single vs. double) 197*> or the size of the matrix. It must be at least zero. 198*> Not modified. 199*> 200*> NOUNIT INTEGER 201*> The FORTRAN unit number for printing out error messages 202*> (e.g., if a routine returns IINFO not equal to 0.) 203*> Not modified. 204*> 205*> A DOUBLE PRECISION array, dimension (LDA , max(NN)) 206*> Used to hold the matrix whose eigenvalues are to be 207*> computed. On exit, A contains the last matrix actually 208*> used. 209*> Modified. 210*> 211*> LDA INTEGER 212*> The leading dimension of A. It must be at 213*> least 1 and at least max( NN ). 214*> Not modified. 215*> 216*> D1 DOUBLE PRECISION array, dimension (max(NN)) 217*> The eigenvalues of A, as computed by DSTEQR simlutaneously 218*> with Z. On exit, the eigenvalues in D1 correspond with the 219*> matrix in A. 220*> Modified. 221*> 222*> D2 DOUBLE PRECISION array, dimension (max(NN)) 223*> The eigenvalues of A, as computed by DSTEQR if Z is not 224*> computed. On exit, the eigenvalues in D2 correspond with 225*> the matrix in A. 226*> Modified. 227*> 228*> D3 DOUBLE PRECISION array, dimension (max(NN)) 229*> The eigenvalues of A, as computed by DSTERF. On exit, the 230*> eigenvalues in D3 correspond with the matrix in A. 231*> Modified. 232*> 233*> D4 DOUBLE PRECISION array, dimension 234*> 235*> EVEIGS DOUBLE PRECISION array, dimension (max(NN)) 236*> The eigenvalues as computed by DSTEV('N', ... ) 237*> (I reserve the right to change this to the output of 238*> whichever algorithm computes the most accurate eigenvalues). 239*> 240*> WA1 DOUBLE PRECISION array, dimension 241*> 242*> WA2 DOUBLE PRECISION array, dimension 243*> 244*> WA3 DOUBLE PRECISION array, dimension 245*> 246*> U DOUBLE PRECISION array, dimension (LDU, max(NN)) 247*> The orthogonal matrix computed by DSYTRD + DORGTR. 248*> Modified. 249*> 250*> LDU INTEGER 251*> The leading dimension of U, Z, and V. It must be at 252*> least 1 and at least max( NN ). 253*> Not modified. 254*> 255*> V DOUBLE PRECISION array, dimension (LDU, max(NN)) 256*> The Housholder vectors computed by DSYTRD in reducing A to 257*> tridiagonal form. 258*> Modified. 259*> 260*> TAU DOUBLE PRECISION array, dimension (max(NN)) 261*> The Householder factors computed by DSYTRD in reducing A 262*> to tridiagonal form. 263*> Modified. 264*> 265*> Z DOUBLE PRECISION array, dimension (LDU, max(NN)) 266*> The orthogonal matrix of eigenvectors computed by DSTEQR, 267*> DPTEQR, and DSTEIN. 268*> Modified. 269*> 270*> WORK DOUBLE PRECISION array, dimension (LWORK) 271*> Workspace. 272*> Modified. 273*> 274*> LWORK INTEGER 275*> The number of entries in WORK. This must be at least 276*> 1 + 4 * Nmax + 2 * Nmax * lg Nmax + 4 * Nmax**2 277*> where Nmax = max( NN(j), 2 ) and lg = log base 2. 278*> Not modified. 279*> 280*> IWORK INTEGER array, 281*> dimension (6 + 6*Nmax + 5 * Nmax * lg Nmax ) 282*> where Nmax = max( NN(j), 2 ) and lg = log base 2. 283*> Workspace. 284*> Modified. 285*> 286*> RESULT DOUBLE PRECISION array, dimension (105) 287*> The values computed by the tests described above. 288*> The values are currently limited to 1/ulp, to avoid 289*> overflow. 290*> Modified. 291*> 292*> INFO INTEGER 293*> If 0, then everything ran OK. 294*> -1: NSIZES < 0 295*> -2: Some NN(j) < 0 296*> -3: NTYPES < 0 297*> -5: THRESH < 0 298*> -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ). 299*> -16: LDU < 1 or LDU < NMAX. 300*> -21: LWORK too small. 301*> If DLATMR, DLATMS, DSYTRD, DORGTR, DSTEQR, DSTERF, 302*> or DORMTR returns an error code, the 303*> absolute value of it is returned. 304*> Modified. 305*> 306*>----------------------------------------------------------------------- 307*> 308*> Some Local Variables and Parameters: 309*> ---- ----- --------- --- ---------- 310*> ZERO, ONE Real 0 and 1. 311*> MAXTYP The number of types defined. 312*> NTEST The number of tests performed, or which can 313*> be performed so far, for the current matrix. 314*> NTESTT The total number of tests performed so far. 315*> NMAX Largest value in NN. 316*> NMATS The number of matrices generated so far. 317*> NERRS The number of tests which have exceeded THRESH 318*> so far (computed by DLAFTS). 319*> COND, IMODE Values to be passed to the matrix generators. 320*> ANORM Norm of A; passed to matrix generators. 321*> 322*> OVFL, UNFL Overflow and underflow thresholds. 323*> ULP, ULPINV Finest relative precision and its inverse. 324*> RTOVFL, RTUNFL Square roots of the previous 2 values. 325*> The following four arrays decode JTYPE: 326*> KTYPE(j) The general type (1-10) for type "j". 327*> KMODE(j) The MODE value to be passed to the matrix 328*> generator for type "j". 329*> KMAGN(j) The order of magnitude ( O(1), 330*> O(overflow^(1/2) ), O(underflow^(1/2) ) 331*> 332*> The tests performed are: Routine tested 333*> 1= | A - U S U' | / ( |A| n ulp ) DSTEV('V', ... ) 334*> 2= | I - U U' | / ( n ulp ) DSTEV('V', ... ) 335*> 3= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEV('N', ... ) 336*> 4= | A - U S U' | / ( |A| n ulp ) DSTEVX('V','A', ... ) 337*> 5= | I - U U' | / ( n ulp ) DSTEVX('V','A', ... ) 338*> 6= |D(with Z) - EVEIGS| / (|D| ulp) DSTEVX('N','A', ... ) 339*> 7= | A - U S U' | / ( |A| n ulp ) DSTEVR('V','A', ... ) 340*> 8= | I - U U' | / ( n ulp ) DSTEVR('V','A', ... ) 341*> 9= |D(with Z) - EVEIGS| / (|D| ulp) DSTEVR('N','A', ... ) 342*> 10= | A - U S U' | / ( |A| n ulp ) DSTEVX('V','I', ... ) 343*> 11= | I - U U' | / ( n ulp ) DSTEVX('V','I', ... ) 344*> 12= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEVX('N','I', ... ) 345*> 13= | A - U S U' | / ( |A| n ulp ) DSTEVX('V','V', ... ) 346*> 14= | I - U U' | / ( n ulp ) DSTEVX('V','V', ... ) 347*> 15= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEVX('N','V', ... ) 348*> 16= | A - U S U' | / ( |A| n ulp ) DSTEVD('V', ... ) 349*> 17= | I - U U' | / ( n ulp ) DSTEVD('V', ... ) 350*> 18= |D(with Z) - EVEIGS| / (|D| ulp) DSTEVD('N', ... ) 351*> 19= | A - U S U' | / ( |A| n ulp ) DSTEVR('V','I', ... ) 352*> 20= | I - U U' | / ( n ulp ) DSTEVR('V','I', ... ) 353*> 21= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEVR('N','I', ... ) 354*> 22= | A - U S U' | / ( |A| n ulp ) DSTEVR('V','V', ... ) 355*> 23= | I - U U' | / ( n ulp ) DSTEVR('V','V', ... ) 356*> 24= |D(with Z) - D(w/o Z)| / (|D| ulp) DSTEVR('N','V', ... ) 357*> 358*> 25= | A - U S U' | / ( |A| n ulp ) DSYEV('L','V', ... ) 359*> 26= | I - U U' | / ( n ulp ) DSYEV('L','V', ... ) 360*> 27= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEV('L','N', ... ) 361*> 28= | A - U S U' | / ( |A| n ulp ) DSYEVX('L','V','A', ... ) 362*> 29= | I - U U' | / ( n ulp ) DSYEVX('L','V','A', ... ) 363*> 30= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVX('L','N','A', ... ) 364*> 31= | A - U S U' | / ( |A| n ulp ) DSYEVX('L','V','I', ... ) 365*> 32= | I - U U' | / ( n ulp ) DSYEVX('L','V','I', ... ) 366*> 33= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVX('L','N','I', ... ) 367*> 34= | A - U S U' | / ( |A| n ulp ) DSYEVX('L','V','V', ... ) 368*> 35= | I - U U' | / ( n ulp ) DSYEVX('L','V','V', ... ) 369*> 36= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVX('L','N','V', ... ) 370*> 37= | A - U S U' | / ( |A| n ulp ) DSPEV('L','V', ... ) 371*> 38= | I - U U' | / ( n ulp ) DSPEV('L','V', ... ) 372*> 39= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEV('L','N', ... ) 373*> 40= | A - U S U' | / ( |A| n ulp ) DSPEVX('L','V','A', ... ) 374*> 41= | I - U U' | / ( n ulp ) DSPEVX('L','V','A', ... ) 375*> 42= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVX('L','N','A', ... ) 376*> 43= | A - U S U' | / ( |A| n ulp ) DSPEVX('L','V','I', ... ) 377*> 44= | I - U U' | / ( n ulp ) DSPEVX('L','V','I', ... ) 378*> 45= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVX('L','N','I', ... ) 379*> 46= | A - U S U' | / ( |A| n ulp ) DSPEVX('L','V','V', ... ) 380*> 47= | I - U U' | / ( n ulp ) DSPEVX('L','V','V', ... ) 381*> 48= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVX('L','N','V', ... ) 382*> 49= | A - U S U' | / ( |A| n ulp ) DSBEV('L','V', ... ) 383*> 50= | I - U U' | / ( n ulp ) DSBEV('L','V', ... ) 384*> 51= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEV('L','N', ... ) 385*> 52= | A - U S U' | / ( |A| n ulp ) DSBEVX('L','V','A', ... ) 386*> 53= | I - U U' | / ( n ulp ) DSBEVX('L','V','A', ... ) 387*> 54= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVX('L','N','A', ... ) 388*> 55= | A - U S U' | / ( |A| n ulp ) DSBEVX('L','V','I', ... ) 389*> 56= | I - U U' | / ( n ulp ) DSBEVX('L','V','I', ... ) 390*> 57= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVX('L','N','I', ... ) 391*> 58= | A - U S U' | / ( |A| n ulp ) DSBEVX('L','V','V', ... ) 392*> 59= | I - U U' | / ( n ulp ) DSBEVX('L','V','V', ... ) 393*> 60= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVX('L','N','V', ... ) 394*> 61= | A - U S U' | / ( |A| n ulp ) DSYEVD('L','V', ... ) 395*> 62= | I - U U' | / ( n ulp ) DSYEVD('L','V', ... ) 396*> 63= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVD('L','N', ... ) 397*> 64= | A - U S U' | / ( |A| n ulp ) DSPEVD('L','V', ... ) 398*> 65= | I - U U' | / ( n ulp ) DSPEVD('L','V', ... ) 399*> 66= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVD('L','N', ... ) 400*> 67= | A - U S U' | / ( |A| n ulp ) DSBEVD('L','V', ... ) 401*> 68= | I - U U' | / ( n ulp ) DSBEVD('L','V', ... ) 402*> 69= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVD('L','N', ... ) 403*> 70= | A - U S U' | / ( |A| n ulp ) DSYEVR('L','V','A', ... ) 404*> 71= | I - U U' | / ( n ulp ) DSYEVR('L','V','A', ... ) 405*> 72= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVR('L','N','A', ... ) 406*> 73= | A - U S U' | / ( |A| n ulp ) DSYEVR('L','V','I', ... ) 407*> 74= | I - U U' | / ( n ulp ) DSYEVR('L','V','I', ... ) 408*> 75= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVR('L','N','I', ... ) 409*> 76= | A - U S U' | / ( |A| n ulp ) DSYEVR('L','V','V', ... ) 410*> 77= | I - U U' | / ( n ulp ) DSYEVR('L','V','V', ... ) 411*> 78= |D(with Z) - D(w/o Z)| / (|D| ulp) DSYEVR('L','N','V', ... ) 412*> 413*> Tests 25 through 78 are repeated (as tests 79 through 132) 414*> with UPLO='U' 415*> 416*> To be added in 1999 417*> 418*> 79= | A - U S U' | / ( |A| n ulp ) DSPEVR('L','V','A', ... ) 419*> 80= | I - U U' | / ( n ulp ) DSPEVR('L','V','A', ... ) 420*> 81= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVR('L','N','A', ... ) 421*> 82= | A - U S U' | / ( |A| n ulp ) DSPEVR('L','V','I', ... ) 422*> 83= | I - U U' | / ( n ulp ) DSPEVR('L','V','I', ... ) 423*> 84= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVR('L','N','I', ... ) 424*> 85= | A - U S U' | / ( |A| n ulp ) DSPEVR('L','V','V', ... ) 425*> 86= | I - U U' | / ( n ulp ) DSPEVR('L','V','V', ... ) 426*> 87= |D(with Z) - D(w/o Z)| / (|D| ulp) DSPEVR('L','N','V', ... ) 427*> 88= | A - U S U' | / ( |A| n ulp ) DSBEVR('L','V','A', ... ) 428*> 89= | I - U U' | / ( n ulp ) DSBEVR('L','V','A', ... ) 429*> 90= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVR('L','N','A', ... ) 430*> 91= | A - U S U' | / ( |A| n ulp ) DSBEVR('L','V','I', ... ) 431*> 92= | I - U U' | / ( n ulp ) DSBEVR('L','V','I', ... ) 432*> 93= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVR('L','N','I', ... ) 433*> 94= | A - U S U' | / ( |A| n ulp ) DSBEVR('L','V','V', ... ) 434*> 95= | I - U U' | / ( n ulp ) DSBEVR('L','V','V', ... ) 435*> 96= |D(with Z) - D(w/o Z)| / (|D| ulp) DSBEVR('L','N','V', ... ) 436*> \endverbatim 437* 438* Authors: 439* ======== 440* 441*> \author Univ. of Tennessee 442*> \author Univ. of California Berkeley 443*> \author Univ. of Colorado Denver 444*> \author NAG Ltd. 445* 446*> \date November 2011 447* 448*> \ingroup double_eig 449* 450* ===================================================================== 451 SUBROUTINE DDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 452 $ NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1, 453 $ WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK, 454 $ IWORK, LIWORK, RESULT, INFO ) 455* 456* -- LAPACK test routine (version 3.4.0) -- 457* -- LAPACK is a software package provided by Univ. of Tennessee, -- 458* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 459* November 2011 460* 461* .. Scalar Arguments .. 462 INTEGER INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES, 463 $ NTYPES 464 DOUBLE PRECISION THRESH 465* .. 466* .. Array Arguments .. 467 LOGICAL DOTYPE( * ) 468 INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 469 DOUBLE PRECISION A( LDA, * ), D1( * ), D2( * ), D3( * ), 470 $ D4( * ), EVEIGS( * ), RESULT( * ), TAU( * ), 471 $ U( LDU, * ), V( LDU, * ), WA1( * ), WA2( * ), 472 $ WA3( * ), WORK( * ), Z( LDU, * ) 473* .. 474* 475* ===================================================================== 476* 477* .. Parameters .. 478 DOUBLE PRECISION ZERO, ONE, TWO, TEN 479 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0, 480 $ TEN = 10.0D0 ) 481 DOUBLE PRECISION HALF 482 PARAMETER ( HALF = 0.5D0 ) 483 INTEGER MAXTYP 484 PARAMETER ( MAXTYP = 18 ) 485* .. 486* .. Local Scalars .. 487 LOGICAL BADNN 488 CHARACTER UPLO 489 INTEGER I, IDIAG, IHBW, IINFO, IL, IMODE, INDX, IROW, 490 $ ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL, 491 $ JSIZE, JTYPE, KD, LGN, LIWEDC, LWEDC, M, M2, 492 $ M3, MTYPES, N, NERRS, NMATS, NMAX, NTEST, 493 $ NTESTT 494 DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL, 495 $ RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL, 496 $ VL, VU 497* .. 498* .. Local Arrays .. 499 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ), 500 $ ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ), 501 $ KTYPE( MAXTYP ) 502* .. 503* .. External Functions .. 504 DOUBLE PRECISION DLAMCH, DLARND, DSXT1 505 EXTERNAL DLAMCH, DLARND, DSXT1 506* .. 507* .. External Subroutines .. 508 EXTERNAL ALASVM, DLABAD, DLACPY, DLAFTS, DLASET, DLATMR, 509 $ DLATMS, DSBEV, DSBEVD, DSBEVX, DSPEV, DSPEVD, 510 $ DSPEVX, DSTEV, DSTEVD, DSTEVR, DSTEVX, DSTT21, 511 $ DSTT22, DSYEV, DSYEVD, DSYEVR, DSYEVX, DSYT21, 512 $ DSYT22, XERBLA 513* .. 514* .. Scalars in Common .. 515 CHARACTER*32 SRNAMT 516* .. 517* .. Common blocks .. 518 COMMON / SRNAMC / SRNAMT 519* .. 520* .. Intrinsic Functions .. 521 INTRINSIC ABS, DBLE, INT, LOG, MAX, MIN, SQRT 522* .. 523* .. Data statements .. 524 DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 3*9 / 525 DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1, 526 $ 2, 3, 1, 2, 3 / 527 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, 528 $ 0, 0, 4, 4, 4 / 529* .. 530* .. Executable Statements .. 531* 532* Keep ftrnchek happy 533* 534 VL = ZERO 535 VU = ZERO 536* 537* 1) Check for errors 538* 539 NTESTT = 0 540 INFO = 0 541* 542 BADNN = .FALSE. 543 NMAX = 1 544 DO 10 J = 1, NSIZES 545 NMAX = MAX( NMAX, NN( J ) ) 546 IF( NN( J ).LT.0 ) 547 $ BADNN = .TRUE. 548 10 CONTINUE 549* 550* Check for errors 551* 552 IF( NSIZES.LT.0 ) THEN 553 INFO = -1 554 ELSE IF( BADNN ) THEN 555 INFO = -2 556 ELSE IF( NTYPES.LT.0 ) THEN 557 INFO = -3 558 ELSE IF( LDA.LT.NMAX ) THEN 559 INFO = -9 560 ELSE IF( LDU.LT.NMAX ) THEN 561 INFO = -16 562 ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN 563 INFO = -21 564 END IF 565* 566 IF( INFO.NE.0 ) THEN 567 CALL XERBLA( 'DDRVST', -INFO ) 568 RETURN 569 END IF 570* 571* Quick return if nothing to do 572* 573 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 ) 574 $ RETURN 575* 576* More Important constants 577* 578 UNFL = DLAMCH( 'Safe minimum' ) 579 OVFL = DLAMCH( 'Overflow' ) 580 CALL DLABAD( UNFL, OVFL ) 581 ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) 582 ULPINV = ONE / ULP 583 RTUNFL = SQRT( UNFL ) 584 RTOVFL = SQRT( OVFL ) 585* 586* Loop over sizes, types 587* 588 DO 20 I = 1, 4 589 ISEED2( I ) = ISEED( I ) 590 ISEED3( I ) = ISEED( I ) 591 20 CONTINUE 592* 593 NERRS = 0 594 NMATS = 0 595* 596* 597 DO 1740 JSIZE = 1, NSIZES 598 N = NN( JSIZE ) 599 IF( N.GT.0 ) THEN 600 LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) ) 601 IF( 2**LGN.LT.N ) 602 $ LGN = LGN + 1 603 IF( 2**LGN.LT.N ) 604 $ LGN = LGN + 1 605 LWEDC = 1 + 4*N + 2*N*LGN + 4*N**2 606c LIWEDC = 6 + 6*N + 5*N*LGN 607 LIWEDC = 3 + 5*N 608 ELSE 609 LWEDC = 9 610c LIWEDC = 12 611 LIWEDC = 8 612 END IF 613 ANINV = ONE / DBLE( MAX( 1, N ) ) 614* 615 IF( NSIZES.NE.1 ) THEN 616 MTYPES = MIN( MAXTYP, NTYPES ) 617 ELSE 618 MTYPES = MIN( MAXTYP+1, NTYPES ) 619 END IF 620* 621 DO 1730 JTYPE = 1, MTYPES 622* 623 IF( .NOT.DOTYPE( JTYPE ) ) 624 $ GO TO 1730 625 NMATS = NMATS + 1 626 NTEST = 0 627* 628 DO 30 J = 1, 4 629 IOLDSD( J ) = ISEED( J ) 630 30 CONTINUE 631* 632* 2) Compute "A" 633* 634* Control parameters: 635* 636* KMAGN KMODE KTYPE 637* =1 O(1) clustered 1 zero 638* =2 large clustered 2 identity 639* =3 small exponential (none) 640* =4 arithmetic diagonal, (w/ eigenvalues) 641* =5 random log symmetric, w/ eigenvalues 642* =6 random (none) 643* =7 random diagonal 644* =8 random symmetric 645* =9 band symmetric, w/ eigenvalues 646* 647 IF( MTYPES.GT.MAXTYP ) 648 $ GO TO 110 649* 650 ITYPE = KTYPE( JTYPE ) 651 IMODE = KMODE( JTYPE ) 652* 653* Compute norm 654* 655 GO TO ( 40, 50, 60 )KMAGN( JTYPE ) 656* 657 40 CONTINUE 658 ANORM = ONE 659 GO TO 70 660* 661 50 CONTINUE 662 ANORM = ( RTOVFL*ULP )*ANINV 663 GO TO 70 664* 665 60 CONTINUE 666 ANORM = RTUNFL*N*ULPINV 667 GO TO 70 668* 669 70 CONTINUE 670* 671 CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA ) 672 IINFO = 0 673 COND = ULPINV 674* 675* Special Matrices -- Identity & Jordan block 676* 677* Zero 678* 679 IF( ITYPE.EQ.1 ) THEN 680 IINFO = 0 681* 682 ELSE IF( ITYPE.EQ.2 ) THEN 683* 684* Identity 685* 686 DO 80 JCOL = 1, N 687 A( JCOL, JCOL ) = ANORM 688 80 CONTINUE 689* 690 ELSE IF( ITYPE.EQ.4 ) THEN 691* 692* Diagonal Matrix, [Eigen]values Specified 693* 694 CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND, 695 $ ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ), 696 $ IINFO ) 697* 698 ELSE IF( ITYPE.EQ.5 ) THEN 699* 700* Symmetric, eigenvalues specified 701* 702 CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND, 703 $ ANORM, N, N, 'N', A, LDA, WORK( N+1 ), 704 $ IINFO ) 705* 706 ELSE IF( ITYPE.EQ.7 ) THEN 707* 708* Diagonal, random eigenvalues 709* 710 IDUMMA( 1 ) = 1 711 CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE, 712 $ 'T', 'N', WORK( N+1 ), 1, ONE, 713 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0, 714 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 715* 716 ELSE IF( ITYPE.EQ.8 ) THEN 717* 718* Symmetric, random eigenvalues 719* 720 IDUMMA( 1 ) = 1 721 CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE, 722 $ 'T', 'N', WORK( N+1 ), 1, ONE, 723 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N, 724 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 725* 726 ELSE IF( ITYPE.EQ.9 ) THEN 727* 728* Symmetric banded, eigenvalues specified 729* 730 IHBW = INT( ( N-1 )*DLARND( 1, ISEED3 ) ) 731 CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND, 732 $ ANORM, IHBW, IHBW, 'Z', U, LDU, WORK( N+1 ), 733 $ IINFO ) 734* 735* Store as dense matrix for most routines. 736* 737 CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA ) 738 DO 100 IDIAG = -IHBW, IHBW 739 IROW = IHBW - IDIAG + 1 740 J1 = MAX( 1, IDIAG+1 ) 741 J2 = MIN( N, N+IDIAG ) 742 DO 90 J = J1, J2 743 I = J - IDIAG 744 A( I, J ) = U( IROW, J ) 745 90 CONTINUE 746 100 CONTINUE 747 ELSE 748 IINFO = 1 749 END IF 750* 751 IF( IINFO.NE.0 ) THEN 752 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE, 753 $ IOLDSD 754 INFO = ABS( IINFO ) 755 RETURN 756 END IF 757* 758 110 CONTINUE 759* 760 ABSTOL = UNFL + UNFL 761 IF( N.LE.1 ) THEN 762 IL = 1 763 IU = N 764 ELSE 765 IL = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) ) 766 IU = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) ) 767 IF( IL.GT.IU ) THEN 768 ITEMP = IL 769 IL = IU 770 IU = ITEMP 771 END IF 772 END IF 773* 774* 3) If matrix is tridiagonal, call DSTEV and DSTEVX. 775* 776 IF( JTYPE.LE.7 ) THEN 777 NTEST = 1 778 DO 120 I = 1, N 779 D1( I ) = DBLE( A( I, I ) ) 780 120 CONTINUE 781 DO 130 I = 1, N - 1 782 D2( I ) = DBLE( A( I+1, I ) ) 783 130 CONTINUE 784 SRNAMT = 'DSTEV' 785 CALL DSTEV( 'V', N, D1, D2, Z, LDU, WORK, IINFO ) 786 IF( IINFO.NE.0 ) THEN 787 WRITE( NOUNIT, FMT = 9999 )'DSTEV(V)', IINFO, N, 788 $ JTYPE, IOLDSD 789 INFO = ABS( IINFO ) 790 IF( IINFO.LT.0 ) THEN 791 RETURN 792 ELSE 793 RESULT( 1 ) = ULPINV 794 RESULT( 2 ) = ULPINV 795 RESULT( 3 ) = ULPINV 796 GO TO 180 797 END IF 798 END IF 799* 800* Do tests 1 and 2. 801* 802 DO 140 I = 1, N 803 D3( I ) = DBLE( A( I, I ) ) 804 140 CONTINUE 805 DO 150 I = 1, N - 1 806 D4( I ) = DBLE( A( I+1, I ) ) 807 150 CONTINUE 808 CALL DSTT21( N, 0, D3, D4, D1, D2, Z, LDU, WORK, 809 $ RESULT( 1 ) ) 810* 811 NTEST = 3 812 DO 160 I = 1, N - 1 813 D4( I ) = DBLE( A( I+1, I ) ) 814 160 CONTINUE 815 SRNAMT = 'DSTEV' 816 CALL DSTEV( 'N', N, D3, D4, Z, LDU, WORK, IINFO ) 817 IF( IINFO.NE.0 ) THEN 818 WRITE( NOUNIT, FMT = 9999 )'DSTEV(N)', IINFO, N, 819 $ JTYPE, IOLDSD 820 INFO = ABS( IINFO ) 821 IF( IINFO.LT.0 ) THEN 822 RETURN 823 ELSE 824 RESULT( 3 ) = ULPINV 825 GO TO 180 826 END IF 827 END IF 828* 829* Do test 3. 830* 831 TEMP1 = ZERO 832 TEMP2 = ZERO 833 DO 170 J = 1, N 834 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 835 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 836 170 CONTINUE 837 RESULT( 3 ) = TEMP2 / MAX( UNFL, 838 $ ULP*MAX( TEMP1, TEMP2 ) ) 839* 840 180 CONTINUE 841* 842 NTEST = 4 843 DO 190 I = 1, N 844 EVEIGS( I ) = D3( I ) 845 D1( I ) = DBLE( A( I, I ) ) 846 190 CONTINUE 847 DO 200 I = 1, N - 1 848 D2( I ) = DBLE( A( I+1, I ) ) 849 200 CONTINUE 850 SRNAMT = 'DSTEVX' 851 CALL DSTEVX( 'V', 'A', N, D1, D2, VL, VU, IL, IU, ABSTOL, 852 $ M, WA1, Z, LDU, WORK, IWORK, IWORK( 5*N+1 ), 853 $ IINFO ) 854 IF( IINFO.NE.0 ) THEN 855 WRITE( NOUNIT, FMT = 9999 )'DSTEVX(V,A)', IINFO, N, 856 $ JTYPE, IOLDSD 857 INFO = ABS( IINFO ) 858 IF( IINFO.LT.0 ) THEN 859 RETURN 860 ELSE 861 RESULT( 4 ) = ULPINV 862 RESULT( 5 ) = ULPINV 863 RESULT( 6 ) = ULPINV 864 GO TO 250 865 END IF 866 END IF 867 IF( N.GT.0 ) THEN 868 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 869 ELSE 870 TEMP3 = ZERO 871 END IF 872* 873* Do tests 4 and 5. 874* 875 DO 210 I = 1, N 876 D3( I ) = DBLE( A( I, I ) ) 877 210 CONTINUE 878 DO 220 I = 1, N - 1 879 D4( I ) = DBLE( A( I+1, I ) ) 880 220 CONTINUE 881 CALL DSTT21( N, 0, D3, D4, WA1, D2, Z, LDU, WORK, 882 $ RESULT( 4 ) ) 883* 884 NTEST = 6 885 DO 230 I = 1, N - 1 886 D4( I ) = DBLE( A( I+1, I ) ) 887 230 CONTINUE 888 SRNAMT = 'DSTEVX' 889 CALL DSTEVX( 'N', 'A', N, D3, D4, VL, VU, IL, IU, ABSTOL, 890 $ M2, WA2, Z, LDU, WORK, IWORK, 891 $ IWORK( 5*N+1 ), IINFO ) 892 IF( IINFO.NE.0 ) THEN 893 WRITE( NOUNIT, FMT = 9999 )'DSTEVX(N,A)', IINFO, N, 894 $ JTYPE, IOLDSD 895 INFO = ABS( IINFO ) 896 IF( IINFO.LT.0 ) THEN 897 RETURN 898 ELSE 899 RESULT( 6 ) = ULPINV 900 GO TO 250 901 END IF 902 END IF 903* 904* Do test 6. 905* 906 TEMP1 = ZERO 907 TEMP2 = ZERO 908 DO 240 J = 1, N 909 TEMP1 = MAX( TEMP1, ABS( WA2( J ) ), 910 $ ABS( EVEIGS( J ) ) ) 911 TEMP2 = MAX( TEMP2, ABS( WA2( J )-EVEIGS( J ) ) ) 912 240 CONTINUE 913 RESULT( 6 ) = TEMP2 / MAX( UNFL, 914 $ ULP*MAX( TEMP1, TEMP2 ) ) 915* 916 250 CONTINUE 917* 918 NTEST = 7 919 DO 260 I = 1, N 920 D1( I ) = DBLE( A( I, I ) ) 921 260 CONTINUE 922 DO 270 I = 1, N - 1 923 D2( I ) = DBLE( A( I+1, I ) ) 924 270 CONTINUE 925 SRNAMT = 'DSTEVR' 926 CALL DSTEVR( 'V', 'A', N, D1, D2, VL, VU, IL, IU, ABSTOL, 927 $ M, WA1, Z, LDU, IWORK, WORK, LWORK, 928 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 929 IF( IINFO.NE.0 ) THEN 930 WRITE( NOUNIT, FMT = 9999 )'DSTEVR(V,A)', IINFO, N, 931 $ JTYPE, IOLDSD 932 INFO = ABS( IINFO ) 933 IF( IINFO.LT.0 ) THEN 934 RETURN 935 ELSE 936 RESULT( 7 ) = ULPINV 937 RESULT( 8 ) = ULPINV 938 GO TO 320 939 END IF 940 END IF 941 IF( N.GT.0 ) THEN 942 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 943 ELSE 944 TEMP3 = ZERO 945 END IF 946* 947* Do tests 7 and 8. 948* 949 DO 280 I = 1, N 950 D3( I ) = DBLE( A( I, I ) ) 951 280 CONTINUE 952 DO 290 I = 1, N - 1 953 D4( I ) = DBLE( A( I+1, I ) ) 954 290 CONTINUE 955 CALL DSTT21( N, 0, D3, D4, WA1, D2, Z, LDU, WORK, 956 $ RESULT( 7 ) ) 957* 958 NTEST = 9 959 DO 300 I = 1, N - 1 960 D4( I ) = DBLE( A( I+1, I ) ) 961 300 CONTINUE 962 SRNAMT = 'DSTEVR' 963 CALL DSTEVR( 'N', 'A', N, D3, D4, VL, VU, IL, IU, ABSTOL, 964 $ M2, WA2, Z, LDU, IWORK, WORK, LWORK, 965 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 966 IF( IINFO.NE.0 ) THEN 967 WRITE( NOUNIT, FMT = 9999 )'DSTEVR(N,A)', IINFO, N, 968 $ JTYPE, IOLDSD 969 INFO = ABS( IINFO ) 970 IF( IINFO.LT.0 ) THEN 971 RETURN 972 ELSE 973 RESULT( 9 ) = ULPINV 974 GO TO 320 975 END IF 976 END IF 977* 978* Do test 9. 979* 980 TEMP1 = ZERO 981 TEMP2 = ZERO 982 DO 310 J = 1, N 983 TEMP1 = MAX( TEMP1, ABS( WA2( J ) ), 984 $ ABS( EVEIGS( J ) ) ) 985 TEMP2 = MAX( TEMP2, ABS( WA2( J )-EVEIGS( J ) ) ) 986 310 CONTINUE 987 RESULT( 9 ) = TEMP2 / MAX( UNFL, 988 $ ULP*MAX( TEMP1, TEMP2 ) ) 989* 990 320 CONTINUE 991* 992* 993 NTEST = 10 994 DO 330 I = 1, N 995 D1( I ) = DBLE( A( I, I ) ) 996 330 CONTINUE 997 DO 340 I = 1, N - 1 998 D2( I ) = DBLE( A( I+1, I ) ) 999 340 CONTINUE 1000 SRNAMT = 'DSTEVX' 1001 CALL DSTEVX( 'V', 'I', N, D1, D2, VL, VU, IL, IU, ABSTOL, 1002 $ M2, WA2, Z, LDU, WORK, IWORK, 1003 $ IWORK( 5*N+1 ), IINFO ) 1004 IF( IINFO.NE.0 ) THEN 1005 WRITE( NOUNIT, FMT = 9999 )'DSTEVX(V,I)', IINFO, N, 1006 $ JTYPE, IOLDSD 1007 INFO = ABS( IINFO ) 1008 IF( IINFO.LT.0 ) THEN 1009 RETURN 1010 ELSE 1011 RESULT( 10 ) = ULPINV 1012 RESULT( 11 ) = ULPINV 1013 RESULT( 12 ) = ULPINV 1014 GO TO 380 1015 END IF 1016 END IF 1017* 1018* Do tests 10 and 11. 1019* 1020 DO 350 I = 1, N 1021 D3( I ) = DBLE( A( I, I ) ) 1022 350 CONTINUE 1023 DO 360 I = 1, N - 1 1024 D4( I ) = DBLE( A( I+1, I ) ) 1025 360 CONTINUE 1026 CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK, 1027 $ MAX( 1, M2 ), RESULT( 10 ) ) 1028* 1029* 1030 NTEST = 12 1031 DO 370 I = 1, N - 1 1032 D4( I ) = DBLE( A( I+1, I ) ) 1033 370 CONTINUE 1034 SRNAMT = 'DSTEVX' 1035 CALL DSTEVX( 'N', 'I', N, D3, D4, VL, VU, IL, IU, ABSTOL, 1036 $ M3, WA3, Z, LDU, WORK, IWORK, 1037 $ IWORK( 5*N+1 ), IINFO ) 1038 IF( IINFO.NE.0 ) THEN 1039 WRITE( NOUNIT, FMT = 9999 )'DSTEVX(N,I)', IINFO, N, 1040 $ JTYPE, IOLDSD 1041 INFO = ABS( IINFO ) 1042 IF( IINFO.LT.0 ) THEN 1043 RETURN 1044 ELSE 1045 RESULT( 12 ) = ULPINV 1046 GO TO 380 1047 END IF 1048 END IF 1049* 1050* Do test 12. 1051* 1052 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1053 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1054 RESULT( 12 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, ULP*TEMP3 ) 1055* 1056 380 CONTINUE 1057* 1058 NTEST = 12 1059 IF( N.GT.0 ) THEN 1060 IF( IL.NE.1 ) THEN 1061 VL = WA1( IL ) - MAX( HALF* 1062 $ ( WA1( IL )-WA1( IL-1 ) ), TEN*ULP*TEMP3, 1063 $ TEN*RTUNFL ) 1064 ELSE 1065 VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ), 1066 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1067 END IF 1068 IF( IU.NE.N ) THEN 1069 VU = WA1( IU ) + MAX( HALF* 1070 $ ( WA1( IU+1 )-WA1( IU ) ), TEN*ULP*TEMP3, 1071 $ TEN*RTUNFL ) 1072 ELSE 1073 VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ), 1074 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1075 END IF 1076 ELSE 1077 VL = ZERO 1078 VU = ONE 1079 END IF 1080* 1081 DO 390 I = 1, N 1082 D1( I ) = DBLE( A( I, I ) ) 1083 390 CONTINUE 1084 DO 400 I = 1, N - 1 1085 D2( I ) = DBLE( A( I+1, I ) ) 1086 400 CONTINUE 1087 SRNAMT = 'DSTEVX' 1088 CALL DSTEVX( 'V', 'V', N, D1, D2, VL, VU, IL, IU, ABSTOL, 1089 $ M2, WA2, Z, LDU, WORK, IWORK, 1090 $ IWORK( 5*N+1 ), IINFO ) 1091 IF( IINFO.NE.0 ) THEN 1092 WRITE( NOUNIT, FMT = 9999 )'DSTEVX(V,V)', IINFO, N, 1093 $ JTYPE, IOLDSD 1094 INFO = ABS( IINFO ) 1095 IF( IINFO.LT.0 ) THEN 1096 RETURN 1097 ELSE 1098 RESULT( 13 ) = ULPINV 1099 RESULT( 14 ) = ULPINV 1100 RESULT( 15 ) = ULPINV 1101 GO TO 440 1102 END IF 1103 END IF 1104* 1105 IF( M2.EQ.0 .AND. N.GT.0 ) THEN 1106 RESULT( 13 ) = ULPINV 1107 RESULT( 14 ) = ULPINV 1108 RESULT( 15 ) = ULPINV 1109 GO TO 440 1110 END IF 1111* 1112* Do tests 13 and 14. 1113* 1114 DO 410 I = 1, N 1115 D3( I ) = DBLE( A( I, I ) ) 1116 410 CONTINUE 1117 DO 420 I = 1, N - 1 1118 D4( I ) = DBLE( A( I+1, I ) ) 1119 420 CONTINUE 1120 CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK, 1121 $ MAX( 1, M2 ), RESULT( 13 ) ) 1122* 1123 NTEST = 15 1124 DO 430 I = 1, N - 1 1125 D4( I ) = DBLE( A( I+1, I ) ) 1126 430 CONTINUE 1127 SRNAMT = 'DSTEVX' 1128 CALL DSTEVX( 'N', 'V', N, D3, D4, VL, VU, IL, IU, ABSTOL, 1129 $ M3, WA3, Z, LDU, WORK, IWORK, 1130 $ IWORK( 5*N+1 ), IINFO ) 1131 IF( IINFO.NE.0 ) THEN 1132 WRITE( NOUNIT, FMT = 9999 )'DSTEVX(N,V)', IINFO, N, 1133 $ JTYPE, IOLDSD 1134 INFO = ABS( IINFO ) 1135 IF( IINFO.LT.0 ) THEN 1136 RETURN 1137 ELSE 1138 RESULT( 15 ) = ULPINV 1139 GO TO 440 1140 END IF 1141 END IF 1142* 1143* Do test 15. 1144* 1145 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1146 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1147 RESULT( 15 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP ) 1148* 1149 440 CONTINUE 1150* 1151 NTEST = 16 1152 DO 450 I = 1, N 1153 D1( I ) = DBLE( A( I, I ) ) 1154 450 CONTINUE 1155 DO 460 I = 1, N - 1 1156 D2( I ) = DBLE( A( I+1, I ) ) 1157 460 CONTINUE 1158 SRNAMT = 'DSTEVD' 1159 CALL DSTEVD( 'V', N, D1, D2, Z, LDU, WORK, LWEDC, IWORK, 1160 $ LIWEDC, IINFO ) 1161 IF( IINFO.NE.0 ) THEN 1162 WRITE( NOUNIT, FMT = 9999 )'DSTEVD(V)', IINFO, N, 1163 $ JTYPE, IOLDSD 1164 INFO = ABS( IINFO ) 1165 IF( IINFO.LT.0 ) THEN 1166 RETURN 1167 ELSE 1168 RESULT( 16 ) = ULPINV 1169 RESULT( 17 ) = ULPINV 1170 RESULT( 18 ) = ULPINV 1171 GO TO 510 1172 END IF 1173 END IF 1174* 1175* Do tests 16 and 17. 1176* 1177 DO 470 I = 1, N 1178 D3( I ) = DBLE( A( I, I ) ) 1179 470 CONTINUE 1180 DO 480 I = 1, N - 1 1181 D4( I ) = DBLE( A( I+1, I ) ) 1182 480 CONTINUE 1183 CALL DSTT21( N, 0, D3, D4, D1, D2, Z, LDU, WORK, 1184 $ RESULT( 16 ) ) 1185* 1186 NTEST = 18 1187 DO 490 I = 1, N - 1 1188 D4( I ) = DBLE( A( I+1, I ) ) 1189 490 CONTINUE 1190 SRNAMT = 'DSTEVD' 1191 CALL DSTEVD( 'N', N, D3, D4, Z, LDU, WORK, LWEDC, IWORK, 1192 $ LIWEDC, IINFO ) 1193 IF( IINFO.NE.0 ) THEN 1194 WRITE( NOUNIT, FMT = 9999 )'DSTEVD(N)', IINFO, N, 1195 $ JTYPE, IOLDSD 1196 INFO = ABS( IINFO ) 1197 IF( IINFO.LT.0 ) THEN 1198 RETURN 1199 ELSE 1200 RESULT( 18 ) = ULPINV 1201 GO TO 510 1202 END IF 1203 END IF 1204* 1205* Do test 18. 1206* 1207 TEMP1 = ZERO 1208 TEMP2 = ZERO 1209 DO 500 J = 1, N 1210 TEMP1 = MAX( TEMP1, ABS( EVEIGS( J ) ), 1211 $ ABS( D3( J ) ) ) 1212 TEMP2 = MAX( TEMP2, ABS( EVEIGS( J )-D3( J ) ) ) 1213 500 CONTINUE 1214 RESULT( 18 ) = TEMP2 / MAX( UNFL, 1215 $ ULP*MAX( TEMP1, TEMP2 ) ) 1216* 1217 510 CONTINUE 1218* 1219 NTEST = 19 1220 DO 520 I = 1, N 1221 D1( I ) = DBLE( A( I, I ) ) 1222 520 CONTINUE 1223 DO 530 I = 1, N - 1 1224 D2( I ) = DBLE( A( I+1, I ) ) 1225 530 CONTINUE 1226 SRNAMT = 'DSTEVR' 1227 CALL DSTEVR( 'V', 'I', N, D1, D2, VL, VU, IL, IU, ABSTOL, 1228 $ M2, WA2, Z, LDU, IWORK, WORK, LWORK, 1229 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 1230 IF( IINFO.NE.0 ) THEN 1231 WRITE( NOUNIT, FMT = 9999 )'DSTEVR(V,I)', IINFO, N, 1232 $ JTYPE, IOLDSD 1233 INFO = ABS( IINFO ) 1234 IF( IINFO.LT.0 ) THEN 1235 RETURN 1236 ELSE 1237 RESULT( 19 ) = ULPINV 1238 RESULT( 20 ) = ULPINV 1239 RESULT( 21 ) = ULPINV 1240 GO TO 570 1241 END IF 1242 END IF 1243* 1244* DO tests 19 and 20. 1245* 1246 DO 540 I = 1, N 1247 D3( I ) = DBLE( A( I, I ) ) 1248 540 CONTINUE 1249 DO 550 I = 1, N - 1 1250 D4( I ) = DBLE( A( I+1, I ) ) 1251 550 CONTINUE 1252 CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK, 1253 $ MAX( 1, M2 ), RESULT( 19 ) ) 1254* 1255* 1256 NTEST = 21 1257 DO 560 I = 1, N - 1 1258 D4( I ) = DBLE( A( I+1, I ) ) 1259 560 CONTINUE 1260 SRNAMT = 'DSTEVR' 1261 CALL DSTEVR( 'N', 'I', N, D3, D4, VL, VU, IL, IU, ABSTOL, 1262 $ M3, WA3, Z, LDU, IWORK, WORK, LWORK, 1263 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 1264 IF( IINFO.NE.0 ) THEN 1265 WRITE( NOUNIT, FMT = 9999 )'DSTEVR(N,I)', IINFO, N, 1266 $ JTYPE, IOLDSD 1267 INFO = ABS( IINFO ) 1268 IF( IINFO.LT.0 ) THEN 1269 RETURN 1270 ELSE 1271 RESULT( 21 ) = ULPINV 1272 GO TO 570 1273 END IF 1274 END IF 1275* 1276* Do test 21. 1277* 1278 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1279 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1280 RESULT( 21 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, ULP*TEMP3 ) 1281* 1282 570 CONTINUE 1283* 1284 NTEST = 21 1285 IF( N.GT.0 ) THEN 1286 IF( IL.NE.1 ) THEN 1287 VL = WA1( IL ) - MAX( HALF* 1288 $ ( WA1( IL )-WA1( IL-1 ) ), TEN*ULP*TEMP3, 1289 $ TEN*RTUNFL ) 1290 ELSE 1291 VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ), 1292 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1293 END IF 1294 IF( IU.NE.N ) THEN 1295 VU = WA1( IU ) + MAX( HALF* 1296 $ ( WA1( IU+1 )-WA1( IU ) ), TEN*ULP*TEMP3, 1297 $ TEN*RTUNFL ) 1298 ELSE 1299 VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ), 1300 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1301 END IF 1302 ELSE 1303 VL = ZERO 1304 VU = ONE 1305 END IF 1306* 1307 DO 580 I = 1, N 1308 D1( I ) = DBLE( A( I, I ) ) 1309 580 CONTINUE 1310 DO 590 I = 1, N - 1 1311 D2( I ) = DBLE( A( I+1, I ) ) 1312 590 CONTINUE 1313 SRNAMT = 'DSTEVR' 1314 CALL DSTEVR( 'V', 'V', N, D1, D2, VL, VU, IL, IU, ABSTOL, 1315 $ M2, WA2, Z, LDU, IWORK, WORK, LWORK, 1316 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 1317 IF( IINFO.NE.0 ) THEN 1318 WRITE( NOUNIT, FMT = 9999 )'DSTEVR(V,V)', IINFO, N, 1319 $ JTYPE, IOLDSD 1320 INFO = ABS( IINFO ) 1321 IF( IINFO.LT.0 ) THEN 1322 RETURN 1323 ELSE 1324 RESULT( 22 ) = ULPINV 1325 RESULT( 23 ) = ULPINV 1326 RESULT( 24 ) = ULPINV 1327 GO TO 630 1328 END IF 1329 END IF 1330* 1331 IF( M2.EQ.0 .AND. N.GT.0 ) THEN 1332 RESULT( 22 ) = ULPINV 1333 RESULT( 23 ) = ULPINV 1334 RESULT( 24 ) = ULPINV 1335 GO TO 630 1336 END IF 1337* 1338* Do tests 22 and 23. 1339* 1340 DO 600 I = 1, N 1341 D3( I ) = DBLE( A( I, I ) ) 1342 600 CONTINUE 1343 DO 610 I = 1, N - 1 1344 D4( I ) = DBLE( A( I+1, I ) ) 1345 610 CONTINUE 1346 CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK, 1347 $ MAX( 1, M2 ), RESULT( 22 ) ) 1348* 1349 NTEST = 24 1350 DO 620 I = 1, N - 1 1351 D4( I ) = DBLE( A( I+1, I ) ) 1352 620 CONTINUE 1353 SRNAMT = 'DSTEVR' 1354 CALL DSTEVR( 'N', 'V', N, D3, D4, VL, VU, IL, IU, ABSTOL, 1355 $ M3, WA3, Z, LDU, IWORK, WORK, LWORK, 1356 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 1357 IF( IINFO.NE.0 ) THEN 1358 WRITE( NOUNIT, FMT = 9999 )'DSTEVR(N,V)', IINFO, N, 1359 $ JTYPE, IOLDSD 1360 INFO = ABS( IINFO ) 1361 IF( IINFO.LT.0 ) THEN 1362 RETURN 1363 ELSE 1364 RESULT( 24 ) = ULPINV 1365 GO TO 630 1366 END IF 1367 END IF 1368* 1369* Do test 24. 1370* 1371 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1372 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1373 RESULT( 24 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP ) 1374* 1375 630 CONTINUE 1376* 1377* 1378* 1379 ELSE 1380* 1381 DO 640 I = 1, 24 1382 RESULT( I ) = ZERO 1383 640 CONTINUE 1384 NTEST = 24 1385 END IF 1386* 1387* Perform remaining tests storing upper or lower triangular 1388* part of matrix. 1389* 1390 DO 1720 IUPLO = 0, 1 1391 IF( IUPLO.EQ.0 ) THEN 1392 UPLO = 'L' 1393 ELSE 1394 UPLO = 'U' 1395 END IF 1396* 1397* 4) Call DSYEV and DSYEVX. 1398* 1399 CALL DLACPY( ' ', N, N, A, LDA, V, LDU ) 1400* 1401 NTEST = NTEST + 1 1402 SRNAMT = 'DSYEV' 1403 CALL DSYEV( 'V', UPLO, N, A, LDU, D1, WORK, LWORK, 1404 $ IINFO ) 1405 IF( IINFO.NE.0 ) THEN 1406 WRITE( NOUNIT, FMT = 9999 )'DSYEV(V,' // UPLO // ')', 1407 $ IINFO, N, JTYPE, IOLDSD 1408 INFO = ABS( IINFO ) 1409 IF( IINFO.LT.0 ) THEN 1410 RETURN 1411 ELSE 1412 RESULT( NTEST ) = ULPINV 1413 RESULT( NTEST+1 ) = ULPINV 1414 RESULT( NTEST+2 ) = ULPINV 1415 GO TO 660 1416 END IF 1417 END IF 1418* 1419* Do tests 25 and 26 (or +54) 1420* 1421 CALL DSYT21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z, 1422 $ LDU, TAU, WORK, RESULT( NTEST ) ) 1423* 1424 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1425* 1426 NTEST = NTEST + 2 1427 SRNAMT = 'DSYEV' 1428 CALL DSYEV( 'N', UPLO, N, A, LDU, D3, WORK, LWORK, 1429 $ IINFO ) 1430 IF( IINFO.NE.0 ) THEN 1431 WRITE( NOUNIT, FMT = 9999 )'DSYEV(N,' // UPLO // ')', 1432 $ IINFO, N, JTYPE, IOLDSD 1433 INFO = ABS( IINFO ) 1434 IF( IINFO.LT.0 ) THEN 1435 RETURN 1436 ELSE 1437 RESULT( NTEST ) = ULPINV 1438 GO TO 660 1439 END IF 1440 END IF 1441* 1442* Do test 27 (or +54) 1443* 1444 TEMP1 = ZERO 1445 TEMP2 = ZERO 1446 DO 650 J = 1, N 1447 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 1448 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 1449 650 CONTINUE 1450 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1451 $ ULP*MAX( TEMP1, TEMP2 ) ) 1452* 1453 660 CONTINUE 1454 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1455* 1456 NTEST = NTEST + 1 1457* 1458 IF( N.GT.0 ) THEN 1459 TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) ) 1460 IF( IL.NE.1 ) THEN 1461 VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ), 1462 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1463 ELSE IF( N.GT.0 ) THEN 1464 VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ), 1465 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1466 END IF 1467 IF( IU.NE.N ) THEN 1468 VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ), 1469 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1470 ELSE IF( N.GT.0 ) THEN 1471 VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ), 1472 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1473 END IF 1474 ELSE 1475 TEMP3 = ZERO 1476 VL = ZERO 1477 VU = ONE 1478 END IF 1479* 1480 SRNAMT = 'DSYEVX' 1481 CALL DSYEVX( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 1482 $ ABSTOL, M, WA1, Z, LDU, WORK, LWORK, IWORK, 1483 $ IWORK( 5*N+1 ), IINFO ) 1484 IF( IINFO.NE.0 ) THEN 1485 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,A,' // UPLO // 1486 $ ')', IINFO, N, JTYPE, IOLDSD 1487 INFO = ABS( IINFO ) 1488 IF( IINFO.LT.0 ) THEN 1489 RETURN 1490 ELSE 1491 RESULT( NTEST ) = ULPINV 1492 RESULT( NTEST+1 ) = ULPINV 1493 RESULT( NTEST+2 ) = ULPINV 1494 GO TO 680 1495 END IF 1496 END IF 1497* 1498* Do tests 28 and 29 (or +54) 1499* 1500 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1501* 1502 CALL DSYT21( 1, UPLO, N, 0, A, LDU, D1, D2, Z, LDU, V, 1503 $ LDU, TAU, WORK, RESULT( NTEST ) ) 1504* 1505 NTEST = NTEST + 2 1506 SRNAMT = 'DSYEVX' 1507 CALL DSYEVX( 'N', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 1508 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK, 1509 $ IWORK( 5*N+1 ), IINFO ) 1510 IF( IINFO.NE.0 ) THEN 1511 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(N,A,' // UPLO // 1512 $ ')', IINFO, N, JTYPE, IOLDSD 1513 INFO = ABS( IINFO ) 1514 IF( IINFO.LT.0 ) THEN 1515 RETURN 1516 ELSE 1517 RESULT( NTEST ) = ULPINV 1518 GO TO 680 1519 END IF 1520 END IF 1521* 1522* Do test 30 (or +54) 1523* 1524 TEMP1 = ZERO 1525 TEMP2 = ZERO 1526 DO 670 J = 1, N 1527 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 1528 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 1529 670 CONTINUE 1530 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1531 $ ULP*MAX( TEMP1, TEMP2 ) ) 1532* 1533 680 CONTINUE 1534* 1535 NTEST = NTEST + 1 1536 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1537 SRNAMT = 'DSYEVX' 1538 CALL DSYEVX( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 1539 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK, 1540 $ IWORK( 5*N+1 ), IINFO ) 1541 IF( IINFO.NE.0 ) THEN 1542 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,I,' // UPLO // 1543 $ ')', IINFO, N, JTYPE, IOLDSD 1544 INFO = ABS( IINFO ) 1545 IF( IINFO.LT.0 ) THEN 1546 RETURN 1547 ELSE 1548 RESULT( NTEST ) = ULPINV 1549 RESULT( NTEST+1 ) = ULPINV 1550 RESULT( NTEST+2 ) = ULPINV 1551 GO TO 690 1552 END IF 1553 END IF 1554* 1555* Do tests 31 and 32 (or +54) 1556* 1557 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1558* 1559 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1560 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 1561* 1562 NTEST = NTEST + 2 1563 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1564 SRNAMT = 'DSYEVX' 1565 CALL DSYEVX( 'N', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 1566 $ ABSTOL, M3, WA3, Z, LDU, WORK, LWORK, IWORK, 1567 $ IWORK( 5*N+1 ), IINFO ) 1568 IF( IINFO.NE.0 ) THEN 1569 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(N,I,' // UPLO // 1570 $ ')', IINFO, N, JTYPE, IOLDSD 1571 INFO = ABS( IINFO ) 1572 IF( IINFO.LT.0 ) THEN 1573 RETURN 1574 ELSE 1575 RESULT( NTEST ) = ULPINV 1576 GO TO 690 1577 END IF 1578 END IF 1579* 1580* Do test 33 (or +54) 1581* 1582 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1583 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1584 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1585 $ MAX( UNFL, ULP*TEMP3 ) 1586 690 CONTINUE 1587* 1588 NTEST = NTEST + 1 1589 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1590 SRNAMT = 'DSYEVX' 1591 CALL DSYEVX( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 1592 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK, 1593 $ IWORK( 5*N+1 ), IINFO ) 1594 IF( IINFO.NE.0 ) THEN 1595 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,V,' // UPLO // 1596 $ ')', IINFO, N, JTYPE, IOLDSD 1597 INFO = ABS( IINFO ) 1598 IF( IINFO.LT.0 ) THEN 1599 RETURN 1600 ELSE 1601 RESULT( NTEST ) = ULPINV 1602 RESULT( NTEST+1 ) = ULPINV 1603 RESULT( NTEST+2 ) = ULPINV 1604 GO TO 700 1605 END IF 1606 END IF 1607* 1608* Do tests 34 and 35 (or +54) 1609* 1610 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1611* 1612 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1613 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 1614* 1615 NTEST = NTEST + 2 1616 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1617 SRNAMT = 'DSYEVX' 1618 CALL DSYEVX( 'N', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 1619 $ ABSTOL, M3, WA3, Z, LDU, WORK, LWORK, IWORK, 1620 $ IWORK( 5*N+1 ), IINFO ) 1621 IF( IINFO.NE.0 ) THEN 1622 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(N,V,' // UPLO // 1623 $ ')', IINFO, N, JTYPE, IOLDSD 1624 INFO = ABS( IINFO ) 1625 IF( IINFO.LT.0 ) THEN 1626 RETURN 1627 ELSE 1628 RESULT( NTEST ) = ULPINV 1629 GO TO 700 1630 END IF 1631 END IF 1632* 1633 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 1634 RESULT( NTEST ) = ULPINV 1635 GO TO 700 1636 END IF 1637* 1638* Do test 36 (or +54) 1639* 1640 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1641 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1642 IF( N.GT.0 ) THEN 1643 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 1644 ELSE 1645 TEMP3 = ZERO 1646 END IF 1647 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1648 $ MAX( UNFL, TEMP3*ULP ) 1649* 1650 700 CONTINUE 1651* 1652* 5) Call DSPEV and DSPEVX. 1653* 1654 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1655* 1656* Load array WORK with the upper or lower triangular 1657* part of the matrix in packed form. 1658* 1659 IF( IUPLO.EQ.1 ) THEN 1660 INDX = 1 1661 DO 720 J = 1, N 1662 DO 710 I = 1, J 1663 WORK( INDX ) = A( I, J ) 1664 INDX = INDX + 1 1665 710 CONTINUE 1666 720 CONTINUE 1667 ELSE 1668 INDX = 1 1669 DO 740 J = 1, N 1670 DO 730 I = J, N 1671 WORK( INDX ) = A( I, J ) 1672 INDX = INDX + 1 1673 730 CONTINUE 1674 740 CONTINUE 1675 END IF 1676* 1677 NTEST = NTEST + 1 1678 SRNAMT = 'DSPEV' 1679 CALL DSPEV( 'V', UPLO, N, WORK, D1, Z, LDU, V, IINFO ) 1680 IF( IINFO.NE.0 ) THEN 1681 WRITE( NOUNIT, FMT = 9999 )'DSPEV(V,' // UPLO // ')', 1682 $ IINFO, N, JTYPE, IOLDSD 1683 INFO = ABS( IINFO ) 1684 IF( IINFO.LT.0 ) THEN 1685 RETURN 1686 ELSE 1687 RESULT( NTEST ) = ULPINV 1688 RESULT( NTEST+1 ) = ULPINV 1689 RESULT( NTEST+2 ) = ULPINV 1690 GO TO 800 1691 END IF 1692 END IF 1693* 1694* Do tests 37 and 38 (or +54) 1695* 1696 CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 1697 $ LDU, TAU, WORK, RESULT( NTEST ) ) 1698* 1699 IF( IUPLO.EQ.1 ) THEN 1700 INDX = 1 1701 DO 760 J = 1, N 1702 DO 750 I = 1, J 1703 WORK( INDX ) = A( I, J ) 1704 INDX = INDX + 1 1705 750 CONTINUE 1706 760 CONTINUE 1707 ELSE 1708 INDX = 1 1709 DO 780 J = 1, N 1710 DO 770 I = J, N 1711 WORK( INDX ) = A( I, J ) 1712 INDX = INDX + 1 1713 770 CONTINUE 1714 780 CONTINUE 1715 END IF 1716* 1717 NTEST = NTEST + 2 1718 SRNAMT = 'DSPEV' 1719 CALL DSPEV( 'N', UPLO, N, WORK, D3, Z, LDU, V, IINFO ) 1720 IF( IINFO.NE.0 ) THEN 1721 WRITE( NOUNIT, FMT = 9999 )'DSPEV(N,' // UPLO // ')', 1722 $ IINFO, N, JTYPE, IOLDSD 1723 INFO = ABS( IINFO ) 1724 IF( IINFO.LT.0 ) THEN 1725 RETURN 1726 ELSE 1727 RESULT( NTEST ) = ULPINV 1728 GO TO 800 1729 END IF 1730 END IF 1731* 1732* Do test 39 (or +54) 1733* 1734 TEMP1 = ZERO 1735 TEMP2 = ZERO 1736 DO 790 J = 1, N 1737 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 1738 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 1739 790 CONTINUE 1740 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1741 $ ULP*MAX( TEMP1, TEMP2 ) ) 1742* 1743* Load array WORK with the upper or lower triangular part 1744* of the matrix in packed form. 1745* 1746 800 CONTINUE 1747 IF( IUPLO.EQ.1 ) THEN 1748 INDX = 1 1749 DO 820 J = 1, N 1750 DO 810 I = 1, J 1751 WORK( INDX ) = A( I, J ) 1752 INDX = INDX + 1 1753 810 CONTINUE 1754 820 CONTINUE 1755 ELSE 1756 INDX = 1 1757 DO 840 J = 1, N 1758 DO 830 I = J, N 1759 WORK( INDX ) = A( I, J ) 1760 INDX = INDX + 1 1761 830 CONTINUE 1762 840 CONTINUE 1763 END IF 1764* 1765 NTEST = NTEST + 1 1766* 1767 IF( N.GT.0 ) THEN 1768 TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) ) 1769 IF( IL.NE.1 ) THEN 1770 VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ), 1771 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1772 ELSE IF( N.GT.0 ) THEN 1773 VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ), 1774 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1775 END IF 1776 IF( IU.NE.N ) THEN 1777 VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ), 1778 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1779 ELSE IF( N.GT.0 ) THEN 1780 VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ), 1781 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1782 END IF 1783 ELSE 1784 TEMP3 = ZERO 1785 VL = ZERO 1786 VU = ONE 1787 END IF 1788* 1789 SRNAMT = 'DSPEVX' 1790 CALL DSPEVX( 'V', 'A', UPLO, N, WORK, VL, VU, IL, IU, 1791 $ ABSTOL, M, WA1, Z, LDU, V, IWORK, 1792 $ IWORK( 5*N+1 ), IINFO ) 1793 IF( IINFO.NE.0 ) THEN 1794 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,A,' // UPLO // 1795 $ ')', IINFO, N, JTYPE, IOLDSD 1796 INFO = ABS( IINFO ) 1797 IF( IINFO.LT.0 ) THEN 1798 RETURN 1799 ELSE 1800 RESULT( NTEST ) = ULPINV 1801 RESULT( NTEST+1 ) = ULPINV 1802 RESULT( NTEST+2 ) = ULPINV 1803 GO TO 900 1804 END IF 1805 END IF 1806* 1807* Do tests 40 and 41 (or +54) 1808* 1809 CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 1810 $ LDU, TAU, WORK, RESULT( NTEST ) ) 1811* 1812 NTEST = NTEST + 2 1813* 1814 IF( IUPLO.EQ.1 ) THEN 1815 INDX = 1 1816 DO 860 J = 1, N 1817 DO 850 I = 1, J 1818 WORK( INDX ) = A( I, J ) 1819 INDX = INDX + 1 1820 850 CONTINUE 1821 860 CONTINUE 1822 ELSE 1823 INDX = 1 1824 DO 880 J = 1, N 1825 DO 870 I = J, N 1826 WORK( INDX ) = A( I, J ) 1827 INDX = INDX + 1 1828 870 CONTINUE 1829 880 CONTINUE 1830 END IF 1831* 1832 SRNAMT = 'DSPEVX' 1833 CALL DSPEVX( 'N', 'A', UPLO, N, WORK, VL, VU, IL, IU, 1834 $ ABSTOL, M2, WA2, Z, LDU, V, IWORK, 1835 $ IWORK( 5*N+1 ), IINFO ) 1836 IF( IINFO.NE.0 ) THEN 1837 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,A,' // UPLO // 1838 $ ')', IINFO, N, JTYPE, IOLDSD 1839 INFO = ABS( IINFO ) 1840 IF( IINFO.LT.0 ) THEN 1841 RETURN 1842 ELSE 1843 RESULT( NTEST ) = ULPINV 1844 GO TO 900 1845 END IF 1846 END IF 1847* 1848* Do test 42 (or +54) 1849* 1850 TEMP1 = ZERO 1851 TEMP2 = ZERO 1852 DO 890 J = 1, N 1853 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 1854 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 1855 890 CONTINUE 1856 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1857 $ ULP*MAX( TEMP1, TEMP2 ) ) 1858* 1859 900 CONTINUE 1860 IF( IUPLO.EQ.1 ) THEN 1861 INDX = 1 1862 DO 920 J = 1, N 1863 DO 910 I = 1, J 1864 WORK( INDX ) = A( I, J ) 1865 INDX = INDX + 1 1866 910 CONTINUE 1867 920 CONTINUE 1868 ELSE 1869 INDX = 1 1870 DO 940 J = 1, N 1871 DO 930 I = J, N 1872 WORK( INDX ) = A( I, J ) 1873 INDX = INDX + 1 1874 930 CONTINUE 1875 940 CONTINUE 1876 END IF 1877* 1878 NTEST = NTEST + 1 1879* 1880 SRNAMT = 'DSPEVX' 1881 CALL DSPEVX( 'V', 'I', UPLO, N, WORK, VL, VU, IL, IU, 1882 $ ABSTOL, M2, WA2, Z, LDU, V, IWORK, 1883 $ IWORK( 5*N+1 ), IINFO ) 1884 IF( IINFO.NE.0 ) THEN 1885 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,I,' // UPLO // 1886 $ ')', IINFO, N, JTYPE, IOLDSD 1887 INFO = ABS( IINFO ) 1888 IF( IINFO.LT.0 ) THEN 1889 RETURN 1890 ELSE 1891 RESULT( NTEST ) = ULPINV 1892 RESULT( NTEST+1 ) = ULPINV 1893 RESULT( NTEST+2 ) = ULPINV 1894 GO TO 990 1895 END IF 1896 END IF 1897* 1898* Do tests 43 and 44 (or +54) 1899* 1900 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1901 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 1902* 1903 NTEST = NTEST + 2 1904* 1905 IF( IUPLO.EQ.1 ) THEN 1906 INDX = 1 1907 DO 960 J = 1, N 1908 DO 950 I = 1, J 1909 WORK( INDX ) = A( I, J ) 1910 INDX = INDX + 1 1911 950 CONTINUE 1912 960 CONTINUE 1913 ELSE 1914 INDX = 1 1915 DO 980 J = 1, N 1916 DO 970 I = J, N 1917 WORK( INDX ) = A( I, J ) 1918 INDX = INDX + 1 1919 970 CONTINUE 1920 980 CONTINUE 1921 END IF 1922* 1923 SRNAMT = 'DSPEVX' 1924 CALL DSPEVX( 'N', 'I', UPLO, N, WORK, VL, VU, IL, IU, 1925 $ ABSTOL, M3, WA3, Z, LDU, V, IWORK, 1926 $ IWORK( 5*N+1 ), IINFO ) 1927 IF( IINFO.NE.0 ) THEN 1928 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,I,' // UPLO // 1929 $ ')', IINFO, N, JTYPE, IOLDSD 1930 INFO = ABS( IINFO ) 1931 IF( IINFO.LT.0 ) THEN 1932 RETURN 1933 ELSE 1934 RESULT( NTEST ) = ULPINV 1935 GO TO 990 1936 END IF 1937 END IF 1938* 1939 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 1940 RESULT( NTEST ) = ULPINV 1941 GO TO 990 1942 END IF 1943* 1944* Do test 45 (or +54) 1945* 1946 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1947 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1948 IF( N.GT.0 ) THEN 1949 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 1950 ELSE 1951 TEMP3 = ZERO 1952 END IF 1953 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1954 $ MAX( UNFL, TEMP3*ULP ) 1955* 1956 990 CONTINUE 1957 IF( IUPLO.EQ.1 ) THEN 1958 INDX = 1 1959 DO 1010 J = 1, N 1960 DO 1000 I = 1, J 1961 WORK( INDX ) = A( I, J ) 1962 INDX = INDX + 1 1963 1000 CONTINUE 1964 1010 CONTINUE 1965 ELSE 1966 INDX = 1 1967 DO 1030 J = 1, N 1968 DO 1020 I = J, N 1969 WORK( INDX ) = A( I, J ) 1970 INDX = INDX + 1 1971 1020 CONTINUE 1972 1030 CONTINUE 1973 END IF 1974* 1975 NTEST = NTEST + 1 1976* 1977 SRNAMT = 'DSPEVX' 1978 CALL DSPEVX( 'V', 'V', UPLO, N, WORK, VL, VU, IL, IU, 1979 $ ABSTOL, M2, WA2, Z, LDU, V, IWORK, 1980 $ IWORK( 5*N+1 ), IINFO ) 1981 IF( IINFO.NE.0 ) THEN 1982 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,V,' // UPLO // 1983 $ ')', IINFO, N, JTYPE, IOLDSD 1984 INFO = ABS( IINFO ) 1985 IF( IINFO.LT.0 ) THEN 1986 RETURN 1987 ELSE 1988 RESULT( NTEST ) = ULPINV 1989 RESULT( NTEST+1 ) = ULPINV 1990 RESULT( NTEST+2 ) = ULPINV 1991 GO TO 1080 1992 END IF 1993 END IF 1994* 1995* Do tests 46 and 47 (or +54) 1996* 1997 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1998 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 1999* 2000 NTEST = NTEST + 2 2001* 2002 IF( IUPLO.EQ.1 ) THEN 2003 INDX = 1 2004 DO 1050 J = 1, N 2005 DO 1040 I = 1, J 2006 WORK( INDX ) = A( I, J ) 2007 INDX = INDX + 1 2008 1040 CONTINUE 2009 1050 CONTINUE 2010 ELSE 2011 INDX = 1 2012 DO 1070 J = 1, N 2013 DO 1060 I = J, N 2014 WORK( INDX ) = A( I, J ) 2015 INDX = INDX + 1 2016 1060 CONTINUE 2017 1070 CONTINUE 2018 END IF 2019* 2020 SRNAMT = 'DSPEVX' 2021 CALL DSPEVX( 'N', 'V', UPLO, N, WORK, VL, VU, IL, IU, 2022 $ ABSTOL, M3, WA3, Z, LDU, V, IWORK, 2023 $ IWORK( 5*N+1 ), IINFO ) 2024 IF( IINFO.NE.0 ) THEN 2025 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,V,' // UPLO // 2026 $ ')', IINFO, N, JTYPE, IOLDSD 2027 INFO = ABS( IINFO ) 2028 IF( IINFO.LT.0 ) THEN 2029 RETURN 2030 ELSE 2031 RESULT( NTEST ) = ULPINV 2032 GO TO 1080 2033 END IF 2034 END IF 2035* 2036 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 2037 RESULT( NTEST ) = ULPINV 2038 GO TO 1080 2039 END IF 2040* 2041* Do test 48 (or +54) 2042* 2043 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 2044 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 2045 IF( N.GT.0 ) THEN 2046 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 2047 ELSE 2048 TEMP3 = ZERO 2049 END IF 2050 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 2051 $ MAX( UNFL, TEMP3*ULP ) 2052* 2053 1080 CONTINUE 2054* 2055* 6) Call DSBEV and DSBEVX. 2056* 2057 IF( JTYPE.LE.7 ) THEN 2058 KD = 1 2059 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN 2060 KD = MAX( N-1, 0 ) 2061 ELSE 2062 KD = IHBW 2063 END IF 2064* 2065* Load array V with the upper or lower triangular part 2066* of the matrix in band form. 2067* 2068 IF( IUPLO.EQ.1 ) THEN 2069 DO 1100 J = 1, N 2070 DO 1090 I = MAX( 1, J-KD ), J 2071 V( KD+1+I-J, J ) = A( I, J ) 2072 1090 CONTINUE 2073 1100 CONTINUE 2074 ELSE 2075 DO 1120 J = 1, N 2076 DO 1110 I = J, MIN( N, J+KD ) 2077 V( 1+I-J, J ) = A( I, J ) 2078 1110 CONTINUE 2079 1120 CONTINUE 2080 END IF 2081* 2082 NTEST = NTEST + 1 2083 SRNAMT = 'DSBEV' 2084 CALL DSBEV( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK, 2085 $ IINFO ) 2086 IF( IINFO.NE.0 ) THEN 2087 WRITE( NOUNIT, FMT = 9999 )'DSBEV(V,' // UPLO // ')', 2088 $ IINFO, N, JTYPE, IOLDSD 2089 INFO = ABS( IINFO ) 2090 IF( IINFO.LT.0 ) THEN 2091 RETURN 2092 ELSE 2093 RESULT( NTEST ) = ULPINV 2094 RESULT( NTEST+1 ) = ULPINV 2095 RESULT( NTEST+2 ) = ULPINV 2096 GO TO 1180 2097 END IF 2098 END IF 2099* 2100* Do tests 49 and 50 (or ... ) 2101* 2102 CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 2103 $ LDU, TAU, WORK, RESULT( NTEST ) ) 2104* 2105 IF( IUPLO.EQ.1 ) THEN 2106 DO 1140 J = 1, N 2107 DO 1130 I = MAX( 1, J-KD ), J 2108 V( KD+1+I-J, J ) = A( I, J ) 2109 1130 CONTINUE 2110 1140 CONTINUE 2111 ELSE 2112 DO 1160 J = 1, N 2113 DO 1150 I = J, MIN( N, J+KD ) 2114 V( 1+I-J, J ) = A( I, J ) 2115 1150 CONTINUE 2116 1160 CONTINUE 2117 END IF 2118* 2119 NTEST = NTEST + 2 2120 SRNAMT = 'DSBEV' 2121 CALL DSBEV( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, WORK, 2122 $ IINFO ) 2123 IF( IINFO.NE.0 ) THEN 2124 WRITE( NOUNIT, FMT = 9999 )'DSBEV(N,' // UPLO // ')', 2125 $ IINFO, N, JTYPE, IOLDSD 2126 INFO = ABS( IINFO ) 2127 IF( IINFO.LT.0 ) THEN 2128 RETURN 2129 ELSE 2130 RESULT( NTEST ) = ULPINV 2131 GO TO 1180 2132 END IF 2133 END IF 2134* 2135* Do test 51 (or +54) 2136* 2137 TEMP1 = ZERO 2138 TEMP2 = ZERO 2139 DO 1170 J = 1, N 2140 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 2141 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 2142 1170 CONTINUE 2143 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 2144 $ ULP*MAX( TEMP1, TEMP2 ) ) 2145* 2146* Load array V with the upper or lower triangular part 2147* of the matrix in band form. 2148* 2149 1180 CONTINUE 2150 IF( IUPLO.EQ.1 ) THEN 2151 DO 1200 J = 1, N 2152 DO 1190 I = MAX( 1, J-KD ), J 2153 V( KD+1+I-J, J ) = A( I, J ) 2154 1190 CONTINUE 2155 1200 CONTINUE 2156 ELSE 2157 DO 1220 J = 1, N 2158 DO 1210 I = J, MIN( N, J+KD ) 2159 V( 1+I-J, J ) = A( I, J ) 2160 1210 CONTINUE 2161 1220 CONTINUE 2162 END IF 2163* 2164 NTEST = NTEST + 1 2165 SRNAMT = 'DSBEVX' 2166 CALL DSBEVX( 'V', 'A', UPLO, N, KD, V, LDU, U, LDU, VL, 2167 $ VU, IL, IU, ABSTOL, M, WA2, Z, LDU, WORK, 2168 $ IWORK, IWORK( 5*N+1 ), IINFO ) 2169 IF( IINFO.NE.0 ) THEN 2170 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,A,' // UPLO // 2171 $ ')', IINFO, N, JTYPE, IOLDSD 2172 INFO = ABS( IINFO ) 2173 IF( IINFO.LT.0 ) THEN 2174 RETURN 2175 ELSE 2176 RESULT( NTEST ) = ULPINV 2177 RESULT( NTEST+1 ) = ULPINV 2178 RESULT( NTEST+2 ) = ULPINV 2179 GO TO 1280 2180 END IF 2181 END IF 2182* 2183* Do tests 52 and 53 (or +54) 2184* 2185 CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA2, D2, Z, LDU, V, 2186 $ LDU, TAU, WORK, RESULT( NTEST ) ) 2187* 2188 NTEST = NTEST + 2 2189* 2190 IF( IUPLO.EQ.1 ) THEN 2191 DO 1240 J = 1, N 2192 DO 1230 I = MAX( 1, J-KD ), J 2193 V( KD+1+I-J, J ) = A( I, J ) 2194 1230 CONTINUE 2195 1240 CONTINUE 2196 ELSE 2197 DO 1260 J = 1, N 2198 DO 1250 I = J, MIN( N, J+KD ) 2199 V( 1+I-J, J ) = A( I, J ) 2200 1250 CONTINUE 2201 1260 CONTINUE 2202 END IF 2203* 2204 SRNAMT = 'DSBEVX' 2205 CALL DSBEVX( 'N', 'A', UPLO, N, KD, V, LDU, U, LDU, VL, 2206 $ VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK, 2207 $ IWORK, IWORK( 5*N+1 ), IINFO ) 2208 IF( IINFO.NE.0 ) THEN 2209 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(N,A,' // UPLO // 2210 $ ')', IINFO, N, JTYPE, IOLDSD 2211 INFO = ABS( IINFO ) 2212 IF( IINFO.LT.0 ) THEN 2213 RETURN 2214 ELSE 2215 RESULT( NTEST ) = ULPINV 2216 GO TO 1280 2217 END IF 2218 END IF 2219* 2220* Do test 54 (or +54) 2221* 2222 TEMP1 = ZERO 2223 TEMP2 = ZERO 2224 DO 1270 J = 1, N 2225 TEMP1 = MAX( TEMP1, ABS( WA2( J ) ), ABS( WA3( J ) ) ) 2226 TEMP2 = MAX( TEMP2, ABS( WA2( J )-WA3( J ) ) ) 2227 1270 CONTINUE 2228 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 2229 $ ULP*MAX( TEMP1, TEMP2 ) ) 2230* 2231 1280 CONTINUE 2232 NTEST = NTEST + 1 2233 IF( IUPLO.EQ.1 ) THEN 2234 DO 1300 J = 1, N 2235 DO 1290 I = MAX( 1, J-KD ), J 2236 V( KD+1+I-J, J ) = A( I, J ) 2237 1290 CONTINUE 2238 1300 CONTINUE 2239 ELSE 2240 DO 1320 J = 1, N 2241 DO 1310 I = J, MIN( N, J+KD ) 2242 V( 1+I-J, J ) = A( I, J ) 2243 1310 CONTINUE 2244 1320 CONTINUE 2245 END IF 2246* 2247 SRNAMT = 'DSBEVX' 2248 CALL DSBEVX( 'V', 'I', UPLO, N, KD, V, LDU, U, LDU, VL, 2249 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 2250 $ IWORK, IWORK( 5*N+1 ), IINFO ) 2251 IF( IINFO.NE.0 ) THEN 2252 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,I,' // UPLO // 2253 $ ')', IINFO, N, JTYPE, IOLDSD 2254 INFO = ABS( IINFO ) 2255 IF( IINFO.LT.0 ) THEN 2256 RETURN 2257 ELSE 2258 RESULT( NTEST ) = ULPINV 2259 RESULT( NTEST+1 ) = ULPINV 2260 RESULT( NTEST+2 ) = ULPINV 2261 GO TO 1370 2262 END IF 2263 END IF 2264* 2265* Do tests 55 and 56 (or +54) 2266* 2267 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 2268 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 2269* 2270 NTEST = NTEST + 2 2271* 2272 IF( IUPLO.EQ.1 ) THEN 2273 DO 1340 J = 1, N 2274 DO 1330 I = MAX( 1, J-KD ), J 2275 V( KD+1+I-J, J ) = A( I, J ) 2276 1330 CONTINUE 2277 1340 CONTINUE 2278 ELSE 2279 DO 1360 J = 1, N 2280 DO 1350 I = J, MIN( N, J+KD ) 2281 V( 1+I-J, J ) = A( I, J ) 2282 1350 CONTINUE 2283 1360 CONTINUE 2284 END IF 2285* 2286 SRNAMT = 'DSBEVX' 2287 CALL DSBEVX( 'N', 'I', UPLO, N, KD, V, LDU, U, LDU, VL, 2288 $ VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK, 2289 $ IWORK, IWORK( 5*N+1 ), IINFO ) 2290 IF( IINFO.NE.0 ) THEN 2291 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(N,I,' // UPLO // 2292 $ ')', IINFO, N, JTYPE, IOLDSD 2293 INFO = ABS( IINFO ) 2294 IF( IINFO.LT.0 ) THEN 2295 RETURN 2296 ELSE 2297 RESULT( NTEST ) = ULPINV 2298 GO TO 1370 2299 END IF 2300 END IF 2301* 2302* Do test 57 (or +54) 2303* 2304 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 2305 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 2306 IF( N.GT.0 ) THEN 2307 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 2308 ELSE 2309 TEMP3 = ZERO 2310 END IF 2311 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 2312 $ MAX( UNFL, TEMP3*ULP ) 2313* 2314 1370 CONTINUE 2315 NTEST = NTEST + 1 2316 IF( IUPLO.EQ.1 ) THEN 2317 DO 1390 J = 1, N 2318 DO 1380 I = MAX( 1, J-KD ), J 2319 V( KD+1+I-J, J ) = A( I, J ) 2320 1380 CONTINUE 2321 1390 CONTINUE 2322 ELSE 2323 DO 1410 J = 1, N 2324 DO 1400 I = J, MIN( N, J+KD ) 2325 V( 1+I-J, J ) = A( I, J ) 2326 1400 CONTINUE 2327 1410 CONTINUE 2328 END IF 2329* 2330 SRNAMT = 'DSBEVX' 2331 CALL DSBEVX( 'V', 'V', UPLO, N, KD, V, LDU, U, LDU, VL, 2332 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 2333 $ IWORK, IWORK( 5*N+1 ), IINFO ) 2334 IF( IINFO.NE.0 ) THEN 2335 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,V,' // UPLO // 2336 $ ')', IINFO, N, JTYPE, IOLDSD 2337 INFO = ABS( IINFO ) 2338 IF( IINFO.LT.0 ) THEN 2339 RETURN 2340 ELSE 2341 RESULT( NTEST ) = ULPINV 2342 RESULT( NTEST+1 ) = ULPINV 2343 RESULT( NTEST+2 ) = ULPINV 2344 GO TO 1460 2345 END IF 2346 END IF 2347* 2348* Do tests 58 and 59 (or +54) 2349* 2350 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 2351 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 2352* 2353 NTEST = NTEST + 2 2354* 2355 IF( IUPLO.EQ.1 ) THEN 2356 DO 1430 J = 1, N 2357 DO 1420 I = MAX( 1, J-KD ), J 2358 V( KD+1+I-J, J ) = A( I, J ) 2359 1420 CONTINUE 2360 1430 CONTINUE 2361 ELSE 2362 DO 1450 J = 1, N 2363 DO 1440 I = J, MIN( N, J+KD ) 2364 V( 1+I-J, J ) = A( I, J ) 2365 1440 CONTINUE 2366 1450 CONTINUE 2367 END IF 2368* 2369 SRNAMT = 'DSBEVX' 2370 CALL DSBEVX( 'N', 'V', UPLO, N, KD, V, LDU, U, LDU, VL, 2371 $ VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK, 2372 $ IWORK, IWORK( 5*N+1 ), IINFO ) 2373 IF( IINFO.NE.0 ) THEN 2374 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(N,V,' // UPLO // 2375 $ ')', IINFO, N, JTYPE, IOLDSD 2376 INFO = ABS( IINFO ) 2377 IF( IINFO.LT.0 ) THEN 2378 RETURN 2379 ELSE 2380 RESULT( NTEST ) = ULPINV 2381 GO TO 1460 2382 END IF 2383 END IF 2384* 2385 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 2386 RESULT( NTEST ) = ULPINV 2387 GO TO 1460 2388 END IF 2389* 2390* Do test 60 (or +54) 2391* 2392 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 2393 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 2394 IF( N.GT.0 ) THEN 2395 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 2396 ELSE 2397 TEMP3 = ZERO 2398 END IF 2399 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 2400 $ MAX( UNFL, TEMP3*ULP ) 2401* 2402 1460 CONTINUE 2403* 2404* 7) Call DSYEVD 2405* 2406 CALL DLACPY( ' ', N, N, A, LDA, V, LDU ) 2407* 2408 NTEST = NTEST + 1 2409 SRNAMT = 'DSYEVD' 2410 CALL DSYEVD( 'V', UPLO, N, A, LDU, D1, WORK, LWEDC, 2411 $ IWORK, LIWEDC, IINFO ) 2412 IF( IINFO.NE.0 ) THEN 2413 WRITE( NOUNIT, FMT = 9999 )'DSYEVD(V,' // UPLO // 2414 $ ')', IINFO, N, JTYPE, IOLDSD 2415 INFO = ABS( IINFO ) 2416 IF( IINFO.LT.0 ) THEN 2417 RETURN 2418 ELSE 2419 RESULT( NTEST ) = ULPINV 2420 RESULT( NTEST+1 ) = ULPINV 2421 RESULT( NTEST+2 ) = ULPINV 2422 GO TO 1480 2423 END IF 2424 END IF 2425* 2426* Do tests 61 and 62 (or +54) 2427* 2428 CALL DSYT21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z, 2429 $ LDU, TAU, WORK, RESULT( NTEST ) ) 2430* 2431 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2432* 2433 NTEST = NTEST + 2 2434 SRNAMT = 'DSYEVD' 2435 CALL DSYEVD( 'N', UPLO, N, A, LDU, D3, WORK, LWEDC, 2436 $ IWORK, LIWEDC, IINFO ) 2437 IF( IINFO.NE.0 ) THEN 2438 WRITE( NOUNIT, FMT = 9999 )'DSYEVD(N,' // UPLO // 2439 $ ')', IINFO, N, JTYPE, IOLDSD 2440 INFO = ABS( IINFO ) 2441 IF( IINFO.LT.0 ) THEN 2442 RETURN 2443 ELSE 2444 RESULT( NTEST ) = ULPINV 2445 GO TO 1480 2446 END IF 2447 END IF 2448* 2449* Do test 63 (or +54) 2450* 2451 TEMP1 = ZERO 2452 TEMP2 = ZERO 2453 DO 1470 J = 1, N 2454 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 2455 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 2456 1470 CONTINUE 2457 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 2458 $ ULP*MAX( TEMP1, TEMP2 ) ) 2459* 2460 1480 CONTINUE 2461* 2462* 8) Call DSPEVD. 2463* 2464 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2465* 2466* Load array WORK with the upper or lower triangular 2467* part of the matrix in packed form. 2468* 2469 IF( IUPLO.EQ.1 ) THEN 2470 INDX = 1 2471 DO 1500 J = 1, N 2472 DO 1490 I = 1, J 2473 WORK( INDX ) = A( I, J ) 2474 INDX = INDX + 1 2475 1490 CONTINUE 2476 1500 CONTINUE 2477 ELSE 2478 INDX = 1 2479 DO 1520 J = 1, N 2480 DO 1510 I = J, N 2481 WORK( INDX ) = A( I, J ) 2482 INDX = INDX + 1 2483 1510 CONTINUE 2484 1520 CONTINUE 2485 END IF 2486* 2487 NTEST = NTEST + 1 2488 SRNAMT = 'DSPEVD' 2489 CALL DSPEVD( 'V', UPLO, N, WORK, D1, Z, LDU, 2490 $ WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC, 2491 $ IINFO ) 2492 IF( IINFO.NE.0 ) THEN 2493 WRITE( NOUNIT, FMT = 9999 )'DSPEVD(V,' // UPLO // 2494 $ ')', IINFO, N, JTYPE, IOLDSD 2495 INFO = ABS( IINFO ) 2496 IF( IINFO.LT.0 ) THEN 2497 RETURN 2498 ELSE 2499 RESULT( NTEST ) = ULPINV 2500 RESULT( NTEST+1 ) = ULPINV 2501 RESULT( NTEST+2 ) = ULPINV 2502 GO TO 1580 2503 END IF 2504 END IF 2505* 2506* Do tests 64 and 65 (or +54) 2507* 2508 CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 2509 $ LDU, TAU, WORK, RESULT( NTEST ) ) 2510* 2511 IF( IUPLO.EQ.1 ) THEN 2512 INDX = 1 2513 DO 1540 J = 1, N 2514 DO 1530 I = 1, J 2515* 2516 WORK( INDX ) = A( I, J ) 2517 INDX = INDX + 1 2518 1530 CONTINUE 2519 1540 CONTINUE 2520 ELSE 2521 INDX = 1 2522 DO 1560 J = 1, N 2523 DO 1550 I = J, N 2524 WORK( INDX ) = A( I, J ) 2525 INDX = INDX + 1 2526 1550 CONTINUE 2527 1560 CONTINUE 2528 END IF 2529* 2530 NTEST = NTEST + 2 2531 SRNAMT = 'DSPEVD' 2532 CALL DSPEVD( 'N', UPLO, N, WORK, D3, Z, LDU, 2533 $ WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC, 2534 $ IINFO ) 2535 IF( IINFO.NE.0 ) THEN 2536 WRITE( NOUNIT, FMT = 9999 )'DSPEVD(N,' // UPLO // 2537 $ ')', IINFO, N, JTYPE, IOLDSD 2538 INFO = ABS( IINFO ) 2539 IF( IINFO.LT.0 ) THEN 2540 RETURN 2541 ELSE 2542 RESULT( NTEST ) = ULPINV 2543 GO TO 1580 2544 END IF 2545 END IF 2546* 2547* Do test 66 (or +54) 2548* 2549 TEMP1 = ZERO 2550 TEMP2 = ZERO 2551 DO 1570 J = 1, N 2552 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 2553 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 2554 1570 CONTINUE 2555 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 2556 $ ULP*MAX( TEMP1, TEMP2 ) ) 2557 1580 CONTINUE 2558* 2559* 9) Call DSBEVD. 2560* 2561 IF( JTYPE.LE.7 ) THEN 2562 KD = 1 2563 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN 2564 KD = MAX( N-1, 0 ) 2565 ELSE 2566 KD = IHBW 2567 END IF 2568* 2569* Load array V with the upper or lower triangular part 2570* of the matrix in band form. 2571* 2572 IF( IUPLO.EQ.1 ) THEN 2573 DO 1600 J = 1, N 2574 DO 1590 I = MAX( 1, J-KD ), J 2575 V( KD+1+I-J, J ) = A( I, J ) 2576 1590 CONTINUE 2577 1600 CONTINUE 2578 ELSE 2579 DO 1620 J = 1, N 2580 DO 1610 I = J, MIN( N, J+KD ) 2581 V( 1+I-J, J ) = A( I, J ) 2582 1610 CONTINUE 2583 1620 CONTINUE 2584 END IF 2585* 2586 NTEST = NTEST + 1 2587 SRNAMT = 'DSBEVD' 2588 CALL DSBEVD( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK, 2589 $ LWEDC, IWORK, LIWEDC, IINFO ) 2590 IF( IINFO.NE.0 ) THEN 2591 WRITE( NOUNIT, FMT = 9999 )'DSBEVD(V,' // UPLO // 2592 $ ')', IINFO, N, JTYPE, IOLDSD 2593 INFO = ABS( IINFO ) 2594 IF( IINFO.LT.0 ) THEN 2595 RETURN 2596 ELSE 2597 RESULT( NTEST ) = ULPINV 2598 RESULT( NTEST+1 ) = ULPINV 2599 RESULT( NTEST+2 ) = ULPINV 2600 GO TO 1680 2601 END IF 2602 END IF 2603* 2604* Do tests 67 and 68 (or +54) 2605* 2606 CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 2607 $ LDU, TAU, WORK, RESULT( NTEST ) ) 2608* 2609 IF( IUPLO.EQ.1 ) THEN 2610 DO 1640 J = 1, N 2611 DO 1630 I = MAX( 1, J-KD ), J 2612 V( KD+1+I-J, J ) = A( I, J ) 2613 1630 CONTINUE 2614 1640 CONTINUE 2615 ELSE 2616 DO 1660 J = 1, N 2617 DO 1650 I = J, MIN( N, J+KD ) 2618 V( 1+I-J, J ) = A( I, J ) 2619 1650 CONTINUE 2620 1660 CONTINUE 2621 END IF 2622* 2623 NTEST = NTEST + 2 2624 SRNAMT = 'DSBEVD' 2625 CALL DSBEVD( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, WORK, 2626 $ LWEDC, IWORK, LIWEDC, IINFO ) 2627 IF( IINFO.NE.0 ) THEN 2628 WRITE( NOUNIT, FMT = 9999 )'DSBEVD(N,' // UPLO // 2629 $ ')', IINFO, N, JTYPE, IOLDSD 2630 INFO = ABS( IINFO ) 2631 IF( IINFO.LT.0 ) THEN 2632 RETURN 2633 ELSE 2634 RESULT( NTEST ) = ULPINV 2635 GO TO 1680 2636 END IF 2637 END IF 2638* 2639* Do test 69 (or +54) 2640* 2641 TEMP1 = ZERO 2642 TEMP2 = ZERO 2643 DO 1670 J = 1, N 2644 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 2645 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 2646 1670 CONTINUE 2647 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 2648 $ ULP*MAX( TEMP1, TEMP2 ) ) 2649* 2650 1680 CONTINUE 2651* 2652* 2653 CALL DLACPY( ' ', N, N, A, LDA, V, LDU ) 2654 NTEST = NTEST + 1 2655 SRNAMT = 'DSYEVR' 2656 CALL DSYEVR( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 2657 $ ABSTOL, M, WA1, Z, LDU, IWORK, WORK, LWORK, 2658 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 2659 IF( IINFO.NE.0 ) THEN 2660 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,A,' // UPLO // 2661 $ ')', IINFO, N, JTYPE, IOLDSD 2662 INFO = ABS( IINFO ) 2663 IF( IINFO.LT.0 ) THEN 2664 RETURN 2665 ELSE 2666 RESULT( NTEST ) = ULPINV 2667 RESULT( NTEST+1 ) = ULPINV 2668 RESULT( NTEST+2 ) = ULPINV 2669 GO TO 1700 2670 END IF 2671 END IF 2672* 2673* Do tests 70 and 71 (or ... ) 2674* 2675 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2676* 2677 CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 2678 $ LDU, TAU, WORK, RESULT( NTEST ) ) 2679* 2680 NTEST = NTEST + 2 2681 SRNAMT = 'DSYEVR' 2682 CALL DSYEVR( 'N', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 2683 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 2684 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 2685 IF( IINFO.NE.0 ) THEN 2686 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(N,A,' // UPLO // 2687 $ ')', IINFO, N, JTYPE, IOLDSD 2688 INFO = ABS( IINFO ) 2689 IF( IINFO.LT.0 ) THEN 2690 RETURN 2691 ELSE 2692 RESULT( NTEST ) = ULPINV 2693 GO TO 1700 2694 END IF 2695 END IF 2696* 2697* Do test 72 (or ... ) 2698* 2699 TEMP1 = ZERO 2700 TEMP2 = ZERO 2701 DO 1690 J = 1, N 2702 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 2703 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 2704 1690 CONTINUE 2705 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 2706 $ ULP*MAX( TEMP1, TEMP2 ) ) 2707* 2708 1700 CONTINUE 2709* 2710 NTEST = NTEST + 1 2711 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2712 SRNAMT = 'DSYEVR' 2713 CALL DSYEVR( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 2714 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 2715 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 2716 IF( IINFO.NE.0 ) THEN 2717 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,I,' // UPLO // 2718 $ ')', IINFO, N, JTYPE, IOLDSD 2719 INFO = ABS( IINFO ) 2720 IF( IINFO.LT.0 ) THEN 2721 RETURN 2722 ELSE 2723 RESULT( NTEST ) = ULPINV 2724 RESULT( NTEST+1 ) = ULPINV 2725 RESULT( NTEST+2 ) = ULPINV 2726 GO TO 1710 2727 END IF 2728 END IF 2729* 2730* Do tests 73 and 74 (or +54) 2731* 2732 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2733* 2734 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 2735 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 2736* 2737 NTEST = NTEST + 2 2738 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2739 SRNAMT = 'DSYEVR' 2740 CALL DSYEVR( 'N', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 2741 $ ABSTOL, M3, WA3, Z, LDU, IWORK, WORK, LWORK, 2742 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 2743 IF( IINFO.NE.0 ) THEN 2744 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(N,I,' // UPLO // 2745 $ ')', IINFO, N, JTYPE, IOLDSD 2746 INFO = ABS( IINFO ) 2747 IF( IINFO.LT.0 ) THEN 2748 RETURN 2749 ELSE 2750 RESULT( NTEST ) = ULPINV 2751 GO TO 1710 2752 END IF 2753 END IF 2754* 2755* Do test 75 (or +54) 2756* 2757 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 2758 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 2759 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 2760 $ MAX( UNFL, ULP*TEMP3 ) 2761 1710 CONTINUE 2762* 2763 NTEST = NTEST + 1 2764 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2765 SRNAMT = 'DSYEVR' 2766 CALL DSYEVR( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 2767 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 2768 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 2769 IF( IINFO.NE.0 ) THEN 2770 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,V,' // UPLO // 2771 $ ')', IINFO, N, JTYPE, IOLDSD 2772 INFO = ABS( IINFO ) 2773 IF( IINFO.LT.0 ) THEN 2774 RETURN 2775 ELSE 2776 RESULT( NTEST ) = ULPINV 2777 RESULT( NTEST+1 ) = ULPINV 2778 RESULT( NTEST+2 ) = ULPINV 2779 GO TO 700 2780 END IF 2781 END IF 2782* 2783* Do tests 76 and 77 (or +54) 2784* 2785 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2786* 2787 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 2788 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 2789* 2790 NTEST = NTEST + 2 2791 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2792 SRNAMT = 'DSYEVR' 2793 CALL DSYEVR( 'N', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 2794 $ ABSTOL, M3, WA3, Z, LDU, IWORK, WORK, LWORK, 2795 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 2796 IF( IINFO.NE.0 ) THEN 2797 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(N,V,' // UPLO // 2798 $ ')', IINFO, N, JTYPE, IOLDSD 2799 INFO = ABS( IINFO ) 2800 IF( IINFO.LT.0 ) THEN 2801 RETURN 2802 ELSE 2803 RESULT( NTEST ) = ULPINV 2804 GO TO 700 2805 END IF 2806 END IF 2807* 2808 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 2809 RESULT( NTEST ) = ULPINV 2810 GO TO 700 2811 END IF 2812* 2813* Do test 78 (or +54) 2814* 2815 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 2816 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 2817 IF( N.GT.0 ) THEN 2818 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 2819 ELSE 2820 TEMP3 = ZERO 2821 END IF 2822 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 2823 $ MAX( UNFL, TEMP3*ULP ) 2824* 2825 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2826* 2827 1720 CONTINUE 2828* 2829* End of Loop -- Check for RESULT(j) > THRESH 2830* 2831 NTESTT = NTESTT + NTEST 2832* 2833 CALL DLAFTS( 'DST', N, N, JTYPE, NTEST, RESULT, IOLDSD, 2834 $ THRESH, NOUNIT, NERRS ) 2835* 2836 1730 CONTINUE 2837 1740 CONTINUE 2838* 2839* Summary 2840* 2841 CALL ALASVM( 'DST', NOUNIT, NERRS, NTESTT, 0 ) 2842* 2843 9999 FORMAT( ' DDRVST: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', 2844 $ I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' ) 2845* 2846 RETURN 2847* 2848* End of DDRVST 2849* 2850 END 2851