swiftnav: cdrvsg.c Source File

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