zdrvsg.c
Go to the documentation of this file.
00001 /* zdrvsg.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__0 = 0;
00021 static integer c__6 = 6;
00022 static doublereal c_b33 = 1.;
00023 static integer c__1 = 1;
00024 static doublereal c_b43 = 0.;
00025 static integer c__4 = 4;
00026 static integer c__5 = 5;
00027 static doublereal c_b78 = 10.;
00028 static integer c__3 = 3;
00029 
00030 /* Subroutine */ int zdrvsg_(integer *nsizes, integer *nn, integer *ntypes, 
00031         logical *dotype, integer *iseed, doublereal *thresh, integer *nounit, 
00032         doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, 
00033         doublereal *d__, doublecomplex *z__, integer *ldz, doublecomplex *ab, 
00034         doublecomplex *bb, doublecomplex *ap, doublecomplex *bp, 
00035         doublecomplex *work, integer *nwork, doublereal *rwork, integer *
00036         lrwork, integer *iwork, integer *liwork, doublereal *result, integer *
00037         info)
00038 {
00039     /* Initialized data */
00040 
00041     static integer ktype[21] = { 1,2,4,4,4,4,4,5,5,5,5,5,8,8,8,9,9,9,9,9,9 };
00042     static integer kmagn[21] = { 1,1,1,1,1,2,3,1,1,1,2,3,1,2,3,1,1,1,1,1,1 };
00043     static integer kmode[21] = { 0,0,4,3,1,4,4,4,3,1,4,4,0,0,0,4,4,4,4,4,4 };
00044 
00045     /* Format strings */
00046     static char fmt_9999[] = "(\002 ZDRVSG: \002,a,\002 returned INFO=\002,i"
00047             "6,\002.\002,/9x,\002N=\002,i6,\002, JTYPE=\002,i6,\002, ISEED="
00048             "(\002,3(i5,\002,\002),i5,\002)\002)";
00049 
00050     /* System generated locals */
00051     address a__1[3];
00052     integer a_dim1, a_offset, ab_dim1, ab_offset, b_dim1, b_offset, bb_dim1, 
00053             bb_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5, i__6[3]
00054             , i__7;
00055     char ch__1[10], ch__2[11], ch__3[12], ch__4[13];
00056 
00057     /* Builtin functions */
00058     double sqrt(doublereal);
00059     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00060     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
00061 
00062     /* Local variables */
00063     integer i__, j, m, n, ka, kb, ij, il, iu;
00064     doublereal vl, vu;
00065     integer ka9, kb9;
00066     doublereal ulp, cond;
00067     integer jcol, nmax;
00068     doublereal unfl, ovfl;
00069     char uplo[1];
00070     logical badnn;
00071     integer imode;
00072     extern logical lsame_(char *, char *);
00073     integer iinfo;
00074     doublereal aninv, anorm;
00075     integer itemp;
00076     extern /* Subroutine */ int zhbgv_(char *, char *, integer *, integer *, 
00077             integer *, doublecomplex *, integer *, doublecomplex *, integer *, 
00078              doublereal *, doublecomplex *, integer *, doublecomplex *, 
00079             doublereal *, integer *);
00080     integer nmats, jsize;
00081     extern /* Subroutine */ int zhegv_(integer *, char *, char *, integer *, 
00082             doublecomplex *, integer *, doublecomplex *, integer *, 
00083             doublereal *, doublecomplex *, integer *, doublereal *, integer *), zsgt01_(integer *, char *, integer *, integer *, 
00084              doublecomplex *, integer *, doublecomplex *, integer *, 
00085             doublecomplex *, integer *, doublereal *, doublecomplex *, 
00086             doublereal *, doublereal *);
00087     integer nerrs, itype, jtype, ntest;
00088     extern /* Subroutine */ int zhpgv_(integer *, char *, char *, integer *, 
00089             doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, 
00090             integer *, doublecomplex *, doublereal *, integer *);
00091     integer iseed2[4];
00092     extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
00093     extern doublereal dlamch_(char *), dlarnd_(integer *, integer *);
00094     integer idumma[1];
00095     extern /* Subroutine */ int dlafts_(char *, integer *, integer *, integer 
00096             *, integer *, doublereal *, integer *, doublereal *, integer *, 
00097             integer *);
00098     integer ioldsd[4];
00099     extern /* Subroutine */ int xerbla_(char *, integer *);
00100     doublereal abstol;
00101     extern /* Subroutine */ int dlasum_(char *, integer *, integer *, integer 
00102             *), zhbgvd_(char *, char *, integer *, integer *, integer 
00103             *, doublecomplex *, integer *, doublecomplex *, integer *, 
00104             doublereal *, doublecomplex *, integer *, doublecomplex *, 
00105             integer *, doublereal *, integer *, integer *, integer *, integer 
00106             *), zhegvd_(integer *, char *, char *, integer *, 
00107             doublecomplex *, integer *, doublecomplex *, integer *, 
00108             doublereal *, doublecomplex *, integer *, doublereal *, integer *, 
00109              integer *, integer *, integer *);
00110     integer ibuplo, ibtype;
00111     extern /* Subroutine */ int zhpgvd_(integer *, char *, char *, integer *, 
00112             doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, 
00113             integer *, doublecomplex *, integer *, doublereal *, integer *, 
00114             integer *, integer *, integer *), zlacpy_(char *, 
00115             integer *, integer *, doublecomplex *, integer *, doublecomplex *, 
00116              integer *), zlaset_(char *, integer *, integer *, 
00117             doublecomplex *, doublecomplex *, doublecomplex *, integer *), zhbgvx_(char *, char *, char *, integer *, integer *, 
00118             integer *, doublecomplex *, integer *, doublecomplex *, integer *, 
00119              doublecomplex *, integer *, doublereal *, doublereal *, integer *
00120 , integer *, doublereal *, integer *, doublereal *, doublecomplex 
00121             *, integer *, doublecomplex *, doublereal *, integer *, integer *, 
00122              integer *), zlatmr_(integer *, integer *, 
00123              char *, integer *, char *, doublecomplex *, integer *, 
00124             doublereal *, doublecomplex *, char *, char *, doublecomplex *, 
00125             integer *, doublereal *, doublecomplex *, integer *, doublereal *, 
00126              char *, integer *, integer *, integer *, doublereal *, 
00127             doublereal *, char *, doublecomplex *, integer *, integer *, 
00128             integer *);
00129     doublereal rtunfl, rtovfl;
00130     integer mtypes, ntestt;
00131     doublereal ulpinv;
00132     extern /* Subroutine */ int zhegvx_(integer *, char *, char *, char *, 
00133             integer *, doublecomplex *, integer *, doublecomplex *, integer *, 
00134              doublereal *, doublereal *, integer *, integer *, doublereal *, 
00135             integer *, doublereal *, doublecomplex *, integer *, 
00136             doublecomplex *, integer *, doublereal *, integer *, integer *, 
00137             integer *), zhpgvx_(integer *, char *, 
00138             char *, char *, integer *, doublecomplex *, doublecomplex *, 
00139             doublereal *, doublereal *, integer *, integer *, doublereal *, 
00140             integer *, doublereal *, doublecomplex *, integer *, 
00141             doublecomplex *, doublereal *, integer *, integer *, integer *), zlatms_(integer *, integer *, char *, 
00142             integer *, char *, doublereal *, integer *, doublereal *, 
00143             doublereal *, integer *, integer *, char *, doublecomplex *, 
00144             integer *, doublecomplex *, integer *);
00145 
00146     /* Fortran I/O blocks */
00147     static cilist io___36 = { 0, 0, 0, fmt_9999, 0 };
00148     static cilist io___44 = { 0, 0, 0, fmt_9999, 0 };
00149     static cilist io___45 = { 0, 0, 0, fmt_9999, 0 };
00150     static cilist io___49 = { 0, 0, 0, fmt_9999, 0 };
00151     static cilist io___50 = { 0, 0, 0, fmt_9999, 0 };
00152     static cilist io___51 = { 0, 0, 0, fmt_9999, 0 };
00153     static cilist io___53 = { 0, 0, 0, fmt_9999, 0 };
00154     static cilist io___54 = { 0, 0, 0, fmt_9999, 0 };
00155     static cilist io___55 = { 0, 0, 0, fmt_9999, 0 };
00156     static cilist io___56 = { 0, 0, 0, fmt_9999, 0 };
00157     static cilist io___57 = { 0, 0, 0, fmt_9999, 0 };
00158     static cilist io___58 = { 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___61 = { 0, 0, 0, fmt_9999, 0 };
00162     static cilist io___62 = { 0, 0, 0, fmt_9999, 0 };
00163 
00164 
00165 
00166 /*  -- LAPACK test routine (version 3.1) -- */
00167 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00168 /*     November 2006 */
00169 
00170 /* ********************************************************************* */
00171 
00172 /*     modified August 1997, a new parameter LRWORK and LIWORK are */
00173 /*     added in the calling sequence. */
00174 
00175 /*     test routine CDGT01 is also modified */
00176 
00177 /* ********************************************************************* */
00178 
00179 /*     .. Scalar Arguments .. */
00180 /*     .. */
00181 /*     .. Array Arguments .. */
00182 /*     .. */
00183 
00184 /*  Purpose */
00185 /*  ======= */
00186 
00187 /*       ZDRVSG checks the complex Hermitian generalized eigenproblem */
00188 /*       drivers. */
00189 
00190 /*               ZHEGV computes all eigenvalues and, optionally, */
00191 /*               eigenvectors of a complex Hermitian-definite generalized */
00192 /*               eigenproblem. */
00193 
00194 /*               ZHEGVD computes all eigenvalues and, optionally, */
00195 /*               eigenvectors of a complex Hermitian-definite generalized */
00196 /*               eigenproblem using a divide and conquer algorithm. */
00197 
00198 /*               ZHEGVX computes selected eigenvalues and, optionally, */
00199 /*               eigenvectors of a complex Hermitian-definite generalized */
00200 /*               eigenproblem. */
00201 
00202 /*               ZHPGV computes all eigenvalues and, optionally, */
00203 /*               eigenvectors of a complex Hermitian-definite generalized */
00204 /*               eigenproblem in packed storage. */
00205 
00206 /*               ZHPGVD computes all eigenvalues and, optionally, */
00207 /*               eigenvectors of a complex Hermitian-definite generalized */
00208 /*               eigenproblem in packed storage using a divide and */
00209 /*               conquer algorithm. */
00210 
00211 /*               ZHPGVX computes selected eigenvalues and, optionally, */
00212 /*               eigenvectors of a complex Hermitian-definite generalized */
00213 /*               eigenproblem in packed storage. */
00214 
00215 /*               ZHBGV computes all eigenvalues and, optionally, */
00216 /*               eigenvectors of a complex Hermitian-definite banded */
00217 /*               generalized eigenproblem. */
00218 
00219 /*               ZHBGVD computes all eigenvalues and, optionally, */
00220 /*               eigenvectors of a complex Hermitian-definite banded */
00221 /*               generalized eigenproblem using a divide and conquer */
00222 /*               algorithm. */
00223 
00224 /*               ZHBGVX computes selected eigenvalues and, optionally, */
00225 /*               eigenvectors of a complex Hermitian-definite banded */
00226 /*               generalized eigenproblem. */
00227 
00228 /*       When ZDRVSG is called, a number of matrix "sizes" ("n's") and a */
00229 /*       number of matrix "types" are specified.  For each size ("n") */
00230 /*       and each type of matrix, one matrix A of the given type will be */
00231 /*       generated; a random well-conditioned matrix B is also generated */
00232 /*       and the pair (A,B) is used to test the drivers. */
00233 
00234 /*       For each pair (A,B), the following tests are performed: */
00235 
00236 /*       (1) ZHEGV with ITYPE = 1 and UPLO ='U': */
00237 
00238 /*               | A Z - B Z D | / ( |A| |Z| n ulp ) */
00239 
00240 /*       (2) as (1) but calling ZHPGV */
00241 /*       (3) as (1) but calling ZHBGV */
00242 /*       (4) as (1) but with UPLO = 'L' */
00243 /*       (5) as (4) but calling ZHPGV */
00244 /*       (6) as (4) but calling ZHBGV */
00245 
00246 /*       (7) ZHEGV with ITYPE = 2 and UPLO ='U': */
00247 
00248 /*               | A B Z - Z D | / ( |A| |Z| n ulp ) */
00249 
00250 /*       (8) as (7) but calling ZHPGV */
00251 /*       (9) as (7) but with UPLO = 'L' */
00252 /*       (10) as (9) but calling ZHPGV */
00253 
00254 /*       (11) ZHEGV with ITYPE = 3 and UPLO ='U': */
00255 
00256 /*               | B A Z - Z D | / ( |A| |Z| n ulp ) */
00257 
00258 /*       (12) as (11) but calling ZHPGV */
00259 /*       (13) as (11) but with UPLO = 'L' */
00260 /*       (14) as (13) but calling ZHPGV */
00261 
00262 /*       ZHEGVD, ZHPGVD and ZHBGVD performed the same 14 tests. */
00263 
00264 /*       ZHEGVX, ZHPGVX and ZHBGVX performed the above 14 tests with */
00265 /*       the parameter RANGE = 'A', 'N' and 'I', respectively. */
00266 
00267 /*       The "sizes" are specified by an array NN(1:NSIZES); the value of */
00268 /*       each element NN(j) specifies one size. */
00269 /*       The "types" are specified by a logical array DOTYPE( 1:NTYPES ); */
00270 /*       if DOTYPE(j) is .TRUE., then matrix type "j" will be generated. */
00271 /*       This type is used for the matrix A which has half-bandwidth KA. */
00272 /*       B is generated as a well-conditioned positive definite matrix */
00273 /*       with half-bandwidth KB (<= KA). */
00274 /*       Currently, the list of possible types for A is: */
00275 
00276 /*       (1)  The zero matrix. */
00277 /*       (2)  The identity matrix. */
00278 
00279 /*       (3)  A diagonal matrix with evenly spaced entries */
00280 /*            1, ..., ULP  and random signs. */
00281 /*            (ULP = (first number larger than 1) - 1 ) */
00282 /*       (4)  A diagonal matrix with geometrically spaced entries */
00283 /*            1, ..., ULP  and random signs. */
00284 /*       (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP */
00285 /*            and random signs. */
00286 
00287 /*       (6)  Same as (4), but multiplied by SQRT( overflow threshold ) */
00288 /*       (7)  Same as (4), but multiplied by SQRT( underflow threshold ) */
00289 
00290 /*       (8)  A matrix of the form  U* D U, where U is unitary and */
00291 /*            D has evenly spaced entries 1, ..., ULP with random signs */
00292 /*            on the diagonal. */
00293 
00294 /*       (9)  A matrix of the form  U* D U, where U is unitary and */
00295 /*            D has geometrically spaced entries 1, ..., ULP with random */
00296 /*            signs on the diagonal. */
00297 
00298 /*       (10) A matrix of the form  U* D U, where U is unitary and */
00299 /*            D has "clustered" entries 1, ULP,..., ULP with random */
00300 /*            signs on the diagonal. */
00301 
00302 /*       (11) Same as (8), but multiplied by SQRT( overflow threshold ) */
00303 /*       (12) Same as (8), but multiplied by SQRT( underflow threshold ) */
00304 
00305 /*       (13) Hermitian matrix with random entries chosen from (-1,1). */
00306 /*       (14) Same as (13), but multiplied by SQRT( overflow threshold ) */
00307 /*       (15) Same as (13), but multiplied by SQRT( underflow threshold ) */
00308 
00309 /*       (16) Same as (8), but with KA = 1 and KB = 1 */
00310 /*       (17) Same as (8), but with KA = 2 and KB = 1 */
00311 /*       (18) Same as (8), but with KA = 2 and KB = 2 */
00312 /*       (19) Same as (8), but with KA = 3 and KB = 1 */
00313 /*       (20) Same as (8), but with KA = 3 and KB = 2 */
00314 /*       (21) Same as (8), but with KA = 3 and KB = 3 */
00315 
00316 /*  Arguments */
00317 /*  ========= */
00318 
00319 /*  NSIZES  INTEGER */
00320 /*          The number of sizes of matrices to use.  If it is zero, */
00321 /*          ZDRVSG does nothing.  It must be at least zero. */
00322 /*          Not modified. */
00323 
00324 /*  NN      INTEGER array, dimension (NSIZES) */
00325 /*          An array containing the sizes to be used for the matrices. */
00326 /*          Zero values will be skipped.  The values must be at least */
00327 /*          zero. */
00328 /*          Not modified. */
00329 
00330 /*  NTYPES  INTEGER */
00331 /*          The number of elements in DOTYPE.   If it is zero, ZDRVSG */
00332 /*          does nothing.  It must be at least zero.  If it is MAXTYP+1 */
00333 /*          and NSIZES is 1, then an additional type, MAXTYP+1 is */
00334 /*          defined, which is to use whatever matrix is in A.  This */
00335 /*          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and */
00336 /*          DOTYPE(MAXTYP+1) is .TRUE. . */
00337 /*          Not modified. */
00338 
00339 /*  DOTYPE  LOGICAL array, dimension (NTYPES) */
00340 /*          If DOTYPE(j) is .TRUE., then for each size in NN a */
00341 /*          matrix of that size and of type j will be generated. */
00342 /*          If NTYPES is smaller than the maximum number of types */
00343 /*          defined (PARAMETER MAXTYP), then types NTYPES+1 through */
00344 /*          MAXTYP will not be generated.  If NTYPES is larger */
00345 /*          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) */
00346 /*          will be ignored. */
00347 /*          Not modified. */
00348 
00349 /*  ISEED   INTEGER array, dimension (4) */
00350 /*          On entry ISEED specifies the seed of the random number */
00351 /*          generator. The array elements should be between 0 and 4095; */
00352 /*          if not they will be reduced mod 4096.  Also, ISEED(4) must */
00353 /*          be odd.  The random number generator uses a linear */
00354 /*          congruential sequence limited to small integers, and so */
00355 /*          should produce machine independent random numbers. The */
00356 /*          values of ISEED are changed on exit, and can be used in the */
00357 /*          next call to ZDRVSG to continue the same random number */
00358 /*          sequence. */
00359 /*          Modified. */
00360 
00361 /*  THRESH  DOUBLE PRECISION */
00362 /*          A test will count as "failed" if the "error", computed as */
00363 /*          described above, exceeds THRESH.  Note that the error */
00364 /*          is scaled to be O(1), so THRESH should be a reasonably */
00365 /*          small multiple of 1, e.g., 10 or 100.  In particular, */
00366 /*          it should not depend on the precision (single vs. double) */
00367 /*          or the size of the matrix.  It must be at least zero. */
00368 /*          Not modified. */
00369 
00370 /*  NOUNIT  INTEGER */
00371 /*          The FORTRAN unit number for printing out error messages */
00372 /*          (e.g., if a routine returns IINFO not equal to 0.) */
00373 /*          Not modified. */
00374 
00375 /*  A       COMPLEX*16 array, dimension (LDA , max(NN)) */
00376 /*          Used to hold the matrix whose eigenvalues are to be */
00377 /*          computed.  On exit, A contains the last matrix actually */
00378 /*          used. */
00379 /*          Modified. */
00380 
00381 /*  LDA     INTEGER */
00382 /*          The leading dimension of A.  It must be at */
00383 /*          least 1 and at least max( NN ). */
00384 /*          Not modified. */
00385 
00386 /*  B       COMPLEX*16 array, dimension (LDB , max(NN)) */
00387 /*          Used to hold the Hermitian positive definite matrix for */
00388 /*          the generailzed problem. */
00389 /*          On exit, B contains the last matrix actually */
00390 /*          used. */
00391 /*          Modified. */
00392 
00393 /*  LDB     INTEGER */
00394 /*          The leading dimension of B.  It must be at */
00395 /*          least 1 and at least max( NN ). */
00396 /*          Not modified. */
00397 
00398 /*  D       DOUBLE PRECISION array, dimension (max(NN)) */
00399 /*          The eigenvalues of A. On exit, the eigenvalues in D */
00400 /*          correspond with the matrix in A. */
00401 /*          Modified. */
00402 
00403 /*  Z       COMPLEX*16 array, dimension (LDZ, max(NN)) */
00404 /*          The matrix of eigenvectors. */
00405 /*          Modified. */
00406 
00407 /*  LDZ     INTEGER */
00408 /*          The leading dimension of ZZ.  It must be at least 1 and */
00409 /*          at least max( NN ). */
00410 /*          Not modified. */
00411 
00412 /*  AB      COMPLEX*16 array, dimension (LDA, max(NN)) */
00413 /*          Workspace. */
00414 /*          Modified. */
00415 
00416 /*  BB      COMPLEX*16 array, dimension (LDB, max(NN)) */
00417 /*          Workspace. */
00418 /*          Modified. */
00419 
00420 /*  AP      COMPLEX*16 array, dimension (max(NN)**2) */
00421 /*          Workspace. */
00422 /*          Modified. */
00423 
00424 /*  BP      COMPLEX*16 array, dimension (max(NN)**2) */
00425 /*          Workspace. */
00426 /*          Modified. */
00427 
00428 /*  WORK    COMPLEX*16 array, dimension (NWORK) */
00429 /*          Workspace. */
00430 /*          Modified. */
00431 
00432 /*  NWORK   INTEGER */
00433 /*          The number of entries in WORK.  This must be at least */
00434 /*          2*N + N**2  where  N = max( NN(j), 2 ). */
00435 /*          Not modified. */
00436 
00437 /*  RWORK   DOUBLE PRECISION array, dimension (LRWORK) */
00438 /*          Workspace. */
00439 /*          Modified. */
00440 
00441 /*  LRWORK  INTEGER */
00442 /*          The number of entries in RWORK.  This must be at least */
00443 /*          max( 7*N, 1 + 4*N + 2*N*lg(N) + 3*N**2 ) where */
00444 /*          N = max( NN(j) ) and lg( N ) = smallest integer k such */
00445 /*          that 2**k >= N . */
00446 /*          Not modified. */
00447 
00448 /*  IWORK   INTEGER array, dimension (LIWORK)) */
00449 /*          Workspace. */
00450 /*          Modified. */
00451 
00452 /*  LIWORK  INTEGER */
00453 /*          The number of entries in IWORK.  This must be at least */
00454 /*          2 + 5*max( NN(j) ). */
00455 /*          Not modified. */
00456 
00457 /*  RESULT  DOUBLE PRECISION array, dimension (70) */
00458 /*          The values computed by the 70 tests described above. */
00459 /*          Modified. */
00460 
00461 /*  INFO    INTEGER */
00462 /*          If 0, then everything ran OK. */
00463 /*           -1: NSIZES < 0 */
00464 /*           -2: Some NN(j) < 0 */
00465 /*           -3: NTYPES < 0 */
00466 /*           -5: THRESH < 0 */
00467 /*           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ). */
00468 /*          -16: LDZ < 1 or LDZ < NMAX. */
00469 /*          -21: NWORK too small. */
00470 /*          -23: LRWORK too small. */
00471 /*          -25: LIWORK too small. */
00472 /*          If  ZLATMR, CLATMS, ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD, */
00473 /*              ZHPGVD, ZHEGVX, CHPGVX, ZHBGVX returns an error code, */
00474 /*              the absolute value of it is returned. */
00475 /*          Modified. */
00476 
00477 /* ----------------------------------------------------------------------- */
00478 
00479 /*       Some Local Variables and Parameters: */
00480 /*       ---- ----- --------- --- ---------- */
00481 /*       ZERO, ONE       Real 0 and 1. */
00482 /*       MAXTYP          The number of types defined. */
00483 /*       NTEST           The number of tests that have been run */
00484 /*                       on this matrix. */
00485 /*       NTESTT          The total number of tests for this call. */
00486 /*       NMAX            Largest value in NN. */
00487 /*       NMATS           The number of matrices generated so far. */
00488 /*       NERRS           The number of tests which have exceeded THRESH */
00489 /*                       so far (computed by DLAFTS). */
00490 /*       COND, IMODE     Values to be passed to the matrix generators. */
00491 /*       ANORM           Norm of A; passed to matrix generators. */
00492 
00493 /*       OVFL, UNFL      Overflow and underflow thresholds. */
00494 /*       ULP, ULPINV     Finest relative precision and its inverse. */
00495 /*       RTOVFL, RTUNFL  Square roots of the previous 2 values. */
00496 /*               The following four arrays decode JTYPE: */
00497 /*       KTYPE(j)        The general type (1-10) for type "j". */
00498 /*       KMODE(j)        The MODE value to be passed to the matrix */
00499 /*                       generator for type "j". */
00500 /*       KMAGN(j)        The order of magnitude ( O(1), */
00501 /*                       O(overflow^(1/2) ), O(underflow^(1/2) ) */
00502 
00503 /*  ===================================================================== */
00504 
00505 /*     .. Parameters .. */
00506 /*     .. */
00507 /*     .. Local Scalars .. */
00508 /*     .. */
00509 /*     .. Local Arrays .. */
00510 /*     .. */
00511 /*     .. External Functions .. */
00512 /*     .. */
00513 /*     .. External Subroutines .. */
00514 /*     .. */
00515 /*     .. Intrinsic Functions .. */
00516 /*     .. */
00517 /*     .. Data statements .. */
00518     /* Parameter adjustments */
00519     --nn;
00520     --dotype;
00521     --iseed;
00522     ab_dim1 = *lda;
00523     ab_offset = 1 + ab_dim1;
00524     ab -= ab_offset;
00525     a_dim1 = *lda;
00526     a_offset = 1 + a_dim1;
00527     a -= a_offset;
00528     bb_dim1 = *ldb;
00529     bb_offset = 1 + bb_dim1;
00530     bb -= bb_offset;
00531     b_dim1 = *ldb;
00532     b_offset = 1 + b_dim1;
00533     b -= b_offset;
00534     --d__;
00535     z_dim1 = *ldz;
00536     z_offset = 1 + z_dim1;
00537     z__ -= z_offset;
00538     --ap;
00539     --bp;
00540     --work;
00541     --rwork;
00542     --iwork;
00543     --result;
00544 
00545     /* Function Body */
00546 /*     .. */
00547 /*     .. Executable Statements .. */
00548 
00549 /*     1)      Check for errors */
00550 
00551     ntestt = 0;
00552     *info = 0;
00553 
00554     badnn = FALSE_;
00555     nmax = 0;
00556     i__1 = *nsizes;
00557     for (j = 1; j <= i__1; ++j) {
00558 /* Computing MAX */
00559         i__2 = nmax, i__3 = nn[j];
00560         nmax = max(i__2,i__3);
00561         if (nn[j] < 0) {
00562             badnn = TRUE_;
00563         }
00564 /* L10: */
00565     }
00566 
00567 /*     Check for errors */
00568 
00569     if (*nsizes < 0) {
00570         *info = -1;
00571     } else if (badnn) {
00572         *info = -2;
00573     } else if (*ntypes < 0) {
00574         *info = -3;
00575     } else if (*lda <= 1 || *lda < nmax) {
00576         *info = -9;
00577     } else if (*ldz <= 1 || *ldz < nmax) {
00578         *info = -16;
00579     } else /* if(complicated condition) */ {
00580 /* Computing 2nd power */
00581         i__1 = max(nmax,2);
00582         if (i__1 * i__1 << 1 > *nwork) {
00583             *info = -21;
00584         } else /* if(complicated condition) */ {
00585 /* Computing 2nd power */
00586             i__1 = max(nmax,2);
00587             if (i__1 * i__1 << 1 > *lrwork) {
00588                 *info = -23;
00589             } else /* if(complicated condition) */ {
00590 /* Computing 2nd power */
00591                 i__1 = max(nmax,2);
00592                 if (i__1 * i__1 << 1 > *liwork) {
00593                     *info = -25;
00594                 }
00595             }
00596         }
00597     }
00598 
00599     if (*info != 0) {
00600         i__1 = -(*info);
00601         xerbla_("ZDRVSG", &i__1);
00602         return 0;
00603     }
00604 
00605 /*     Quick return if possible */
00606 
00607     if (*nsizes == 0 || *ntypes == 0) {
00608         return 0;
00609     }
00610 
00611 /*     More Important constants */
00612 
00613     unfl = dlamch_("Safe minimum");
00614     ovfl = dlamch_("Overflow");
00615     dlabad_(&unfl, &ovfl);
00616     ulp = dlamch_("Epsilon") * dlamch_("Base");
00617     ulpinv = 1. / ulp;
00618     rtunfl = sqrt(unfl);
00619     rtovfl = sqrt(ovfl);
00620 
00621     for (i__ = 1; i__ <= 4; ++i__) {
00622         iseed2[i__ - 1] = iseed[i__];
00623 /* L20: */
00624     }
00625 
00626 /*     Loop over sizes, types */
00627 
00628     nerrs = 0;
00629     nmats = 0;
00630 
00631     i__1 = *nsizes;
00632     for (jsize = 1; jsize <= i__1; ++jsize) {
00633         n = nn[jsize];
00634         aninv = 1. / (doublereal) max(1,n);
00635 
00636         if (*nsizes != 1) {
00637             mtypes = min(21,*ntypes);
00638         } else {
00639             mtypes = min(22,*ntypes);
00640         }
00641 
00642         ka9 = 0;
00643         kb9 = 0;
00644         i__2 = mtypes;
00645         for (jtype = 1; jtype <= i__2; ++jtype) {
00646             if (! dotype[jtype]) {
00647                 goto L640;
00648             }
00649             ++nmats;
00650             ntest = 0;
00651 
00652             for (j = 1; j <= 4; ++j) {
00653                 ioldsd[j - 1] = iseed[j];
00654 /* L30: */
00655             }
00656 
00657 /*           2)      Compute "A" */
00658 
00659 /*                   Control parameters: */
00660 
00661 /*               KMAGN  KMODE        KTYPE */
00662 /*           =1  O(1)   clustered 1  zero */
00663 /*           =2  large  clustered 2  identity */
00664 /*           =3  small  exponential  (none) */
00665 /*           =4         arithmetic   diagonal, w/ eigenvalues */
00666 /*           =5         random log   hermitian, w/ eigenvalues */
00667 /*           =6         random       (none) */
00668 /*           =7                      random diagonal */
00669 /*           =8                      random hermitian */
00670 /*           =9                      banded, w/ eigenvalues */
00671 
00672             if (mtypes > 21) {
00673                 goto L90;
00674             }
00675 
00676             itype = ktype[jtype - 1];
00677             imode = kmode[jtype - 1];
00678 
00679 /*           Compute norm */
00680 
00681             switch (kmagn[jtype - 1]) {
00682                 case 1:  goto L40;
00683                 case 2:  goto L50;
00684                 case 3:  goto L60;
00685             }
00686 
00687 L40:
00688             anorm = 1.;
00689             goto L70;
00690 
00691 L50:
00692             anorm = rtovfl * ulp * aninv;
00693             goto L70;
00694 
00695 L60:
00696             anorm = rtunfl * n * ulpinv;
00697             goto L70;
00698 
00699 L70:
00700 
00701             iinfo = 0;
00702             cond = ulpinv;
00703 
00704 /*           Special Matrices -- Identity & Jordan block */
00705 
00706             if (itype == 1) {
00707 
00708 /*              Zero */
00709 
00710                 ka = 0;
00711                 kb = 0;
00712                 zlaset_("Full", lda, &n, &c_b1, &c_b1, &a[a_offset], lda);
00713 
00714             } else if (itype == 2) {
00715 
00716 /*              Identity */
00717 
00718                 ka = 0;
00719                 kb = 0;
00720                 zlaset_("Full", lda, &n, &c_b1, &c_b1, &a[a_offset], lda);
00721                 i__3 = n;
00722                 for (jcol = 1; jcol <= i__3; ++jcol) {
00723                     i__4 = jcol + jcol * a_dim1;
00724                     a[i__4].r = anorm, a[i__4].i = 0.;
00725 /* L80: */
00726                 }
00727 
00728             } else if (itype == 4) {
00729 
00730 /*              Diagonal Matrix, [Eigen]values Specified */
00731 
00732                 ka = 0;
00733                 kb = 0;
00734                 zlatms_(&n, &n, "S", &iseed[1], "H", &rwork[1], &imode, &cond, 
00735                          &anorm, &c__0, &c__0, "N", &a[a_offset], lda, &work[
00736                         1], &iinfo);
00737 
00738             } else if (itype == 5) {
00739 
00740 /*              Hermitian, eigenvalues specified */
00741 
00742 /* Computing MAX */
00743                 i__3 = 0, i__4 = n - 1;
00744                 ka = max(i__3,i__4);
00745                 kb = ka;
00746                 zlatms_(&n, &n, "S", &iseed[1], "H", &rwork[1], &imode, &cond, 
00747                          &anorm, &n, &n, "N", &a[a_offset], lda, &work[1], &
00748                         iinfo);
00749 
00750             } else if (itype == 7) {
00751 
00752 /*              Diagonal, random eigenvalues */
00753 
00754                 ka = 0;
00755                 kb = 0;
00756                 zlatmr_(&n, &n, "S", &iseed[1], "H", &work[1], &c__6, &c_b33, 
00757                         &c_b2, "T", "N", &work[n + 1], &c__1, &c_b33, &work[(
00758                         n << 1) + 1], &c__1, &c_b33, "N", idumma, &c__0, &
00759                         c__0, &c_b43, &anorm, "NO", &a[a_offset], lda, &iwork[
00760                         1], &iinfo);
00761 
00762             } else if (itype == 8) {
00763 
00764 /*              Hermitian, random eigenvalues */
00765 
00766 /* Computing MAX */
00767                 i__3 = 0, i__4 = n - 1;
00768                 ka = max(i__3,i__4);
00769                 kb = ka;
00770                 zlatmr_(&n, &n, "S", &iseed[1], "H", &work[1], &c__6, &c_b33, 
00771                         &c_b2, "T", "N", &work[n + 1], &c__1, &c_b33, &work[(
00772                         n << 1) + 1], &c__1, &c_b33, "N", idumma, &n, &n, &
00773                         c_b43, &anorm, "NO", &a[a_offset], lda, &iwork[1], &
00774                         iinfo);
00775 
00776             } else if (itype == 9) {
00777 
00778 /*              Hermitian banded, eigenvalues specified */
00779 
00780 /*              The following values are used for the half-bandwidths: */
00781 
00782 /*                ka = 1   kb = 1 */
00783 /*                ka = 2   kb = 1 */
00784 /*                ka = 2   kb = 2 */
00785 /*                ka = 3   kb = 1 */
00786 /*                ka = 3   kb = 2 */
00787 /*                ka = 3   kb = 3 */
00788 
00789                 ++kb9;
00790                 if (kb9 > ka9) {
00791                     ++ka9;
00792                     kb9 = 1;
00793                 }
00794 /* Computing MAX */
00795 /* Computing MIN */
00796                 i__5 = n - 1;
00797                 i__3 = 0, i__4 = min(i__5,ka9);
00798                 ka = max(i__3,i__4);
00799 /* Computing MAX */
00800 /* Computing MIN */
00801                 i__5 = n - 1;
00802                 i__3 = 0, i__4 = min(i__5,kb9);
00803                 kb = max(i__3,i__4);
00804                 zlatms_(&n, &n, "S", &iseed[1], "H", &rwork[1], &imode, &cond, 
00805                          &anorm, &ka, &ka, "N", &a[a_offset], lda, &work[1], &
00806                         iinfo);
00807 
00808             } else {
00809 
00810                 iinfo = 1;
00811             }
00812 
00813             if (iinfo != 0) {
00814                 io___36.ciunit = *nounit;
00815                 s_wsfe(&io___36);
00816                 do_fio(&c__1, "Generator", (ftnlen)9);
00817                 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00818                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00819                 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00820                 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00821                 e_wsfe();
00822                 *info = abs(iinfo);
00823                 return 0;
00824             }
00825 
00826 L90:
00827 
00828             abstol = unfl + unfl;
00829             if (n <= 1) {
00830                 il = 1;
00831                 iu = n;
00832             } else {
00833                 il = (integer) ((n - 1) * dlarnd_(&c__1, iseed2) + 1);
00834                 iu = (integer) ((n - 1) * dlarnd_(&c__1, iseed2) + 1);
00835                 if (il > iu) {
00836                     itemp = il;
00837                     il = iu;
00838                     iu = itemp;
00839                 }
00840             }
00841 
00842 /*           3) Call ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD, CHBGVD, */
00843 /*              ZHEGVX, ZHPGVX and ZHBGVX, do tests. */
00844 
00845 /*           loop over the three generalized problems */
00846 /*                 IBTYPE = 1: A*x = (lambda)*B*x */
00847 /*                 IBTYPE = 2: A*B*x = (lambda)*x */
00848 /*                 IBTYPE = 3: B*A*x = (lambda)*x */
00849 
00850             for (ibtype = 1; ibtype <= 3; ++ibtype) {
00851 
00852 /*              loop over the setting UPLO */
00853 
00854                 for (ibuplo = 1; ibuplo <= 2; ++ibuplo) {
00855                     if (ibuplo == 1) {
00856                         *(unsigned char *)uplo = 'U';
00857                     }
00858                     if (ibuplo == 2) {
00859                         *(unsigned char *)uplo = 'L';
00860                     }
00861 
00862 /*                 Generate random well-conditioned positive definite */
00863 /*                 matrix B, of bandwidth not greater than that of A. */
00864 
00865                     zlatms_(&n, &n, "U", &iseed[1], "P", &rwork[1], &c__5, &
00866                             c_b78, &c_b33, &kb, &kb, uplo, &b[b_offset], ldb, 
00867                             &work[n + 1], &iinfo);
00868 
00869 /*                 Test ZHEGV */
00870 
00871                     ++ntest;
00872 
00873                     zlacpy_(" ", &n, &n, &a[a_offset], lda, &z__[z_offset], 
00874                             ldz);
00875                     zlacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset], 
00876                             ldb);
00877 
00878                     zhegv_(&ibtype, "V", uplo, &n, &z__[z_offset], ldz, &bb[
00879                             bb_offset], ldb, &d__[1], &work[1], nwork, &rwork[
00880                             1], &iinfo);
00881                     if (iinfo != 0) {
00882                         io___44.ciunit = *nounit;
00883                         s_wsfe(&io___44);
00884 /* Writing concatenation */
00885                         i__6[0] = 8, a__1[0] = "ZHEGV(V,";
00886                         i__6[1] = 1, a__1[1] = uplo;
00887                         i__6[2] = 1, a__1[2] = ")";
00888                         s_cat(ch__1, a__1, i__6, &c__3, (ftnlen)10);
00889                         do_fio(&c__1, ch__1, (ftnlen)10);
00890                         do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
00891                                 ;
00892                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00893                         do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
00894                                 ;
00895                         do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
00896                                 integer));
00897                         e_wsfe();
00898                         *info = abs(iinfo);
00899                         if (iinfo < 0) {
00900                             return 0;
00901                         } else {
00902                             result[ntest] = ulpinv;
00903                             goto L100;
00904                         }
00905                     }
00906 
00907 /*                 Do Test */
00908 
00909                     zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
00910                             b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
00911                             work[1], &rwork[1], &result[ntest]);
00912 
00913 /*                 Test ZHEGVD */
00914 
00915                     ++ntest;
00916 
00917                     zlacpy_(" ", &n, &n, &a[a_offset], lda, &z__[z_offset], 
00918                             ldz);
00919                     zlacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset], 
00920                             ldb);
00921 
00922                     zhegvd_(&ibtype, "V", uplo, &n, &z__[z_offset], ldz, &bb[
00923                             bb_offset], ldb, &d__[1], &work[1], nwork, &rwork[
00924                             1], lrwork, &iwork[1], liwork, &iinfo);
00925                     if (iinfo != 0) {
00926                         io___45.ciunit = *nounit;
00927                         s_wsfe(&io___45);
00928 /* Writing concatenation */
00929                         i__6[0] = 9, a__1[0] = "ZHEGVD(V,";
00930                         i__6[1] = 1, a__1[1] = uplo;
00931                         i__6[2] = 1, a__1[2] = ")";
00932                         s_cat(ch__2, a__1, i__6, &c__3, (ftnlen)11);
00933                         do_fio(&c__1, ch__2, (ftnlen)11);
00934                         do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
00935                                 ;
00936                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00937                         do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
00938                                 ;
00939                         do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
00940                                 integer));
00941                         e_wsfe();
00942                         *info = abs(iinfo);
00943                         if (iinfo < 0) {
00944                             return 0;
00945                         } else {
00946                             result[ntest] = ulpinv;
00947                             goto L100;
00948                         }
00949                     }
00950 
00951 /*                 Do Test */
00952 
00953                     zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
00954                             b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
00955                             work[1], &rwork[1], &result[ntest]);
00956 
00957 /*                 Test ZHEGVX */
00958 
00959                     ++ntest;
00960 
00961                     zlacpy_(" ", &n, &n, &a[a_offset], lda, &ab[ab_offset], 
00962                             lda);
00963                     zlacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset], 
00964                             ldb);
00965 
00966                     zhegvx_(&ibtype, "V", "A", uplo, &n, &ab[ab_offset], lda, 
00967                             &bb[bb_offset], ldb, &vl, &vu, &il, &iu, &abstol, 
00968                             &m, &d__[1], &z__[z_offset], ldz, &work[1], nwork, 
00969                              &rwork[1], &iwork[n + 1], &iwork[1], &iinfo);
00970                     if (iinfo != 0) {
00971                         io___49.ciunit = *nounit;
00972                         s_wsfe(&io___49);
00973 /* Writing concatenation */
00974                         i__6[0] = 10, a__1[0] = "ZHEGVX(V,A";
00975                         i__6[1] = 1, a__1[1] = uplo;
00976                         i__6[2] = 1, a__1[2] = ")";
00977                         s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
00978                         do_fio(&c__1, ch__3, (ftnlen)12);
00979                         do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
00980                                 ;
00981                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00982                         do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
00983                                 ;
00984                         do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
00985                                 integer));
00986                         e_wsfe();
00987                         *info = abs(iinfo);
00988                         if (iinfo < 0) {
00989                             return 0;
00990                         } else {
00991                             result[ntest] = ulpinv;
00992                             goto L100;
00993                         }
00994                     }
00995 
00996 /*                 Do Test */
00997 
00998                     zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
00999                             b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01000                             work[1], &rwork[1], &result[ntest]);
01001 
01002                     ++ntest;
01003 
01004                     zlacpy_(" ", &n, &n, &a[a_offset], lda, &ab[ab_offset], 
01005                             lda);
01006                     zlacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset], 
01007                             ldb);
01008 
01009 /*                 since we do not know the exact eigenvalues of this */
01010 /*                 eigenpair, we just set VL and VU as constants. */
01011 /*                 It is quite possible that there are no eigenvalues */
01012 /*                 in this interval. */
01013 
01014                     vl = 0.;
01015                     vu = anorm;
01016                     zhegvx_(&ibtype, "V", "V", uplo, &n, &ab[ab_offset], lda, 
01017                             &bb[bb_offset], ldb, &vl, &vu, &il, &iu, &abstol, 
01018                             &m, &d__[1], &z__[z_offset], ldz, &work[1], nwork, 
01019                              &rwork[1], &iwork[n + 1], &iwork[1], &iinfo);
01020                     if (iinfo != 0) {
01021                         io___50.ciunit = *nounit;
01022                         s_wsfe(&io___50);
01023 /* Writing concatenation */
01024                         i__6[0] = 11, a__1[0] = "ZHEGVX(V,V,";
01025                         i__6[1] = 1, a__1[1] = uplo;
01026                         i__6[2] = 1, a__1[2] = ")";
01027                         s_cat(ch__4, a__1, i__6, &c__3, (ftnlen)13);
01028                         do_fio(&c__1, ch__4, (ftnlen)13);
01029                         do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01030                                 ;
01031                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01032                         do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01033                                 ;
01034                         do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01035                                 integer));
01036                         e_wsfe();
01037                         *info = abs(iinfo);
01038                         if (iinfo < 0) {
01039                             return 0;
01040                         } else {
01041                             result[ntest] = ulpinv;
01042                             goto L100;
01043                         }
01044                     }
01045 
01046 /*                 Do Test */
01047 
01048                     zsgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01049                             b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01050                             work[1], &rwork[1], &result[ntest]);
01051 
01052                     ++ntest;
01053 
01054                     zlacpy_(" ", &n, &n, &a[a_offset], lda, &ab[ab_offset], 
01055                             lda);
01056                     zlacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset], 
01057                             ldb);
01058 
01059                     zhegvx_(&ibtype, "V", "I", uplo, &n, &ab[ab_offset], lda, 
01060                             &bb[bb_offset], ldb, &vl, &vu, &il, &iu, &abstol, 
01061                             &m, &d__[1], &z__[z_offset], ldz, &work[1], nwork, 
01062                              &rwork[1], &iwork[n + 1], &iwork[1], &iinfo);
01063                     if (iinfo != 0) {
01064                         io___51.ciunit = *nounit;
01065                         s_wsfe(&io___51);
01066 /* Writing concatenation */
01067                         i__6[0] = 11, a__1[0] = "ZHEGVX(V,I,";
01068                         i__6[1] = 1, a__1[1] = uplo;
01069                         i__6[2] = 1, a__1[2] = ")";
01070                         s_cat(ch__4, a__1, i__6, &c__3, (ftnlen)13);
01071                         do_fio(&c__1, ch__4, (ftnlen)13);
01072                         do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01073                                 ;
01074                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01075                         do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01076                                 ;
01077                         do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01078                                 integer));
01079                         e_wsfe();
01080                         *info = abs(iinfo);
01081                         if (iinfo < 0) {
01082                             return 0;
01083                         } else {
01084                             result[ntest] = ulpinv;
01085                             goto L100;
01086                         }
01087                     }
01088 
01089 /*                 Do Test */
01090 
01091                     zsgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01092                             b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01093                             work[1], &rwork[1], &result[ntest]);
01094 
01095 L100:
01096 
01097 /*                 Test ZHPGV */
01098 
01099                     ++ntest;
01100 
01101 /*                 Copy the matrices into packed storage. */
01102 
01103                     if (lsame_(uplo, "U")) {
01104                         ij = 1;
01105                         i__3 = n;
01106                         for (j = 1; j <= i__3; ++j) {
01107                             i__4 = j;
01108                             for (i__ = 1; i__ <= i__4; ++i__) {
01109                                 i__5 = ij;
01110                                 i__7 = i__ + j * a_dim1;
01111                                 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01112                                         .i;
01113                                 i__5 = ij;
01114                                 i__7 = i__ + j * b_dim1;
01115                                 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01116                                         .i;
01117                                 ++ij;
01118 /* L110: */
01119                             }
01120 /* L120: */
01121                         }
01122                     } else {
01123                         ij = 1;
01124                         i__3 = n;
01125                         for (j = 1; j <= i__3; ++j) {
01126                             i__4 = n;
01127                             for (i__ = j; i__ <= i__4; ++i__) {
01128                                 i__5 = ij;
01129                                 i__7 = i__ + j * a_dim1;
01130                                 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01131                                         .i;
01132                                 i__5 = ij;
01133                                 i__7 = i__ + j * b_dim1;
01134                                 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01135                                         .i;
01136                                 ++ij;
01137 /* L130: */
01138                             }
01139 /* L140: */
01140                         }
01141                     }
01142 
01143                     zhpgv_(&ibtype, "V", uplo, &n, &ap[1], &bp[1], &d__[1], &
01144                             z__[z_offset], ldz, &work[1], &rwork[1], &iinfo);
01145                     if (iinfo != 0) {
01146                         io___53.ciunit = *nounit;
01147                         s_wsfe(&io___53);
01148 /* Writing concatenation */
01149                         i__6[0] = 8, a__1[0] = "ZHPGV(V,";
01150                         i__6[1] = 1, a__1[1] = uplo;
01151                         i__6[2] = 1, a__1[2] = ")";
01152                         s_cat(ch__1, a__1, i__6, &c__3, (ftnlen)10);
01153                         do_fio(&c__1, ch__1, (ftnlen)10);
01154                         do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01155                                 ;
01156                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01157                         do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01158                                 ;
01159                         do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01160                                 integer));
01161                         e_wsfe();
01162                         *info = abs(iinfo);
01163                         if (iinfo < 0) {
01164                             return 0;
01165                         } else {
01166                             result[ntest] = ulpinv;
01167                             goto L310;
01168                         }
01169                     }
01170 
01171 /*                 Do Test */
01172 
01173                     zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01174                             b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01175                             work[1], &rwork[1], &result[ntest]);
01176 
01177 /*                 Test ZHPGVD */
01178 
01179                     ++ntest;
01180 
01181 /*                 Copy the matrices into packed storage. */
01182 
01183                     if (lsame_(uplo, "U")) {
01184                         ij = 1;
01185                         i__3 = n;
01186                         for (j = 1; j <= i__3; ++j) {
01187                             i__4 = j;
01188                             for (i__ = 1; i__ <= i__4; ++i__) {
01189                                 i__5 = ij;
01190                                 i__7 = i__ + j * a_dim1;
01191                                 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01192                                         .i;
01193                                 i__5 = ij;
01194                                 i__7 = i__ + j * b_dim1;
01195                                 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01196                                         .i;
01197                                 ++ij;
01198 /* L150: */
01199                             }
01200 /* L160: */
01201                         }
01202                     } else {
01203                         ij = 1;
01204                         i__3 = n;
01205                         for (j = 1; j <= i__3; ++j) {
01206                             i__4 = n;
01207                             for (i__ = j; i__ <= i__4; ++i__) {
01208                                 i__5 = ij;
01209                                 i__7 = i__ + j * a_dim1;
01210                                 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01211                                         .i;
01212                                 i__5 = ij;
01213                                 i__7 = i__ + j * b_dim1;
01214                                 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01215                                         .i;
01216                                 ++ij;
01217 /* L170: */
01218                             }
01219 /* L180: */
01220                         }
01221                     }
01222 
01223                     zhpgvd_(&ibtype, "V", uplo, &n, &ap[1], &bp[1], &d__[1], &
01224                             z__[z_offset], ldz, &work[1], nwork, &rwork[1], 
01225                             lrwork, &iwork[1], liwork, &iinfo);
01226                     if (iinfo != 0) {
01227                         io___54.ciunit = *nounit;
01228                         s_wsfe(&io___54);
01229 /* Writing concatenation */
01230                         i__6[0] = 9, a__1[0] = "ZHPGVD(V,";
01231                         i__6[1] = 1, a__1[1] = uplo;
01232                         i__6[2] = 1, a__1[2] = ")";
01233                         s_cat(ch__2, a__1, i__6, &c__3, (ftnlen)11);
01234                         do_fio(&c__1, ch__2, (ftnlen)11);
01235                         do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01236                                 ;
01237                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01238                         do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01239                                 ;
01240                         do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01241                                 integer));
01242                         e_wsfe();
01243                         *info = abs(iinfo);
01244                         if (iinfo < 0) {
01245                             return 0;
01246                         } else {
01247                             result[ntest] = ulpinv;
01248                             goto L310;
01249                         }
01250                     }
01251 
01252 /*                 Do Test */
01253 
01254                     zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01255                             b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01256                             work[1], &rwork[1], &result[ntest]);
01257 
01258 /*                 Test ZHPGVX */
01259 
01260                     ++ntest;
01261 
01262 /*                 Copy the matrices into packed storage. */
01263 
01264                     if (lsame_(uplo, "U")) {
01265                         ij = 1;
01266                         i__3 = n;
01267                         for (j = 1; j <= i__3; ++j) {
01268                             i__4 = j;
01269                             for (i__ = 1; i__ <= i__4; ++i__) {
01270                                 i__5 = ij;
01271                                 i__7 = i__ + j * a_dim1;
01272                                 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01273                                         .i;
01274                                 i__5 = ij;
01275                                 i__7 = i__ + j * b_dim1;
01276                                 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01277                                         .i;
01278                                 ++ij;
01279 /* L190: */
01280                             }
01281 /* L200: */
01282                         }
01283                     } else {
01284                         ij = 1;
01285                         i__3 = n;
01286                         for (j = 1; j <= i__3; ++j) {
01287                             i__4 = n;
01288                             for (i__ = j; i__ <= i__4; ++i__) {
01289                                 i__5 = ij;
01290                                 i__7 = i__ + j * a_dim1;
01291                                 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01292                                         .i;
01293                                 i__5 = ij;
01294                                 i__7 = i__ + j * b_dim1;
01295                                 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01296                                         .i;
01297                                 ++ij;
01298 /* L210: */
01299                             }
01300 /* L220: */
01301                         }
01302                     }
01303 
01304                     zhpgvx_(&ibtype, "V", "A", uplo, &n, &ap[1], &bp[1], &vl, 
01305                             &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01306                             z_offset], ldz, &work[1], &rwork[1], &iwork[n + 1]
01307 , &iwork[1], info);
01308                     if (iinfo != 0) {
01309                         io___55.ciunit = *nounit;
01310                         s_wsfe(&io___55);
01311 /* Writing concatenation */
01312                         i__6[0] = 10, a__1[0] = "ZHPGVX(V,A";
01313                         i__6[1] = 1, a__1[1] = uplo;
01314                         i__6[2] = 1, a__1[2] = ")";
01315                         s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01316                         do_fio(&c__1, ch__3, (ftnlen)12);
01317                         do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01318                                 ;
01319                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01320                         do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01321                                 ;
01322                         do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01323                                 integer));
01324                         e_wsfe();
01325                         *info = abs(iinfo);
01326                         if (iinfo < 0) {
01327                             return 0;
01328                         } else {
01329                             result[ntest] = ulpinv;
01330                             goto L310;
01331                         }
01332                     }
01333 
01334 /*                 Do Test */
01335 
01336                     zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01337                             b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01338                             work[1], &rwork[1], &result[ntest]);
01339 
01340                     ++ntest;
01341 
01342 /*                 Copy the matrices into packed storage. */
01343 
01344                     if (lsame_(uplo, "U")) {
01345                         ij = 1;
01346                         i__3 = n;
01347                         for (j = 1; j <= i__3; ++j) {
01348                             i__4 = j;
01349                             for (i__ = 1; i__ <= i__4; ++i__) {
01350                                 i__5 = ij;
01351                                 i__7 = i__ + j * a_dim1;
01352                                 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01353                                         .i;
01354                                 i__5 = ij;
01355                                 i__7 = i__ + j * b_dim1;
01356                                 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01357                                         .i;
01358                                 ++ij;
01359 /* L230: */
01360                             }
01361 /* L240: */
01362                         }
01363                     } else {
01364                         ij = 1;
01365                         i__3 = n;
01366                         for (j = 1; j <= i__3; ++j) {
01367                             i__4 = n;
01368                             for (i__ = j; i__ <= i__4; ++i__) {
01369                                 i__5 = ij;
01370                                 i__7 = i__ + j * a_dim1;
01371                                 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01372                                         .i;
01373                                 i__5 = ij;
01374                                 i__7 = i__ + j * b_dim1;
01375                                 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01376                                         .i;
01377                                 ++ij;
01378 /* L250: */
01379                             }
01380 /* L260: */
01381                         }
01382                     }
01383 
01384                     vl = 0.;
01385                     vu = anorm;
01386                     zhpgvx_(&ibtype, "V", "V", uplo, &n, &ap[1], &bp[1], &vl, 
01387                             &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01388                             z_offset], ldz, &work[1], &rwork[1], &iwork[n + 1]
01389 , &iwork[1], info);
01390                     if (iinfo != 0) {
01391                         io___56.ciunit = *nounit;
01392                         s_wsfe(&io___56);
01393 /* Writing concatenation */
01394                         i__6[0] = 10, a__1[0] = "ZHPGVX(V,V";
01395                         i__6[1] = 1, a__1[1] = uplo;
01396                         i__6[2] = 1, a__1[2] = ")";
01397                         s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01398                         do_fio(&c__1, ch__3, (ftnlen)12);
01399                         do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01400                                 ;
01401                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01402                         do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01403                                 ;
01404                         do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01405                                 integer));
01406                         e_wsfe();
01407                         *info = abs(iinfo);
01408                         if (iinfo < 0) {
01409                             return 0;
01410                         } else {
01411                             result[ntest] = ulpinv;
01412                             goto L310;
01413                         }
01414                     }
01415 
01416 /*                 Do Test */
01417 
01418                     zsgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01419                             b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01420                             work[1], &rwork[1], &result[ntest]);
01421 
01422                     ++ntest;
01423 
01424 /*                 Copy the matrices into packed storage. */
01425 
01426                     if (lsame_(uplo, "U")) {
01427                         ij = 1;
01428                         i__3 = n;
01429                         for (j = 1; j <= i__3; ++j) {
01430                             i__4 = j;
01431                             for (i__ = 1; i__ <= i__4; ++i__) {
01432                                 i__5 = ij;
01433                                 i__7 = i__ + j * a_dim1;
01434                                 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01435                                         .i;
01436                                 i__5 = ij;
01437                                 i__7 = i__ + j * b_dim1;
01438                                 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01439                                         .i;
01440                                 ++ij;
01441 /* L270: */
01442                             }
01443 /* L280: */
01444                         }
01445                     } else {
01446                         ij = 1;
01447                         i__3 = n;
01448                         for (j = 1; j <= i__3; ++j) {
01449                             i__4 = n;
01450                             for (i__ = j; i__ <= i__4; ++i__) {
01451                                 i__5 = ij;
01452                                 i__7 = i__ + j * a_dim1;
01453                                 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01454                                         .i;
01455                                 i__5 = ij;
01456                                 i__7 = i__ + j * b_dim1;
01457                                 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01458                                         .i;
01459                                 ++ij;
01460 /* L290: */
01461                             }
01462 /* L300: */
01463                         }
01464                     }
01465 
01466                     zhpgvx_(&ibtype, "V", "I", uplo, &n, &ap[1], &bp[1], &vl, 
01467                             &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01468                             z_offset], ldz, &work[1], &rwork[1], &iwork[n + 1]
01469 , &iwork[1], info);
01470                     if (iinfo != 0) {
01471                         io___57.ciunit = *nounit;
01472                         s_wsfe(&io___57);
01473 /* Writing concatenation */
01474                         i__6[0] = 10, a__1[0] = "ZHPGVX(V,I";
01475                         i__6[1] = 1, a__1[1] = uplo;
01476                         i__6[2] = 1, a__1[2] = ")";
01477                         s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01478                         do_fio(&c__1, ch__3, (ftnlen)12);
01479                         do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01480                                 ;
01481                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01482                         do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01483                                 ;
01484                         do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01485                                 integer));
01486                         e_wsfe();
01487                         *info = abs(iinfo);
01488                         if (iinfo < 0) {
01489                             return 0;
01490                         } else {
01491                             result[ntest] = ulpinv;
01492                             goto L310;
01493                         }
01494                     }
01495 
01496 /*                 Do Test */
01497 
01498                     zsgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01499                             b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01500                             work[1], &rwork[1], &result[ntest]);
01501 
01502 L310:
01503 
01504                     if (ibtype == 1) {
01505 
01506 /*                    TEST ZHBGV */
01507 
01508                         ++ntest;
01509 
01510 /*                    Copy the matrices into band storage. */
01511 
01512                         if (lsame_(uplo, "U")) {
01513                             i__3 = n;
01514                             for (j = 1; j <= i__3; ++j) {
01515 /* Computing MAX */
01516                                 i__4 = 1, i__5 = j - ka;
01517                                 i__7 = j;
01518                                 for (i__ = max(i__4,i__5); i__ <= i__7; ++i__)
01519                                          {
01520                                     i__4 = ka + 1 + i__ - j + j * ab_dim1;
01521                                     i__5 = i__ + j * a_dim1;
01522                                     ab[i__4].r = a[i__5].r, ab[i__4].i = a[
01523                                             i__5].i;
01524 /* L320: */
01525                                 }
01526 /* Computing MAX */
01527                                 i__7 = 1, i__4 = j - kb;
01528                                 i__5 = j;
01529                                 for (i__ = max(i__7,i__4); i__ <= i__5; ++i__)
01530                                          {
01531                                     i__7 = kb + 1 + i__ - j + j * bb_dim1;
01532                                     i__4 = i__ + j * b_dim1;
01533                                     bb[i__7].r = b[i__4].r, bb[i__7].i = b[
01534                                             i__4].i;
01535 /* L330: */
01536                                 }
01537 /* L340: */
01538                             }
01539                         } else {
01540                             i__3 = n;
01541                             for (j = 1; j <= i__3; ++j) {
01542 /* Computing MIN */
01543                                 i__7 = n, i__4 = j + ka;
01544                                 i__5 = min(i__7,i__4);
01545                                 for (i__ = j; i__ <= i__5; ++i__) {
01546                                     i__7 = i__ + 1 - j + j * ab_dim1;
01547                                     i__4 = i__ + j * a_dim1;
01548                                     ab[i__7].r = a[i__4].r, ab[i__7].i = a[
01549                                             i__4].i;
01550 /* L350: */
01551                                 }
01552 /* Computing MIN */
01553                                 i__7 = n, i__4 = j + kb;
01554                                 i__5 = min(i__7,i__4);
01555                                 for (i__ = j; i__ <= i__5; ++i__) {
01556                                     i__7 = i__ + 1 - j + j * bb_dim1;
01557                                     i__4 = i__ + j * b_dim1;
01558                                     bb[i__7].r = b[i__4].r, bb[i__7].i = b[
01559                                             i__4].i;
01560 /* L360: */
01561                                 }
01562 /* L370: */
01563                             }
01564                         }
01565 
01566                         zhbgv_("V", uplo, &n, &ka, &kb, &ab[ab_offset], lda, &
01567                                 bb[bb_offset], ldb, &d__[1], &z__[z_offset], 
01568                                 ldz, &work[1], &rwork[1], &iinfo);
01569                         if (iinfo != 0) {
01570                             io___58.ciunit = *nounit;
01571                             s_wsfe(&io___58);
01572 /* Writing concatenation */
01573                             i__6[0] = 8, a__1[0] = "ZHBGV(V,";
01574                             i__6[1] = 1, a__1[1] = uplo;
01575                             i__6[2] = 1, a__1[2] = ")";
01576                             s_cat(ch__1, a__1, i__6, &c__3, (ftnlen)10);
01577                             do_fio(&c__1, ch__1, (ftnlen)10);
01578                             do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01579                                     integer));
01580                             do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01581                                     ;
01582                             do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01583                                     integer));
01584                             do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01585                                     integer));
01586                             e_wsfe();
01587                             *info = abs(iinfo);
01588                             if (iinfo < 0) {
01589                                 return 0;
01590                             } else {
01591                                 result[ntest] = ulpinv;
01592                                 goto L620;
01593                             }
01594                         }
01595 
01596 /*                    Do Test */
01597 
01598                         zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01599                                 b_offset], ldb, &z__[z_offset], ldz, &d__[1], 
01600                                 &work[1], &rwork[1], &result[ntest]);
01601 
01602 /*                    TEST ZHBGVD */
01603 
01604                         ++ntest;
01605 
01606 /*                    Copy the matrices into band storage. */
01607 
01608                         if (lsame_(uplo, "U")) {
01609                             i__3 = n;
01610                             for (j = 1; j <= i__3; ++j) {
01611 /* Computing MAX */
01612                                 i__5 = 1, i__7 = j - ka;
01613                                 i__4 = j;
01614                                 for (i__ = max(i__5,i__7); i__ <= i__4; ++i__)
01615                                          {
01616                                     i__5 = ka + 1 + i__ - j + j * ab_dim1;
01617                                     i__7 = i__ + j * a_dim1;
01618                                     ab[i__5].r = a[i__7].r, ab[i__5].i = a[
01619                                             i__7].i;
01620 /* L380: */
01621                                 }
01622 /* Computing MAX */
01623                                 i__4 = 1, i__5 = j - kb;
01624                                 i__7 = j;
01625                                 for (i__ = max(i__4,i__5); i__ <= i__7; ++i__)
01626                                          {
01627                                     i__4 = kb + 1 + i__ - j + j * bb_dim1;
01628                                     i__5 = i__ + j * b_dim1;
01629                                     bb[i__4].r = b[i__5].r, bb[i__4].i = b[
01630                                             i__5].i;
01631 /* L390: */
01632                                 }
01633 /* L400: */
01634                             }
01635                         } else {
01636                             i__3 = n;
01637                             for (j = 1; j <= i__3; ++j) {
01638 /* Computing MIN */
01639                                 i__4 = n, i__5 = j + ka;
01640                                 i__7 = min(i__4,i__5);
01641                                 for (i__ = j; i__ <= i__7; ++i__) {
01642                                     i__4 = i__ + 1 - j + j * ab_dim1;
01643                                     i__5 = i__ + j * a_dim1;
01644                                     ab[i__4].r = a[i__5].r, ab[i__4].i = a[
01645                                             i__5].i;
01646 /* L410: */
01647                                 }
01648 /* Computing MIN */
01649                                 i__4 = n, i__5 = j + kb;
01650                                 i__7 = min(i__4,i__5);
01651                                 for (i__ = j; i__ <= i__7; ++i__) {
01652                                     i__4 = i__ + 1 - j + j * bb_dim1;
01653                                     i__5 = i__ + j * b_dim1;
01654                                     bb[i__4].r = b[i__5].r, bb[i__4].i = b[
01655                                             i__5].i;
01656 /* L420: */
01657                                 }
01658 /* L430: */
01659                             }
01660                         }
01661 
01662                         zhbgvd_("V", uplo, &n, &ka, &kb, &ab[ab_offset], lda, 
01663                                 &bb[bb_offset], ldb, &d__[1], &z__[z_offset], 
01664                                 ldz, &work[1], nwork, &rwork[1], lrwork, &
01665                                 iwork[1], liwork, &iinfo);
01666                         if (iinfo != 0) {
01667                             io___59.ciunit = *nounit;
01668                             s_wsfe(&io___59);
01669 /* Writing concatenation */
01670                             i__6[0] = 9, a__1[0] = "ZHBGVD(V,";
01671                             i__6[1] = 1, a__1[1] = uplo;
01672                             i__6[2] = 1, a__1[2] = ")";
01673                             s_cat(ch__2, a__1, i__6, &c__3, (ftnlen)11);
01674                             do_fio(&c__1, ch__2, (ftnlen)11);
01675                             do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01676                                     integer));
01677                             do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01678                                     ;
01679                             do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01680                                     integer));
01681                             do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01682                                     integer));
01683                             e_wsfe();
01684                             *info = abs(iinfo);
01685                             if (iinfo < 0) {
01686                                 return 0;
01687                             } else {
01688                                 result[ntest] = ulpinv;
01689                                 goto L620;
01690                             }
01691                         }
01692 
01693 /*                    Do Test */
01694 
01695                         zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01696                                 b_offset], ldb, &z__[z_offset], ldz, &d__[1], 
01697                                 &work[1], &rwork[1], &result[ntest]);
01698 
01699 /*                    Test ZHBGVX */
01700 
01701                         ++ntest;
01702 
01703 /*                    Copy the matrices into band storage. */
01704 
01705                         if (lsame_(uplo, "U")) {
01706                             i__3 = n;
01707                             for (j = 1; j <= i__3; ++j) {
01708 /* Computing MAX */
01709                                 i__7 = 1, i__4 = j - ka;
01710                                 i__5 = j;
01711                                 for (i__ = max(i__7,i__4); i__ <= i__5; ++i__)
01712                                          {
01713                                     i__7 = ka + 1 + i__ - j + j * ab_dim1;
01714                                     i__4 = i__ + j * a_dim1;
01715                                     ab[i__7].r = a[i__4].r, ab[i__7].i = a[
01716                                             i__4].i;
01717 /* L440: */
01718                                 }
01719 /* Computing MAX */
01720                                 i__5 = 1, i__7 = j - kb;
01721                                 i__4 = j;
01722                                 for (i__ = max(i__5,i__7); i__ <= i__4; ++i__)
01723                                          {
01724                                     i__5 = kb + 1 + i__ - j + j * bb_dim1;
01725                                     i__7 = i__ + j * b_dim1;
01726                                     bb[i__5].r = b[i__7].r, bb[i__5].i = b[
01727                                             i__7].i;
01728 /* L450: */
01729                                 }
01730 /* L460: */
01731                             }
01732                         } else {
01733                             i__3 = n;
01734                             for (j = 1; j <= i__3; ++j) {
01735 /* Computing MIN */
01736                                 i__5 = n, i__7 = j + ka;
01737                                 i__4 = min(i__5,i__7);
01738                                 for (i__ = j; i__ <= i__4; ++i__) {
01739                                     i__5 = i__ + 1 - j + j * ab_dim1;
01740                                     i__7 = i__ + j * a_dim1;
01741                                     ab[i__5].r = a[i__7].r, ab[i__5].i = a[
01742                                             i__7].i;
01743 /* L470: */
01744                                 }
01745 /* Computing MIN */
01746                                 i__5 = n, i__7 = j + kb;
01747                                 i__4 = min(i__5,i__7);
01748                                 for (i__ = j; i__ <= i__4; ++i__) {
01749                                     i__5 = i__ + 1 - j + j * bb_dim1;
01750                                     i__7 = i__ + j * b_dim1;
01751                                     bb[i__5].r = b[i__7].r, bb[i__5].i = b[
01752                                             i__7].i;
01753 /* L480: */
01754                                 }
01755 /* L490: */
01756                             }
01757                         }
01758 
01759                         i__3 = max(1,n);
01760                         zhbgvx_("V", "A", uplo, &n, &ka, &kb, &ab[ab_offset], 
01761                                 lda, &bb[bb_offset], ldb, &bp[1], &i__3, &vl, 
01762                                 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01763                                 z_offset], ldz, &work[1], &rwork[1], &iwork[n 
01764                                 + 1], &iwork[1], &iinfo);
01765                         if (iinfo != 0) {
01766                             io___60.ciunit = *nounit;
01767                             s_wsfe(&io___60);
01768 /* Writing concatenation */
01769                             i__6[0] = 10, a__1[0] = "ZHBGVX(V,A";
01770                             i__6[1] = 1, a__1[1] = uplo;
01771                             i__6[2] = 1, a__1[2] = ")";
01772                             s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01773                             do_fio(&c__1, ch__3, (ftnlen)12);
01774                             do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01775                                     integer));
01776                             do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01777                                     ;
01778                             do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01779                                     integer));
01780                             do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01781                                     integer));
01782                             e_wsfe();
01783                             *info = abs(iinfo);
01784                             if (iinfo < 0) {
01785                                 return 0;
01786                             } else {
01787                                 result[ntest] = ulpinv;
01788                                 goto L620;
01789                             }
01790                         }
01791 
01792 /*                    Do Test */
01793 
01794                         zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01795                                 b_offset], ldb, &z__[z_offset], ldz, &d__[1], 
01796                                 &work[1], &rwork[1], &result[ntest]);
01797 
01798                         ++ntest;
01799 
01800 /*                    Copy the matrices into band storage. */
01801 
01802                         if (lsame_(uplo, "U")) {
01803                             i__3 = n;
01804                             for (j = 1; j <= i__3; ++j) {
01805 /* Computing MAX */
01806                                 i__4 = 1, i__5 = j - ka;
01807                                 i__7 = j;
01808                                 for (i__ = max(i__4,i__5); i__ <= i__7; ++i__)
01809                                          {
01810                                     i__4 = ka + 1 + i__ - j + j * ab_dim1;
01811                                     i__5 = i__ + j * a_dim1;
01812                                     ab[i__4].r = a[i__5].r, ab[i__4].i = a[
01813                                             i__5].i;
01814 /* L500: */
01815                                 }
01816 /* Computing MAX */
01817                                 i__7 = 1, i__4 = j - kb;
01818                                 i__5 = j;
01819                                 for (i__ = max(i__7,i__4); i__ <= i__5; ++i__)
01820                                          {
01821                                     i__7 = kb + 1 + i__ - j + j * bb_dim1;
01822                                     i__4 = i__ + j * b_dim1;
01823                                     bb[i__7].r = b[i__4].r, bb[i__7].i = b[
01824                                             i__4].i;
01825 /* L510: */
01826                                 }
01827 /* L520: */
01828                             }
01829                         } else {
01830                             i__3 = n;
01831                             for (j = 1; j <= i__3; ++j) {
01832 /* Computing MIN */
01833                                 i__7 = n, i__4 = j + ka;
01834                                 i__5 = min(i__7,i__4);
01835                                 for (i__ = j; i__ <= i__5; ++i__) {
01836                                     i__7 = i__ + 1 - j + j * ab_dim1;
01837                                     i__4 = i__ + j * a_dim1;
01838                                     ab[i__7].r = a[i__4].r, ab[i__7].i = a[
01839                                             i__4].i;
01840 /* L530: */
01841                                 }
01842 /* Computing MIN */
01843                                 i__7 = n, i__4 = j + kb;
01844                                 i__5 = min(i__7,i__4);
01845                                 for (i__ = j; i__ <= i__5; ++i__) {
01846                                     i__7 = i__ + 1 - j + j * bb_dim1;
01847                                     i__4 = i__ + j * b_dim1;
01848                                     bb[i__7].r = b[i__4].r, bb[i__7].i = b[
01849                                             i__4].i;
01850 /* L540: */
01851                                 }
01852 /* L550: */
01853                             }
01854                         }
01855 
01856                         vl = 0.;
01857                         vu = anorm;
01858                         i__3 = max(1,n);
01859                         zhbgvx_("V", "V", uplo, &n, &ka, &kb, &ab[ab_offset], 
01860                                 lda, &bb[bb_offset], ldb, &bp[1], &i__3, &vl, 
01861                                 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01862                                 z_offset], ldz, &work[1], &rwork[1], &iwork[n 
01863                                 + 1], &iwork[1], &iinfo);
01864                         if (iinfo != 0) {
01865                             io___61.ciunit = *nounit;
01866                             s_wsfe(&io___61);
01867 /* Writing concatenation */
01868                             i__6[0] = 10, a__1[0] = "ZHBGVX(V,V";
01869                             i__6[1] = 1, a__1[1] = uplo;
01870                             i__6[2] = 1, a__1[2] = ")";
01871                             s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01872                             do_fio(&c__1, ch__3, (ftnlen)12);
01873                             do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01874                                     integer));
01875                             do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01876                                     ;
01877                             do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01878                                     integer));
01879                             do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01880                                     integer));
01881                             e_wsfe();
01882                             *info = abs(iinfo);
01883                             if (iinfo < 0) {
01884                                 return 0;
01885                             } else {
01886                                 result[ntest] = ulpinv;
01887                                 goto L620;
01888                             }
01889                         }
01890 
01891 /*                    Do Test */
01892 
01893                         zsgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01894                                 b_offset], ldb, &z__[z_offset], ldz, &d__[1], 
01895                                 &work[1], &rwork[1], &result[ntest]);
01896 
01897                         ++ntest;
01898 
01899 /*                    Copy the matrices into band storage. */
01900 
01901                         if (lsame_(uplo, "U")) {
01902                             i__3 = n;
01903                             for (j = 1; j <= i__3; ++j) {
01904 /* Computing MAX */
01905                                 i__5 = 1, i__7 = j - ka;
01906                                 i__4 = j;
01907                                 for (i__ = max(i__5,i__7); i__ <= i__4; ++i__)
01908                                          {
01909                                     i__5 = ka + 1 + i__ - j + j * ab_dim1;
01910                                     i__7 = i__ + j * a_dim1;
01911                                     ab[i__5].r = a[i__7].r, ab[i__5].i = a[
01912                                             i__7].i;
01913 /* L560: */
01914                                 }
01915 /* Computing MAX */
01916                                 i__4 = 1, i__5 = j - kb;
01917                                 i__7 = j;
01918                                 for (i__ = max(i__4,i__5); i__ <= i__7; ++i__)
01919                                          {
01920                                     i__4 = kb + 1 + i__ - j + j * bb_dim1;
01921                                     i__5 = i__ + j * b_dim1;
01922                                     bb[i__4].r = b[i__5].r, bb[i__4].i = b[
01923                                             i__5].i;
01924 /* L570: */
01925                                 }
01926 /* L580: */
01927                             }
01928                         } else {
01929                             i__3 = n;
01930                             for (j = 1; j <= i__3; ++j) {
01931 /* Computing MIN */
01932                                 i__4 = n, i__5 = j + ka;
01933                                 i__7 = min(i__4,i__5);
01934                                 for (i__ = j; i__ <= i__7; ++i__) {
01935                                     i__4 = i__ + 1 - j + j * ab_dim1;
01936                                     i__5 = i__ + j * a_dim1;
01937                                     ab[i__4].r = a[i__5].r, ab[i__4].i = a[
01938                                             i__5].i;
01939 /* L590: */
01940                                 }
01941 /* Computing MIN */
01942                                 i__4 = n, i__5 = j + kb;
01943                                 i__7 = min(i__4,i__5);
01944                                 for (i__ = j; i__ <= i__7; ++i__) {
01945                                     i__4 = i__ + 1 - j + j * bb_dim1;
01946                                     i__5 = i__ + j * b_dim1;
01947                                     bb[i__4].r = b[i__5].r, bb[i__4].i = b[
01948                                             i__5].i;
01949 /* L600: */
01950                                 }
01951 /* L610: */
01952                             }
01953                         }
01954 
01955                         i__3 = max(1,n);
01956                         zhbgvx_("V", "I", uplo, &n, &ka, &kb, &ab[ab_offset], 
01957                                 lda, &bb[bb_offset], ldb, &bp[1], &i__3, &vl, 
01958                                 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01959                                 z_offset], ldz, &work[1], &rwork[1], &iwork[n 
01960                                 + 1], &iwork[1], &iinfo);
01961                         if (iinfo != 0) {
01962                             io___62.ciunit = *nounit;
01963                             s_wsfe(&io___62);
01964 /* Writing concatenation */
01965                             i__6[0] = 10, a__1[0] = "ZHBGVX(V,I";
01966                             i__6[1] = 1, a__1[1] = uplo;
01967                             i__6[2] = 1, a__1[2] = ")";
01968                             s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01969                             do_fio(&c__1, ch__3, (ftnlen)12);
01970                             do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01971                                     integer));
01972                             do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01973                                     ;
01974                             do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01975                                     integer));
01976                             do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01977                                     integer));
01978                             e_wsfe();
01979                             *info = abs(iinfo);
01980                             if (iinfo < 0) {
01981                                 return 0;
01982                             } else {
01983                                 result[ntest] = ulpinv;
01984                                 goto L620;
01985                             }
01986                         }
01987 
01988 /*                    Do Test */
01989 
01990                         zsgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01991                                 b_offset], ldb, &z__[z_offset], ldz, &d__[1], 
01992                                 &work[1], &rwork[1], &result[ntest]);
01993 
01994                     }
01995 
01996 L620:
01997                     ;
01998                 }
01999 /* L630: */
02000             }
02001 
02002 /*           End of Loop -- Check for RESULT(j) > THRESH */
02003 
02004             ntestt += ntest;
02005             dlafts_("ZSG", &n, &n, &jtype, &ntest, &result[1], ioldsd, thresh, 
02006                      nounit, &nerrs);
02007 L640:
02008             ;
02009         }
02010 /* L650: */
02011     }
02012 
02013 /*     Summary */
02014 
02015     dlasum_("ZSG", nounit, &nerrs, &ntestt);
02016 
02017     return 0;
02018 
02019 
02020 /*     End of ZDRVSG */
02021 
02022 } /* zdrvsg_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:23