swiftnav: zdrvst.c Source File

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