1*> \brief \b DDRVST2STG 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 DDRVST2STG( 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*> DDRVST2STG 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 DDRVST2STG 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*> DDRVST2STG 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, DDRVST2STG 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 DDRVST2STG 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_2STAGE('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_2STAGE('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_2STAGE('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_2STAGE('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_2STAGE('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_2STAGE('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_2STAGE('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_2STAGE('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_2STAGE('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_2STAGE('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_2STAGE('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_2STAGE('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_2STAGE('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*> \ingroup double_eig 447* 448* ===================================================================== 449 SUBROUTINE DDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 450 $ NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1, 451 $ WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK, 452 $ IWORK, LIWORK, RESULT, INFO ) 453* 454* -- LAPACK test routine -- 455* -- LAPACK is a software package provided by Univ. of Tennessee, -- 456* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 457* 458* .. Scalar Arguments .. 459 INTEGER INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES, 460 $ NTYPES 461 DOUBLE PRECISION THRESH 462* .. 463* .. Array Arguments .. 464 LOGICAL DOTYPE( * ) 465 INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 466 DOUBLE PRECISION A( LDA, * ), D1( * ), D2( * ), D3( * ), 467 $ D4( * ), EVEIGS( * ), RESULT( * ), TAU( * ), 468 $ U( LDU, * ), V( LDU, * ), WA1( * ), WA2( * ), 469 $ WA3( * ), WORK( * ), Z( LDU, * ) 470* .. 471* 472* ===================================================================== 473* 474* .. Parameters .. 475 DOUBLE PRECISION ZERO, ONE, TWO, TEN 476 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0, 477 $ TEN = 10.0D0 ) 478 DOUBLE PRECISION HALF 479 PARAMETER ( HALF = 0.5D0 ) 480 INTEGER MAXTYP 481 PARAMETER ( MAXTYP = 18 ) 482* .. 483* .. Local Scalars .. 484 LOGICAL BADNN 485 CHARACTER UPLO 486 INTEGER I, IDIAG, IHBW, IINFO, IL, IMODE, INDX, IROW, 487 $ ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL, 488 $ JSIZE, JTYPE, KD, LGN, LIWEDC, LWEDC, M, M2, 489 $ M3, MTYPES, N, NERRS, NMATS, NMAX, NTEST, 490 $ NTESTT 491 DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL, 492 $ RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL, 493 $ VL, VU 494* .. 495* .. Local Arrays .. 496 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ), 497 $ ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ), 498 $ KTYPE( MAXTYP ) 499* .. 500* .. External Functions .. 501 DOUBLE PRECISION DLAMCH, DLARND, DSXT1 502 EXTERNAL DLAMCH, DLARND, DSXT1 503* .. 504* .. External Subroutines .. 505 EXTERNAL ALASVM, DLABAD, DLACPY, DLAFTS, DLASET, DLATMR, 506 $ DLATMS, DSBEV, DSBEVD, DSBEVX, DSPEV, DSPEVD, 507 $ DSPEVX, DSTEV, DSTEVD, DSTEVR, DSTEVX, DSTT21, 508 $ DSTT22, DSYEV, DSYEVD, DSYEVR, DSYEVX, DSYT21, 509 $ DSYEVD_2STAGE, DSYEVR_2STAGE, DSYEVX_2STAGE, 510 $ DSYEV_2STAGE, DSBEV_2STAGE, DSBEVD_2STAGE, 511 $ DSBEVX_2STAGE, DSYTRD_2STAGE, DSYTRD_SY2SB, 512 $ DSYTRD_SB2ST, 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( 'DDRVST2STG', -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 + INT( ( N-1 )*DLARND( 1, ISEED2 ) ) 766 IU = 1 + INT( ( N-1 )*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_2STAGE' 1428 CALL DSYEV_2STAGE( 'N', UPLO, N, A, LDU, D3, WORK, LWORK, 1429 $ IINFO ) 1430 IF( IINFO.NE.0 ) THEN 1431 WRITE( NOUNIT, FMT = 9999 ) 1432 $ 'DSYEV_2STAGE(N,' // UPLO // ')', 1433 $ IINFO, N, JTYPE, IOLDSD 1434 INFO = ABS( IINFO ) 1435 IF( IINFO.LT.0 ) THEN 1436 RETURN 1437 ELSE 1438 RESULT( NTEST ) = ULPINV 1439 GO TO 660 1440 END IF 1441 END IF 1442* 1443* Do test 27 (or +54) 1444* 1445 TEMP1 = ZERO 1446 TEMP2 = ZERO 1447 DO 650 J = 1, N 1448 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 1449 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 1450 650 CONTINUE 1451 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1452 $ ULP*MAX( TEMP1, TEMP2 ) ) 1453* 1454 660 CONTINUE 1455 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1456* 1457 NTEST = NTEST + 1 1458* 1459 IF( N.GT.0 ) THEN 1460 TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) ) 1461 IF( IL.NE.1 ) THEN 1462 VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ), 1463 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1464 ELSE IF( N.GT.0 ) THEN 1465 VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ), 1466 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1467 END IF 1468 IF( IU.NE.N ) THEN 1469 VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ), 1470 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1471 ELSE IF( N.GT.0 ) THEN 1472 VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ), 1473 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1474 END IF 1475 ELSE 1476 TEMP3 = ZERO 1477 VL = ZERO 1478 VU = ONE 1479 END IF 1480* 1481 SRNAMT = 'DSYEVX' 1482 CALL DSYEVX( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 1483 $ ABSTOL, M, WA1, Z, LDU, WORK, LWORK, IWORK, 1484 $ IWORK( 5*N+1 ), IINFO ) 1485 IF( IINFO.NE.0 ) THEN 1486 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,A,' // UPLO // 1487 $ ')', IINFO, N, JTYPE, IOLDSD 1488 INFO = ABS( IINFO ) 1489 IF( IINFO.LT.0 ) THEN 1490 RETURN 1491 ELSE 1492 RESULT( NTEST ) = ULPINV 1493 RESULT( NTEST+1 ) = ULPINV 1494 RESULT( NTEST+2 ) = ULPINV 1495 GO TO 680 1496 END IF 1497 END IF 1498* 1499* Do tests 28 and 29 (or +54) 1500* 1501 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1502* 1503 CALL DSYT21( 1, UPLO, N, 0, A, LDU, D1, D2, Z, LDU, V, 1504 $ LDU, TAU, WORK, RESULT( NTEST ) ) 1505* 1506 NTEST = NTEST + 2 1507 SRNAMT = 'DSYEVX_2STAGE' 1508 CALL DSYEVX_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU, 1509 $ IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 1510 $ LWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1511 IF( IINFO.NE.0 ) THEN 1512 WRITE( NOUNIT, FMT = 9999 ) 1513 $ 'DSYEVX_2STAGE(N,A,' // UPLO // 1514 $ ')', IINFO, N, JTYPE, IOLDSD 1515 INFO = ABS( IINFO ) 1516 IF( IINFO.LT.0 ) THEN 1517 RETURN 1518 ELSE 1519 RESULT( NTEST ) = ULPINV 1520 GO TO 680 1521 END IF 1522 END IF 1523* 1524* Do test 30 (or +54) 1525* 1526 TEMP1 = ZERO 1527 TEMP2 = ZERO 1528 DO 670 J = 1, N 1529 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 1530 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 1531 670 CONTINUE 1532 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1533 $ ULP*MAX( TEMP1, TEMP2 ) ) 1534* 1535 680 CONTINUE 1536* 1537 NTEST = NTEST + 1 1538 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1539 SRNAMT = 'DSYEVX' 1540 CALL DSYEVX( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 1541 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK, 1542 $ IWORK( 5*N+1 ), IINFO ) 1543 IF( IINFO.NE.0 ) THEN 1544 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,I,' // UPLO // 1545 $ ')', IINFO, N, JTYPE, IOLDSD 1546 INFO = ABS( IINFO ) 1547 IF( IINFO.LT.0 ) THEN 1548 RETURN 1549 ELSE 1550 RESULT( NTEST ) = ULPINV 1551 RESULT( NTEST+1 ) = ULPINV 1552 RESULT( NTEST+2 ) = ULPINV 1553 GO TO 690 1554 END IF 1555 END IF 1556* 1557* Do tests 31 and 32 (or +54) 1558* 1559 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1560* 1561 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1562 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 1563* 1564 NTEST = NTEST + 2 1565 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1566 SRNAMT = 'DSYEVX_2STAGE' 1567 CALL DSYEVX_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU, 1568 $ IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK, 1569 $ LWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1570 IF( IINFO.NE.0 ) THEN 1571 WRITE( NOUNIT, FMT = 9999 ) 1572 $ 'DSYEVX_2STAGE(N,I,' // UPLO // 1573 $ ')', IINFO, N, JTYPE, IOLDSD 1574 INFO = ABS( IINFO ) 1575 IF( IINFO.LT.0 ) THEN 1576 RETURN 1577 ELSE 1578 RESULT( NTEST ) = ULPINV 1579 GO TO 690 1580 END IF 1581 END IF 1582* 1583* Do test 33 (or +54) 1584* 1585 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1586 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1587 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1588 $ MAX( UNFL, ULP*TEMP3 ) 1589 690 CONTINUE 1590* 1591 NTEST = NTEST + 1 1592 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1593 SRNAMT = 'DSYEVX' 1594 CALL DSYEVX( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 1595 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK, 1596 $ IWORK( 5*N+1 ), IINFO ) 1597 IF( IINFO.NE.0 ) THEN 1598 WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,V,' // UPLO // 1599 $ ')', IINFO, N, JTYPE, IOLDSD 1600 INFO = ABS( IINFO ) 1601 IF( IINFO.LT.0 ) THEN 1602 RETURN 1603 ELSE 1604 RESULT( NTEST ) = ULPINV 1605 RESULT( NTEST+1 ) = ULPINV 1606 RESULT( NTEST+2 ) = ULPINV 1607 GO TO 700 1608 END IF 1609 END IF 1610* 1611* Do tests 34 and 35 (or +54) 1612* 1613 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1614* 1615 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1616 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 1617* 1618 NTEST = NTEST + 2 1619 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1620 SRNAMT = 'DSYEVX_2STAGE' 1621 CALL DSYEVX_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU, 1622 $ IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK, 1623 $ LWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1624 IF( IINFO.NE.0 ) THEN 1625 WRITE( NOUNIT, FMT = 9999 ) 1626 $ 'DSYEVX_2STAGE(N,V,' // UPLO // 1627 $ ')', IINFO, N, JTYPE, IOLDSD 1628 INFO = ABS( IINFO ) 1629 IF( IINFO.LT.0 ) THEN 1630 RETURN 1631 ELSE 1632 RESULT( NTEST ) = ULPINV 1633 GO TO 700 1634 END IF 1635 END IF 1636* 1637 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 1638 RESULT( NTEST ) = ULPINV 1639 GO TO 700 1640 END IF 1641* 1642* Do test 36 (or +54) 1643* 1644 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1645 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1646 IF( N.GT.0 ) THEN 1647 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 1648 ELSE 1649 TEMP3 = ZERO 1650 END IF 1651 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1652 $ MAX( UNFL, TEMP3*ULP ) 1653* 1654 700 CONTINUE 1655* 1656* 5) Call DSPEV and DSPEVX. 1657* 1658 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 1659* 1660* Load array WORK with the upper or lower triangular 1661* part of the matrix in packed form. 1662* 1663 IF( IUPLO.EQ.1 ) THEN 1664 INDX = 1 1665 DO 720 J = 1, N 1666 DO 710 I = 1, J 1667 WORK( INDX ) = A( I, J ) 1668 INDX = INDX + 1 1669 710 CONTINUE 1670 720 CONTINUE 1671 ELSE 1672 INDX = 1 1673 DO 740 J = 1, N 1674 DO 730 I = J, N 1675 WORK( INDX ) = A( I, J ) 1676 INDX = INDX + 1 1677 730 CONTINUE 1678 740 CONTINUE 1679 END IF 1680* 1681 NTEST = NTEST + 1 1682 SRNAMT = 'DSPEV' 1683 CALL DSPEV( 'V', UPLO, N, WORK, D1, Z, LDU, V, IINFO ) 1684 IF( IINFO.NE.0 ) THEN 1685 WRITE( NOUNIT, FMT = 9999 )'DSPEV(V,' // UPLO // ')', 1686 $ IINFO, N, JTYPE, IOLDSD 1687 INFO = ABS( IINFO ) 1688 IF( IINFO.LT.0 ) THEN 1689 RETURN 1690 ELSE 1691 RESULT( NTEST ) = ULPINV 1692 RESULT( NTEST+1 ) = ULPINV 1693 RESULT( NTEST+2 ) = ULPINV 1694 GO TO 800 1695 END IF 1696 END IF 1697* 1698* Do tests 37 and 38 (or +54) 1699* 1700 CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 1701 $ LDU, TAU, WORK, RESULT( NTEST ) ) 1702* 1703 IF( IUPLO.EQ.1 ) THEN 1704 INDX = 1 1705 DO 760 J = 1, N 1706 DO 750 I = 1, J 1707 WORK( INDX ) = A( I, J ) 1708 INDX = INDX + 1 1709 750 CONTINUE 1710 760 CONTINUE 1711 ELSE 1712 INDX = 1 1713 DO 780 J = 1, N 1714 DO 770 I = J, N 1715 WORK( INDX ) = A( I, J ) 1716 INDX = INDX + 1 1717 770 CONTINUE 1718 780 CONTINUE 1719 END IF 1720* 1721 NTEST = NTEST + 2 1722 SRNAMT = 'DSPEV' 1723 CALL DSPEV( 'N', UPLO, N, WORK, D3, Z, LDU, V, IINFO ) 1724 IF( IINFO.NE.0 ) THEN 1725 WRITE( NOUNIT, FMT = 9999 )'DSPEV(N,' // UPLO // ')', 1726 $ IINFO, N, JTYPE, IOLDSD 1727 INFO = ABS( IINFO ) 1728 IF( IINFO.LT.0 ) THEN 1729 RETURN 1730 ELSE 1731 RESULT( NTEST ) = ULPINV 1732 GO TO 800 1733 END IF 1734 END IF 1735* 1736* Do test 39 (or +54) 1737* 1738 TEMP1 = ZERO 1739 TEMP2 = ZERO 1740 DO 790 J = 1, N 1741 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 1742 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 1743 790 CONTINUE 1744 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1745 $ ULP*MAX( TEMP1, TEMP2 ) ) 1746* 1747* Load array WORK with the upper or lower triangular part 1748* of the matrix in packed form. 1749* 1750 800 CONTINUE 1751 IF( IUPLO.EQ.1 ) THEN 1752 INDX = 1 1753 DO 820 J = 1, N 1754 DO 810 I = 1, J 1755 WORK( INDX ) = A( I, J ) 1756 INDX = INDX + 1 1757 810 CONTINUE 1758 820 CONTINUE 1759 ELSE 1760 INDX = 1 1761 DO 840 J = 1, N 1762 DO 830 I = J, N 1763 WORK( INDX ) = A( I, J ) 1764 INDX = INDX + 1 1765 830 CONTINUE 1766 840 CONTINUE 1767 END IF 1768* 1769 NTEST = NTEST + 1 1770* 1771 IF( N.GT.0 ) THEN 1772 TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) ) 1773 IF( IL.NE.1 ) THEN 1774 VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ), 1775 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1776 ELSE IF( N.GT.0 ) THEN 1777 VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ), 1778 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1779 END IF 1780 IF( IU.NE.N ) THEN 1781 VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ), 1782 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1783 ELSE IF( N.GT.0 ) THEN 1784 VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ), 1785 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1786 END IF 1787 ELSE 1788 TEMP3 = ZERO 1789 VL = ZERO 1790 VU = ONE 1791 END IF 1792* 1793 SRNAMT = 'DSPEVX' 1794 CALL DSPEVX( 'V', 'A', UPLO, N, WORK, VL, VU, IL, IU, 1795 $ ABSTOL, M, WA1, Z, LDU, V, IWORK, 1796 $ IWORK( 5*N+1 ), IINFO ) 1797 IF( IINFO.NE.0 ) THEN 1798 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,A,' // UPLO // 1799 $ ')', IINFO, N, JTYPE, IOLDSD 1800 INFO = ABS( IINFO ) 1801 IF( IINFO.LT.0 ) THEN 1802 RETURN 1803 ELSE 1804 RESULT( NTEST ) = ULPINV 1805 RESULT( NTEST+1 ) = ULPINV 1806 RESULT( NTEST+2 ) = ULPINV 1807 GO TO 900 1808 END IF 1809 END IF 1810* 1811* Do tests 40 and 41 (or +54) 1812* 1813 CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 1814 $ LDU, TAU, WORK, RESULT( NTEST ) ) 1815* 1816 NTEST = NTEST + 2 1817* 1818 IF( IUPLO.EQ.1 ) THEN 1819 INDX = 1 1820 DO 860 J = 1, N 1821 DO 850 I = 1, J 1822 WORK( INDX ) = A( I, J ) 1823 INDX = INDX + 1 1824 850 CONTINUE 1825 860 CONTINUE 1826 ELSE 1827 INDX = 1 1828 DO 880 J = 1, N 1829 DO 870 I = J, N 1830 WORK( INDX ) = A( I, J ) 1831 INDX = INDX + 1 1832 870 CONTINUE 1833 880 CONTINUE 1834 END IF 1835* 1836 SRNAMT = 'DSPEVX' 1837 CALL DSPEVX( 'N', 'A', UPLO, N, WORK, VL, VU, IL, IU, 1838 $ ABSTOL, M2, WA2, Z, LDU, V, IWORK, 1839 $ IWORK( 5*N+1 ), IINFO ) 1840 IF( IINFO.NE.0 ) THEN 1841 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,A,' // UPLO // 1842 $ ')', IINFO, N, JTYPE, IOLDSD 1843 INFO = ABS( IINFO ) 1844 IF( IINFO.LT.0 ) THEN 1845 RETURN 1846 ELSE 1847 RESULT( NTEST ) = ULPINV 1848 GO TO 900 1849 END IF 1850 END IF 1851* 1852* Do test 42 (or +54) 1853* 1854 TEMP1 = ZERO 1855 TEMP2 = ZERO 1856 DO 890 J = 1, N 1857 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 1858 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 1859 890 CONTINUE 1860 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1861 $ ULP*MAX( TEMP1, TEMP2 ) ) 1862* 1863 900 CONTINUE 1864 IF( IUPLO.EQ.1 ) THEN 1865 INDX = 1 1866 DO 920 J = 1, N 1867 DO 910 I = 1, J 1868 WORK( INDX ) = A( I, J ) 1869 INDX = INDX + 1 1870 910 CONTINUE 1871 920 CONTINUE 1872 ELSE 1873 INDX = 1 1874 DO 940 J = 1, N 1875 DO 930 I = J, N 1876 WORK( INDX ) = A( I, J ) 1877 INDX = INDX + 1 1878 930 CONTINUE 1879 940 CONTINUE 1880 END IF 1881* 1882 NTEST = NTEST + 1 1883* 1884 SRNAMT = 'DSPEVX' 1885 CALL DSPEVX( 'V', 'I', UPLO, N, WORK, VL, VU, IL, IU, 1886 $ ABSTOL, M2, WA2, Z, LDU, V, IWORK, 1887 $ IWORK( 5*N+1 ), IINFO ) 1888 IF( IINFO.NE.0 ) THEN 1889 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,I,' // UPLO // 1890 $ ')', IINFO, N, JTYPE, IOLDSD 1891 INFO = ABS( IINFO ) 1892 IF( IINFO.LT.0 ) THEN 1893 RETURN 1894 ELSE 1895 RESULT( NTEST ) = ULPINV 1896 RESULT( NTEST+1 ) = ULPINV 1897 RESULT( NTEST+2 ) = ULPINV 1898 GO TO 990 1899 END IF 1900 END IF 1901* 1902* Do tests 43 and 44 (or +54) 1903* 1904 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1905 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 1906* 1907 NTEST = NTEST + 2 1908* 1909 IF( IUPLO.EQ.1 ) THEN 1910 INDX = 1 1911 DO 960 J = 1, N 1912 DO 950 I = 1, J 1913 WORK( INDX ) = A( I, J ) 1914 INDX = INDX + 1 1915 950 CONTINUE 1916 960 CONTINUE 1917 ELSE 1918 INDX = 1 1919 DO 980 J = 1, N 1920 DO 970 I = J, N 1921 WORK( INDX ) = A( I, J ) 1922 INDX = INDX + 1 1923 970 CONTINUE 1924 980 CONTINUE 1925 END IF 1926* 1927 SRNAMT = 'DSPEVX' 1928 CALL DSPEVX( 'N', 'I', UPLO, N, WORK, VL, VU, IL, IU, 1929 $ ABSTOL, M3, WA3, Z, LDU, V, IWORK, 1930 $ IWORK( 5*N+1 ), IINFO ) 1931 IF( IINFO.NE.0 ) THEN 1932 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,I,' // UPLO // 1933 $ ')', IINFO, N, JTYPE, IOLDSD 1934 INFO = ABS( IINFO ) 1935 IF( IINFO.LT.0 ) THEN 1936 RETURN 1937 ELSE 1938 RESULT( NTEST ) = ULPINV 1939 GO TO 990 1940 END IF 1941 END IF 1942* 1943 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 1944 RESULT( NTEST ) = ULPINV 1945 GO TO 990 1946 END IF 1947* 1948* Do test 45 (or +54) 1949* 1950 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1951 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1952 IF( N.GT.0 ) THEN 1953 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 1954 ELSE 1955 TEMP3 = ZERO 1956 END IF 1957 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1958 $ MAX( UNFL, TEMP3*ULP ) 1959* 1960 990 CONTINUE 1961 IF( IUPLO.EQ.1 ) THEN 1962 INDX = 1 1963 DO 1010 J = 1, N 1964 DO 1000 I = 1, J 1965 WORK( INDX ) = A( I, J ) 1966 INDX = INDX + 1 1967 1000 CONTINUE 1968 1010 CONTINUE 1969 ELSE 1970 INDX = 1 1971 DO 1030 J = 1, N 1972 DO 1020 I = J, N 1973 WORK( INDX ) = A( I, J ) 1974 INDX = INDX + 1 1975 1020 CONTINUE 1976 1030 CONTINUE 1977 END IF 1978* 1979 NTEST = NTEST + 1 1980* 1981 SRNAMT = 'DSPEVX' 1982 CALL DSPEVX( 'V', 'V', UPLO, N, WORK, VL, VU, IL, IU, 1983 $ ABSTOL, M2, WA2, Z, LDU, V, IWORK, 1984 $ IWORK( 5*N+1 ), IINFO ) 1985 IF( IINFO.NE.0 ) THEN 1986 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,V,' // UPLO // 1987 $ ')', IINFO, N, JTYPE, IOLDSD 1988 INFO = ABS( IINFO ) 1989 IF( IINFO.LT.0 ) THEN 1990 RETURN 1991 ELSE 1992 RESULT( NTEST ) = ULPINV 1993 RESULT( NTEST+1 ) = ULPINV 1994 RESULT( NTEST+2 ) = ULPINV 1995 GO TO 1080 1996 END IF 1997 END IF 1998* 1999* Do tests 46 and 47 (or +54) 2000* 2001 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 2002 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 2003* 2004 NTEST = NTEST + 2 2005* 2006 IF( IUPLO.EQ.1 ) THEN 2007 INDX = 1 2008 DO 1050 J = 1, N 2009 DO 1040 I = 1, J 2010 WORK( INDX ) = A( I, J ) 2011 INDX = INDX + 1 2012 1040 CONTINUE 2013 1050 CONTINUE 2014 ELSE 2015 INDX = 1 2016 DO 1070 J = 1, N 2017 DO 1060 I = J, N 2018 WORK( INDX ) = A( I, J ) 2019 INDX = INDX + 1 2020 1060 CONTINUE 2021 1070 CONTINUE 2022 END IF 2023* 2024 SRNAMT = 'DSPEVX' 2025 CALL DSPEVX( 'N', 'V', UPLO, N, WORK, VL, VU, IL, IU, 2026 $ ABSTOL, M3, WA3, Z, LDU, V, IWORK, 2027 $ IWORK( 5*N+1 ), IINFO ) 2028 IF( IINFO.NE.0 ) THEN 2029 WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,V,' // UPLO // 2030 $ ')', IINFO, N, JTYPE, IOLDSD 2031 INFO = ABS( IINFO ) 2032 IF( IINFO.LT.0 ) THEN 2033 RETURN 2034 ELSE 2035 RESULT( NTEST ) = ULPINV 2036 GO TO 1080 2037 END IF 2038 END IF 2039* 2040 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 2041 RESULT( NTEST ) = ULPINV 2042 GO TO 1080 2043 END IF 2044* 2045* Do test 48 (or +54) 2046* 2047 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 2048 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 2049 IF( N.GT.0 ) THEN 2050 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 2051 ELSE 2052 TEMP3 = ZERO 2053 END IF 2054 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 2055 $ MAX( UNFL, TEMP3*ULP ) 2056* 2057 1080 CONTINUE 2058* 2059* 6) Call DSBEV and DSBEVX. 2060* 2061 IF( JTYPE.LE.7 ) THEN 2062 KD = 1 2063 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN 2064 KD = MAX( N-1, 0 ) 2065 ELSE 2066 KD = IHBW 2067 END IF 2068* 2069* Load array V with the upper or lower triangular part 2070* of the matrix in band form. 2071* 2072 IF( IUPLO.EQ.1 ) THEN 2073 DO 1100 J = 1, N 2074 DO 1090 I = MAX( 1, J-KD ), J 2075 V( KD+1+I-J, J ) = A( I, J ) 2076 1090 CONTINUE 2077 1100 CONTINUE 2078 ELSE 2079 DO 1120 J = 1, N 2080 DO 1110 I = J, MIN( N, J+KD ) 2081 V( 1+I-J, J ) = A( I, J ) 2082 1110 CONTINUE 2083 1120 CONTINUE 2084 END IF 2085* 2086 NTEST = NTEST + 1 2087 SRNAMT = 'DSBEV' 2088 CALL DSBEV( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK, 2089 $ IINFO ) 2090 IF( IINFO.NE.0 ) THEN 2091 WRITE( NOUNIT, FMT = 9999 )'DSBEV(V,' // UPLO // ')', 2092 $ IINFO, N, JTYPE, IOLDSD 2093 INFO = ABS( IINFO ) 2094 IF( IINFO.LT.0 ) THEN 2095 RETURN 2096 ELSE 2097 RESULT( NTEST ) = ULPINV 2098 RESULT( NTEST+1 ) = ULPINV 2099 RESULT( NTEST+2 ) = ULPINV 2100 GO TO 1180 2101 END IF 2102 END IF 2103* 2104* Do tests 49 and 50 (or ... ) 2105* 2106 CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 2107 $ LDU, TAU, WORK, RESULT( NTEST ) ) 2108* 2109 IF( IUPLO.EQ.1 ) THEN 2110 DO 1140 J = 1, N 2111 DO 1130 I = MAX( 1, J-KD ), J 2112 V( KD+1+I-J, J ) = A( I, J ) 2113 1130 CONTINUE 2114 1140 CONTINUE 2115 ELSE 2116 DO 1160 J = 1, N 2117 DO 1150 I = J, MIN( N, J+KD ) 2118 V( 1+I-J, J ) = A( I, J ) 2119 1150 CONTINUE 2120 1160 CONTINUE 2121 END IF 2122* 2123 NTEST = NTEST + 2 2124 SRNAMT = 'DSBEV_2STAGE' 2125 CALL DSBEV_2STAGE( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, 2126 $ WORK, LWORK, IINFO ) 2127 IF( IINFO.NE.0 ) THEN 2128 WRITE( NOUNIT, FMT = 9999 ) 2129 $ 'DSBEV_2STAGE(N,' // UPLO // ')', 2130 $ IINFO, N, JTYPE, IOLDSD 2131 INFO = ABS( IINFO ) 2132 IF( IINFO.LT.0 ) THEN 2133 RETURN 2134 ELSE 2135 RESULT( NTEST ) = ULPINV 2136 GO TO 1180 2137 END IF 2138 END IF 2139* 2140* Do test 51 (or +54) 2141* 2142 TEMP1 = ZERO 2143 TEMP2 = ZERO 2144 DO 1170 J = 1, N 2145 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 2146 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 2147 1170 CONTINUE 2148 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 2149 $ ULP*MAX( TEMP1, TEMP2 ) ) 2150* 2151* Load array V with the upper or lower triangular part 2152* of the matrix in band form. 2153* 2154 1180 CONTINUE 2155 IF( IUPLO.EQ.1 ) THEN 2156 DO 1200 J = 1, N 2157 DO 1190 I = MAX( 1, J-KD ), J 2158 V( KD+1+I-J, J ) = A( I, J ) 2159 1190 CONTINUE 2160 1200 CONTINUE 2161 ELSE 2162 DO 1220 J = 1, N 2163 DO 1210 I = J, MIN( N, J+KD ) 2164 V( 1+I-J, J ) = A( I, J ) 2165 1210 CONTINUE 2166 1220 CONTINUE 2167 END IF 2168* 2169 NTEST = NTEST + 1 2170 SRNAMT = 'DSBEVX' 2171 CALL DSBEVX( 'V', 'A', UPLO, N, KD, V, LDU, U, LDU, VL, 2172 $ VU, IL, IU, ABSTOL, M, WA2, Z, LDU, WORK, 2173 $ IWORK, IWORK( 5*N+1 ), IINFO ) 2174 IF( IINFO.NE.0 ) THEN 2175 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,A,' // UPLO // 2176 $ ')', IINFO, N, JTYPE, IOLDSD 2177 INFO = ABS( IINFO ) 2178 IF( IINFO.LT.0 ) THEN 2179 RETURN 2180 ELSE 2181 RESULT( NTEST ) = ULPINV 2182 RESULT( NTEST+1 ) = ULPINV 2183 RESULT( NTEST+2 ) = ULPINV 2184 GO TO 1280 2185 END IF 2186 END IF 2187* 2188* Do tests 52 and 53 (or +54) 2189* 2190 CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA2, D2, Z, LDU, V, 2191 $ LDU, TAU, WORK, RESULT( NTEST ) ) 2192* 2193 NTEST = NTEST + 2 2194* 2195 IF( IUPLO.EQ.1 ) THEN 2196 DO 1240 J = 1, N 2197 DO 1230 I = MAX( 1, J-KD ), J 2198 V( KD+1+I-J, J ) = A( I, J ) 2199 1230 CONTINUE 2200 1240 CONTINUE 2201 ELSE 2202 DO 1260 J = 1, N 2203 DO 1250 I = J, MIN( N, J+KD ) 2204 V( 1+I-J, J ) = A( I, J ) 2205 1250 CONTINUE 2206 1260 CONTINUE 2207 END IF 2208* 2209 SRNAMT = 'DSBEVX_2STAGE' 2210 CALL DSBEVX_2STAGE( 'N', 'A', UPLO, N, KD, V, LDU, 2211 $ U, LDU, VL, VU, IL, IU, ABSTOL, M3, WA3, 2212 $ Z, LDU, WORK, LWORK, IWORK, IWORK( 5*N+1 ), 2213 $ IINFO ) 2214 IF( IINFO.NE.0 ) THEN 2215 WRITE( NOUNIT, FMT = 9999 ) 2216 $ 'DSBEVX_2STAGE(N,A,' // UPLO // 2217 $ ')', IINFO, N, JTYPE, IOLDSD 2218 INFO = ABS( IINFO ) 2219 IF( IINFO.LT.0 ) THEN 2220 RETURN 2221 ELSE 2222 RESULT( NTEST ) = ULPINV 2223 GO TO 1280 2224 END IF 2225 END IF 2226* 2227* Do test 54 (or +54) 2228* 2229 TEMP1 = ZERO 2230 TEMP2 = ZERO 2231 DO 1270 J = 1, N 2232 TEMP1 = MAX( TEMP1, ABS( WA2( J ) ), ABS( WA3( J ) ) ) 2233 TEMP2 = MAX( TEMP2, ABS( WA2( J )-WA3( J ) ) ) 2234 1270 CONTINUE 2235 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 2236 $ ULP*MAX( TEMP1, TEMP2 ) ) 2237* 2238 1280 CONTINUE 2239 NTEST = NTEST + 1 2240 IF( IUPLO.EQ.1 ) THEN 2241 DO 1300 J = 1, N 2242 DO 1290 I = MAX( 1, J-KD ), J 2243 V( KD+1+I-J, J ) = A( I, J ) 2244 1290 CONTINUE 2245 1300 CONTINUE 2246 ELSE 2247 DO 1320 J = 1, N 2248 DO 1310 I = J, MIN( N, J+KD ) 2249 V( 1+I-J, J ) = A( I, J ) 2250 1310 CONTINUE 2251 1320 CONTINUE 2252 END IF 2253* 2254 SRNAMT = 'DSBEVX' 2255 CALL DSBEVX( 'V', 'I', UPLO, N, KD, V, LDU, U, LDU, VL, 2256 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 2257 $ IWORK, IWORK( 5*N+1 ), IINFO ) 2258 IF( IINFO.NE.0 ) THEN 2259 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,I,' // UPLO // 2260 $ ')', IINFO, N, JTYPE, IOLDSD 2261 INFO = ABS( IINFO ) 2262 IF( IINFO.LT.0 ) THEN 2263 RETURN 2264 ELSE 2265 RESULT( NTEST ) = ULPINV 2266 RESULT( NTEST+1 ) = ULPINV 2267 RESULT( NTEST+2 ) = ULPINV 2268 GO TO 1370 2269 END IF 2270 END IF 2271* 2272* Do tests 55 and 56 (or +54) 2273* 2274 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 2275 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 2276* 2277 NTEST = NTEST + 2 2278* 2279 IF( IUPLO.EQ.1 ) THEN 2280 DO 1340 J = 1, N 2281 DO 1330 I = MAX( 1, J-KD ), J 2282 V( KD+1+I-J, J ) = A( I, J ) 2283 1330 CONTINUE 2284 1340 CONTINUE 2285 ELSE 2286 DO 1360 J = 1, N 2287 DO 1350 I = J, MIN( N, J+KD ) 2288 V( 1+I-J, J ) = A( I, J ) 2289 1350 CONTINUE 2290 1360 CONTINUE 2291 END IF 2292* 2293 SRNAMT = 'DSBEVX_2STAGE' 2294 CALL DSBEVX_2STAGE( 'N', 'I', UPLO, N, KD, V, LDU, 2295 $ U, LDU, VL, VU, IL, IU, ABSTOL, M3, WA3, 2296 $ Z, LDU, WORK, LWORK, IWORK, IWORK( 5*N+1 ), 2297 $ IINFO ) 2298 IF( IINFO.NE.0 ) THEN 2299 WRITE( NOUNIT, FMT = 9999 ) 2300 $ 'DSBEVX_2STAGE(N,I,' // UPLO // 2301 $ ')', IINFO, N, JTYPE, IOLDSD 2302 INFO = ABS( IINFO ) 2303 IF( IINFO.LT.0 ) THEN 2304 RETURN 2305 ELSE 2306 RESULT( NTEST ) = ULPINV 2307 GO TO 1370 2308 END IF 2309 END IF 2310* 2311* Do test 57 (or +54) 2312* 2313 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 2314 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 2315 IF( N.GT.0 ) THEN 2316 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 2317 ELSE 2318 TEMP3 = ZERO 2319 END IF 2320 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 2321 $ MAX( UNFL, TEMP3*ULP ) 2322* 2323 1370 CONTINUE 2324 NTEST = NTEST + 1 2325 IF( IUPLO.EQ.1 ) THEN 2326 DO 1390 J = 1, N 2327 DO 1380 I = MAX( 1, J-KD ), J 2328 V( KD+1+I-J, J ) = A( I, J ) 2329 1380 CONTINUE 2330 1390 CONTINUE 2331 ELSE 2332 DO 1410 J = 1, N 2333 DO 1400 I = J, MIN( N, J+KD ) 2334 V( 1+I-J, J ) = A( I, J ) 2335 1400 CONTINUE 2336 1410 CONTINUE 2337 END IF 2338* 2339 SRNAMT = 'DSBEVX' 2340 CALL DSBEVX( 'V', 'V', UPLO, N, KD, V, LDU, U, LDU, VL, 2341 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 2342 $ IWORK, IWORK( 5*N+1 ), IINFO ) 2343 IF( IINFO.NE.0 ) THEN 2344 WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,V,' // UPLO // 2345 $ ')', IINFO, N, JTYPE, IOLDSD 2346 INFO = ABS( IINFO ) 2347 IF( IINFO.LT.0 ) THEN 2348 RETURN 2349 ELSE 2350 RESULT( NTEST ) = ULPINV 2351 RESULT( NTEST+1 ) = ULPINV 2352 RESULT( NTEST+2 ) = ULPINV 2353 GO TO 1460 2354 END IF 2355 END IF 2356* 2357* Do tests 58 and 59 (or +54) 2358* 2359 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 2360 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 2361* 2362 NTEST = NTEST + 2 2363* 2364 IF( IUPLO.EQ.1 ) THEN 2365 DO 1430 J = 1, N 2366 DO 1420 I = MAX( 1, J-KD ), J 2367 V( KD+1+I-J, J ) = A( I, J ) 2368 1420 CONTINUE 2369 1430 CONTINUE 2370 ELSE 2371 DO 1450 J = 1, N 2372 DO 1440 I = J, MIN( N, J+KD ) 2373 V( 1+I-J, J ) = A( I, J ) 2374 1440 CONTINUE 2375 1450 CONTINUE 2376 END IF 2377* 2378 SRNAMT = 'DSBEVX_2STAGE' 2379 CALL DSBEVX_2STAGE( 'N', 'V', UPLO, N, KD, V, LDU, 2380 $ U, LDU, VL, VU, IL, IU, ABSTOL, M3, WA3, 2381 $ Z, LDU, WORK, LWORK, IWORK, IWORK( 5*N+1 ), 2382 $ IINFO ) 2383 IF( IINFO.NE.0 ) THEN 2384 WRITE( NOUNIT, FMT = 9999 ) 2385 $ 'DSBEVX_2STAGE(N,V,' // UPLO // 2386 $ ')', IINFO, N, JTYPE, IOLDSD 2387 INFO = ABS( IINFO ) 2388 IF( IINFO.LT.0 ) THEN 2389 RETURN 2390 ELSE 2391 RESULT( NTEST ) = ULPINV 2392 GO TO 1460 2393 END IF 2394 END IF 2395* 2396 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 2397 RESULT( NTEST ) = ULPINV 2398 GO TO 1460 2399 END IF 2400* 2401* Do test 60 (or +54) 2402* 2403 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 2404 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 2405 IF( N.GT.0 ) THEN 2406 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 2407 ELSE 2408 TEMP3 = ZERO 2409 END IF 2410 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 2411 $ MAX( UNFL, TEMP3*ULP ) 2412* 2413 1460 CONTINUE 2414* 2415* 7) Call DSYEVD 2416* 2417 CALL DLACPY( ' ', N, N, A, LDA, V, LDU ) 2418* 2419 NTEST = NTEST + 1 2420 SRNAMT = 'DSYEVD' 2421 CALL DSYEVD( 'V', UPLO, N, A, LDU, D1, WORK, LWEDC, 2422 $ IWORK, LIWEDC, IINFO ) 2423 IF( IINFO.NE.0 ) THEN 2424 WRITE( NOUNIT, FMT = 9999 )'DSYEVD(V,' // UPLO // 2425 $ ')', IINFO, N, JTYPE, IOLDSD 2426 INFO = ABS( IINFO ) 2427 IF( IINFO.LT.0 ) THEN 2428 RETURN 2429 ELSE 2430 RESULT( NTEST ) = ULPINV 2431 RESULT( NTEST+1 ) = ULPINV 2432 RESULT( NTEST+2 ) = ULPINV 2433 GO TO 1480 2434 END IF 2435 END IF 2436* 2437* Do tests 61 and 62 (or +54) 2438* 2439 CALL DSYT21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z, 2440 $ LDU, TAU, WORK, RESULT( NTEST ) ) 2441* 2442 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2443* 2444 NTEST = NTEST + 2 2445 SRNAMT = 'DSYEVD_2STAGE' 2446 CALL DSYEVD_2STAGE( 'N', UPLO, N, A, LDU, D3, WORK, 2447 $ LWORK, IWORK, LIWEDC, IINFO ) 2448 IF( IINFO.NE.0 ) THEN 2449 WRITE( NOUNIT, FMT = 9999 ) 2450 $ 'DSYEVD_2STAGE(N,' // UPLO // 2451 $ ')', IINFO, N, JTYPE, IOLDSD 2452 INFO = ABS( IINFO ) 2453 IF( IINFO.LT.0 ) THEN 2454 RETURN 2455 ELSE 2456 RESULT( NTEST ) = ULPINV 2457 GO TO 1480 2458 END IF 2459 END IF 2460* 2461* Do test 63 (or +54) 2462* 2463 TEMP1 = ZERO 2464 TEMP2 = ZERO 2465 DO 1470 J = 1, N 2466 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 2467 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 2468 1470 CONTINUE 2469 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 2470 $ ULP*MAX( TEMP1, TEMP2 ) ) 2471* 2472 1480 CONTINUE 2473* 2474* 8) Call DSPEVD. 2475* 2476 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2477* 2478* Load array WORK with the upper or lower triangular 2479* part of the matrix in packed form. 2480* 2481 IF( IUPLO.EQ.1 ) THEN 2482 INDX = 1 2483 DO 1500 J = 1, N 2484 DO 1490 I = 1, J 2485 WORK( INDX ) = A( I, J ) 2486 INDX = INDX + 1 2487 1490 CONTINUE 2488 1500 CONTINUE 2489 ELSE 2490 INDX = 1 2491 DO 1520 J = 1, N 2492 DO 1510 I = J, N 2493 WORK( INDX ) = A( I, J ) 2494 INDX = INDX + 1 2495 1510 CONTINUE 2496 1520 CONTINUE 2497 END IF 2498* 2499 NTEST = NTEST + 1 2500 SRNAMT = 'DSPEVD' 2501 CALL DSPEVD( 'V', UPLO, N, WORK, D1, Z, LDU, 2502 $ WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC, 2503 $ IINFO ) 2504 IF( IINFO.NE.0 ) THEN 2505 WRITE( NOUNIT, FMT = 9999 )'DSPEVD(V,' // UPLO // 2506 $ ')', IINFO, N, JTYPE, IOLDSD 2507 INFO = ABS( IINFO ) 2508 IF( IINFO.LT.0 ) THEN 2509 RETURN 2510 ELSE 2511 RESULT( NTEST ) = ULPINV 2512 RESULT( NTEST+1 ) = ULPINV 2513 RESULT( NTEST+2 ) = ULPINV 2514 GO TO 1580 2515 END IF 2516 END IF 2517* 2518* Do tests 64 and 65 (or +54) 2519* 2520 CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 2521 $ LDU, TAU, WORK, RESULT( NTEST ) ) 2522* 2523 IF( IUPLO.EQ.1 ) THEN 2524 INDX = 1 2525 DO 1540 J = 1, N 2526 DO 1530 I = 1, J 2527* 2528 WORK( INDX ) = A( I, J ) 2529 INDX = INDX + 1 2530 1530 CONTINUE 2531 1540 CONTINUE 2532 ELSE 2533 INDX = 1 2534 DO 1560 J = 1, N 2535 DO 1550 I = J, N 2536 WORK( INDX ) = A( I, J ) 2537 INDX = INDX + 1 2538 1550 CONTINUE 2539 1560 CONTINUE 2540 END IF 2541* 2542 NTEST = NTEST + 2 2543 SRNAMT = 'DSPEVD' 2544 CALL DSPEVD( 'N', UPLO, N, WORK, D3, Z, LDU, 2545 $ WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC, 2546 $ IINFO ) 2547 IF( IINFO.NE.0 ) THEN 2548 WRITE( NOUNIT, FMT = 9999 )'DSPEVD(N,' // UPLO // 2549 $ ')', IINFO, N, JTYPE, IOLDSD 2550 INFO = ABS( IINFO ) 2551 IF( IINFO.LT.0 ) THEN 2552 RETURN 2553 ELSE 2554 RESULT( NTEST ) = ULPINV 2555 GO TO 1580 2556 END IF 2557 END IF 2558* 2559* Do test 66 (or +54) 2560* 2561 TEMP1 = ZERO 2562 TEMP2 = ZERO 2563 DO 1570 J = 1, N 2564 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 2565 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 2566 1570 CONTINUE 2567 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 2568 $ ULP*MAX( TEMP1, TEMP2 ) ) 2569 1580 CONTINUE 2570* 2571* 9) Call DSBEVD. 2572* 2573 IF( JTYPE.LE.7 ) THEN 2574 KD = 1 2575 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN 2576 KD = MAX( N-1, 0 ) 2577 ELSE 2578 KD = IHBW 2579 END IF 2580* 2581* Load array V with the upper or lower triangular part 2582* of the matrix in band form. 2583* 2584 IF( IUPLO.EQ.1 ) THEN 2585 DO 1600 J = 1, N 2586 DO 1590 I = MAX( 1, J-KD ), J 2587 V( KD+1+I-J, J ) = A( I, J ) 2588 1590 CONTINUE 2589 1600 CONTINUE 2590 ELSE 2591 DO 1620 J = 1, N 2592 DO 1610 I = J, MIN( N, J+KD ) 2593 V( 1+I-J, J ) = A( I, J ) 2594 1610 CONTINUE 2595 1620 CONTINUE 2596 END IF 2597* 2598 NTEST = NTEST + 1 2599 SRNAMT = 'DSBEVD' 2600 CALL DSBEVD( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK, 2601 $ LWEDC, IWORK, LIWEDC, IINFO ) 2602 IF( IINFO.NE.0 ) THEN 2603 WRITE( NOUNIT, FMT = 9999 )'DSBEVD(V,' // UPLO // 2604 $ ')', IINFO, N, JTYPE, IOLDSD 2605 INFO = ABS( IINFO ) 2606 IF( IINFO.LT.0 ) THEN 2607 RETURN 2608 ELSE 2609 RESULT( NTEST ) = ULPINV 2610 RESULT( NTEST+1 ) = ULPINV 2611 RESULT( NTEST+2 ) = ULPINV 2612 GO TO 1680 2613 END IF 2614 END IF 2615* 2616* Do tests 67 and 68 (or +54) 2617* 2618 CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 2619 $ LDU, TAU, WORK, RESULT( NTEST ) ) 2620* 2621 IF( IUPLO.EQ.1 ) THEN 2622 DO 1640 J = 1, N 2623 DO 1630 I = MAX( 1, J-KD ), J 2624 V( KD+1+I-J, J ) = A( I, J ) 2625 1630 CONTINUE 2626 1640 CONTINUE 2627 ELSE 2628 DO 1660 J = 1, N 2629 DO 1650 I = J, MIN( N, J+KD ) 2630 V( 1+I-J, J ) = A( I, J ) 2631 1650 CONTINUE 2632 1660 CONTINUE 2633 END IF 2634* 2635 NTEST = NTEST + 2 2636 SRNAMT = 'DSBEVD_2STAGE' 2637 CALL DSBEVD_2STAGE( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, 2638 $ WORK, LWORK, IWORK, LIWEDC, IINFO ) 2639 IF( IINFO.NE.0 ) THEN 2640 WRITE( NOUNIT, FMT = 9999 ) 2641 $ 'DSBEVD_2STAGE(N,' // UPLO // 2642 $ ')', IINFO, N, JTYPE, IOLDSD 2643 INFO = ABS( IINFO ) 2644 IF( IINFO.LT.0 ) THEN 2645 RETURN 2646 ELSE 2647 RESULT( NTEST ) = ULPINV 2648 GO TO 1680 2649 END IF 2650 END IF 2651* 2652* Do test 69 (or +54) 2653* 2654 TEMP1 = ZERO 2655 TEMP2 = ZERO 2656 DO 1670 J = 1, N 2657 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 2658 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 2659 1670 CONTINUE 2660 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 2661 $ ULP*MAX( TEMP1, TEMP2 ) ) 2662* 2663 1680 CONTINUE 2664* 2665* 2666 CALL DLACPY( ' ', N, N, A, LDA, V, LDU ) 2667 NTEST = NTEST + 1 2668 SRNAMT = 'DSYEVR' 2669 CALL DSYEVR( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 2670 $ ABSTOL, M, WA1, Z, LDU, IWORK, WORK, LWORK, 2671 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 2672 IF( IINFO.NE.0 ) THEN 2673 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,A,' // UPLO // 2674 $ ')', IINFO, N, JTYPE, IOLDSD 2675 INFO = ABS( IINFO ) 2676 IF( IINFO.LT.0 ) THEN 2677 RETURN 2678 ELSE 2679 RESULT( NTEST ) = ULPINV 2680 RESULT( NTEST+1 ) = ULPINV 2681 RESULT( NTEST+2 ) = ULPINV 2682 GO TO 1700 2683 END IF 2684 END IF 2685* 2686* Do tests 70 and 71 (or ... ) 2687* 2688 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2689* 2690 CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 2691 $ LDU, TAU, WORK, RESULT( NTEST ) ) 2692* 2693 NTEST = NTEST + 2 2694 SRNAMT = 'DSYEVR_2STAGE' 2695 CALL DSYEVR_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU, 2696 $ IL, IU, ABSTOL, M2, WA2, Z, LDU, IWORK, 2697 $ WORK, LWORK, IWORK(2*N+1), LIWORK-2*N, 2698 $ IINFO ) 2699 IF( IINFO.NE.0 ) THEN 2700 WRITE( NOUNIT, FMT = 9999 ) 2701 $ 'DSYEVR_2STAGE(N,A,' // UPLO // 2702 $ ')', IINFO, N, JTYPE, IOLDSD 2703 INFO = ABS( IINFO ) 2704 IF( IINFO.LT.0 ) THEN 2705 RETURN 2706 ELSE 2707 RESULT( NTEST ) = ULPINV 2708 GO TO 1700 2709 END IF 2710 END IF 2711* 2712* Do test 72 (or ... ) 2713* 2714 TEMP1 = ZERO 2715 TEMP2 = ZERO 2716 DO 1690 J = 1, N 2717 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 2718 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 2719 1690 CONTINUE 2720 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 2721 $ ULP*MAX( TEMP1, TEMP2 ) ) 2722* 2723 1700 CONTINUE 2724* 2725 NTEST = NTEST + 1 2726 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2727 SRNAMT = 'DSYEVR' 2728 CALL DSYEVR( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 2729 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 2730 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 2731 IF( IINFO.NE.0 ) THEN 2732 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,I,' // UPLO // 2733 $ ')', IINFO, N, JTYPE, IOLDSD 2734 INFO = ABS( IINFO ) 2735 IF( IINFO.LT.0 ) THEN 2736 RETURN 2737 ELSE 2738 RESULT( NTEST ) = ULPINV 2739 RESULT( NTEST+1 ) = ULPINV 2740 RESULT( NTEST+2 ) = ULPINV 2741 GO TO 1710 2742 END IF 2743 END IF 2744* 2745* Do tests 73 and 74 (or +54) 2746* 2747 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2748* 2749 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 2750 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 2751* 2752 NTEST = NTEST + 2 2753 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2754 SRNAMT = 'DSYEVR_2STAGE' 2755 CALL DSYEVR_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU, 2756 $ IL, IU, ABSTOL, M3, WA3, Z, LDU, IWORK, 2757 $ WORK, LWORK, IWORK(2*N+1), LIWORK-2*N, 2758 $ IINFO ) 2759 IF( IINFO.NE.0 ) THEN 2760 WRITE( NOUNIT, FMT = 9999 ) 2761 $ 'DSYEVR_2STAGE(N,I,' // UPLO // 2762 $ ')', IINFO, N, JTYPE, IOLDSD 2763 INFO = ABS( IINFO ) 2764 IF( IINFO.LT.0 ) THEN 2765 RETURN 2766 ELSE 2767 RESULT( NTEST ) = ULPINV 2768 GO TO 1710 2769 END IF 2770 END IF 2771* 2772* Do test 75 (or +54) 2773* 2774 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 2775 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 2776 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 2777 $ MAX( UNFL, ULP*TEMP3 ) 2778 1710 CONTINUE 2779* 2780 NTEST = NTEST + 1 2781 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2782 SRNAMT = 'DSYEVR' 2783 CALL DSYEVR( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 2784 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 2785 $ IWORK(2*N+1), LIWORK-2*N, IINFO ) 2786 IF( IINFO.NE.0 ) THEN 2787 WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,V,' // UPLO // 2788 $ ')', IINFO, N, JTYPE, IOLDSD 2789 INFO = ABS( IINFO ) 2790 IF( IINFO.LT.0 ) THEN 2791 RETURN 2792 ELSE 2793 RESULT( NTEST ) = ULPINV 2794 RESULT( NTEST+1 ) = ULPINV 2795 RESULT( NTEST+2 ) = ULPINV 2796 GO TO 700 2797 END IF 2798 END IF 2799* 2800* Do tests 76 and 77 (or +54) 2801* 2802 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2803* 2804 CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 2805 $ V, LDU, TAU, WORK, RESULT( NTEST ) ) 2806* 2807 NTEST = NTEST + 2 2808 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2809 SRNAMT = 'DSYEVR_2STAGE' 2810 CALL DSYEVR_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU, 2811 $ IL, IU, ABSTOL, M3, WA3, Z, LDU, IWORK, 2812 $ WORK, LWORK, IWORK(2*N+1), LIWORK-2*N, 2813 $ IINFO ) 2814 IF( IINFO.NE.0 ) THEN 2815 WRITE( NOUNIT, FMT = 9999 ) 2816 $ 'DSYEVR_2STAGE(N,V,' // UPLO // 2817 $ ')', IINFO, N, JTYPE, IOLDSD 2818 INFO = ABS( IINFO ) 2819 IF( IINFO.LT.0 ) THEN 2820 RETURN 2821 ELSE 2822 RESULT( NTEST ) = ULPINV 2823 GO TO 700 2824 END IF 2825 END IF 2826* 2827 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 2828 RESULT( NTEST ) = ULPINV 2829 GO TO 700 2830 END IF 2831* 2832* Do test 78 (or +54) 2833* 2834 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 2835 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 2836 IF( N.GT.0 ) THEN 2837 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 2838 ELSE 2839 TEMP3 = ZERO 2840 END IF 2841 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 2842 $ MAX( UNFL, TEMP3*ULP ) 2843* 2844 CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) 2845* 2846 1720 CONTINUE 2847* 2848* End of Loop -- Check for RESULT(j) > THRESH 2849* 2850 NTESTT = NTESTT + NTEST 2851* 2852 CALL DLAFTS( 'DST', N, N, JTYPE, NTEST, RESULT, IOLDSD, 2853 $ THRESH, NOUNIT, NERRS ) 2854* 2855 1730 CONTINUE 2856 1740 CONTINUE 2857* 2858* Summary 2859* 2860 CALL ALASVM( 'DST', NOUNIT, NERRS, NTESTT, 0 ) 2861* 2862 9999 FORMAT( ' DDRVST2STG: ', A, ' returned INFO=', I6, '.', / 9X, 2863 $ 'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' ) 2864* 2865 RETURN 2866* 2867* End of DDRVST2STG 2868* 2869 END 2870