cdrvst.c
Go to the documentation of this file.
00001 /* cdrvst.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Table of constant values */
00017 
00018 static complex c_b1 = {0.f,0.f};
00019 static complex c_b2 = {1.f,0.f};
00020 static integer c__2 = 2;
00021 static integer c__0 = 0;
00022 static integer c__6 = 6;
00023 static real c_b34 = 1.f;
00024 static integer c__1 = 1;
00025 static real c_b44 = 0.f;
00026 static integer c__4 = 4;
00027 static integer c__3 = 3;
00028 
00029 /* Subroutine */ int cdrvst_(integer *nsizes, integer *nn, integer *ntypes, 
00030         logical *dotype, integer *iseed, real *thresh, integer *nounit, 
00031         complex *a, integer *lda, real *d1, real *d2, real *d3, real *wa1, 
00032         real *wa2, real *wa3, complex *u, integer *ldu, complex *v, complex *
00033         tau, complex *z__, complex *work, integer *lwork, real *rwork, 
00034         integer *lrwork, integer *iwork, integer *liwork, real *result, 
00035         integer *info)
00036 {
00037     /* Initialized data */
00038 
00039     static integer ktype[18] = { 1,2,4,4,4,4,4,5,5,5,5,5,8,8,8,9,9,9 };
00040     static integer kmagn[18] = { 1,1,1,1,1,2,3,1,1,1,2,3,1,2,3,1,2,3 };
00041     static integer kmode[18] = { 0,0,4,3,1,4,4,4,3,1,4,4,0,0,0,4,4,4 };
00042 
00043     /* Format strings */
00044     static char fmt_9999[] = "(\002 CDRVST: \002,a,\002 returned INFO=\002,i"
00045             "6,/9x,\002N=\002,i6,\002, JTYPE=\002,i6,\002, ISEED=(\002,3(i5"
00046             ",\002,\002),i5,\002)\002)";
00047     static char fmt_9998[] = "(\002 CDRVST: \002,a,\002 returned INFO=\002,i"
00048             "6,/9x,\002N=\002,i6,\002, KD=\002,i6,\002, JTYPE=\002,i6,\002, I"
00049             "SEED=(\002,3(i5,\002,\002),i5,\002)\002)";
00050 
00051     /* System generated locals */
00052     address a__1[3];
00053     integer a_dim1, a_offset, u_dim1, u_offset, v_dim1, v_offset, z_dim1, 
00054             z_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7[3];
00055     real r__1, r__2, r__3, r__4;
00056     char ch__1[11], ch__2[13], ch__3[10];
00057 
00058     /* Builtin functions */
00059     double sqrt(doublereal), log(doublereal);
00060     integer pow_ii(integer *, integer *), s_wsfe(cilist *), do_fio(integer *, 
00061             char *, ftnlen), e_wsfe(void);
00062     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
00063 
00064     /* Local variables */
00065     integer i__, j, m, n, j1, j2, m2, m3, kd, il, iu;
00066     real vl, vu;
00067     integer lgn;
00068     real ulp, cond;
00069     integer jcol, ihbw, indx, nmax;
00070     real unfl, ovfl;
00071     char uplo[1];
00072     integer irow;
00073     real temp1, temp2, temp3;
00074     integer idiag;
00075     logical badnn;
00076     extern doublereal ssxt1_(integer *, real *, integer *, real *, integer *, 
00077             real *, real *, real *);
00078     extern /* Subroutine */ int chet21_(integer *, char *, integer *, integer 
00079             *, complex *, integer *, real *, real *, complex *, integer *, 
00080             complex *, integer *, complex *, complex *, real *, real *), chbev_(char *, char *, integer *, integer *, complex *, 
00081             integer *, real *, complex *, integer *, complex *, real *, 
00082             integer *), chet22_(integer *, char *, integer *, 
00083             integer *, integer *, complex *, integer *, real *, real *, 
00084             complex *, integer *, complex *, integer *, complex *, complex *, 
00085             real *, real *), cheev_(char *, char *, integer *, 
00086             complex *, integer *, real *, complex *, integer *, real *, 
00087             integer *);
00088     integer imode, lwedc, iinfo;
00089     extern /* Subroutine */ int chpev_(char *, char *, integer *, complex *, 
00090             real *, complex *, integer *, complex *, real *, integer *);
00091     real aninv, anorm;
00092     integer itemp, nmats, jsize, iuplo, nerrs, itype, jtype, ntest, iseed2[4],
00093              iseed3[4];
00094     extern /* Subroutine */ int slabad_(real *, real *), chbevd_(char *, char 
00095             *, integer *, integer *, complex *, integer *, real *, complex *, 
00096             integer *, complex *, integer *, real *, integer *, integer *, 
00097             integer *, integer *), cheevd_(char *, char *, 
00098             integer *, complex *, integer *, real *, complex *, integer *, 
00099             real *, integer *, integer *, integer *, integer *);
00100     integer liwedc;
00101     extern doublereal slamch_(char *);
00102     extern /* Subroutine */ int chpevd_(char *, char *, integer *, complex *, 
00103             real *, complex *, integer *, complex *, integer *, real *, 
00104             integer *, integer *, integer *, integer *), 
00105             clacpy_(char *, integer *, integer *, complex *, integer *, 
00106             complex *, integer *);
00107     integer idumma[1];
00108     extern /* Subroutine */ int cheevr_(char *, char *, char *, integer *, 
00109             complex *, integer *, real *, real *, integer *, integer *, real *
00110 , integer *, real *, complex *, integer *, integer *, complex *, 
00111             integer *, real *, integer *, integer *, integer *, integer *);
00112     integer ioldsd[4];
00113     extern /* Subroutine */ int chbevx_(char *, char *, char *, integer *, 
00114             integer *, complex *, integer *, complex *, integer *, real *, 
00115             real *, integer *, integer *, real *, integer *, real *, complex *
00116 , integer *, complex *, real *, integer *, integer *, integer *);
00117     integer lrwedc;
00118     extern /* Subroutine */ int claset_(char *, integer *, integer *, complex 
00119             *, complex *, complex *, integer *), cheevx_(char *, char 
00120             *, char *, integer *, complex *, integer *, real *, real *, 
00121             integer *, integer *, real *, integer *, real *, complex *, 
00122             integer *, complex *, integer *, real *, integer *, integer *, 
00123             integer *);
00124     extern doublereal slarnd_(integer *, integer *);
00125     real abstol;
00126     extern /* Subroutine */ int alasvm_(char *, integer *, integer *, integer 
00127             *, integer *), clatmr_(integer *, integer *, char *, 
00128             integer *, char *, complex *, integer *, real *, complex *, char *
00129 , char *, complex *, integer *, real *, complex *, integer *, 
00130             real *, char *, integer *, integer *, integer *, real *, real *, 
00131             char *, complex *, integer *, integer *, integer *), clatms_(integer *, 
00132             integer *, char *, integer *, char *, real *, integer *, real *, 
00133             real *, integer *, integer *, char *, complex *, integer *, 
00134             complex *, integer *), xerbla_(char *, 
00135             integer *), slafts_(char *, integer *, integer *, integer 
00136             *, integer *, real *, integer *, real *, integer *, integer *);
00137     integer indwrk;
00138     extern /* Subroutine */ int chpevx_(char *, char *, char *, integer *, 
00139             complex *, real *, real *, integer *, integer *, real *, integer *
00140 , real *, complex *, integer *, complex *, real *, integer *, 
00141             integer *, integer *);
00142     real rtunfl, rtovfl, ulpinv;
00143     integer mtypes, ntestt;
00144 
00145     /* Fortran I/O blocks */
00146     static cilist io___42 = { 0, 0, 0, fmt_9999, 0 };
00147     static cilist io___49 = { 0, 0, 0, fmt_9999, 0 };
00148     static cilist io___50 = { 0, 0, 0, fmt_9999, 0 };
00149     static cilist io___57 = { 0, 0, 0, fmt_9999, 0 };
00150     static cilist io___59 = { 0, 0, 0, fmt_9999, 0 };
00151     static cilist io___60 = { 0, 0, 0, fmt_9999, 0 };
00152     static cilist io___62 = { 0, 0, 0, fmt_9999, 0 };
00153     static cilist io___63 = { 0, 0, 0, fmt_9999, 0 };
00154     static cilist io___64 = { 0, 0, 0, fmt_9999, 0 };
00155     static cilist io___67 = { 0, 0, 0, fmt_9999, 0 };
00156     static cilist io___68 = { 0, 0, 0, fmt_9999, 0 };
00157     static cilist io___69 = { 0, 0, 0, fmt_9999, 0 };
00158     static cilist io___70 = { 0, 0, 0, fmt_9999, 0 };
00159     static cilist io___71 = { 0, 0, 0, fmt_9999, 0 };
00160     static cilist io___72 = { 0, 0, 0, fmt_9999, 0 };
00161     static cilist io___73 = { 0, 0, 0, fmt_9999, 0 };
00162     static cilist io___74 = { 0, 0, 0, fmt_9999, 0 };
00163     static cilist io___76 = { 0, 0, 0, fmt_9998, 0 };
00164     static cilist io___77 = { 0, 0, 0, fmt_9998, 0 };
00165     static cilist io___78 = { 0, 0, 0, fmt_9999, 0 };
00166     static cilist io___79 = { 0, 0, 0, fmt_9998, 0 };
00167     static cilist io___80 = { 0, 0, 0, fmt_9998, 0 };
00168     static cilist io___81 = { 0, 0, 0, fmt_9998, 0 };
00169     static cilist io___82 = { 0, 0, 0, fmt_9998, 0 };
00170     static cilist io___83 = { 0, 0, 0, fmt_9998, 0 };
00171     static cilist io___84 = { 0, 0, 0, fmt_9999, 0 };
00172     static cilist io___85 = { 0, 0, 0, fmt_9999, 0 };
00173     static cilist io___86 = { 0, 0, 0, fmt_9999, 0 };
00174     static cilist io___87 = { 0, 0, 0, fmt_9999, 0 };
00175     static cilist io___88 = { 0, 0, 0, fmt_9998, 0 };
00176     static cilist io___89 = { 0, 0, 0, fmt_9998, 0 };
00177     static cilist io___90 = { 0, 0, 0, fmt_9999, 0 };
00178     static cilist io___91 = { 0, 0, 0, fmt_9999, 0 };
00179     static cilist io___92 = { 0, 0, 0, fmt_9999, 0 };
00180     static cilist io___93 = { 0, 0, 0, fmt_9999, 0 };
00181     static cilist io___94 = { 0, 0, 0, fmt_9999, 0 };
00182     static cilist io___95 = { 0, 0, 0, fmt_9999, 0 };
00183 
00184 
00185 
00186 /*  -- LAPACK test routine (version 3.1) -- */
00187 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00188 /*     November 2006 */
00189 
00190 /*     .. Scalar Arguments .. */
00191 /*     .. */
00192 /*     .. Array Arguments .. */
00193 /*     .. */
00194 
00195 /*  Purpose */
00196 /*  ======= */
00197 
00198 /*       CDRVST  checks the Hermitian eigenvalue problem drivers. */
00199 
00200 /*               CHEEVD computes all eigenvalues and, optionally, */
00201 /*               eigenvectors of a complex Hermitian matrix, */
00202 /*               using a divide-and-conquer algorithm. */
00203 
00204 /*               CHEEVX computes selected eigenvalues and, optionally, */
00205 /*               eigenvectors of a complex Hermitian matrix. */
00206 
00207 /*               CHEEVR computes selected eigenvalues and, optionally, */
00208 /*               eigenvectors of a complex Hermitian matrix */
00209 /*               using the Relatively Robust Representation where it can. */
00210 
00211 /*               CHPEVD computes all eigenvalues and, optionally, */
00212 /*               eigenvectors of a complex Hermitian matrix in packed */
00213 /*               storage, using a divide-and-conquer algorithm. */
00214 
00215 /*               CHPEVX computes selected eigenvalues and, optionally, */
00216 /*               eigenvectors of a complex Hermitian matrix in packed */
00217 /*               storage. */
00218 
00219 /*               CHBEVD computes all eigenvalues and, optionally, */
00220 /*               eigenvectors of a complex Hermitian band matrix, */
00221 /*               using a divide-and-conquer algorithm. */
00222 
00223 /*               CHBEVX computes selected eigenvalues and, optionally, */
00224 /*               eigenvectors of a complex Hermitian band matrix. */
00225 
00226 /*               CHEEV computes all eigenvalues and, optionally, */
00227 /*               eigenvectors of a complex Hermitian matrix. */
00228 
00229 /*               CHPEV computes all eigenvalues and, optionally, */
00230 /*               eigenvectors of a complex Hermitian matrix in packed */
00231 /*               storage. */
00232 
00233 /*               CHBEV computes all eigenvalues and, optionally, */
00234 /*               eigenvectors of a complex Hermitian band matrix. */
00235 
00236 /*       When CDRVST is called, a number of matrix "sizes" ("n's") and a */
00237 /*       number of matrix "types" are specified.  For each size ("n") */
00238 /*       and each type of matrix, one matrix will be generated and used */
00239 /*       to test the appropriate drivers.  For each matrix and each */
00240 /*       driver routine called, the following tests will be performed: */
00241 
00242 /*       (1)     | A - Z D Z' | / ( |A| n ulp ) */
00243 
00244 /*       (2)     | I - Z Z' | / ( n ulp ) */
00245 
00246 /*       (3)     | D1 - D2 | / ( |D1| ulp ) */
00247 
00248 /*       where Z is the matrix of eigenvectors returned when the */
00249 /*       eigenvector option is given and D1 and D2 are the eigenvalues */
00250 /*       returned with and without the eigenvector option. */
00251 
00252 /*       The "sizes" are specified by an array NN(1:NSIZES); the value of */
00253 /*       each element NN(j) specifies one size. */
00254 /*       The "types" are specified by a logical array DOTYPE( 1:NTYPES ); */
00255 /*       if DOTYPE(j) is .TRUE., then matrix type "j" will be generated. */
00256 /*       Currently, the list of possible types is: */
00257 
00258 /*       (1)  The zero matrix. */
00259 /*       (2)  The identity matrix. */
00260 
00261 /*       (3)  A diagonal matrix with evenly spaced entries */
00262 /*            1, ..., ULP  and random signs. */
00263 /*            (ULP = (first number larger than 1) - 1 ) */
00264 /*       (4)  A diagonal matrix with geometrically spaced entries */
00265 /*            1, ..., ULP  and random signs. */
00266 /*       (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP */
00267 /*            and random signs. */
00268 
00269 /*       (6)  Same as (4), but multiplied by SQRT( overflow threshold ) */
00270 /*       (7)  Same as (4), but multiplied by SQRT( underflow threshold ) */
00271 
00272 /*       (8)  A matrix of the form  U* D U, where U is unitary and */
00273 /*            D has evenly spaced entries 1, ..., ULP with random signs */
00274 /*            on the diagonal. */
00275 
00276 /*       (9)  A matrix of the form  U* D U, where U is unitary and */
00277 /*            D has geometrically spaced entries 1, ..., ULP with random */
00278 /*            signs on the diagonal. */
00279 
00280 /*       (10) A matrix of the form  U* D U, where U is unitary and */
00281 /*            D has "clustered" entries 1, ULP,..., ULP with random */
00282 /*            signs on the diagonal. */
00283 
00284 /*       (11) Same as (8), but multiplied by SQRT( overflow threshold ) */
00285 /*       (12) Same as (8), but multiplied by SQRT( underflow threshold ) */
00286 
00287 /*       (13) Symmetric matrix with random entries chosen from (-1,1). */
00288 /*       (14) Same as (13), but multiplied by SQRT( overflow threshold ) */
00289 /*       (15) Same as (13), but multiplied by SQRT( underflow threshold ) */
00290 /*       (16) A band matrix with half bandwidth randomly chosen between */
00291 /*            0 and N-1, with evenly spaced eigenvalues 1, ..., ULP */
00292 /*            with random signs. */
00293 /*       (17) Same as (16), but multiplied by SQRT( overflow threshold ) */
00294 /*       (18) Same as (16), but multiplied by SQRT( underflow threshold ) */
00295 
00296 /*  Arguments */
00297 /*  ========= */
00298 
00299 /*  NSIZES  INTEGER */
00300 /*          The number of sizes of matrices to use.  If it is zero, */
00301 /*          CDRVST does nothing.  It must be at least zero. */
00302 /*          Not modified. */
00303 
00304 /*  NN      INTEGER array, dimension (NSIZES) */
00305 /*          An array containing the sizes to be used for the matrices. */
00306 /*          Zero values will be skipped.  The values must be at least */
00307 /*          zero. */
00308 /*          Not modified. */
00309 
00310 /*  NTYPES  INTEGER */
00311 /*          The number of elements in DOTYPE.   If it is zero, CDRVST */
00312 /*          does nothing.  It must be at least zero.  If it is MAXTYP+1 */
00313 /*          and NSIZES is 1, then an additional type, MAXTYP+1 is */
00314 /*          defined, which is to use whatever matrix is in A.  This */
00315 /*          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and */
00316 /*          DOTYPE(MAXTYP+1) is .TRUE. . */
00317 /*          Not modified. */
00318 
00319 /*  DOTYPE  LOGICAL array, dimension (NTYPES) */
00320 /*          If DOTYPE(j) is .TRUE., then for each size in NN a */
00321 /*          matrix of that size and of type j will be generated. */
00322 /*          If NTYPES is smaller than the maximum number of types */
00323 /*          defined (PARAMETER MAXTYP), then types NTYPES+1 through */
00324 /*          MAXTYP will not be generated.  If NTYPES is larger */
00325 /*          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) */
00326 /*          will be ignored. */
00327 /*          Not modified. */
00328 
00329 /*  ISEED   INTEGER array, dimension (4) */
00330 /*          On entry ISEED specifies the seed of the random number */
00331 /*          generator. The array elements should be between 0 and 4095; */
00332 /*          if not they will be reduced mod 4096.  Also, ISEED(4) must */
00333 /*          be odd.  The random number generator uses a linear */
00334 /*          congruential sequence limited to small integers, and so */
00335 /*          should produce machine independent random numbers. The */
00336 /*          values of ISEED are changed on exit, and can be used in the */
00337 /*          next call to CDRVST to continue the same random number */
00338 /*          sequence. */
00339 /*          Modified. */
00340 
00341 /*  THRESH  REAL */
00342 /*          A test will count as "failed" if the "error", computed as */
00343 /*          described above, exceeds THRESH.  Note that the error */
00344 /*          is scaled to be O(1), so THRESH should be a reasonably */
00345 /*          small multiple of 1, e.g., 10 or 100.  In particular, */
00346 /*          it should not depend on the precision (single vs. double) */
00347 /*          or the size of the matrix.  It must be at least zero. */
00348 /*          Not modified. */
00349 
00350 /*  NOUNIT  INTEGER */
00351 /*          The FORTRAN unit number for printing out error messages */
00352 /*          (e.g., if a routine returns IINFO not equal to 0.) */
00353 /*          Not modified. */
00354 
00355 /*  A       COMPLEX array, dimension (LDA , max(NN)) */
00356 /*          Used to hold the matrix whose eigenvalues are to be */
00357 /*          computed.  On exit, A contains the last matrix actually */
00358 /*          used. */
00359 /*          Modified. */
00360 
00361 /*  LDA     INTEGER */
00362 /*          The leading dimension of A.  It must be at */
00363 /*          least 1 and at least max( NN ). */
00364 /*          Not modified. */
00365 
00366 /*  D1      REAL array, dimension (max(NN)) */
00367 /*          The eigenvalues of A, as computed by CSTEQR simlutaneously */
00368 /*          with Z.  On exit, the eigenvalues in D1 correspond with the */
00369 /*          matrix in A. */
00370 /*          Modified. */
00371 
00372 /*  D2      REAL array, dimension (max(NN)) */
00373 /*          The eigenvalues of A, as computed by CSTEQR if Z is not */
00374 /*          computed.  On exit, the eigenvalues in D2 correspond with */
00375 /*          the matrix in A. */
00376 /*          Modified. */
00377 
00378 /*  D3      REAL array, dimension (max(NN)) */
00379 /*          The eigenvalues of A, as computed by SSTERF.  On exit, the */
00380 /*          eigenvalues in D3 correspond with the matrix in A. */
00381 /*          Modified. */
00382 
00383 /*  WA1     REAL array, dimension */
00384 
00385 /*  WA2     REAL array, dimension */
00386 
00387 /*  WA3     REAL array, dimension */
00388 
00389 /*  U       COMPLEX array, dimension (LDU, max(NN)) */
00390 /*          The unitary matrix computed by CHETRD + CUNGC3. */
00391 /*          Modified. */
00392 
00393 /*  LDU     INTEGER */
00394 /*          The leading dimension of U, Z, and V.  It must be at */
00395 /*          least 1 and at least max( NN ). */
00396 /*          Not modified. */
00397 
00398 /*  V       COMPLEX array, dimension (LDU, max(NN)) */
00399 /*          The Housholder vectors computed by CHETRD in reducing A to */
00400 /*          tridiagonal form. */
00401 /*          Modified. */
00402 
00403 /*  TAU     COMPLEX array, dimension (max(NN)) */
00404 /*          The Householder factors computed by CHETRD in reducing A */
00405 /*          to tridiagonal form. */
00406 /*          Modified. */
00407 
00408 /*  Z       COMPLEX array, dimension (LDU, max(NN)) */
00409 /*          The unitary matrix of eigenvectors computed by CHEEVD, */
00410 /*          CHEEVX, CHPEVD, CHPEVX, CHBEVD, and CHBEVX. */
00411 /*          Modified. */
00412 
00413 /*  WORK  - COMPLEX array of dimension ( LWORK ) */
00414 /*           Workspace. */
00415 /*           Modified. */
00416 
00417 /*  LWORK - INTEGER */
00418 /*           The number of entries in WORK.  This must be at least */
00419 /*           2*max( NN(j), 2 )**2. */
00420 /*           Not modified. */
00421 
00422 /*  RWORK   REAL array, dimension (3*max(NN)) */
00423 /*           Workspace. */
00424 /*           Modified. */
00425 
00426 /*  LRWORK - INTEGER */
00427 /*           The number of entries in RWORK. */
00428 
00429 /*  IWORK   INTEGER array, dimension (6*max(NN)) */
00430 /*          Workspace. */
00431 /*          Modified. */
00432 
00433 /*  LIWORK - INTEGER */
00434 /*           The number of entries in IWORK. */
00435 
00436 /*  RESULT  REAL array, dimension (??) */
00437 /*          The values computed by the tests described above. */
00438 /*          The values are currently limited to 1/ulp, to avoid */
00439 /*          overflow. */
00440 /*          Modified. */
00441 
00442 /*  INFO    INTEGER */
00443 /*          If 0, then everything ran OK. */
00444 /*           -1: NSIZES < 0 */
00445 /*           -2: Some NN(j) < 0 */
00446 /*           -3: NTYPES < 0 */
00447 /*           -5: THRESH < 0 */
00448 /*           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ). */
00449 /*          -16: LDU < 1 or LDU < NMAX. */
00450 /*          -21: LWORK too small. */
00451 /*          If  SLATMR, SLATMS, CHETRD, SORGC3, CSTEQR, SSTERF, */
00452 /*              or SORMC2 returns an error code, the */
00453 /*              absolute value of it is returned. */
00454 /*          Modified. */
00455 
00456 /* ----------------------------------------------------------------------- */
00457 
00458 /*       Some Local Variables and Parameters: */
00459 /*       ---- ----- --------- --- ---------- */
00460 /*       ZERO, ONE       Real 0 and 1. */
00461 /*       MAXTYP          The number of types defined. */
00462 /*       NTEST           The number of tests performed, or which can */
00463 /*                       be performed so far, for the current matrix. */
00464 /*       NTESTT          The total number of tests performed so far. */
00465 /*       NMAX            Largest value in NN. */
00466 /*       NMATS           The number of matrices generated so far. */
00467 /*       NERRS           The number of tests which have exceeded THRESH */
00468 /*                       so far (computed by SLAFTS). */
00469 /*       COND, IMODE     Values to be passed to the matrix generators. */
00470 /*       ANORM           Norm of A; passed to matrix generators. */
00471 
00472 /*       OVFL, UNFL      Overflow and underflow thresholds. */
00473 /*       ULP, ULPINV     Finest relative precision and its inverse. */
00474 /*       RTOVFL, RTUNFL  Square roots of the previous 2 values. */
00475 /*               The following four arrays decode JTYPE: */
00476 /*       KTYPE(j)        The general type (1-10) for type "j". */
00477 /*       KMODE(j)        The MODE value to be passed to the matrix */
00478 /*                       generator for type "j". */
00479 /*       KMAGN(j)        The order of magnitude ( O(1), */
00480 /*                       O(overflow^(1/2) ), O(underflow^(1/2) ) */
00481 
00482 /*  ===================================================================== */
00483 
00484 
00485 /*     .. Parameters .. */
00486 /*     .. */
00487 /*     .. Local Scalars .. */
00488 /*     .. */
00489 /*     .. Local Arrays .. */
00490 /*     .. */
00491 /*     .. External Functions .. */
00492 /*     .. */
00493 /*     .. External Subroutines .. */
00494 /*     .. */
00495 /*     .. Intrinsic Functions .. */
00496 /*     .. */
00497 /*     .. Data statements .. */
00498     /* Parameter adjustments */
00499     --nn;
00500     --dotype;
00501     --iseed;
00502     a_dim1 = *lda;
00503     a_offset = 1 + a_dim1;
00504     a -= a_offset;
00505     --d1;
00506     --d2;
00507     --d3;
00508     --wa1;
00509     --wa2;
00510     --wa3;
00511     z_dim1 = *ldu;
00512     z_offset = 1 + z_dim1;
00513     z__ -= z_offset;
00514     v_dim1 = *ldu;
00515     v_offset = 1 + v_dim1;
00516     v -= v_offset;
00517     u_dim1 = *ldu;
00518     u_offset = 1 + u_dim1;
00519     u -= u_offset;
00520     --tau;
00521     --work;
00522     --rwork;
00523     --iwork;
00524     --result;
00525 
00526     /* Function Body */
00527 /*     .. */
00528 /*     .. Executable Statements .. */
00529 
00530 /*     1)      Check for errors */
00531 
00532     ntestt = 0;
00533     *info = 0;
00534 
00535     badnn = FALSE_;
00536     nmax = 1;
00537     i__1 = *nsizes;
00538     for (j = 1; j <= i__1; ++j) {
00539 /* Computing MAX */
00540         i__2 = nmax, i__3 = nn[j];
00541         nmax = max(i__2,i__3);
00542         if (nn[j] < 0) {
00543             badnn = TRUE_;
00544         }
00545 /* L10: */
00546     }
00547 
00548 /*     Check for errors */
00549 
00550     if (*nsizes < 0) {
00551         *info = -1;
00552     } else if (badnn) {
00553         *info = -2;
00554     } else if (*ntypes < 0) {
00555         *info = -3;
00556     } else if (*lda < nmax) {
00557         *info = -9;
00558     } else if (*ldu < nmax) {
00559         *info = -16;
00560     } else /* if(complicated condition) */ {
00561 /* Computing 2nd power */
00562         i__1 = max(2,nmax);
00563         if (i__1 * i__1 << 1 > *lwork) {
00564             *info = -22;
00565         }
00566     }
00567 
00568     if (*info != 0) {
00569         i__1 = -(*info);
00570         xerbla_("CDRVST", &i__1);
00571         return 0;
00572     }
00573 
00574 /*     Quick return if nothing to do */
00575 
00576     if (*nsizes == 0 || *ntypes == 0) {
00577         return 0;
00578     }
00579 
00580 /*     More Important constants */
00581 
00582     unfl = slamch_("Safe minimum");
00583     ovfl = slamch_("Overflow");
00584     slabad_(&unfl, &ovfl);
00585     ulp = slamch_("Epsilon") * slamch_("Base");
00586     ulpinv = 1.f / ulp;
00587     rtunfl = sqrt(unfl);
00588     rtovfl = sqrt(ovfl);
00589 
00590 /*     Loop over sizes, types */
00591 
00592     for (i__ = 1; i__ <= 4; ++i__) {
00593         iseed2[i__ - 1] = iseed[i__];
00594         iseed3[i__ - 1] = iseed[i__];
00595 /* L20: */
00596     }
00597 
00598     nerrs = 0;
00599     nmats = 0;
00600 
00601     i__1 = *nsizes;
00602     for (jsize = 1; jsize <= i__1; ++jsize) {
00603         n = nn[jsize];
00604         if (n > 0) {
00605             lgn = (integer) (log((real) n) / log(2.f));
00606             if (pow_ii(&c__2, &lgn) < n) {
00607                 ++lgn;
00608             }
00609             if (pow_ii(&c__2, &lgn) < n) {
00610                 ++lgn;
00611             }
00612 /* Computing MAX */
00613             i__2 = (n << 1) + n * n, i__3 = (n << 1) * n;
00614             lwedc = max(i__2,i__3);
00615 /* Computing 2nd power */
00616             i__2 = n;
00617             lrwedc = (n << 2) + 1 + (n << 1) * lgn + i__2 * i__2 * 3;
00618             liwedc = n * 5 + 3;
00619         } else {
00620             lwedc = 2;
00621             lrwedc = 8;
00622             liwedc = 8;
00623         }
00624         aninv = 1.f / (real) max(1,n);
00625 
00626         if (*nsizes != 1) {
00627             mtypes = min(18,*ntypes);
00628         } else {
00629             mtypes = min(19,*ntypes);
00630         }
00631 
00632         i__2 = mtypes;
00633         for (jtype = 1; jtype <= i__2; ++jtype) {
00634             if (! dotype[jtype]) {
00635                 goto L1210;
00636             }
00637             ++nmats;
00638             ntest = 0;
00639 
00640             for (j = 1; j <= 4; ++j) {
00641                 ioldsd[j - 1] = iseed[j];
00642 /* L30: */
00643             }
00644 
00645 /*           2)      Compute "A" */
00646 
00647 /*                   Control parameters: */
00648 
00649 /*               KMAGN  KMODE        KTYPE */
00650 /*           =1  O(1)   clustered 1  zero */
00651 /*           =2  large  clustered 2  identity */
00652 /*           =3  small  exponential  (none) */
00653 /*           =4         arithmetic   diagonal, (w/ eigenvalues) */
00654 /*           =5         random log   Hermitian, w/ eigenvalues */
00655 /*           =6         random       (none) */
00656 /*           =7                      random diagonal */
00657 /*           =8                      random Hermitian */
00658 /*           =9                      band Hermitian, w/ eigenvalues */
00659 
00660             if (mtypes > 18) {
00661                 goto L110;
00662             }
00663 
00664             itype = ktype[jtype - 1];
00665             imode = kmode[jtype - 1];
00666 
00667 /*           Compute norm */
00668 
00669             switch (kmagn[jtype - 1]) {
00670                 case 1:  goto L40;
00671                 case 2:  goto L50;
00672                 case 3:  goto L60;
00673             }
00674 
00675 L40:
00676             anorm = 1.f;
00677             goto L70;
00678 
00679 L50:
00680             anorm = rtovfl * ulp * aninv;
00681             goto L70;
00682 
00683 L60:
00684             anorm = rtunfl * n * ulpinv;
00685             goto L70;
00686 
00687 L70:
00688 
00689             claset_("Full", lda, &n, &c_b1, &c_b1, &a[a_offset], lda);
00690             iinfo = 0;
00691             cond = ulpinv;
00692 
00693 /*           Special Matrices -- Identity & Jordan block */
00694 
00695 /*                   Zero */
00696 
00697             if (itype == 1) {
00698                 iinfo = 0;
00699 
00700             } else if (itype == 2) {
00701 
00702 /*              Identity */
00703 
00704                 i__3 = n;
00705                 for (jcol = 1; jcol <= i__3; ++jcol) {
00706                     i__4 = jcol + jcol * a_dim1;
00707                     a[i__4].r = anorm, a[i__4].i = 0.f;
00708 /* L80: */
00709                 }
00710 
00711             } else if (itype == 4) {
00712 
00713 /*              Diagonal Matrix, [Eigen]values Specified */
00714 
00715                 clatms_(&n, &n, "S", &iseed[1], "H", &rwork[1], &imode, &cond, 
00716                          &anorm, &c__0, &c__0, "N", &a[a_offset], lda, &work[
00717                         1], &iinfo);
00718 
00719             } else if (itype == 5) {
00720 
00721 /*              Hermitian, eigenvalues specified */
00722 
00723                 clatms_(&n, &n, "S", &iseed[1], "H", &rwork[1], &imode, &cond, 
00724                          &anorm, &n, &n, "N", &a[a_offset], lda, &work[1], &
00725                         iinfo);
00726 
00727             } else if (itype == 7) {
00728 
00729 /*              Diagonal, random eigenvalues */
00730 
00731                 clatmr_(&n, &n, "S", &iseed[1], "H", &work[1], &c__6, &c_b34, 
00732                         &c_b2, "T", "N", &work[n + 1], &c__1, &c_b34, &work[(
00733                         n << 1) + 1], &c__1, &c_b34, "N", idumma, &c__0, &
00734                         c__0, &c_b44, &anorm, "NO", &a[a_offset], lda, &iwork[
00735                         1], &iinfo);
00736 
00737             } else if (itype == 8) {
00738 
00739 /*              Hermitian, random eigenvalues */
00740 
00741                 clatmr_(&n, &n, "S", &iseed[1], "H", &work[1], &c__6, &c_b34, 
00742                         &c_b2, "T", "N", &work[n + 1], &c__1, &c_b34, &work[(
00743                         n << 1) + 1], &c__1, &c_b34, "N", idumma, &n, &n, &
00744                         c_b44, &anorm, "NO", &a[a_offset], lda, &iwork[1], &
00745                         iinfo);
00746 
00747             } else if (itype == 9) {
00748 
00749 /*              Hermitian banded, eigenvalues specified */
00750 
00751                 ihbw = (integer) ((n - 1) * slarnd_(&c__1, iseed3));
00752                 clatms_(&n, &n, "S", &iseed[1], "H", &rwork[1], &imode, &cond, 
00753                          &anorm, &ihbw, &ihbw, "Z", &u[u_offset], ldu, &work[
00754                         1], &iinfo);
00755 
00756 /*              Store as dense matrix for most routines. */
00757 
00758                 claset_("Full", lda, &n, &c_b1, &c_b1, &a[a_offset], lda);
00759                 i__3 = ihbw;
00760                 for (idiag = -ihbw; idiag <= i__3; ++idiag) {
00761                     irow = ihbw - idiag + 1;
00762 /* Computing MAX */
00763                     i__4 = 1, i__5 = idiag + 1;
00764                     j1 = max(i__4,i__5);
00765 /* Computing MIN */
00766                     i__4 = n, i__5 = n + idiag;
00767                     j2 = min(i__4,i__5);
00768                     i__4 = j2;
00769                     for (j = j1; j <= i__4; ++j) {
00770                         i__ = j - idiag;
00771                         i__5 = i__ + j * a_dim1;
00772                         i__6 = irow + j * u_dim1;
00773                         a[i__5].r = u[i__6].r, a[i__5].i = u[i__6].i;
00774 /* L90: */
00775                     }
00776 /* L100: */
00777                 }
00778             } else {
00779                 iinfo = 1;
00780             }
00781 
00782             if (iinfo != 0) {
00783                 io___42.ciunit = *nounit;
00784                 s_wsfe(&io___42);
00785                 do_fio(&c__1, "Generator", (ftnlen)9);
00786                 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00787                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00788                 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00789                 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00790                 e_wsfe();
00791                 *info = abs(iinfo);
00792                 return 0;
00793             }
00794 
00795 L110:
00796 
00797             abstol = unfl + unfl;
00798             if (n <= 1) {
00799                 il = 1;
00800                 iu = n;
00801             } else {
00802                 il = (integer) ((n - 1) * slarnd_(&c__1, iseed2)) + 1;
00803                 iu = (integer) ((n - 1) * slarnd_(&c__1, iseed2)) + 1;
00804                 if (il > iu) {
00805                     itemp = il;
00806                     il = iu;
00807                     iu = itemp;
00808                 }
00809             }
00810 
00811 /*           Perform tests storing upper or lower triangular */
00812 /*           part of matrix. */
00813 
00814             for (iuplo = 0; iuplo <= 1; ++iuplo) {
00815                 if (iuplo == 0) {
00816                     *(unsigned char *)uplo = 'L';
00817                 } else {
00818                     *(unsigned char *)uplo = 'U';
00819                 }
00820 
00821 /*              Call CHEEVD and CHEEVX. */
00822 
00823                 clacpy_(" ", &n, &n, &a[a_offset], lda, &v[v_offset], ldu);
00824 
00825                 ++ntest;
00826                 cheevd_("V", uplo, &n, &a[a_offset], ldu, &d1[1], &work[1], &
00827                         lwedc, &rwork[1], &lrwedc, &iwork[1], &liwedc, &iinfo);
00828                 if (iinfo != 0) {
00829                     io___49.ciunit = *nounit;
00830                     s_wsfe(&io___49);
00831 /* Writing concatenation */
00832                     i__7[0] = 9, a__1[0] = "CHEEVD(V,";
00833                     i__7[1] = 1, a__1[1] = uplo;
00834                     i__7[2] = 1, a__1[2] = ")";
00835                     s_cat(ch__1, a__1, i__7, &c__3, (ftnlen)11);
00836                     do_fio(&c__1, ch__1, (ftnlen)11);
00837                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00838                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00839                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00840                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
00841                             ;
00842                     e_wsfe();
00843                     *info = abs(iinfo);
00844                     if (iinfo < 0) {
00845                         return 0;
00846                     } else {
00847                         result[ntest] = ulpinv;
00848                         result[ntest + 1] = ulpinv;
00849                         result[ntest + 2] = ulpinv;
00850                         goto L130;
00851                     }
00852                 }
00853 
00854 /*              Do tests 1 and 2. */
00855 
00856                 chet21_(&c__1, uplo, &n, &c__0, &v[v_offset], ldu, &d1[1], &
00857                         d2[1], &a[a_offset], ldu, &z__[z_offset], ldu, &tau[1]
00858 , &work[1], &rwork[1], &result[ntest]);
00859 
00860                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
00861 
00862                 ntest += 2;
00863                 cheevd_("N", uplo, &n, &a[a_offset], ldu, &d3[1], &work[1], &
00864                         lwedc, &rwork[1], &lrwedc, &iwork[1], &liwedc, &iinfo);
00865                 if (iinfo != 0) {
00866                     io___50.ciunit = *nounit;
00867                     s_wsfe(&io___50);
00868 /* Writing concatenation */
00869                     i__7[0] = 9, a__1[0] = "CHEEVD(N,";
00870                     i__7[1] = 1, a__1[1] = uplo;
00871                     i__7[2] = 1, a__1[2] = ")";
00872                     s_cat(ch__1, a__1, i__7, &c__3, (ftnlen)11);
00873                     do_fio(&c__1, ch__1, (ftnlen)11);
00874                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00875                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00876                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00877                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
00878                             ;
00879                     e_wsfe();
00880                     *info = abs(iinfo);
00881                     if (iinfo < 0) {
00882                         return 0;
00883                     } else {
00884                         result[ntest] = ulpinv;
00885                         goto L130;
00886                     }
00887                 }
00888 
00889 /*              Do test 3. */
00890 
00891                 temp1 = 0.f;
00892                 temp2 = 0.f;
00893                 i__3 = n;
00894                 for (j = 1; j <= i__3; ++j) {
00895 /* Computing MAX */
00896                     r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 = 
00897                             max(r__3,r__4), r__4 = (r__2 = d3[j], dabs(r__2));
00898                     temp1 = dmax(r__3,r__4);
00899 /* Computing MAX */
00900                     r__2 = temp2, r__3 = (r__1 = d1[j] - d3[j], dabs(r__1));
00901                     temp2 = dmax(r__2,r__3);
00902 /* L120: */
00903                 }
00904 /* Computing MAX */
00905                 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
00906                 result[ntest] = temp2 / dmax(r__1,r__2);
00907 
00908 L130:
00909                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
00910 
00911                 ++ntest;
00912 
00913                 if (n > 0) {
00914 /* Computing MAX */
00915                     r__2 = dabs(d1[1]), r__3 = (r__1 = d1[n], dabs(r__1));
00916                     temp3 = dmax(r__2,r__3);
00917                     if (il != 1) {
00918 /* Computing MAX */
00919                         r__1 = (d1[il] - d1[il - 1]) * .5f, r__2 = ulp * 10.f 
00920                                 * temp3, r__1 = max(r__1,r__2), r__2 = rtunfl 
00921                                 * 10.f;
00922                         vl = d1[il] - dmax(r__1,r__2);
00923                     } else if (n > 0) {
00924 /* Computing MAX */
00925                         r__1 = (d1[n] - d1[1]) * .5f, r__2 = ulp * 10.f * 
00926                                 temp3, r__1 = max(r__1,r__2), r__2 = rtunfl * 
00927                                 10.f;
00928                         vl = d1[1] - dmax(r__1,r__2);
00929                     }
00930                     if (iu != n) {
00931 /* Computing MAX */
00932                         r__1 = (d1[iu + 1] - d1[iu]) * .5f, r__2 = ulp * 10.f 
00933                                 * temp3, r__1 = max(r__1,r__2), r__2 = rtunfl 
00934                                 * 10.f;
00935                         vu = d1[iu] + dmax(r__1,r__2);
00936                     } else if (n > 0) {
00937 /* Computing MAX */
00938                         r__1 = (d1[n] - d1[1]) * .5f, r__2 = ulp * 10.f * 
00939                                 temp3, r__1 = max(r__1,r__2), r__2 = rtunfl * 
00940                                 10.f;
00941                         vu = d1[n] + dmax(r__1,r__2);
00942                     }
00943                 } else {
00944                     temp3 = 0.f;
00945                     vl = 0.f;
00946                     vu = 1.f;
00947                 }
00948 
00949                 cheevx_("V", "A", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il, 
00950                         &iu, &abstol, &m, &wa1[1], &z__[z_offset], ldu, &work[
00951                         1], lwork, &rwork[1], &iwork[1], &iwork[n * 5 + 1], &
00952                         iinfo);
00953                 if (iinfo != 0) {
00954                     io___57.ciunit = *nounit;
00955                     s_wsfe(&io___57);
00956 /* Writing concatenation */
00957                     i__7[0] = 11, a__1[0] = "CHEEVX(V,A,";
00958                     i__7[1] = 1, a__1[1] = uplo;
00959                     i__7[2] = 1, a__1[2] = ")";
00960                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
00961                     do_fio(&c__1, ch__2, (ftnlen)13);
00962                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00963                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00964                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00965                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
00966                             ;
00967                     e_wsfe();
00968                     *info = abs(iinfo);
00969                     if (iinfo < 0) {
00970                         return 0;
00971                     } else {
00972                         result[ntest] = ulpinv;
00973                         result[ntest + 1] = ulpinv;
00974                         result[ntest + 2] = ulpinv;
00975                         goto L150;
00976                     }
00977                 }
00978 
00979 /*              Do tests 4 and 5. */
00980 
00981                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
00982 
00983                 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], ldu, &wa1[1], &
00984                         d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
00985 , &work[1], &rwork[1], &result[ntest]);
00986 
00987                 ntest += 2;
00988                 cheevx_("N", "A", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il, 
00989                         &iu, &abstol, &m2, &wa2[1], &z__[z_offset], ldu, &
00990                         work[1], lwork, &rwork[1], &iwork[1], &iwork[n * 5 + 
00991                         1], &iinfo);
00992                 if (iinfo != 0) {
00993                     io___59.ciunit = *nounit;
00994                     s_wsfe(&io___59);
00995 /* Writing concatenation */
00996                     i__7[0] = 11, a__1[0] = "CHEEVX(N,A,";
00997                     i__7[1] = 1, a__1[1] = uplo;
00998                     i__7[2] = 1, a__1[2] = ")";
00999                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01000                     do_fio(&c__1, ch__2, (ftnlen)13);
01001                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01002                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01003                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01004                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01005                             ;
01006                     e_wsfe();
01007                     *info = abs(iinfo);
01008                     if (iinfo < 0) {
01009                         return 0;
01010                     } else {
01011                         result[ntest] = ulpinv;
01012                         goto L150;
01013                     }
01014                 }
01015 
01016 /*              Do test 6. */
01017 
01018                 temp1 = 0.f;
01019                 temp2 = 0.f;
01020                 i__3 = n;
01021                 for (j = 1; j <= i__3; ++j) {
01022 /* Computing MAX */
01023                     r__3 = temp1, r__4 = (r__1 = wa1[j], dabs(r__1)), r__3 = 
01024                             max(r__3,r__4), r__4 = (r__2 = wa2[j], dabs(r__2))
01025                             ;
01026                     temp1 = dmax(r__3,r__4);
01027 /* Computing MAX */
01028                     r__2 = temp2, r__3 = (r__1 = wa1[j] - wa2[j], dabs(r__1));
01029                     temp2 = dmax(r__2,r__3);
01030 /* L140: */
01031                 }
01032 /* Computing MAX */
01033                 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
01034                 result[ntest] = temp2 / dmax(r__1,r__2);
01035 
01036 L150:
01037                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
01038 
01039                 ++ntest;
01040 
01041                 cheevx_("V", "I", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il, 
01042                         &iu, &abstol, &m2, &wa2[1], &z__[z_offset], ldu, &
01043                         work[1], lwork, &rwork[1], &iwork[1], &iwork[n * 5 + 
01044                         1], &iinfo);
01045                 if (iinfo != 0) {
01046                     io___60.ciunit = *nounit;
01047                     s_wsfe(&io___60);
01048 /* Writing concatenation */
01049                     i__7[0] = 11, a__1[0] = "CHEEVX(V,I,";
01050                     i__7[1] = 1, a__1[1] = uplo;
01051                     i__7[2] = 1, a__1[2] = ")";
01052                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01053                     do_fio(&c__1, ch__2, (ftnlen)13);
01054                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01055                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01056                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01057                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01058                             ;
01059                     e_wsfe();
01060                     *info = abs(iinfo);
01061                     if (iinfo < 0) {
01062                         return 0;
01063                     } else {
01064                         result[ntest] = ulpinv;
01065                         goto L160;
01066                     }
01067                 }
01068 
01069 /*              Do tests 7 and 8. */
01070 
01071                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
01072 
01073                 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
01074                         1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
01075                         tau[1], &work[1], &rwork[1], &result[ntest]);
01076 
01077                 ntest += 2;
01078 
01079                 cheevx_("N", "I", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il, 
01080                         &iu, &abstol, &m3, &wa3[1], &z__[z_offset], ldu, &
01081                         work[1], lwork, &rwork[1], &iwork[1], &iwork[n * 5 + 
01082                         1], &iinfo);
01083                 if (iinfo != 0) {
01084                     io___62.ciunit = *nounit;
01085                     s_wsfe(&io___62);
01086 /* Writing concatenation */
01087                     i__7[0] = 11, a__1[0] = "CHEEVX(N,I,";
01088                     i__7[1] = 1, a__1[1] = uplo;
01089                     i__7[2] = 1, a__1[2] = ")";
01090                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01091                     do_fio(&c__1, ch__2, (ftnlen)13);
01092                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01093                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01094                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01095                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01096                             ;
01097                     e_wsfe();
01098                     *info = abs(iinfo);
01099                     if (iinfo < 0) {
01100                         return 0;
01101                     } else {
01102                         result[ntest] = ulpinv;
01103                         goto L160;
01104                     }
01105                 }
01106 
01107 /*              Do test 9. */
01108 
01109                 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
01110                         ulp, &unfl);
01111                 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
01112                         ulp, &unfl);
01113                 if (n > 0) {
01114 /* Computing MAX */
01115                     r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
01116                     temp3 = dmax(r__2,r__3);
01117                 } else {
01118                     temp3 = 0.f;
01119                 }
01120 /* Computing MAX */
01121                 r__1 = unfl, r__2 = temp3 * ulp;
01122                 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
01123 
01124 L160:
01125                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
01126 
01127                 ++ntest;
01128 
01129                 cheevx_("V", "V", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il, 
01130                         &iu, &abstol, &m2, &wa2[1], &z__[z_offset], ldu, &
01131                         work[1], lwork, &rwork[1], &iwork[1], &iwork[n * 5 + 
01132                         1], &iinfo);
01133                 if (iinfo != 0) {
01134                     io___63.ciunit = *nounit;
01135                     s_wsfe(&io___63);
01136 /* Writing concatenation */
01137                     i__7[0] = 11, a__1[0] = "CHEEVX(V,V,";
01138                     i__7[1] = 1, a__1[1] = uplo;
01139                     i__7[2] = 1, a__1[2] = ")";
01140                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01141                     do_fio(&c__1, ch__2, (ftnlen)13);
01142                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01143                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01144                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01145                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01146                             ;
01147                     e_wsfe();
01148                     *info = abs(iinfo);
01149                     if (iinfo < 0) {
01150                         return 0;
01151                     } else {
01152                         result[ntest] = ulpinv;
01153                         goto L170;
01154                     }
01155                 }
01156 
01157 /*              Do tests 10 and 11. */
01158 
01159                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
01160 
01161                 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
01162                         1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
01163                         tau[1], &work[1], &rwork[1], &result[ntest]);
01164 
01165                 ntest += 2;
01166 
01167                 cheevx_("N", "V", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il, 
01168                         &iu, &abstol, &m3, &wa3[1], &z__[z_offset], ldu, &
01169                         work[1], lwork, &rwork[1], &iwork[1], &iwork[n * 5 + 
01170                         1], &iinfo);
01171                 if (iinfo != 0) {
01172                     io___64.ciunit = *nounit;
01173                     s_wsfe(&io___64);
01174 /* Writing concatenation */
01175                     i__7[0] = 11, a__1[0] = "CHEEVX(N,V,";
01176                     i__7[1] = 1, a__1[1] = uplo;
01177                     i__7[2] = 1, a__1[2] = ")";
01178                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01179                     do_fio(&c__1, ch__2, (ftnlen)13);
01180                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01181                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01182                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01183                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01184                             ;
01185                     e_wsfe();
01186                     *info = abs(iinfo);
01187                     if (iinfo < 0) {
01188                         return 0;
01189                     } else {
01190                         result[ntest] = ulpinv;
01191                         goto L170;
01192                     }
01193                 }
01194 
01195                 if (m3 == 0 && n > 0) {
01196                     result[ntest] = ulpinv;
01197                     goto L170;
01198                 }
01199 
01200 /*              Do test 12. */
01201 
01202                 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
01203                         ulp, &unfl);
01204                 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
01205                         ulp, &unfl);
01206                 if (n > 0) {
01207 /* Computing MAX */
01208                     r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
01209                     temp3 = dmax(r__2,r__3);
01210                 } else {
01211                     temp3 = 0.f;
01212                 }
01213 /* Computing MAX */
01214                 r__1 = unfl, r__2 = temp3 * ulp;
01215                 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
01216 
01217 L170:
01218 
01219 /*              Call CHPEVD and CHPEVX. */
01220 
01221                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
01222 
01223 /*              Load array WORK with the upper or lower triangular */
01224 /*              part of the matrix in packed form. */
01225 
01226                 if (iuplo == 1) {
01227                     indx = 1;
01228                     i__3 = n;
01229                     for (j = 1; j <= i__3; ++j) {
01230                         i__4 = j;
01231                         for (i__ = 1; i__ <= i__4; ++i__) {
01232                             i__5 = indx;
01233                             i__6 = i__ + j * a_dim1;
01234                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01235                                     .i;
01236                             ++indx;
01237 /* L180: */
01238                         }
01239 /* L190: */
01240                     }
01241                 } else {
01242                     indx = 1;
01243                     i__3 = n;
01244                     for (j = 1; j <= i__3; ++j) {
01245                         i__4 = n;
01246                         for (i__ = j; i__ <= i__4; ++i__) {
01247                             i__5 = indx;
01248                             i__6 = i__ + j * a_dim1;
01249                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01250                                     .i;
01251                             ++indx;
01252 /* L200: */
01253                         }
01254 /* L210: */
01255                     }
01256                 }
01257 
01258                 ++ntest;
01259                 indwrk = n * (n + 1) / 2 + 1;
01260                 chpevd_("V", uplo, &n, &work[1], &d1[1], &z__[z_offset], ldu, 
01261                         &work[indwrk], &lwedc, &rwork[1], &lrwedc, &iwork[1], 
01262                         &liwedc, &iinfo);
01263                 if (iinfo != 0) {
01264                     io___67.ciunit = *nounit;
01265                     s_wsfe(&io___67);
01266 /* Writing concatenation */
01267                     i__7[0] = 9, a__1[0] = "CHPEVD(V,";
01268                     i__7[1] = 1, a__1[1] = uplo;
01269                     i__7[2] = 1, a__1[2] = ")";
01270                     s_cat(ch__1, a__1, i__7, &c__3, (ftnlen)11);
01271                     do_fio(&c__1, ch__1, (ftnlen)11);
01272                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01273                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01274                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01275                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01276                             ;
01277                     e_wsfe();
01278                     *info = abs(iinfo);
01279                     if (iinfo < 0) {
01280                         return 0;
01281                     } else {
01282                         result[ntest] = ulpinv;
01283                         result[ntest + 1] = ulpinv;
01284                         result[ntest + 2] = ulpinv;
01285                         goto L270;
01286                     }
01287                 }
01288 
01289 /*              Do tests 13 and 14. */
01290 
01291                 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], lda, &d1[1], &
01292                         d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
01293 , &work[1], &rwork[1], &result[ntest]);
01294 
01295                 if (iuplo == 1) {
01296                     indx = 1;
01297                     i__3 = n;
01298                     for (j = 1; j <= i__3; ++j) {
01299                         i__4 = j;
01300                         for (i__ = 1; i__ <= i__4; ++i__) {
01301                             i__5 = indx;
01302                             i__6 = i__ + j * a_dim1;
01303                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01304                                     .i;
01305                             ++indx;
01306 /* L220: */
01307                         }
01308 /* L230: */
01309                     }
01310                 } else {
01311                     indx = 1;
01312                     i__3 = n;
01313                     for (j = 1; j <= i__3; ++j) {
01314                         i__4 = n;
01315                         for (i__ = j; i__ <= i__4; ++i__) {
01316                             i__5 = indx;
01317                             i__6 = i__ + j * a_dim1;
01318                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01319                                     .i;
01320                             ++indx;
01321 /* L240: */
01322                         }
01323 /* L250: */
01324                     }
01325                 }
01326 
01327                 ntest += 2;
01328                 indwrk = n * (n + 1) / 2 + 1;
01329                 chpevd_("N", uplo, &n, &work[1], &d3[1], &z__[z_offset], ldu, 
01330                         &work[indwrk], &lwedc, &rwork[1], &lrwedc, &iwork[1], 
01331                         &liwedc, &iinfo);
01332                 if (iinfo != 0) {
01333                     io___68.ciunit = *nounit;
01334                     s_wsfe(&io___68);
01335 /* Writing concatenation */
01336                     i__7[0] = 9, a__1[0] = "CHPEVD(N,";
01337                     i__7[1] = 1, a__1[1] = uplo;
01338                     i__7[2] = 1, a__1[2] = ")";
01339                     s_cat(ch__1, a__1, i__7, &c__3, (ftnlen)11);
01340                     do_fio(&c__1, ch__1, (ftnlen)11);
01341                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01342                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01343                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01344                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01345                             ;
01346                     e_wsfe();
01347                     *info = abs(iinfo);
01348                     if (iinfo < 0) {
01349                         return 0;
01350                     } else {
01351                         result[ntest] = ulpinv;
01352                         goto L270;
01353                     }
01354                 }
01355 
01356 /*              Do test 15. */
01357 
01358                 temp1 = 0.f;
01359                 temp2 = 0.f;
01360                 i__3 = n;
01361                 for (j = 1; j <= i__3; ++j) {
01362 /* Computing MAX */
01363                     r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 = 
01364                             max(r__3,r__4), r__4 = (r__2 = d3[j], dabs(r__2));
01365                     temp1 = dmax(r__3,r__4);
01366 /* Computing MAX */
01367                     r__2 = temp2, r__3 = (r__1 = d1[j] - d3[j], dabs(r__1));
01368                     temp2 = dmax(r__2,r__3);
01369 /* L260: */
01370                 }
01371 /* Computing MAX */
01372                 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
01373                 result[ntest] = temp2 / dmax(r__1,r__2);
01374 
01375 /*              Load array WORK with the upper or lower triangular part */
01376 /*              of the matrix in packed form. */
01377 
01378 L270:
01379                 if (iuplo == 1) {
01380                     indx = 1;
01381                     i__3 = n;
01382                     for (j = 1; j <= i__3; ++j) {
01383                         i__4 = j;
01384                         for (i__ = 1; i__ <= i__4; ++i__) {
01385                             i__5 = indx;
01386                             i__6 = i__ + j * a_dim1;
01387                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01388                                     .i;
01389                             ++indx;
01390 /* L280: */
01391                         }
01392 /* L290: */
01393                     }
01394                 } else {
01395                     indx = 1;
01396                     i__3 = n;
01397                     for (j = 1; j <= i__3; ++j) {
01398                         i__4 = n;
01399                         for (i__ = j; i__ <= i__4; ++i__) {
01400                             i__5 = indx;
01401                             i__6 = i__ + j * a_dim1;
01402                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01403                                     .i;
01404                             ++indx;
01405 /* L300: */
01406                         }
01407 /* L310: */
01408                     }
01409                 }
01410 
01411                 ++ntest;
01412 
01413                 if (n > 0) {
01414 /* Computing MAX */
01415                     r__2 = dabs(d1[1]), r__3 = (r__1 = d1[n], dabs(r__1));
01416                     temp3 = dmax(r__2,r__3);
01417                     if (il != 1) {
01418 /* Computing MAX */
01419                         r__1 = (d1[il] - d1[il - 1]) * .5f, r__2 = ulp * 10.f 
01420                                 * temp3, r__1 = max(r__1,r__2), r__2 = rtunfl 
01421                                 * 10.f;
01422                         vl = d1[il] - dmax(r__1,r__2);
01423                     } else if (n > 0) {
01424 /* Computing MAX */
01425                         r__1 = (d1[n] - d1[1]) * .5f, r__2 = ulp * 10.f * 
01426                                 temp3, r__1 = max(r__1,r__2), r__2 = rtunfl * 
01427                                 10.f;
01428                         vl = d1[1] - dmax(r__1,r__2);
01429                     }
01430                     if (iu != n) {
01431 /* Computing MAX */
01432                         r__1 = (d1[iu + 1] - d1[iu]) * .5f, r__2 = ulp * 10.f 
01433                                 * temp3, r__1 = max(r__1,r__2), r__2 = rtunfl 
01434                                 * 10.f;
01435                         vu = d1[iu] + dmax(r__1,r__2);
01436                     } else if (n > 0) {
01437 /* Computing MAX */
01438                         r__1 = (d1[n] - d1[1]) * .5f, r__2 = ulp * 10.f * 
01439                                 temp3, r__1 = max(r__1,r__2), r__2 = rtunfl * 
01440                                 10.f;
01441                         vu = d1[n] + dmax(r__1,r__2);
01442                     }
01443                 } else {
01444                     temp3 = 0.f;
01445                     vl = 0.f;
01446                     vu = 1.f;
01447                 }
01448 
01449                 chpevx_("V", "A", uplo, &n, &work[1], &vl, &vu, &il, &iu, &
01450                         abstol, &m, &wa1[1], &z__[z_offset], ldu, &v[v_offset]
01451 , &rwork[1], &iwork[1], &iwork[n * 5 + 1], &iinfo);
01452                 if (iinfo != 0) {
01453                     io___69.ciunit = *nounit;
01454                     s_wsfe(&io___69);
01455 /* Writing concatenation */
01456                     i__7[0] = 11, a__1[0] = "CHPEVX(V,A,";
01457                     i__7[1] = 1, a__1[1] = uplo;
01458                     i__7[2] = 1, a__1[2] = ")";
01459                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01460                     do_fio(&c__1, ch__2, (ftnlen)13);
01461                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01462                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01463                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01464                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01465                             ;
01466                     e_wsfe();
01467                     *info = abs(iinfo);
01468                     if (iinfo < 0) {
01469                         return 0;
01470                     } else {
01471                         result[ntest] = ulpinv;
01472                         result[ntest + 1] = ulpinv;
01473                         result[ntest + 2] = ulpinv;
01474                         goto L370;
01475                     }
01476                 }
01477 
01478 /*              Do tests 16 and 17. */
01479 
01480                 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], ldu, &wa1[1], &
01481                         d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
01482 , &work[1], &rwork[1], &result[ntest]);
01483 
01484                 ntest += 2;
01485 
01486                 if (iuplo == 1) {
01487                     indx = 1;
01488                     i__3 = n;
01489                     for (j = 1; j <= i__3; ++j) {
01490                         i__4 = j;
01491                         for (i__ = 1; i__ <= i__4; ++i__) {
01492                             i__5 = indx;
01493                             i__6 = i__ + j * a_dim1;
01494                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01495                                     .i;
01496                             ++indx;
01497 /* L320: */
01498                         }
01499 /* L330: */
01500                     }
01501                 } else {
01502                     indx = 1;
01503                     i__3 = n;
01504                     for (j = 1; j <= i__3; ++j) {
01505                         i__4 = n;
01506                         for (i__ = j; i__ <= i__4; ++i__) {
01507                             i__5 = indx;
01508                             i__6 = i__ + j * a_dim1;
01509                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01510                                     .i;
01511                             ++indx;
01512 /* L340: */
01513                         }
01514 /* L350: */
01515                     }
01516                 }
01517 
01518                 chpevx_("N", "A", uplo, &n, &work[1], &vl, &vu, &il, &iu, &
01519                         abstol, &m2, &wa2[1], &z__[z_offset], ldu, &v[
01520                         v_offset], &rwork[1], &iwork[1], &iwork[n * 5 + 1], &
01521                         iinfo);
01522                 if (iinfo != 0) {
01523                     io___70.ciunit = *nounit;
01524                     s_wsfe(&io___70);
01525 /* Writing concatenation */
01526                     i__7[0] = 11, a__1[0] = "CHPEVX(N,A,";
01527                     i__7[1] = 1, a__1[1] = uplo;
01528                     i__7[2] = 1, a__1[2] = ")";
01529                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01530                     do_fio(&c__1, ch__2, (ftnlen)13);
01531                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01532                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01533                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01534                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01535                             ;
01536                     e_wsfe();
01537                     *info = abs(iinfo);
01538                     if (iinfo < 0) {
01539                         return 0;
01540                     } else {
01541                         result[ntest] = ulpinv;
01542                         goto L370;
01543                     }
01544                 }
01545 
01546 /*              Do test 18. */
01547 
01548                 temp1 = 0.f;
01549                 temp2 = 0.f;
01550                 i__3 = n;
01551                 for (j = 1; j <= i__3; ++j) {
01552 /* Computing MAX */
01553                     r__3 = temp1, r__4 = (r__1 = wa1[j], dabs(r__1)), r__3 = 
01554                             max(r__3,r__4), r__4 = (r__2 = wa2[j], dabs(r__2))
01555                             ;
01556                     temp1 = dmax(r__3,r__4);
01557 /* Computing MAX */
01558                     r__2 = temp2, r__3 = (r__1 = wa1[j] - wa2[j], dabs(r__1));
01559                     temp2 = dmax(r__2,r__3);
01560 /* L360: */
01561                 }
01562 /* Computing MAX */
01563                 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
01564                 result[ntest] = temp2 / dmax(r__1,r__2);
01565 
01566 L370:
01567                 ++ntest;
01568                 if (iuplo == 1) {
01569                     indx = 1;
01570                     i__3 = n;
01571                     for (j = 1; j <= i__3; ++j) {
01572                         i__4 = j;
01573                         for (i__ = 1; i__ <= i__4; ++i__) {
01574                             i__5 = indx;
01575                             i__6 = i__ + j * a_dim1;
01576                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01577                                     .i;
01578                             ++indx;
01579 /* L380: */
01580                         }
01581 /* L390: */
01582                     }
01583                 } else {
01584                     indx = 1;
01585                     i__3 = n;
01586                     for (j = 1; j <= i__3; ++j) {
01587                         i__4 = n;
01588                         for (i__ = j; i__ <= i__4; ++i__) {
01589                             i__5 = indx;
01590                             i__6 = i__ + j * a_dim1;
01591                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01592                                     .i;
01593                             ++indx;
01594 /* L400: */
01595                         }
01596 /* L410: */
01597                     }
01598                 }
01599 
01600                 chpevx_("V", "I", uplo, &n, &work[1], &vl, &vu, &il, &iu, &
01601                         abstol, &m2, &wa2[1], &z__[z_offset], ldu, &v[
01602                         v_offset], &rwork[1], &iwork[1], &iwork[n * 5 + 1], &
01603                         iinfo);
01604                 if (iinfo != 0) {
01605                     io___71.ciunit = *nounit;
01606                     s_wsfe(&io___71);
01607 /* Writing concatenation */
01608                     i__7[0] = 11, a__1[0] = "CHPEVX(V,I,";
01609                     i__7[1] = 1, a__1[1] = uplo;
01610                     i__7[2] = 1, a__1[2] = ")";
01611                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01612                     do_fio(&c__1, ch__2, (ftnlen)13);
01613                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01614                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01615                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01616                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01617                             ;
01618                     e_wsfe();
01619                     *info = abs(iinfo);
01620                     if (iinfo < 0) {
01621                         return 0;
01622                     } else {
01623                         result[ntest] = ulpinv;
01624                         result[ntest + 1] = ulpinv;
01625                         result[ntest + 2] = ulpinv;
01626                         goto L460;
01627                     }
01628                 }
01629 
01630 /*              Do tests 19 and 20. */
01631 
01632                 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
01633                         1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
01634                         tau[1], &work[1], &rwork[1], &result[ntest]);
01635 
01636                 ntest += 2;
01637 
01638                 if (iuplo == 1) {
01639                     indx = 1;
01640                     i__3 = n;
01641                     for (j = 1; j <= i__3; ++j) {
01642                         i__4 = j;
01643                         for (i__ = 1; i__ <= i__4; ++i__) {
01644                             i__5 = indx;
01645                             i__6 = i__ + j * a_dim1;
01646                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01647                                     .i;
01648                             ++indx;
01649 /* L420: */
01650                         }
01651 /* L430: */
01652                     }
01653                 } else {
01654                     indx = 1;
01655                     i__3 = n;
01656                     for (j = 1; j <= i__3; ++j) {
01657                         i__4 = n;
01658                         for (i__ = j; i__ <= i__4; ++i__) {
01659                             i__5 = indx;
01660                             i__6 = i__ + j * a_dim1;
01661                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01662                                     .i;
01663                             ++indx;
01664 /* L440: */
01665                         }
01666 /* L450: */
01667                     }
01668                 }
01669 
01670                 chpevx_("N", "I", uplo, &n, &work[1], &vl, &vu, &il, &iu, &
01671                         abstol, &m3, &wa3[1], &z__[z_offset], ldu, &v[
01672                         v_offset], &rwork[1], &iwork[1], &iwork[n * 5 + 1], &
01673                         iinfo);
01674                 if (iinfo != 0) {
01675                     io___72.ciunit = *nounit;
01676                     s_wsfe(&io___72);
01677 /* Writing concatenation */
01678                     i__7[0] = 11, a__1[0] = "CHPEVX(N,I,";
01679                     i__7[1] = 1, a__1[1] = uplo;
01680                     i__7[2] = 1, a__1[2] = ")";
01681                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01682                     do_fio(&c__1, ch__2, (ftnlen)13);
01683                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01684                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01685                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01686                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01687                             ;
01688                     e_wsfe();
01689                     *info = abs(iinfo);
01690                     if (iinfo < 0) {
01691                         return 0;
01692                     } else {
01693                         result[ntest] = ulpinv;
01694                         goto L460;
01695                     }
01696                 }
01697 
01698 /*              Do test 21. */
01699 
01700                 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
01701                         ulp, &unfl);
01702                 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
01703                         ulp, &unfl);
01704                 if (n > 0) {
01705 /* Computing MAX */
01706                     r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
01707                     temp3 = dmax(r__2,r__3);
01708                 } else {
01709                     temp3 = 0.f;
01710                 }
01711 /* Computing MAX */
01712                 r__1 = unfl, r__2 = temp3 * ulp;
01713                 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
01714 
01715 L460:
01716                 ++ntest;
01717                 if (iuplo == 1) {
01718                     indx = 1;
01719                     i__3 = n;
01720                     for (j = 1; j <= i__3; ++j) {
01721                         i__4 = j;
01722                         for (i__ = 1; i__ <= i__4; ++i__) {
01723                             i__5 = indx;
01724                             i__6 = i__ + j * a_dim1;
01725                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01726                                     .i;
01727                             ++indx;
01728 /* L470: */
01729                         }
01730 /* L480: */
01731                     }
01732                 } else {
01733                     indx = 1;
01734                     i__3 = n;
01735                     for (j = 1; j <= i__3; ++j) {
01736                         i__4 = n;
01737                         for (i__ = j; i__ <= i__4; ++i__) {
01738                             i__5 = indx;
01739                             i__6 = i__ + j * a_dim1;
01740                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01741                                     .i;
01742                             ++indx;
01743 /* L490: */
01744                         }
01745 /* L500: */
01746                     }
01747                 }
01748 
01749                 chpevx_("V", "V", uplo, &n, &work[1], &vl, &vu, &il, &iu, &
01750                         abstol, &m2, &wa2[1], &z__[z_offset], ldu, &v[
01751                         v_offset], &rwork[1], &iwork[1], &iwork[n * 5 + 1], &
01752                         iinfo);
01753                 if (iinfo != 0) {
01754                     io___73.ciunit = *nounit;
01755                     s_wsfe(&io___73);
01756 /* Writing concatenation */
01757                     i__7[0] = 11, a__1[0] = "CHPEVX(V,V,";
01758                     i__7[1] = 1, a__1[1] = uplo;
01759                     i__7[2] = 1, a__1[2] = ")";
01760                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01761                     do_fio(&c__1, ch__2, (ftnlen)13);
01762                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01763                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01764                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01765                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01766                             ;
01767                     e_wsfe();
01768                     *info = abs(iinfo);
01769                     if (iinfo < 0) {
01770                         return 0;
01771                     } else {
01772                         result[ntest] = ulpinv;
01773                         result[ntest + 1] = ulpinv;
01774                         result[ntest + 2] = ulpinv;
01775                         goto L550;
01776                     }
01777                 }
01778 
01779 /*              Do tests 22 and 23. */
01780 
01781                 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
01782                         1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
01783                         tau[1], &work[1], &rwork[1], &result[ntest]);
01784 
01785                 ntest += 2;
01786 
01787                 if (iuplo == 1) {
01788                     indx = 1;
01789                     i__3 = n;
01790                     for (j = 1; j <= i__3; ++j) {
01791                         i__4 = j;
01792                         for (i__ = 1; i__ <= i__4; ++i__) {
01793                             i__5 = indx;
01794                             i__6 = i__ + j * a_dim1;
01795                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01796                                     .i;
01797                             ++indx;
01798 /* L510: */
01799                         }
01800 /* L520: */
01801                     }
01802                 } else {
01803                     indx = 1;
01804                     i__3 = n;
01805                     for (j = 1; j <= i__3; ++j) {
01806                         i__4 = n;
01807                         for (i__ = j; i__ <= i__4; ++i__) {
01808                             i__5 = indx;
01809                             i__6 = i__ + j * a_dim1;
01810                             work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01811                                     .i;
01812                             ++indx;
01813 /* L530: */
01814                         }
01815 /* L540: */
01816                     }
01817                 }
01818 
01819                 chpevx_("N", "V", uplo, &n, &work[1], &vl, &vu, &il, &iu, &
01820                         abstol, &m3, &wa3[1], &z__[z_offset], ldu, &v[
01821                         v_offset], &rwork[1], &iwork[1], &iwork[n * 5 + 1], &
01822                         iinfo);
01823                 if (iinfo != 0) {
01824                     io___74.ciunit = *nounit;
01825                     s_wsfe(&io___74);
01826 /* Writing concatenation */
01827                     i__7[0] = 11, a__1[0] = "CHPEVX(N,V,";
01828                     i__7[1] = 1, a__1[1] = uplo;
01829                     i__7[2] = 1, a__1[2] = ")";
01830                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01831                     do_fio(&c__1, ch__2, (ftnlen)13);
01832                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01833                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01834                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01835                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01836                             ;
01837                     e_wsfe();
01838                     *info = abs(iinfo);
01839                     if (iinfo < 0) {
01840                         return 0;
01841                     } else {
01842                         result[ntest] = ulpinv;
01843                         goto L550;
01844                     }
01845                 }
01846 
01847                 if (m3 == 0 && n > 0) {
01848                     result[ntest] = ulpinv;
01849                     goto L550;
01850                 }
01851 
01852 /*              Do test 24. */
01853 
01854                 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
01855                         ulp, &unfl);
01856                 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
01857                         ulp, &unfl);
01858                 if (n > 0) {
01859 /* Computing MAX */
01860                     r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
01861                     temp3 = dmax(r__2,r__3);
01862                 } else {
01863                     temp3 = 0.f;
01864                 }
01865 /* Computing MAX */
01866                 r__1 = unfl, r__2 = temp3 * ulp;
01867                 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
01868 
01869 L550:
01870 
01871 /*              Call CHBEVD and CHBEVX. */
01872 
01873                 if (jtype <= 7) {
01874                     kd = 0;
01875                 } else if (jtype >= 8 && jtype <= 15) {
01876 /* Computing MAX */
01877                     i__3 = n - 1;
01878                     kd = max(i__3,0);
01879                 } else {
01880                     kd = ihbw;
01881                 }
01882 
01883 /*              Load array V with the upper or lower triangular part */
01884 /*              of the matrix in band form. */
01885 
01886                 if (iuplo == 1) {
01887                     i__3 = n;
01888                     for (j = 1; j <= i__3; ++j) {
01889 /* Computing MAX */
01890                         i__4 = 1, i__5 = j - kd;
01891                         i__6 = j;
01892                         for (i__ = max(i__4,i__5); i__ <= i__6; ++i__) {
01893                             i__4 = kd + 1 + i__ - j + j * v_dim1;
01894                             i__5 = i__ + j * a_dim1;
01895                             v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
01896 /* L560: */
01897                         }
01898 /* L570: */
01899                     }
01900                 } else {
01901                     i__3 = n;
01902                     for (j = 1; j <= i__3; ++j) {
01903 /* Computing MIN */
01904                         i__4 = n, i__5 = j + kd;
01905                         i__6 = min(i__4,i__5);
01906                         for (i__ = j; i__ <= i__6; ++i__) {
01907                             i__4 = i__ + 1 - j + j * v_dim1;
01908                             i__5 = i__ + j * a_dim1;
01909                             v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
01910 /* L580: */
01911                         }
01912 /* L590: */
01913                     }
01914                 }
01915 
01916                 ++ntest;
01917                 chbevd_("V", uplo, &n, &kd, &v[v_offset], ldu, &d1[1], &z__[
01918                         z_offset], ldu, &work[1], &lwedc, &rwork[1], &lrwedc, 
01919                         &iwork[1], &liwedc, &iinfo);
01920                 if (iinfo != 0) {
01921                     io___76.ciunit = *nounit;
01922                     s_wsfe(&io___76);
01923 /* Writing concatenation */
01924                     i__7[0] = 9, a__1[0] = "CHBEVD(V,";
01925                     i__7[1] = 1, a__1[1] = uplo;
01926                     i__7[2] = 1, a__1[2] = ")";
01927                     s_cat(ch__1, a__1, i__7, &c__3, (ftnlen)11);
01928                     do_fio(&c__1, ch__1, (ftnlen)11);
01929                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01930                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01931                     do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
01932                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01933                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01934                             ;
01935                     e_wsfe();
01936                     *info = abs(iinfo);
01937                     if (iinfo < 0) {
01938                         return 0;
01939                     } else {
01940                         result[ntest] = ulpinv;
01941                         result[ntest + 1] = ulpinv;
01942                         result[ntest + 2] = ulpinv;
01943                         goto L650;
01944                     }
01945                 }
01946 
01947 /*              Do tests 25 and 26. */
01948 
01949                 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], lda, &d1[1], &
01950                         d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
01951 , &work[1], &rwork[1], &result[ntest]);
01952 
01953                 if (iuplo == 1) {
01954                     i__3 = n;
01955                     for (j = 1; j <= i__3; ++j) {
01956 /* Computing MAX */
01957                         i__6 = 1, i__4 = j - kd;
01958                         i__5 = j;
01959                         for (i__ = max(i__6,i__4); i__ <= i__5; ++i__) {
01960                             i__6 = kd + 1 + i__ - j + j * v_dim1;
01961                             i__4 = i__ + j * a_dim1;
01962                             v[i__6].r = a[i__4].r, v[i__6].i = a[i__4].i;
01963 /* L600: */
01964                         }
01965 /* L610: */
01966                     }
01967                 } else {
01968                     i__3 = n;
01969                     for (j = 1; j <= i__3; ++j) {
01970 /* Computing MIN */
01971                         i__6 = n, i__4 = j + kd;
01972                         i__5 = min(i__6,i__4);
01973                         for (i__ = j; i__ <= i__5; ++i__) {
01974                             i__6 = i__ + 1 - j + j * v_dim1;
01975                             i__4 = i__ + j * a_dim1;
01976                             v[i__6].r = a[i__4].r, v[i__6].i = a[i__4].i;
01977 /* L620: */
01978                         }
01979 /* L630: */
01980                     }
01981                 }
01982 
01983                 ntest += 2;
01984                 chbevd_("N", uplo, &n, &kd, &v[v_offset], ldu, &d3[1], &z__[
01985                         z_offset], ldu, &work[1], &lwedc, &rwork[1], &lrwedc, 
01986                         &iwork[1], &liwedc, &iinfo);
01987                 if (iinfo != 0) {
01988                     io___77.ciunit = *nounit;
01989                     s_wsfe(&io___77);
01990 /* Writing concatenation */
01991                     i__7[0] = 9, a__1[0] = "CHBEVD(N,";
01992                     i__7[1] = 1, a__1[1] = uplo;
01993                     i__7[2] = 1, a__1[2] = ")";
01994                     s_cat(ch__1, a__1, i__7, &c__3, (ftnlen)11);
01995                     do_fio(&c__1, ch__1, (ftnlen)11);
01996                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01997                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01998                     do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
01999                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02000                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02001                             ;
02002                     e_wsfe();
02003                     *info = abs(iinfo);
02004                     if (iinfo < 0) {
02005                         return 0;
02006                     } else {
02007                         result[ntest] = ulpinv;
02008                         goto L650;
02009                     }
02010                 }
02011 
02012 /*              Do test 27. */
02013 
02014                 temp1 = 0.f;
02015                 temp2 = 0.f;
02016                 i__3 = n;
02017                 for (j = 1; j <= i__3; ++j) {
02018 /* Computing MAX */
02019                     r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 = 
02020                             max(r__3,r__4), r__4 = (r__2 = d3[j], dabs(r__2));
02021                     temp1 = dmax(r__3,r__4);
02022 /* Computing MAX */
02023                     r__2 = temp2, r__3 = (r__1 = d1[j] - d3[j], dabs(r__1));
02024                     temp2 = dmax(r__2,r__3);
02025 /* L640: */
02026                 }
02027 /* Computing MAX */
02028                 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02029                 result[ntest] = temp2 / dmax(r__1,r__2);
02030 
02031 /*              Load array V with the upper or lower triangular part */
02032 /*              of the matrix in band form. */
02033 
02034 L650:
02035                 if (iuplo == 1) {
02036                     i__3 = n;
02037                     for (j = 1; j <= i__3; ++j) {
02038 /* Computing MAX */
02039                         i__5 = 1, i__6 = j - kd;
02040                         i__4 = j;
02041                         for (i__ = max(i__5,i__6); i__ <= i__4; ++i__) {
02042                             i__5 = kd + 1 + i__ - j + j * v_dim1;
02043                             i__6 = i__ + j * a_dim1;
02044                             v[i__5].r = a[i__6].r, v[i__5].i = a[i__6].i;
02045 /* L660: */
02046                         }
02047 /* L670: */
02048                     }
02049                 } else {
02050                     i__3 = n;
02051                     for (j = 1; j <= i__3; ++j) {
02052 /* Computing MIN */
02053                         i__5 = n, i__6 = j + kd;
02054                         i__4 = min(i__5,i__6);
02055                         for (i__ = j; i__ <= i__4; ++i__) {
02056                             i__5 = i__ + 1 - j + j * v_dim1;
02057                             i__6 = i__ + j * a_dim1;
02058                             v[i__5].r = a[i__6].r, v[i__5].i = a[i__6].i;
02059 /* L680: */
02060                         }
02061 /* L690: */
02062                     }
02063                 }
02064 
02065                 ++ntest;
02066                 chbevx_("V", "A", uplo, &n, &kd, &v[v_offset], ldu, &u[
02067                         u_offset], ldu, &vl, &vu, &il, &iu, &abstol, &m, &wa1[
02068                         1], &z__[z_offset], ldu, &work[1], &rwork[1], &iwork[
02069                         1], &iwork[n * 5 + 1], &iinfo);
02070                 if (iinfo != 0) {
02071                     io___78.ciunit = *nounit;
02072                     s_wsfe(&io___78);
02073 /* Writing concatenation */
02074                     i__7[0] = 11, a__1[0] = "CHBEVX(V,A,";
02075                     i__7[1] = 1, a__1[1] = uplo;
02076                     i__7[2] = 1, a__1[2] = ")";
02077                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02078                     do_fio(&c__1, ch__2, (ftnlen)13);
02079                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02080                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02081                     do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02082                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02083                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02084                             ;
02085                     e_wsfe();
02086                     *info = abs(iinfo);
02087                     if (iinfo < 0) {
02088                         return 0;
02089                     } else {
02090                         result[ntest] = ulpinv;
02091                         result[ntest + 1] = ulpinv;
02092                         result[ntest + 2] = ulpinv;
02093                         goto L750;
02094                     }
02095                 }
02096 
02097 /*              Do tests 28 and 29. */
02098 
02099                 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], ldu, &wa1[1], &
02100                         d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
02101 , &work[1], &rwork[1], &result[ntest]);
02102 
02103                 ntest += 2;
02104 
02105                 if (iuplo == 1) {
02106                     i__3 = n;
02107                     for (j = 1; j <= i__3; ++j) {
02108 /* Computing MAX */
02109                         i__4 = 1, i__5 = j - kd;
02110                         i__6 = j;
02111                         for (i__ = max(i__4,i__5); i__ <= i__6; ++i__) {
02112                             i__4 = kd + 1 + i__ - j + j * v_dim1;
02113                             i__5 = i__ + j * a_dim1;
02114                             v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
02115 /* L700: */
02116                         }
02117 /* L710: */
02118                     }
02119                 } else {
02120                     i__3 = n;
02121                     for (j = 1; j <= i__3; ++j) {
02122 /* Computing MIN */
02123                         i__4 = n, i__5 = j + kd;
02124                         i__6 = min(i__4,i__5);
02125                         for (i__ = j; i__ <= i__6; ++i__) {
02126                             i__4 = i__ + 1 - j + j * v_dim1;
02127                             i__5 = i__ + j * a_dim1;
02128                             v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
02129 /* L720: */
02130                         }
02131 /* L730: */
02132                     }
02133                 }
02134 
02135                 chbevx_("N", "A", uplo, &n, &kd, &v[v_offset], ldu, &u[
02136                         u_offset], ldu, &vl, &vu, &il, &iu, &abstol, &m2, &
02137                         wa2[1], &z__[z_offset], ldu, &work[1], &rwork[1], &
02138                         iwork[1], &iwork[n * 5 + 1], &iinfo);
02139                 if (iinfo != 0) {
02140                     io___79.ciunit = *nounit;
02141                     s_wsfe(&io___79);
02142 /* Writing concatenation */
02143                     i__7[0] = 11, a__1[0] = "CHBEVX(N,A,";
02144                     i__7[1] = 1, a__1[1] = uplo;
02145                     i__7[2] = 1, a__1[2] = ")";
02146                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02147                     do_fio(&c__1, ch__2, (ftnlen)13);
02148                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02149                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02150                     do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02151                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02152                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02153                             ;
02154                     e_wsfe();
02155                     *info = abs(iinfo);
02156                     if (iinfo < 0) {
02157                         return 0;
02158                     } else {
02159                         result[ntest] = ulpinv;
02160                         goto L750;
02161                     }
02162                 }
02163 
02164 /*              Do test 30. */
02165 
02166                 temp1 = 0.f;
02167                 temp2 = 0.f;
02168                 i__3 = n;
02169                 for (j = 1; j <= i__3; ++j) {
02170 /* Computing MAX */
02171                     r__3 = temp1, r__4 = (r__1 = wa1[j], dabs(r__1)), r__3 = 
02172                             max(r__3,r__4), r__4 = (r__2 = wa2[j], dabs(r__2))
02173                             ;
02174                     temp1 = dmax(r__3,r__4);
02175 /* Computing MAX */
02176                     r__2 = temp2, r__3 = (r__1 = wa1[j] - wa2[j], dabs(r__1));
02177                     temp2 = dmax(r__2,r__3);
02178 /* L740: */
02179                 }
02180 /* Computing MAX */
02181                 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02182                 result[ntest] = temp2 / dmax(r__1,r__2);
02183 
02184 /*              Load array V with the upper or lower triangular part */
02185 /*              of the matrix in band form. */
02186 
02187 L750:
02188                 ++ntest;
02189                 if (iuplo == 1) {
02190                     i__3 = n;
02191                     for (j = 1; j <= i__3; ++j) {
02192 /* Computing MAX */
02193                         i__6 = 1, i__4 = j - kd;
02194                         i__5 = j;
02195                         for (i__ = max(i__6,i__4); i__ <= i__5; ++i__) {
02196                             i__6 = kd + 1 + i__ - j + j * v_dim1;
02197                             i__4 = i__ + j * a_dim1;
02198                             v[i__6].r = a[i__4].r, v[i__6].i = a[i__4].i;
02199 /* L760: */
02200                         }
02201 /* L770: */
02202                     }
02203                 } else {
02204                     i__3 = n;
02205                     for (j = 1; j <= i__3; ++j) {
02206 /* Computing MIN */
02207                         i__6 = n, i__4 = j + kd;
02208                         i__5 = min(i__6,i__4);
02209                         for (i__ = j; i__ <= i__5; ++i__) {
02210                             i__6 = i__ + 1 - j + j * v_dim1;
02211                             i__4 = i__ + j * a_dim1;
02212                             v[i__6].r = a[i__4].r, v[i__6].i = a[i__4].i;
02213 /* L780: */
02214                         }
02215 /* L790: */
02216                     }
02217                 }
02218 
02219                 chbevx_("V", "I", uplo, &n, &kd, &v[v_offset], ldu, &u[
02220                         u_offset], ldu, &vl, &vu, &il, &iu, &abstol, &m2, &
02221                         wa2[1], &z__[z_offset], ldu, &work[1], &rwork[1], &
02222                         iwork[1], &iwork[n * 5 + 1], &iinfo);
02223                 if (iinfo != 0) {
02224                     io___80.ciunit = *nounit;
02225                     s_wsfe(&io___80);
02226 /* Writing concatenation */
02227                     i__7[0] = 11, a__1[0] = "CHBEVX(V,I,";
02228                     i__7[1] = 1, a__1[1] = uplo;
02229                     i__7[2] = 1, a__1[2] = ")";
02230                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02231                     do_fio(&c__1, ch__2, (ftnlen)13);
02232                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02233                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02234                     do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02235                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02236                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02237                             ;
02238                     e_wsfe();
02239                     *info = abs(iinfo);
02240                     if (iinfo < 0) {
02241                         return 0;
02242                     } else {
02243                         result[ntest] = ulpinv;
02244                         result[ntest + 1] = ulpinv;
02245                         result[ntest + 2] = ulpinv;
02246                         goto L840;
02247                     }
02248                 }
02249 
02250 /*              Do tests 31 and 32. */
02251 
02252                 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
02253                         1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
02254                         tau[1], &work[1], &rwork[1], &result[ntest]);
02255 
02256                 ntest += 2;
02257 
02258                 if (iuplo == 1) {
02259                     i__3 = n;
02260                     for (j = 1; j <= i__3; ++j) {
02261 /* Computing MAX */
02262                         i__5 = 1, i__6 = j - kd;
02263                         i__4 = j;
02264                         for (i__ = max(i__5,i__6); i__ <= i__4; ++i__) {
02265                             i__5 = kd + 1 + i__ - j + j * v_dim1;
02266                             i__6 = i__ + j * a_dim1;
02267                             v[i__5].r = a[i__6].r, v[i__5].i = a[i__6].i;
02268 /* L800: */
02269                         }
02270 /* L810: */
02271                     }
02272                 } else {
02273                     i__3 = n;
02274                     for (j = 1; j <= i__3; ++j) {
02275 /* Computing MIN */
02276                         i__5 = n, i__6 = j + kd;
02277                         i__4 = min(i__5,i__6);
02278                         for (i__ = j; i__ <= i__4; ++i__) {
02279                             i__5 = i__ + 1 - j + j * v_dim1;
02280                             i__6 = i__ + j * a_dim1;
02281                             v[i__5].r = a[i__6].r, v[i__5].i = a[i__6].i;
02282 /* L820: */
02283                         }
02284 /* L830: */
02285                     }
02286                 }
02287                 chbevx_("N", "I", uplo, &n, &kd, &v[v_offset], ldu, &u[
02288                         u_offset], ldu, &vl, &vu, &il, &iu, &abstol, &m3, &
02289                         wa3[1], &z__[z_offset], ldu, &work[1], &rwork[1], &
02290                         iwork[1], &iwork[n * 5 + 1], &iinfo);
02291                 if (iinfo != 0) {
02292                     io___81.ciunit = *nounit;
02293                     s_wsfe(&io___81);
02294 /* Writing concatenation */
02295                     i__7[0] = 11, a__1[0] = "CHBEVX(N,I,";
02296                     i__7[1] = 1, a__1[1] = uplo;
02297                     i__7[2] = 1, a__1[2] = ")";
02298                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02299                     do_fio(&c__1, ch__2, (ftnlen)13);
02300                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02301                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02302                     do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02303                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02304                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02305                             ;
02306                     e_wsfe();
02307                     *info = abs(iinfo);
02308                     if (iinfo < 0) {
02309                         return 0;
02310                     } else {
02311                         result[ntest] = ulpinv;
02312                         goto L840;
02313                     }
02314                 }
02315 
02316 /*              Do test 33. */
02317 
02318                 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
02319                         ulp, &unfl);
02320                 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
02321                         ulp, &unfl);
02322                 if (n > 0) {
02323 /* Computing MAX */
02324                     r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
02325                     temp3 = dmax(r__2,r__3);
02326                 } else {
02327                     temp3 = 0.f;
02328                 }
02329 /* Computing MAX */
02330                 r__1 = unfl, r__2 = temp3 * ulp;
02331                 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
02332 
02333 /*              Load array V with the upper or lower triangular part */
02334 /*              of the matrix in band form. */
02335 
02336 L840:
02337                 ++ntest;
02338                 if (iuplo == 1) {
02339                     i__3 = n;
02340                     for (j = 1; j <= i__3; ++j) {
02341 /* Computing MAX */
02342                         i__4 = 1, i__5 = j - kd;
02343                         i__6 = j;
02344                         for (i__ = max(i__4,i__5); i__ <= i__6; ++i__) {
02345                             i__4 = kd + 1 + i__ - j + j * v_dim1;
02346                             i__5 = i__ + j * a_dim1;
02347                             v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
02348 /* L850: */
02349                         }
02350 /* L860: */
02351                     }
02352                 } else {
02353                     i__3 = n;
02354                     for (j = 1; j <= i__3; ++j) {
02355 /* Computing MIN */
02356                         i__4 = n, i__5 = j + kd;
02357                         i__6 = min(i__4,i__5);
02358                         for (i__ = j; i__ <= i__6; ++i__) {
02359                             i__4 = i__ + 1 - j + j * v_dim1;
02360                             i__5 = i__ + j * a_dim1;
02361                             v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
02362 /* L870: */
02363                         }
02364 /* L880: */
02365                     }
02366                 }
02367                 chbevx_("V", "V", uplo, &n, &kd, &v[v_offset], ldu, &u[
02368                         u_offset], ldu, &vl, &vu, &il, &iu, &abstol, &m2, &
02369                         wa2[1], &z__[z_offset], ldu, &work[1], &rwork[1], &
02370                         iwork[1], &iwork[n * 5 + 1], &iinfo);
02371                 if (iinfo != 0) {
02372                     io___82.ciunit = *nounit;
02373                     s_wsfe(&io___82);
02374 /* Writing concatenation */
02375                     i__7[0] = 11, a__1[0] = "CHBEVX(V,V,";
02376                     i__7[1] = 1, a__1[1] = uplo;
02377                     i__7[2] = 1, a__1[2] = ")";
02378                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02379                     do_fio(&c__1, ch__2, (ftnlen)13);
02380                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02381                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02382                     do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02383                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02384                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02385                             ;
02386                     e_wsfe();
02387                     *info = abs(iinfo);
02388                     if (iinfo < 0) {
02389                         return 0;
02390                     } else {
02391                         result[ntest] = ulpinv;
02392                         result[ntest + 1] = ulpinv;
02393                         result[ntest + 2] = ulpinv;
02394                         goto L930;
02395                     }
02396                 }
02397 
02398 /*              Do tests 34 and 35. */
02399 
02400                 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
02401                         1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
02402                         tau[1], &work[1], &rwork[1], &result[ntest]);
02403 
02404                 ntest += 2;
02405 
02406                 if (iuplo == 1) {
02407                     i__3 = n;
02408                     for (j = 1; j <= i__3; ++j) {
02409 /* Computing MAX */
02410                         i__6 = 1, i__4 = j - kd;
02411                         i__5 = j;
02412                         for (i__ = max(i__6,i__4); i__ <= i__5; ++i__) {
02413                             i__6 = kd + 1 + i__ - j + j * v_dim1;
02414                             i__4 = i__ + j * a_dim1;
02415                             v[i__6].r = a[i__4].r, v[i__6].i = a[i__4].i;
02416 /* L890: */
02417                         }
02418 /* L900: */
02419                     }
02420                 } else {
02421                     i__3 = n;
02422                     for (j = 1; j <= i__3; ++j) {
02423 /* Computing MIN */
02424                         i__6 = n, i__4 = j + kd;
02425                         i__5 = min(i__6,i__4);
02426                         for (i__ = j; i__ <= i__5; ++i__) {
02427                             i__6 = i__ + 1 - j + j * v_dim1;
02428                             i__4 = i__ + j * a_dim1;
02429                             v[i__6].r = a[i__4].r, v[i__6].i = a[i__4].i;
02430 /* L910: */
02431                         }
02432 /* L920: */
02433                     }
02434                 }
02435                 chbevx_("N", "V", uplo, &n, &kd, &v[v_offset], ldu, &u[
02436                         u_offset], ldu, &vl, &vu, &il, &iu, &abstol, &m3, &
02437                         wa3[1], &z__[z_offset], ldu, &work[1], &rwork[1], &
02438                         iwork[1], &iwork[n * 5 + 1], &iinfo);
02439                 if (iinfo != 0) {
02440                     io___83.ciunit = *nounit;
02441                     s_wsfe(&io___83);
02442 /* Writing concatenation */
02443                     i__7[0] = 11, a__1[0] = "CHBEVX(N,V,";
02444                     i__7[1] = 1, a__1[1] = uplo;
02445                     i__7[2] = 1, a__1[2] = ")";
02446                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02447                     do_fio(&c__1, ch__2, (ftnlen)13);
02448                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02449                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02450                     do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02451                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02452                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02453                             ;
02454                     e_wsfe();
02455                     *info = abs(iinfo);
02456                     if (iinfo < 0) {
02457                         return 0;
02458                     } else {
02459                         result[ntest] = ulpinv;
02460                         goto L930;
02461                     }
02462                 }
02463 
02464                 if (m3 == 0 && n > 0) {
02465                     result[ntest] = ulpinv;
02466                     goto L930;
02467                 }
02468 
02469 /*              Do test 36. */
02470 
02471                 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
02472                         ulp, &unfl);
02473                 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
02474                         ulp, &unfl);
02475                 if (n > 0) {
02476 /* Computing MAX */
02477                     r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
02478                     temp3 = dmax(r__2,r__3);
02479                 } else {
02480                     temp3 = 0.f;
02481                 }
02482 /* Computing MAX */
02483                 r__1 = unfl, r__2 = temp3 * ulp;
02484                 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
02485 
02486 L930:
02487 
02488 /*              Call CHEEV */
02489 
02490                 clacpy_(" ", &n, &n, &a[a_offset], lda, &v[v_offset], ldu);
02491 
02492                 ++ntest;
02493                 cheev_("V", uplo, &n, &a[a_offset], ldu, &d1[1], &work[1], 
02494                         lwork, &rwork[1], &iinfo);
02495                 if (iinfo != 0) {
02496                     io___84.ciunit = *nounit;
02497                     s_wsfe(&io___84);
02498 /* Writing concatenation */
02499                     i__7[0] = 8, a__1[0] = "CHEEV(V,";
02500                     i__7[1] = 1, a__1[1] = uplo;
02501                     i__7[2] = 1, a__1[2] = ")";
02502                     s_cat(ch__3, a__1, i__7, &c__3, (ftnlen)10);
02503                     do_fio(&c__1, ch__3, (ftnlen)10);
02504                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02505                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02506                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02507                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02508                             ;
02509                     e_wsfe();
02510                     *info = abs(iinfo);
02511                     if (iinfo < 0) {
02512                         return 0;
02513                     } else {
02514                         result[ntest] = ulpinv;
02515                         result[ntest + 1] = ulpinv;
02516                         result[ntest + 2] = ulpinv;
02517                         goto L950;
02518                     }
02519                 }
02520 
02521 /*              Do tests 37 and 38 */
02522 
02523                 chet21_(&c__1, uplo, &n, &c__0, &v[v_offset], ldu, &d1[1], &
02524                         d2[1], &a[a_offset], ldu, &z__[z_offset], ldu, &tau[1]
02525 , &work[1], &rwork[1], &result[ntest]);
02526 
02527                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
02528 
02529                 ntest += 2;
02530                 cheev_("N", uplo, &n, &a[a_offset], ldu, &d3[1], &work[1], 
02531                         lwork, &rwork[1], &iinfo);
02532                 if (iinfo != 0) {
02533                     io___85.ciunit = *nounit;
02534                     s_wsfe(&io___85);
02535 /* Writing concatenation */
02536                     i__7[0] = 8, a__1[0] = "CHEEV(N,";
02537                     i__7[1] = 1, a__1[1] = uplo;
02538                     i__7[2] = 1, a__1[2] = ")";
02539                     s_cat(ch__3, a__1, i__7, &c__3, (ftnlen)10);
02540                     do_fio(&c__1, ch__3, (ftnlen)10);
02541                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02542                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02543                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02544                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02545                             ;
02546                     e_wsfe();
02547                     *info = abs(iinfo);
02548                     if (iinfo < 0) {
02549                         return 0;
02550                     } else {
02551                         result[ntest] = ulpinv;
02552                         goto L950;
02553                     }
02554                 }
02555 
02556 /*              Do test 39 */
02557 
02558                 temp1 = 0.f;
02559                 temp2 = 0.f;
02560                 i__3 = n;
02561                 for (j = 1; j <= i__3; ++j) {
02562 /* Computing MAX */
02563                     r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 = 
02564                             max(r__3,r__4), r__4 = (r__2 = d3[j], dabs(r__2));
02565                     temp1 = dmax(r__3,r__4);
02566 /* Computing MAX */
02567                     r__2 = temp2, r__3 = (r__1 = d1[j] - d3[j], dabs(r__1));
02568                     temp2 = dmax(r__2,r__3);
02569 /* L940: */
02570                 }
02571 /* Computing MAX */
02572                 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02573                 result[ntest] = temp2 / dmax(r__1,r__2);
02574 
02575 L950:
02576 
02577                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
02578 
02579 /*              Call CHPEV */
02580 
02581 /*              Load array WORK with the upper or lower triangular */
02582 /*              part of the matrix in packed form. */
02583 
02584                 if (iuplo == 1) {
02585                     indx = 1;
02586                     i__3 = n;
02587                     for (j = 1; j <= i__3; ++j) {
02588                         i__5 = j;
02589                         for (i__ = 1; i__ <= i__5; ++i__) {
02590                             i__6 = indx;
02591                             i__4 = i__ + j * a_dim1;
02592                             work[i__6].r = a[i__4].r, work[i__6].i = a[i__4]
02593                                     .i;
02594                             ++indx;
02595 /* L960: */
02596                         }
02597 /* L970: */
02598                     }
02599                 } else {
02600                     indx = 1;
02601                     i__3 = n;
02602                     for (j = 1; j <= i__3; ++j) {
02603                         i__5 = n;
02604                         for (i__ = j; i__ <= i__5; ++i__) {
02605                             i__6 = indx;
02606                             i__4 = i__ + j * a_dim1;
02607                             work[i__6].r = a[i__4].r, work[i__6].i = a[i__4]
02608                                     .i;
02609                             ++indx;
02610 /* L980: */
02611                         }
02612 /* L990: */
02613                     }
02614                 }
02615 
02616                 ++ntest;
02617                 indwrk = n * (n + 1) / 2 + 1;
02618                 chpev_("V", uplo, &n, &work[1], &d1[1], &z__[z_offset], ldu, &
02619                         work[indwrk], &rwork[1], &iinfo)
02620                         ;
02621                 if (iinfo != 0) {
02622                     io___86.ciunit = *nounit;
02623                     s_wsfe(&io___86);
02624 /* Writing concatenation */
02625                     i__7[0] = 8, a__1[0] = "CHPEV(V,";
02626                     i__7[1] = 1, a__1[1] = uplo;
02627                     i__7[2] = 1, a__1[2] = ")";
02628                     s_cat(ch__3, a__1, i__7, &c__3, (ftnlen)10);
02629                     do_fio(&c__1, ch__3, (ftnlen)10);
02630                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02631                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02632                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02633                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02634                             ;
02635                     e_wsfe();
02636                     *info = abs(iinfo);
02637                     if (iinfo < 0) {
02638                         return 0;
02639                     } else {
02640                         result[ntest] = ulpinv;
02641                         result[ntest + 1] = ulpinv;
02642                         result[ntest + 2] = ulpinv;
02643                         goto L1050;
02644                     }
02645                 }
02646 
02647 /*              Do tests 40 and 41. */
02648 
02649                 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], lda, &d1[1], &
02650                         d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
02651 , &work[1], &rwork[1], &result[ntest]);
02652 
02653                 if (iuplo == 1) {
02654                     indx = 1;
02655                     i__3 = n;
02656                     for (j = 1; j <= i__3; ++j) {
02657                         i__5 = j;
02658                         for (i__ = 1; i__ <= i__5; ++i__) {
02659                             i__6 = indx;
02660                             i__4 = i__ + j * a_dim1;
02661                             work[i__6].r = a[i__4].r, work[i__6].i = a[i__4]
02662                                     .i;
02663                             ++indx;
02664 /* L1000: */
02665                         }
02666 /* L1010: */
02667                     }
02668                 } else {
02669                     indx = 1;
02670                     i__3 = n;
02671                     for (j = 1; j <= i__3; ++j) {
02672                         i__5 = n;
02673                         for (i__ = j; i__ <= i__5; ++i__) {
02674                             i__6 = indx;
02675                             i__4 = i__ + j * a_dim1;
02676                             work[i__6].r = a[i__4].r, work[i__6].i = a[i__4]
02677                                     .i;
02678                             ++indx;
02679 /* L1020: */
02680                         }
02681 /* L1030: */
02682                     }
02683                 }
02684 
02685                 ntest += 2;
02686                 indwrk = n * (n + 1) / 2 + 1;
02687                 chpev_("N", uplo, &n, &work[1], &d3[1], &z__[z_offset], ldu, &
02688                         work[indwrk], &rwork[1], &iinfo)
02689                         ;
02690                 if (iinfo != 0) {
02691                     io___87.ciunit = *nounit;
02692                     s_wsfe(&io___87);
02693 /* Writing concatenation */
02694                     i__7[0] = 8, a__1[0] = "CHPEV(N,";
02695                     i__7[1] = 1, a__1[1] = uplo;
02696                     i__7[2] = 1, a__1[2] = ")";
02697                     s_cat(ch__3, a__1, i__7, &c__3, (ftnlen)10);
02698                     do_fio(&c__1, ch__3, (ftnlen)10);
02699                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02700                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02701                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02702                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02703                             ;
02704                     e_wsfe();
02705                     *info = abs(iinfo);
02706                     if (iinfo < 0) {
02707                         return 0;
02708                     } else {
02709                         result[ntest] = ulpinv;
02710                         goto L1050;
02711                     }
02712                 }
02713 
02714 /*              Do test 42 */
02715 
02716                 temp1 = 0.f;
02717                 temp2 = 0.f;
02718                 i__3 = n;
02719                 for (j = 1; j <= i__3; ++j) {
02720 /* Computing MAX */
02721                     r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 = 
02722                             max(r__3,r__4), r__4 = (r__2 = d3[j], dabs(r__2));
02723                     temp1 = dmax(r__3,r__4);
02724 /* Computing MAX */
02725                     r__2 = temp2, r__3 = (r__1 = d1[j] - d3[j], dabs(r__1));
02726                     temp2 = dmax(r__2,r__3);
02727 /* L1040: */
02728                 }
02729 /* Computing MAX */
02730                 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02731                 result[ntest] = temp2 / dmax(r__1,r__2);
02732 
02733 L1050:
02734 
02735 /*              Call CHBEV */
02736 
02737                 if (jtype <= 7) {
02738                     kd = 0;
02739                 } else if (jtype >= 8 && jtype <= 15) {
02740 /* Computing MAX */
02741                     i__3 = n - 1;
02742                     kd = max(i__3,0);
02743                 } else {
02744                     kd = ihbw;
02745                 }
02746 
02747 /*              Load array V with the upper or lower triangular part */
02748 /*              of the matrix in band form. */
02749 
02750                 if (iuplo == 1) {
02751                     i__3 = n;
02752                     for (j = 1; j <= i__3; ++j) {
02753 /* Computing MAX */
02754                         i__5 = 1, i__6 = j - kd;
02755                         i__4 = j;
02756                         for (i__ = max(i__5,i__6); i__ <= i__4; ++i__) {
02757                             i__5 = kd + 1 + i__ - j + j * v_dim1;
02758                             i__6 = i__ + j * a_dim1;
02759                             v[i__5].r = a[i__6].r, v[i__5].i = a[i__6].i;
02760 /* L1060: */
02761                         }
02762 /* L1070: */
02763                     }
02764                 } else {
02765                     i__3 = n;
02766                     for (j = 1; j <= i__3; ++j) {
02767 /* Computing MIN */
02768                         i__5 = n, i__6 = j + kd;
02769                         i__4 = min(i__5,i__6);
02770                         for (i__ = j; i__ <= i__4; ++i__) {
02771                             i__5 = i__ + 1 - j + j * v_dim1;
02772                             i__6 = i__ + j * a_dim1;
02773                             v[i__5].r = a[i__6].r, v[i__5].i = a[i__6].i;
02774 /* L1080: */
02775                         }
02776 /* L1090: */
02777                     }
02778                 }
02779 
02780                 ++ntest;
02781                 chbev_("V", uplo, &n, &kd, &v[v_offset], ldu, &d1[1], &z__[
02782                         z_offset], ldu, &work[1], &rwork[1], &iinfo);
02783                 if (iinfo != 0) {
02784                     io___88.ciunit = *nounit;
02785                     s_wsfe(&io___88);
02786 /* Writing concatenation */
02787                     i__7[0] = 8, a__1[0] = "CHBEV(V,";
02788                     i__7[1] = 1, a__1[1] = uplo;
02789                     i__7[2] = 1, a__1[2] = ")";
02790                     s_cat(ch__3, a__1, i__7, &c__3, (ftnlen)10);
02791                     do_fio(&c__1, ch__3, (ftnlen)10);
02792                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02793                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02794                     do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02795                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02796                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02797                             ;
02798                     e_wsfe();
02799                     *info = abs(iinfo);
02800                     if (iinfo < 0) {
02801                         return 0;
02802                     } else {
02803                         result[ntest] = ulpinv;
02804                         result[ntest + 1] = ulpinv;
02805                         result[ntest + 2] = ulpinv;
02806                         goto L1140;
02807                     }
02808                 }
02809 
02810 /*              Do tests 43 and 44. */
02811 
02812                 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], lda, &d1[1], &
02813                         d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
02814 , &work[1], &rwork[1], &result[ntest]);
02815 
02816                 if (iuplo == 1) {
02817                     i__3 = n;
02818                     for (j = 1; j <= i__3; ++j) {
02819 /* Computing MAX */
02820                         i__4 = 1, i__5 = j - kd;
02821                         i__6 = j;
02822                         for (i__ = max(i__4,i__5); i__ <= i__6; ++i__) {
02823                             i__4 = kd + 1 + i__ - j + j * v_dim1;
02824                             i__5 = i__ + j * a_dim1;
02825                             v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
02826 /* L1100: */
02827                         }
02828 /* L1110: */
02829                     }
02830                 } else {
02831                     i__3 = n;
02832                     for (j = 1; j <= i__3; ++j) {
02833 /* Computing MIN */
02834                         i__4 = n, i__5 = j + kd;
02835                         i__6 = min(i__4,i__5);
02836                         for (i__ = j; i__ <= i__6; ++i__) {
02837                             i__4 = i__ + 1 - j + j * v_dim1;
02838                             i__5 = i__ + j * a_dim1;
02839                             v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
02840 /* L1120: */
02841                         }
02842 /* L1130: */
02843                     }
02844                 }
02845 
02846                 ntest += 2;
02847                 chbev_("N", uplo, &n, &kd, &v[v_offset], ldu, &d3[1], &z__[
02848                         z_offset], ldu, &work[1], &rwork[1], &iinfo);
02849                 if (iinfo != 0) {
02850                     io___89.ciunit = *nounit;
02851                     s_wsfe(&io___89);
02852 /* Writing concatenation */
02853                     i__7[0] = 8, a__1[0] = "CHBEV(N,";
02854                     i__7[1] = 1, a__1[1] = uplo;
02855                     i__7[2] = 1, a__1[2] = ")";
02856                     s_cat(ch__3, a__1, i__7, &c__3, (ftnlen)10);
02857                     do_fio(&c__1, ch__3, (ftnlen)10);
02858                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02859                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02860                     do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02861                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02862                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02863                             ;
02864                     e_wsfe();
02865                     *info = abs(iinfo);
02866                     if (iinfo < 0) {
02867                         return 0;
02868                     } else {
02869                         result[ntest] = ulpinv;
02870                         goto L1140;
02871                     }
02872                 }
02873 
02874 L1140:
02875 
02876 /*              Do test 45. */
02877 
02878                 temp1 = 0.f;
02879                 temp2 = 0.f;
02880                 i__3 = n;
02881                 for (j = 1; j <= i__3; ++j) {
02882 /* Computing MAX */
02883                     r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 = 
02884                             max(r__3,r__4), r__4 = (r__2 = d3[j], dabs(r__2));
02885                     temp1 = dmax(r__3,r__4);
02886 /* Computing MAX */
02887                     r__2 = temp2, r__3 = (r__1 = d1[j] - d3[j], dabs(r__1));
02888                     temp2 = dmax(r__2,r__3);
02889 /* L1150: */
02890                 }
02891 /* Computing MAX */
02892                 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02893                 result[ntest] = temp2 / dmax(r__1,r__2);
02894 
02895                 clacpy_(" ", &n, &n, &a[a_offset], lda, &v[v_offset], ldu);
02896                 ++ntest;
02897                 i__3 = *liwork - (n << 1);
02898                 cheevr_("V", "A", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il, 
02899                         &iu, &abstol, &m, &wa1[1], &z__[z_offset], ldu, &
02900                         iwork[1], &work[1], lwork, &rwork[1], lrwork, &iwork[(
02901                         n << 1) + 1], &i__3, &iinfo);
02902                 if (iinfo != 0) {
02903                     io___90.ciunit = *nounit;
02904                     s_wsfe(&io___90);
02905 /* Writing concatenation */
02906                     i__7[0] = 11, a__1[0] = "CHEEVR(V,A,";
02907                     i__7[1] = 1, a__1[1] = uplo;
02908                     i__7[2] = 1, a__1[2] = ")";
02909                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02910                     do_fio(&c__1, ch__2, (ftnlen)13);
02911                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02912                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02913                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02914                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02915                             ;
02916                     e_wsfe();
02917                     *info = abs(iinfo);
02918                     if (iinfo < 0) {
02919                         return 0;
02920                     } else {
02921                         result[ntest] = ulpinv;
02922                         result[ntest + 1] = ulpinv;
02923                         result[ntest + 2] = ulpinv;
02924                         goto L1170;
02925                     }
02926                 }
02927 
02928 /*              Do tests 45 and 46 (or ... ) */
02929 
02930                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
02931 
02932                 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], ldu, &wa1[1], &
02933                         d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
02934 , &work[1], &rwork[1], &result[ntest]);
02935 
02936                 ntest += 2;
02937                 i__3 = *liwork - (n << 1);
02938                 cheevr_("N", "A", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il, 
02939                         &iu, &abstol, &m2, &wa2[1], &z__[z_offset], ldu, &
02940                         iwork[1], &work[1], lwork, &rwork[1], lrwork, &iwork[(
02941                         n << 1) + 1], &i__3, &iinfo);
02942                 if (iinfo != 0) {
02943                     io___91.ciunit = *nounit;
02944                     s_wsfe(&io___91);
02945 /* Writing concatenation */
02946                     i__7[0] = 11, a__1[0] = "CHEEVR(N,A,";
02947                     i__7[1] = 1, a__1[1] = uplo;
02948                     i__7[2] = 1, a__1[2] = ")";
02949                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02950                     do_fio(&c__1, ch__2, (ftnlen)13);
02951                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02952                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02953                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02954                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02955                             ;
02956                     e_wsfe();
02957                     *info = abs(iinfo);
02958                     if (iinfo < 0) {
02959                         return 0;
02960                     } else {
02961                         result[ntest] = ulpinv;
02962                         goto L1170;
02963                     }
02964                 }
02965 
02966 /*              Do test 47 (or ... ) */
02967 
02968                 temp1 = 0.f;
02969                 temp2 = 0.f;
02970                 i__3 = n;
02971                 for (j = 1; j <= i__3; ++j) {
02972 /* Computing MAX */
02973                     r__3 = temp1, r__4 = (r__1 = wa1[j], dabs(r__1)), r__3 = 
02974                             max(r__3,r__4), r__4 = (r__2 = wa2[j], dabs(r__2))
02975                             ;
02976                     temp1 = dmax(r__3,r__4);
02977 /* Computing MAX */
02978                     r__2 = temp2, r__3 = (r__1 = wa1[j] - wa2[j], dabs(r__1));
02979                     temp2 = dmax(r__2,r__3);
02980 /* L1160: */
02981                 }
02982 /* Computing MAX */
02983                 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02984                 result[ntest] = temp2 / dmax(r__1,r__2);
02985 
02986 L1170:
02987 
02988                 ++ntest;
02989                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
02990                 i__3 = *liwork - (n << 1);
02991                 cheevr_("V", "I", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il, 
02992                         &iu, &abstol, &m2, &wa2[1], &z__[z_offset], ldu, &
02993                         iwork[1], &work[1], lwork, &rwork[1], lrwork, &iwork[(
02994                         n << 1) + 1], &i__3, &iinfo);
02995                 if (iinfo != 0) {
02996                     io___92.ciunit = *nounit;
02997                     s_wsfe(&io___92);
02998 /* Writing concatenation */
02999                     i__7[0] = 11, a__1[0] = "CHEEVR(V,I,";
03000                     i__7[1] = 1, a__1[1] = uplo;
03001                     i__7[2] = 1, a__1[2] = ")";
03002                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
03003                     do_fio(&c__1, ch__2, (ftnlen)13);
03004                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
03005                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
03006                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
03007                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
03008                             ;
03009                     e_wsfe();
03010                     *info = abs(iinfo);
03011                     if (iinfo < 0) {
03012                         return 0;
03013                     } else {
03014                         result[ntest] = ulpinv;
03015                         result[ntest + 1] = ulpinv;
03016                         result[ntest + 2] = ulpinv;
03017                         goto L1180;
03018                     }
03019                 }
03020 
03021 /*              Do tests 48 and 49 (or +??) */
03022 
03023                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
03024 
03025                 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
03026                         1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
03027                         tau[1], &work[1], &rwork[1], &result[ntest]);
03028 
03029                 ntest += 2;
03030                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
03031                 i__3 = *liwork - (n << 1);
03032                 cheevr_("N", "I", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il, 
03033                         &iu, &abstol, &m3, &wa3[1], &z__[z_offset], ldu, &
03034                         iwork[1], &work[1], lwork, &rwork[1], lrwork, &iwork[(
03035                         n << 1) + 1], &i__3, &iinfo);
03036                 if (iinfo != 0) {
03037                     io___93.ciunit = *nounit;
03038                     s_wsfe(&io___93);
03039 /* Writing concatenation */
03040                     i__7[0] = 11, a__1[0] = "CHEEVR(N,I,";
03041                     i__7[1] = 1, a__1[1] = uplo;
03042                     i__7[2] = 1, a__1[2] = ")";
03043                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
03044                     do_fio(&c__1, ch__2, (ftnlen)13);
03045                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
03046                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
03047                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
03048                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
03049                             ;
03050                     e_wsfe();
03051                     *info = abs(iinfo);
03052                     if (iinfo < 0) {
03053                         return 0;
03054                     } else {
03055                         result[ntest] = ulpinv;
03056                         goto L1180;
03057                     }
03058                 }
03059 
03060 /*              Do test 50 (or +??) */
03061 
03062                 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
03063                         ulp, &unfl);
03064                 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
03065                         ulp, &unfl);
03066 /* Computing MAX */
03067                 r__1 = unfl, r__2 = ulp * temp3;
03068                 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
03069 L1180:
03070 
03071                 ++ntest;
03072                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
03073                 i__3 = *liwork - (n << 1);
03074                 cheevr_("V", "V", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il, 
03075                         &iu, &abstol, &m2, &wa2[1], &z__[z_offset], ldu, &
03076                         iwork[1], &work[1], lwork, &rwork[1], lrwork, &iwork[(
03077                         n << 1) + 1], &i__3, &iinfo);
03078                 if (iinfo != 0) {
03079                     io___94.ciunit = *nounit;
03080                     s_wsfe(&io___94);
03081 /* Writing concatenation */
03082                     i__7[0] = 11, a__1[0] = "CHEEVR(V,V,";
03083                     i__7[1] = 1, a__1[1] = uplo;
03084                     i__7[2] = 1, a__1[2] = ")";
03085                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
03086                     do_fio(&c__1, ch__2, (ftnlen)13);
03087                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
03088                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
03089                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
03090                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
03091                             ;
03092                     e_wsfe();
03093                     *info = abs(iinfo);
03094                     if (iinfo < 0) {
03095                         return 0;
03096                     } else {
03097                         result[ntest] = ulpinv;
03098                         result[ntest + 1] = ulpinv;
03099                         result[ntest + 2] = ulpinv;
03100                         goto L1190;
03101                     }
03102                 }
03103 
03104 /*              Do tests 51 and 52 (or +??) */
03105 
03106                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
03107 
03108                 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
03109                         1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
03110                         tau[1], &work[1], &rwork[1], &result[ntest]);
03111 
03112                 ntest += 2;
03113                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
03114                 i__3 = *liwork - (n << 1);
03115                 cheevr_("N", "V", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il, 
03116                         &iu, &abstol, &m3, &wa3[1], &z__[z_offset], ldu, &
03117                         iwork[1], &work[1], lwork, &rwork[1], lrwork, &iwork[(
03118                         n << 1) + 1], &i__3, &iinfo);
03119                 if (iinfo != 0) {
03120                     io___95.ciunit = *nounit;
03121                     s_wsfe(&io___95);
03122 /* Writing concatenation */
03123                     i__7[0] = 11, a__1[0] = "CHEEVR(N,V,";
03124                     i__7[1] = 1, a__1[1] = uplo;
03125                     i__7[2] = 1, a__1[2] = ")";
03126                     s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
03127                     do_fio(&c__1, ch__2, (ftnlen)13);
03128                     do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
03129                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
03130                     do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
03131                     do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
03132                             ;
03133                     e_wsfe();
03134                     *info = abs(iinfo);
03135                     if (iinfo < 0) {
03136                         return 0;
03137                     } else {
03138                         result[ntest] = ulpinv;
03139                         goto L1190;
03140                     }
03141                 }
03142 
03143                 if (m3 == 0 && n > 0) {
03144                     result[ntest] = ulpinv;
03145                     goto L1190;
03146                 }
03147 
03148 /*              Do test 52 (or +??) */
03149 
03150                 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
03151                         ulp, &unfl);
03152                 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
03153                         ulp, &unfl);
03154                 if (n > 0) {
03155 /* Computing MAX */
03156                     r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
03157                     temp3 = dmax(r__2,r__3);
03158                 } else {
03159                     temp3 = 0.f;
03160                 }
03161 /* Computing MAX */
03162                 r__1 = unfl, r__2 = temp3 * ulp;
03163                 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
03164 
03165                 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
03166 
03167 
03168 
03169 
03170 /*              Load array V with the upper or lower triangular part */
03171 /*              of the matrix in band form. */
03172 
03173 L1190:
03174 
03175 /* L1200: */
03176                 ;
03177             }
03178 
03179 /*           End of Loop -- Check for RESULT(j) > THRESH */
03180 
03181             ntestt += ntest;
03182             slafts_("CST", &n, &n, &jtype, &ntest, &result[1], ioldsd, thresh, 
03183                      nounit, &nerrs);
03184 
03185 L1210:
03186             ;
03187         }
03188 /* L1220: */
03189     }
03190 
03191 /*     Summary */
03192 
03193     alasvm_("CST", nounit, &nerrs, &ntestt, &c__0);
03194 
03195 
03196     return 0;
03197 
03198 /*     End of CDRVST */
03199 
03200 } /* cdrvst_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:21