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

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