sdrvsx.c
Go to the documentation of this file.
00001 /* sdrvsx.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 /* Common Block Declarations */
00017 
00018 struct {
00019     integer selopt, seldim;
00020     logical selval[20];
00021     real selwr[20], selwi[20];
00022 } sslct_;
00023 
00024 #define sslct_1 sslct_
00025 
00026 /* Table of constant values */
00027 
00028 static real c_b18 = 0.f;
00029 static integer c__0 = 0;
00030 static real c_b32 = 1.f;
00031 static integer c__4 = 4;
00032 static integer c__6 = 6;
00033 static integer c__1 = 1;
00034 static integer c__2 = 2;
00035 static logical c_false = FALSE_;
00036 static integer c__3 = 3;
00037 static logical c_true = TRUE_;
00038 static integer c__22 = 22;
00039 
00040 /* Subroutine */ int sdrvsx_(integer *nsizes, integer *nn, integer *ntypes, 
00041         logical *dotype, integer *iseed, real *thresh, integer *niunit, 
00042         integer *nounit, real *a, integer *lda, real *h__, real *ht, real *wr, 
00043          real *wi, real *wrt, real *wit, real *wrtmp, real *witmp, real *vs, 
00044         integer *ldvs, real *vs1, real *result, real *work, integer *lwork, 
00045         integer *iwork, logical *bwork, integer *info)
00046 {
00047     /* Initialized data */
00048 
00049     static integer ktype[21] = { 1,2,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,9,9,9 };
00050     static integer kmagn[21] = { 1,1,1,1,1,1,2,3,1,1,1,1,1,1,1,1,2,3,1,2,3 };
00051     static integer kmode[21] = { 0,0,0,4,3,1,4,4,4,3,1,5,4,3,1,5,5,5,4,3,1 };
00052     static integer kconds[21] = { 0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,2,2,0,0,0 };
00053 
00054     /* Format strings */
00055     static char fmt_9991[] = "(\002 SDRVSX: \002,a,\002 returned INFO=\002,i"
00056             "6,\002.\002,/9x,\002N=\002,i6,\002, JTYPE=\002,i6,\002, ISEED="
00057             "(\002,3(i5,\002,\002),i5,\002)\002)";
00058     static char fmt_9999[] = "(/1x,a3,\002 -- Real Schur Form Decomposition "
00059             "Expert \002,\002Driver\002,/\002 Matrix types (see SDRVSX for de"
00060             "tails):\002)";
00061     static char fmt_9998[] = "(/\002 Special Matrices:\002,/\002  1=Zero mat"
00062             "rix.             \002,\002           \002,\002  5=Diagonal: geom"
00063             "etr. spaced entries.\002,/\002  2=Identity matrix.              "
00064             "      \002,\002  6=Diagona\002,\002l: clustered entries.\002,"
00065             "/\002  3=Transposed Jordan block.  \002,\002          \002,\002 "
00066             " 7=Diagonal: large, evenly spaced.\002,/\002  \002,\0024=Diagona"
00067             "l: evenly spaced entries.    \002,\002  8=Diagonal: s\002,\002ma"
00068             "ll, evenly spaced.\002)";
00069     static char fmt_9997[] = "(\002 Dense, Non-Symmetric Matrices:\002,/\002"
00070             "  9=Well-cond., ev\002,\002enly spaced eigenvals.\002,\002 14=Il"
00071             "l-cond., geomet. spaced e\002,\002igenals.\002,/\002 10=Well-con"
00072             "d., geom. spaced eigenvals. \002,\002 15=Ill-conditioned, cluste"
00073             "red e.vals.\002,/\002 11=Well-cond\002,\002itioned, clustered e."
00074             "vals. \002,\002 16=Ill-cond., random comp\002,\002lex \002,/\002"
00075             " 12=Well-cond., random complex \002,\002         \002,\002 17=Il"
00076             "l-cond., large rand. complx \002,/\002 13=Ill-condi\002,\002tion"
00077             "ed, evenly spaced.     \002,\002 18=Ill-cond., small rand.\002"
00078             ",\002 complx \002)";
00079     static char fmt_9996[] = "(\002 19=Matrix with random O(1) entries.   "
00080             " \002,\002 21=Matrix \002,\002with small random entries.\002,"
00081             "/\002 20=Matrix with large ran\002,\002dom entries.   \002,/)";
00082     static char fmt_9995[] = "(\002 Tests performed with test threshold ="
00083             "\002,f8.2,/\002 ( A denotes A on input and T denotes A on output)"
00084             "\002,//\002 1 = 0 if T in Schur form (no sort), \002,\002  1/ulp"
00085             " otherwise\002,/\002 2 = | A - VS T transpose(VS) | / ( n |A| ul"
00086             "p ) (no sort)\002,/\002 3 = | I - VS transpose(VS) | / ( n ulp )"
00087             " (no sort) \002,/\002 4 = 0 if WR+sqrt(-1)*WI are eigenvalues of"
00088             " T (no sort),\002,\002  1/ulp otherwise\002,/\002 5 = 0 if T sam"
00089             "e no matter if VS computed (no sort),\002,\002  1/ulp otherwis"
00090             "e\002,/\002 6 = 0 if WR, WI same no matter if VS computed (no so"
00091             "rt)\002,\002,  1/ulp otherwise\002)";
00092     static char fmt_9994[] = "(\002 7 = 0 if T in Schur form (sort), \002"
00093             ",\002  1/ulp otherwise\002,/\002 8 = | A - VS T transpose(VS) | "
00094             "/ ( n |A| ulp ) (sort)\002,/\002 9 = | I - VS transpose(VS) | / "
00095             "( n ulp ) (sort) \002,/\002 10 = 0 if WR+sqrt(-1)*WI are eigenva"
00096             "lues of T (sort),\002,\002  1/ulp otherwise\002,/\002 11 = 0 if "
00097             "T same no matter what else computed (sort),\002,\002  1/ulp othe"
00098             "rwise\002,/\002 12 = 0 if WR, WI same no matter what else comput"
00099             "ed \002,\002(sort), 1/ulp otherwise\002,/\002 13 = 0 if sorting "
00100             "succesful, 1/ulp otherwise\002,/\002 14 = 0 if RCONDE same no ma"
00101             "tter what else computed,\002,\002 1/ulp otherwise\002,/\002 15 ="
00102             " 0 if RCONDv same no matter what else computed,\002,\002 1/ulp o"
00103             "therwise\002,/\002 16 = | RCONDE - RCONDE(precomputed) | / cond("
00104             "RCONDE),\002,/\002 17 = | RCONDV - RCONDV(precomputed) | / cond("
00105             "RCONDV),\002)";
00106     static char fmt_9993[] = "(\002 N=\002,i5,\002, IWK=\002,i2,\002, seed"
00107             "=\002,4(i4,\002,\002),\002 type \002,i2,\002, test(\002,i2,\002)="
00108             "\002,g10.3)";
00109     static char fmt_9992[] = "(\002 N=\002,i5,\002, input example =\002,i3"
00110             ",\002,  test(\002,i2,\002)=\002,g10.3)";
00111 
00112     /* System generated locals */
00113     integer a_dim1, a_offset, h_dim1, h_offset, ht_dim1, ht_offset, vs_dim1, 
00114             vs_offset, vs1_dim1, vs1_offset, i__1, i__2, i__3, i__4;
00115 
00116     /* Builtin functions */
00117     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00118     double sqrt(doublereal);
00119     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
00120              s_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), 
00121             e_rsle(void);
00122 
00123     /* Local variables */
00124     integer i__, j, n, iwk;
00125     real ulp, cond;
00126     integer jcol;
00127     char path[3];
00128     integer nmax;
00129     real unfl, ovfl;
00130     logical badnn;
00131     integer nfail, imode, iinfo;
00132     real conds;
00133     extern /* Subroutine */ int sget24_(logical *, integer *, real *, integer 
00134             *, integer *, integer *, real *, integer *, real *, real *, real *
00135 , real *, real *, real *, real *, real *, real *, integer *, real 
00136             *, real *, real *, integer *, integer *, real *, real *, integer *
00137 , integer *, logical *, integer *);
00138     real anorm;
00139     integer islct[20], nslct, jsize, nerrs, itype, jtype, ntest;
00140     real rtulp;
00141     extern /* Subroutine */ int slabad_(real *, real *);
00142     real rcdein;
00143     char adumma[1*1];
00144     extern doublereal slamch_(char *);
00145     integer idumma[1], ioldsd[4];
00146     extern /* Subroutine */ int xerbla_(char *, integer *);
00147     real rcdvin;
00148     extern /* Subroutine */ int slatme_(integer *, char *, integer *, real *, 
00149             integer *, real *, real *, char *, char *, char *, char *, real *, 
00150              integer *, real *, integer *, integer *, real *, real *, integer 
00151             *, real *, integer *), 
00152             slaset_(char *, integer *, integer *, real *, real *, real *, 
00153             integer *), slatmr_(integer *, integer *, char *, integer 
00154             *, char *, real *, integer *, real *, real *, char *, char *, 
00155             real *, integer *, real *, real *, integer *, real *, char *, 
00156             integer *, integer *, integer *, real *, real *, char *, real *, 
00157             integer *, integer *, integer *);
00158     integer ntestf;
00159     extern /* Subroutine */ int slasum_(char *, integer *, integer *, integer 
00160             *), slatms_(integer *, integer *, char *, integer *, char 
00161             *, real *, integer *, real *, real *, integer *, integer *, char *
00162 , real *, integer *, real *, integer *);
00163     real ulpinv;
00164     integer nnwork;
00165     real rtulpi;
00166     integer mtypes, ntestt;
00167 
00168     /* Fortran I/O blocks */
00169     static cilist io___32 = { 0, 0, 0, fmt_9991, 0 };
00170     static cilist io___41 = { 0, 0, 0, fmt_9999, 0 };
00171     static cilist io___42 = { 0, 0, 0, fmt_9998, 0 };
00172     static cilist io___43 = { 0, 0, 0, fmt_9997, 0 };
00173     static cilist io___44 = { 0, 0, 0, fmt_9996, 0 };
00174     static cilist io___45 = { 0, 0, 0, fmt_9995, 0 };
00175     static cilist io___46 = { 0, 0, 0, fmt_9994, 0 };
00176     static cilist io___47 = { 0, 0, 0, fmt_9993, 0 };
00177     static cilist io___48 = { 0, 0, 1, 0, 0 };
00178     static cilist io___49 = { 0, 0, 0, 0, 0 };
00179     static cilist io___51 = { 0, 0, 0, 0, 0 };
00180     static cilist io___52 = { 0, 0, 0, 0, 0 };
00181     static cilist io___53 = { 0, 0, 0, fmt_9999, 0 };
00182     static cilist io___54 = { 0, 0, 0, fmt_9998, 0 };
00183     static cilist io___55 = { 0, 0, 0, fmt_9997, 0 };
00184     static cilist io___56 = { 0, 0, 0, fmt_9996, 0 };
00185     static cilist io___57 = { 0, 0, 0, fmt_9995, 0 };
00186     static cilist io___58 = { 0, 0, 0, fmt_9994, 0 };
00187     static cilist io___59 = { 0, 0, 0, fmt_9992, 0 };
00188 
00189 
00190 
00191 /*  -- LAPACK test routine (version 3.1) -- */
00192 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00193 /*     November 2006 */
00194 
00195 /*     .. Scalar Arguments .. */
00196 /*     .. */
00197 /*     .. Array Arguments .. */
00198 /*     .. */
00199 
00200 /*  Purpose */
00201 /*  ======= */
00202 
00203 /*     SDRVSX checks the nonsymmetric eigenvalue (Schur form) problem */
00204 /*     expert driver SGEESX. */
00205 
00206 /*     SDRVSX uses both test matrices generated randomly depending on */
00207 /*     data supplied in the calling sequence, as well as on data */
00208 /*     read from an input file and including precomputed condition */
00209 /*     numbers to which it compares the ones it computes. */
00210 
00211 /*     When SDRVSX is called, a number of matrix "sizes" ("n's") and a */
00212 /*     number of matrix "types" are specified.  For each size ("n") */
00213 /*     and each type of matrix, one matrix will be generated and used */
00214 /*     to test the nonsymmetric eigenroutines.  For each matrix, 15 */
00215 /*     tests will be performed: */
00216 
00217 /*     (1)     0 if T is in Schur form, 1/ulp otherwise */
00218 /*            (no sorting of eigenvalues) */
00219 
00220 /*     (2)     | A - VS T VS' | / ( n |A| ulp ) */
00221 
00222 /*       Here VS is the matrix of Schur eigenvectors, and T is in Schur */
00223 /*       form  (no sorting of eigenvalues). */
00224 
00225 /*     (3)     | I - VS VS' | / ( n ulp ) (no sorting of eigenvalues). */
00226 
00227 /*     (4)     0     if WR+sqrt(-1)*WI are eigenvalues of T */
00228 /*             1/ulp otherwise */
00229 /*             (no sorting of eigenvalues) */
00230 
00231 /*     (5)     0     if T(with VS) = T(without VS), */
00232 /*             1/ulp otherwise */
00233 /*             (no sorting of eigenvalues) */
00234 
00235 /*     (6)     0     if eigenvalues(with VS) = eigenvalues(without VS), */
00236 /*             1/ulp otherwise */
00237 /*             (no sorting of eigenvalues) */
00238 
00239 /*     (7)     0 if T is in Schur form, 1/ulp otherwise */
00240 /*             (with sorting of eigenvalues) */
00241 
00242 /*     (8)     | A - VS T VS' | / ( n |A| ulp ) */
00243 
00244 /*       Here VS is the matrix of Schur eigenvectors, and T is in Schur */
00245 /*       form  (with sorting of eigenvalues). */
00246 
00247 /*     (9)     | I - VS VS' | / ( n ulp ) (with sorting of eigenvalues). */
00248 
00249 /*     (10)    0     if WR+sqrt(-1)*WI are eigenvalues of T */
00250 /*             1/ulp otherwise */
00251 /*             If workspace sufficient, also compare WR, WI with and */
00252 /*             without reciprocal condition numbers */
00253 /*             (with sorting of eigenvalues) */
00254 
00255 /*     (11)    0     if T(with VS) = T(without VS), */
00256 /*             1/ulp otherwise */
00257 /*             If workspace sufficient, also compare T with and without */
00258 /*             reciprocal condition numbers */
00259 /*             (with sorting of eigenvalues) */
00260 
00261 /*     (12)    0     if eigenvalues(with VS) = eigenvalues(without VS), */
00262 /*             1/ulp otherwise */
00263 /*             If workspace sufficient, also compare VS with and without */
00264 /*             reciprocal condition numbers */
00265 /*             (with sorting of eigenvalues) */
00266 
00267 /*     (13)    if sorting worked and SDIM is the number of */
00268 /*             eigenvalues which were SELECTed */
00269 /*             If workspace sufficient, also compare SDIM with and */
00270 /*             without reciprocal condition numbers */
00271 
00272 /*     (14)    if RCONDE the same no matter if VS and/or RCONDV computed */
00273 
00274 /*     (15)    if RCONDV the same no matter if VS and/or RCONDE computed */
00275 
00276 /*     The "sizes" are specified by an array NN(1:NSIZES); the value of */
00277 /*     each element NN(j) specifies one size. */
00278 /*     The "types" are specified by a logical array DOTYPE( 1:NTYPES ); */
00279 /*     if DOTYPE(j) is .TRUE., then matrix type "j" will be generated. */
00280 /*     Currently, the list of possible types is: */
00281 
00282 /*     (1)  The zero matrix. */
00283 /*     (2)  The identity matrix. */
00284 /*     (3)  A (transposed) Jordan block, with 1's on the diagonal. */
00285 
00286 /*     (4)  A diagonal matrix with evenly spaced entries */
00287 /*          1, ..., ULP  and random signs. */
00288 /*          (ULP = (first number larger than 1) - 1 ) */
00289 /*     (5)  A diagonal matrix with geometrically spaced entries */
00290 /*          1, ..., ULP  and random signs. */
00291 /*     (6)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP */
00292 /*          and random signs. */
00293 
00294 /*     (7)  Same as (4), but multiplied by a constant near */
00295 /*          the overflow threshold */
00296 /*     (8)  Same as (4), but multiplied by a constant near */
00297 /*          the underflow threshold */
00298 
00299 /*     (9)  A matrix of the form  U' T U, where U is orthogonal and */
00300 /*          T has evenly spaced entries 1, ..., ULP with random signs */
00301 /*          on the diagonal and random O(1) entries in the upper */
00302 /*          triangle. */
00303 
00304 /*     (10) A matrix of the form  U' T U, where U is orthogonal and */
00305 /*          T has geometrically spaced entries 1, ..., ULP with random */
00306 /*          signs on the diagonal and random O(1) entries in the upper */
00307 /*          triangle. */
00308 
00309 /*     (11) A matrix of the form  U' T U, where U is orthogonal and */
00310 /*          T has "clustered" entries 1, ULP,..., ULP with random */
00311 /*          signs on the diagonal and random O(1) entries in the upper */
00312 /*          triangle. */
00313 
00314 /*     (12) A matrix of the form  U' T U, where U is orthogonal and */
00315 /*          T has real or complex conjugate paired eigenvalues randomly */
00316 /*          chosen from ( ULP, 1 ) and random O(1) entries in the upper */
00317 /*          triangle. */
00318 
00319 /*     (13) A matrix of the form  X' T X, where X has condition */
00320 /*          SQRT( ULP ) and T has evenly spaced entries 1, ..., ULP */
00321 /*          with random signs on the diagonal and random O(1) entries */
00322 /*          in the upper triangle. */
00323 
00324 /*     (14) A matrix of the form  X' T X, where X has condition */
00325 /*          SQRT( ULP ) and T has geometrically spaced entries */
00326 /*          1, ..., ULP with random signs on the diagonal and random */
00327 /*          O(1) entries in the upper triangle. */
00328 
00329 /*     (15) A matrix of the form  X' T X, where X has condition */
00330 /*          SQRT( ULP ) and T has "clustered" entries 1, ULP,..., ULP */
00331 /*          with random signs on the diagonal and random O(1) entries */
00332 /*          in the upper triangle. */
00333 
00334 /*     (16) A matrix of the form  X' T X, where X has condition */
00335 /*          SQRT( ULP ) and T has real or complex conjugate paired */
00336 /*          eigenvalues randomly chosen from ( ULP, 1 ) and random */
00337 /*          O(1) entries in the upper triangle. */
00338 
00339 /*     (17) Same as (16), but multiplied by a constant */
00340 /*          near the overflow threshold */
00341 /*     (18) Same as (16), but multiplied by a constant */
00342 /*          near the underflow threshold */
00343 
00344 /*     (19) Nonsymmetric matrix with random entries chosen from (-1,1). */
00345 /*          If N is at least 4, all entries in first two rows and last */
00346 /*          row, and first column and last two columns are zero. */
00347 /*     (20) Same as (19), but multiplied by a constant */
00348 /*          near the overflow threshold */
00349 /*     (21) Same as (19), but multiplied by a constant */
00350 /*          near the underflow threshold */
00351 
00352 /*     In addition, an input file will be read from logical unit number */
00353 /*     NIUNIT. The file contains matrices along with precomputed */
00354 /*     eigenvalues and reciprocal condition numbers for the eigenvalue */
00355 /*     average and right invariant subspace. For these matrices, in */
00356 /*     addition to tests (1) to (15) we will compute the following two */
00357 /*     tests: */
00358 
00359 /*    (16)  |RCONDE - RCDEIN| / cond(RCONDE) */
00360 
00361 /*       RCONDE is the reciprocal average eigenvalue condition number */
00362 /*       computed by SGEESX and RCDEIN (the precomputed true value) */
00363 /*       is supplied as input.  cond(RCONDE) is the condition number */
00364 /*       of RCONDE, and takes errors in computing RCONDE into account, */
00365 /*       so that the resulting quantity should be O(ULP). cond(RCONDE) */
00366 /*       is essentially given by norm(A)/RCONDV. */
00367 
00368 /*    (17)  |RCONDV - RCDVIN| / cond(RCONDV) */
00369 
00370 /*       RCONDV is the reciprocal right invariant subspace condition */
00371 /*       number computed by SGEESX and RCDVIN (the precomputed true */
00372 /*       value) is supplied as input. cond(RCONDV) is the condition */
00373 /*       number of RCONDV, and takes errors in computing RCONDV into */
00374 /*       account, so that the resulting quantity should be O(ULP). */
00375 /*       cond(RCONDV) is essentially given by norm(A)/RCONDE. */
00376 
00377 /*  Arguments */
00378 /*  ========= */
00379 
00380 /*  NSIZES  (input) INTEGER */
00381 /*          The number of sizes of matrices to use.  NSIZES must be at */
00382 /*          least zero. If it is zero, no randomly generated matrices */
00383 /*          are tested, but any test matrices read from NIUNIT will be */
00384 /*          tested. */
00385 
00386 /*  NN      (input) INTEGER array, dimension (NSIZES) */
00387 /*          An array containing the sizes to be used for the matrices. */
00388 /*          Zero values will be skipped.  The values must be at least */
00389 /*          zero. */
00390 
00391 /*  NTYPES  (input) INTEGER */
00392 /*          The number of elements in DOTYPE. NTYPES must be at least */
00393 /*          zero. If it is zero, no randomly generated test matrices */
00394 /*          are tested, but and test matrices read from NIUNIT will be */
00395 /*          tested. If it is MAXTYP+1 and NSIZES is 1, then an */
00396 /*          additional type, MAXTYP+1 is defined, which is to use */
00397 /*          whatever matrix is in A.  This is only useful if */
00398 /*          DOTYPE(1:MAXTYP) is .FALSE. and DOTYPE(MAXTYP+1) is .TRUE. . */
00399 
00400 /*  DOTYPE  (input) LOGICAL array, dimension (NTYPES) */
00401 /*          If DOTYPE(j) is .TRUE., then for each size in NN a */
00402 /*          matrix of that size and of type j will be generated. */
00403 /*          If NTYPES is smaller than the maximum number of types */
00404 /*          defined (PARAMETER MAXTYP), then types NTYPES+1 through */
00405 /*          MAXTYP will not be generated.  If NTYPES is larger */
00406 /*          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) */
00407 /*          will be ignored. */
00408 
00409 /*  ISEED   (input/output) INTEGER array, dimension (4) */
00410 /*          On entry ISEED specifies the seed of the random number */
00411 /*          generator. The array elements should be between 0 and 4095; */
00412 /*          if not they will be reduced mod 4096.  Also, ISEED(4) must */
00413 /*          be odd.  The random number generator uses a linear */
00414 /*          congruential sequence limited to small integers, and so */
00415 /*          should produce machine independent random numbers. The */
00416 /*          values of ISEED are changed on exit, and can be used in the */
00417 /*          next call to SDRVSX to continue the same random number */
00418 /*          sequence. */
00419 
00420 /*  THRESH  (input) REAL */
00421 /*          A test will count as "failed" if the "error", computed as */
00422 /*          described above, exceeds THRESH.  Note that the error */
00423 /*          is scaled to be O(1), so THRESH should be a reasonably */
00424 /*          small multiple of 1, e.g., 10 or 100.  In particular, */
00425 /*          it should not depend on the precision (single vs. double) */
00426 /*          or the size of the matrix.  It must be at least zero. */
00427 
00428 /*  NIUNIT  (input) INTEGER */
00429 /*          The FORTRAN unit number for reading in the data file of */
00430 /*          problems to solve. */
00431 
00432 /*  NOUNIT  (input) INTEGER */
00433 /*          The FORTRAN unit number for printing out error messages */
00434 /*          (e.g., if a routine returns INFO not equal to 0.) */
00435 
00436 /*  A       (workspace) REAL array, dimension (LDA, max(NN)) */
00437 /*          Used to hold the matrix whose eigenvalues are to be */
00438 /*          computed.  On exit, A contains the last matrix actually used. */
00439 
00440 /*  LDA     (input) INTEGER */
00441 /*          The leading dimension of A, and H. LDA must be at */
00442 /*          least 1 and at least max( NN ). */
00443 
00444 /*  H       (workspace) REAL array, dimension (LDA, max(NN)) */
00445 /*          Another copy of the test matrix A, modified by SGEESX. */
00446 
00447 /*  HT      (workspace) REAL array, dimension (LDA, max(NN)) */
00448 /*          Yet another copy of the test matrix A, modified by SGEESX. */
00449 
00450 /*  WR      (workspace) REAL array, dimension (max(NN)) */
00451 /*  WI      (workspace) REAL array, dimension (max(NN)) */
00452 /*          The real and imaginary parts of the eigenvalues of A. */
00453 /*          On exit, WR + WI*i are the eigenvalues of the matrix in A. */
00454 
00455 /*  WRT     (workspace) REAL array, dimension (max(NN)) */
00456 /*  WIT     (workspace) REAL array, dimension (max(NN)) */
00457 /*          Like WR, WI, these arrays contain the eigenvalues of A, */
00458 /*          but those computed when SGEESX only computes a partial */
00459 /*          eigendecomposition, i.e. not Schur vectors */
00460 
00461 /*  WRTMP   (workspace) REAL array, dimension (max(NN)) */
00462 /*  WITMP   (workspace) REAL array, dimension (max(NN)) */
00463 /*          More temporary storage for eigenvalues. */
00464 
00465 /*  VS      (workspace) REAL array, dimension (LDVS, max(NN)) */
00466 /*          VS holds the computed Schur vectors. */
00467 
00468 /*  LDVS    (input) INTEGER */
00469 /*          Leading dimension of VS. Must be at least max(1,max(NN)). */
00470 
00471 /*  VS1     (workspace) REAL array, dimension (LDVS, max(NN)) */
00472 /*          VS1 holds another copy of the computed Schur vectors. */
00473 
00474 /*  RESULT  (output) REAL array, dimension (17) */
00475 /*          The values computed by the 17 tests described above. */
00476 /*          The values are currently limited to 1/ulp, to avoid overflow. */
00477 
00478 /*  WORK    (workspace) REAL array, dimension (LWORK) */
00479 
00480 /*  LWORK   (input) INTEGER */
00481 /*          The number of entries in WORK.  This must be at least */
00482 /*          max(3*NN(j),2*NN(j)**2) for all j. */
00483 
00484 /*  IWORK   (workspace) INTEGER array, dimension (max(NN)*max(NN)) */
00485 
00486 /*  INFO    (output) INTEGER */
00487 /*          If 0,  successful exit. */
00488 /*            <0,  input parameter -INFO is incorrect */
00489 /*            >0,  SLATMR, SLATMS, SLATME or SGET24 returned an error */
00490 /*                 code and INFO is its absolute value */
00491 
00492 /* ----------------------------------------------------------------------- */
00493 
00494 /*     Some Local Variables and Parameters: */
00495 /*     ---- ----- --------- --- ---------- */
00496 /*     ZERO, ONE       Real 0 and 1. */
00497 /*     MAXTYP          The number of types defined. */
00498 /*     NMAX            Largest value in NN. */
00499 /*     NERRS           The number of tests which have exceeded THRESH */
00500 /*     COND, CONDS, */
00501 /*     IMODE           Values to be passed to the matrix generators. */
00502 /*     ANORM           Norm of A; passed to matrix generators. */
00503 
00504 /*     OVFL, UNFL      Overflow and underflow thresholds. */
00505 /*     ULP, ULPINV     Finest relative precision and its inverse. */
00506 /*     RTULP, RTULPI   Square roots of the previous 4 values. */
00507 /*             The following four arrays decode JTYPE: */
00508 /*     KTYPE(j)        The general type (1-10) for type "j". */
00509 /*     KMODE(j)        The MODE value to be passed to the matrix */
00510 /*                     generator for type "j". */
00511 /*     KMAGN(j)        The order of magnitude ( O(1), */
00512 /*                     O(overflow^(1/2) ), O(underflow^(1/2) ) */
00513 /*     KCONDS(j)       Selectw whether CONDS is to be 1 or */
00514 /*                     1/sqrt(ulp).  (0 means irrelevant.) */
00515 
00516 /*  ===================================================================== */
00517 
00518 /*     .. Parameters .. */
00519 /*     .. */
00520 /*     .. Local Scalars .. */
00521 /*     .. */
00522 /*     .. Local Arrays .. */
00523 /*     .. */
00524 /*     .. Arrays in Common .. */
00525 /*     .. */
00526 /*     .. Scalars in Common .. */
00527 /*     .. */
00528 /*     .. Common blocks .. */
00529 /*     .. */
00530 /*     .. External Functions .. */
00531 /*     .. */
00532 /*     .. External Subroutines .. */
00533 /*     .. */
00534 /*     .. Intrinsic Functions .. */
00535 /*     .. */
00536 /*     .. Data statements .. */
00537     /* Parameter adjustments */
00538     --nn;
00539     --dotype;
00540     --iseed;
00541     ht_dim1 = *lda;
00542     ht_offset = 1 + ht_dim1;
00543     ht -= ht_offset;
00544     h_dim1 = *lda;
00545     h_offset = 1 + h_dim1;
00546     h__ -= h_offset;
00547     a_dim1 = *lda;
00548     a_offset = 1 + a_dim1;
00549     a -= a_offset;
00550     --wr;
00551     --wi;
00552     --wrt;
00553     --wit;
00554     --wrtmp;
00555     --witmp;
00556     vs1_dim1 = *ldvs;
00557     vs1_offset = 1 + vs1_dim1;
00558     vs1 -= vs1_offset;
00559     vs_dim1 = *ldvs;
00560     vs_offset = 1 + vs_dim1;
00561     vs -= vs_offset;
00562     --result;
00563     --work;
00564     --iwork;
00565     --bwork;
00566 
00567     /* Function Body */
00568 /*     .. */
00569 /*     .. Executable Statements .. */
00570 
00571     s_copy(path, "Single precision", (ftnlen)1, (ftnlen)16);
00572     s_copy(path + 1, "SX", (ftnlen)2, (ftnlen)2);
00573 
00574 /*     Check for errors */
00575 
00576     ntestt = 0;
00577     ntestf = 0;
00578     *info = 0;
00579 
00580 /*     Important constants */
00581 
00582     badnn = FALSE_;
00583 
00584 /*     12 is the largest dimension in the input file of precomputed */
00585 /*     problems */
00586 
00587     nmax = 12;
00588     i__1 = *nsizes;
00589     for (j = 1; j <= i__1; ++j) {
00590 /* Computing MAX */
00591         i__2 = nmax, i__3 = nn[j];
00592         nmax = max(i__2,i__3);
00593         if (nn[j] < 0) {
00594             badnn = TRUE_;
00595         }
00596 /* L10: */
00597     }
00598 
00599 /*     Check for errors */
00600 
00601     if (*nsizes < 0) {
00602         *info = -1;
00603     } else if (badnn) {
00604         *info = -2;
00605     } else if (*ntypes < 0) {
00606         *info = -3;
00607     } else if (*thresh < 0.f) {
00608         *info = -6;
00609     } else if (*niunit <= 0) {
00610         *info = -7;
00611     } else if (*nounit <= 0) {
00612         *info = -8;
00613     } else if (*lda < 1 || *lda < nmax) {
00614         *info = -10;
00615     } else if (*ldvs < 1 || *ldvs < nmax) {
00616         *info = -20;
00617     } else /* if(complicated condition) */ {
00618 /* Computing MAX */
00619 /* Computing 2nd power */
00620         i__3 = nmax;
00621         i__1 = nmax * 3, i__2 = i__3 * i__3 << 1;
00622         if (max(i__1,i__2) > *lwork) {
00623             *info = -24;
00624         }
00625     }
00626 
00627     if (*info != 0) {
00628         i__1 = -(*info);
00629         xerbla_("SDRVSX", &i__1);
00630         return 0;
00631     }
00632 
00633 /*     If nothing to do check on NIUNIT */
00634 
00635     if (*nsizes == 0 || *ntypes == 0) {
00636         goto L150;
00637     }
00638 
00639 /*     More Important constants */
00640 
00641     unfl = slamch_("Safe minimum");
00642     ovfl = 1.f / unfl;
00643     slabad_(&unfl, &ovfl);
00644     ulp = slamch_("Precision");
00645     ulpinv = 1.f / ulp;
00646     rtulp = sqrt(ulp);
00647     rtulpi = 1.f / rtulp;
00648 
00649 /*     Loop over sizes, types */
00650 
00651     nerrs = 0;
00652 
00653     i__1 = *nsizes;
00654     for (jsize = 1; jsize <= i__1; ++jsize) {
00655         n = nn[jsize];
00656         if (*nsizes != 1) {
00657             mtypes = min(21,*ntypes);
00658         } else {
00659             mtypes = min(22,*ntypes);
00660         }
00661 
00662         i__2 = mtypes;
00663         for (jtype = 1; jtype <= i__2; ++jtype) {
00664             if (! dotype[jtype]) {
00665                 goto L130;
00666             }
00667 
00668 /*           Save ISEED in case of an error. */
00669 
00670             for (j = 1; j <= 4; ++j) {
00671                 ioldsd[j - 1] = iseed[j];
00672 /* L20: */
00673             }
00674 
00675 /*           Compute "A" */
00676 
00677 /*           Control parameters: */
00678 
00679 /*           KMAGN  KCONDS  KMODE        KTYPE */
00680 /*       =1  O(1)   1       clustered 1  zero */
00681 /*       =2  large  large   clustered 2  identity */
00682 /*       =3  small          exponential  Jordan */
00683 /*       =4                 arithmetic   diagonal, (w/ eigenvalues) */
00684 /*       =5                 random log   symmetric, w/ eigenvalues */
00685 /*       =6                 random       general, w/ eigenvalues */
00686 /*       =7                              random diagonal */
00687 /*       =8                              random symmetric */
00688 /*       =9                              random general */
00689 /*       =10                             random triangular */
00690 
00691             if (mtypes > 21) {
00692                 goto L90;
00693             }
00694 
00695             itype = ktype[jtype - 1];
00696             imode = kmode[jtype - 1];
00697 
00698 /*           Compute norm */
00699 
00700             switch (kmagn[jtype - 1]) {
00701                 case 1:  goto L30;
00702                 case 2:  goto L40;
00703                 case 3:  goto L50;
00704             }
00705 
00706 L30:
00707             anorm = 1.f;
00708             goto L60;
00709 
00710 L40:
00711             anorm = ovfl * ulp;
00712             goto L60;
00713 
00714 L50:
00715             anorm = unfl * ulpinv;
00716             goto L60;
00717 
00718 L60:
00719 
00720             slaset_("Full", lda, &n, &c_b18, &c_b18, &a[a_offset], lda);
00721             iinfo = 0;
00722             cond = ulpinv;
00723 
00724 /*           Special Matrices -- Identity & Jordan block */
00725 
00726 /*              Zero */
00727 
00728             if (itype == 1) {
00729                 iinfo = 0;
00730 
00731             } else if (itype == 2) {
00732 
00733 /*              Identity */
00734 
00735                 i__3 = n;
00736                 for (jcol = 1; jcol <= i__3; ++jcol) {
00737                     a[jcol + jcol * a_dim1] = anorm;
00738 /* L70: */
00739                 }
00740 
00741             } else if (itype == 3) {
00742 
00743 /*              Jordan Block */
00744 
00745                 i__3 = n;
00746                 for (jcol = 1; jcol <= i__3; ++jcol) {
00747                     a[jcol + jcol * a_dim1] = anorm;
00748                     if (jcol > 1) {
00749                         a[jcol + (jcol - 1) * a_dim1] = 1.f;
00750                     }
00751 /* L80: */
00752                 }
00753 
00754             } else if (itype == 4) {
00755 
00756 /*              Diagonal Matrix, [Eigen]values Specified */
00757 
00758                 slatms_(&n, &n, "S", &iseed[1], "S", &work[1], &imode, &cond, 
00759                         &anorm, &c__0, &c__0, "N", &a[a_offset], lda, &work[n 
00760                         + 1], &iinfo);
00761 
00762             } else if (itype == 5) {
00763 
00764 /*              Symmetric, eigenvalues specified */
00765 
00766                 slatms_(&n, &n, "S", &iseed[1], "S", &work[1], &imode, &cond, 
00767                         &anorm, &n, &n, "N", &a[a_offset], lda, &work[n + 1], 
00768                         &iinfo);
00769 
00770             } else if (itype == 6) {
00771 
00772 /*              General, eigenvalues specified */
00773 
00774                 if (kconds[jtype - 1] == 1) {
00775                     conds = 1.f;
00776                 } else if (kconds[jtype - 1] == 2) {
00777                     conds = rtulpi;
00778                 } else {
00779                     conds = 0.f;
00780                 }
00781 
00782                 *(unsigned char *)&adumma[0] = ' ';
00783                 slatme_(&n, "S", &iseed[1], &work[1], &imode, &cond, &c_b32, 
00784                         adumma, "T", "T", "T", &work[n + 1], &c__4, &conds, &
00785                         n, &n, &anorm, &a[a_offset], lda, &work[(n << 1) + 1], 
00786                          &iinfo);
00787 
00788             } else if (itype == 7) {
00789 
00790 /*              Diagonal, random eigenvalues */
00791 
00792                 slatmr_(&n, &n, "S", &iseed[1], "S", &work[1], &c__6, &c_b32, 
00793                         &c_b32, "T", "N", &work[n + 1], &c__1, &c_b32, &work[(
00794                         n << 1) + 1], &c__1, &c_b32, "N", idumma, &c__0, &
00795                         c__0, &c_b18, &anorm, "NO", &a[a_offset], lda, &iwork[
00796                         1], &iinfo);
00797 
00798             } else if (itype == 8) {
00799 
00800 /*              Symmetric, random eigenvalues */
00801 
00802                 slatmr_(&n, &n, "S", &iseed[1], "S", &work[1], &c__6, &c_b32, 
00803                         &c_b32, "T", "N", &work[n + 1], &c__1, &c_b32, &work[(
00804                         n << 1) + 1], &c__1, &c_b32, "N", idumma, &n, &n, &
00805                         c_b18, &anorm, "NO", &a[a_offset], lda, &iwork[1], &
00806                         iinfo);
00807 
00808             } else if (itype == 9) {
00809 
00810 /*              General, random eigenvalues */
00811 
00812                 slatmr_(&n, &n, "S", &iseed[1], "N", &work[1], &c__6, &c_b32, 
00813                         &c_b32, "T", "N", &work[n + 1], &c__1, &c_b32, &work[(
00814                         n << 1) + 1], &c__1, &c_b32, "N", idumma, &n, &n, &
00815                         c_b18, &anorm, "NO", &a[a_offset], lda, &iwork[1], &
00816                         iinfo);
00817                 if (n >= 4) {
00818                     slaset_("Full", &c__2, &n, &c_b18, &c_b18, &a[a_offset], 
00819                             lda);
00820                     i__3 = n - 3;
00821                     slaset_("Full", &i__3, &c__1, &c_b18, &c_b18, &a[a_dim1 + 
00822                             3], lda);
00823                     i__3 = n - 3;
00824                     slaset_("Full", &i__3, &c__2, &c_b18, &c_b18, &a[(n - 1) *
00825                              a_dim1 + 3], lda);
00826                     slaset_("Full", &c__1, &n, &c_b18, &c_b18, &a[n + a_dim1], 
00827                              lda);
00828                 }
00829 
00830             } else if (itype == 10) {
00831 
00832 /*              Triangular, random eigenvalues */
00833 
00834                 slatmr_(&n, &n, "S", &iseed[1], "N", &work[1], &c__6, &c_b32, 
00835                         &c_b32, "T", "N", &work[n + 1], &c__1, &c_b32, &work[(
00836                         n << 1) + 1], &c__1, &c_b32, "N", idumma, &n, &c__0, &
00837                         c_b18, &anorm, "NO", &a[a_offset], lda, &iwork[1], &
00838                         iinfo);
00839 
00840             } else {
00841 
00842                 iinfo = 1;
00843             }
00844 
00845             if (iinfo != 0) {
00846                 io___32.ciunit = *nounit;
00847                 s_wsfe(&io___32);
00848                 do_fio(&c__1, "Generator", (ftnlen)9);
00849                 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00850                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00851                 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00852                 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00853                 e_wsfe();
00854                 *info = abs(iinfo);
00855                 return 0;
00856             }
00857 
00858 L90:
00859 
00860 /*           Test for minimal and generous workspace */
00861 
00862             for (iwk = 1; iwk <= 2; ++iwk) {
00863                 if (iwk == 1) {
00864                     nnwork = n * 3;
00865                 } else {
00866 /* Computing MAX */
00867                     i__3 = n * 3, i__4 = (n << 1) * n;
00868                     nnwork = max(i__3,i__4);
00869                 }
00870                 nnwork = max(nnwork,1);
00871 
00872                 sget24_(&c_false, &jtype, thresh, ioldsd, nounit, &n, &a[
00873                         a_offset], lda, &h__[h_offset], &ht[ht_offset], &wr[1]
00874 , &wi[1], &wrt[1], &wit[1], &wrtmp[1], &witmp[1], &vs[
00875                         vs_offset], ldvs, &vs1[vs1_offset], &rcdein, &rcdvin, 
00876                         &nslct, islct, &result[1], &work[1], &nnwork, &iwork[
00877                         1], &bwork[1], info);
00878 
00879 /*              Check for RESULT(j) > THRESH */
00880 
00881                 ntest = 0;
00882                 nfail = 0;
00883                 for (j = 1; j <= 15; ++j) {
00884                     if (result[j] >= 0.f) {
00885                         ++ntest;
00886                     }
00887                     if (result[j] >= *thresh) {
00888                         ++nfail;
00889                     }
00890 /* L100: */
00891                 }
00892 
00893                 if (nfail > 0) {
00894                     ++ntestf;
00895                 }
00896                 if (ntestf == 1) {
00897                     io___41.ciunit = *nounit;
00898                     s_wsfe(&io___41);
00899                     do_fio(&c__1, path, (ftnlen)3);
00900                     e_wsfe();
00901                     io___42.ciunit = *nounit;
00902                     s_wsfe(&io___42);
00903                     e_wsfe();
00904                     io___43.ciunit = *nounit;
00905                     s_wsfe(&io___43);
00906                     e_wsfe();
00907                     io___44.ciunit = *nounit;
00908                     s_wsfe(&io___44);
00909                     e_wsfe();
00910                     io___45.ciunit = *nounit;
00911                     s_wsfe(&io___45);
00912                     do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(real));
00913                     e_wsfe();
00914                     io___46.ciunit = *nounit;
00915                     s_wsfe(&io___46);
00916                     e_wsfe();
00917                     ntestf = 2;
00918                 }
00919 
00920                 for (j = 1; j <= 15; ++j) {
00921                     if (result[j] >= *thresh) {
00922                         io___47.ciunit = *nounit;
00923                         s_wsfe(&io___47);
00924                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00925                         do_fio(&c__1, (char *)&iwk, (ftnlen)sizeof(integer));
00926                         do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
00927                                 integer));
00928                         do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
00929                                 ;
00930                         do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
00931                         do_fio(&c__1, (char *)&result[j], (ftnlen)sizeof(real)
00932                                 );
00933                         e_wsfe();
00934                     }
00935 /* L110: */
00936                 }
00937 
00938                 nerrs += nfail;
00939                 ntestt += ntest;
00940 
00941 /* L120: */
00942             }
00943 L130:
00944             ;
00945         }
00946 /* L140: */
00947     }
00948 
00949 L150:
00950 
00951 /*     Read in data from file to check accuracy of condition estimation */
00952 /*     Read input data until N=0 */
00953 
00954     jtype = 0;
00955 L160:
00956     io___48.ciunit = *niunit;
00957     i__1 = s_rsle(&io___48);
00958     if (i__1 != 0) {
00959         goto L200;
00960     }
00961     i__1 = do_lio(&c__3, &c__1, (char *)&n, (ftnlen)sizeof(integer));
00962     if (i__1 != 0) {
00963         goto L200;
00964     }
00965     i__1 = do_lio(&c__3, &c__1, (char *)&nslct, (ftnlen)sizeof(integer));
00966     if (i__1 != 0) {
00967         goto L200;
00968     }
00969     i__1 = e_rsle();
00970     if (i__1 != 0) {
00971         goto L200;
00972     }
00973     if (n == 0) {
00974         goto L200;
00975     }
00976     ++jtype;
00977     iseed[1] = jtype;
00978     if (nslct > 0) {
00979         io___49.ciunit = *niunit;
00980         s_rsle(&io___49);
00981         i__1 = nslct;
00982         for (i__ = 1; i__ <= i__1; ++i__) {
00983             do_lio(&c__3, &c__1, (char *)&islct[i__ - 1], (ftnlen)sizeof(
00984                     integer));
00985         }
00986         e_rsle();
00987     }
00988     i__1 = n;
00989     for (i__ = 1; i__ <= i__1; ++i__) {
00990         io___51.ciunit = *niunit;
00991         s_rsle(&io___51);
00992         i__2 = n;
00993         for (j = 1; j <= i__2; ++j) {
00994             do_lio(&c__4, &c__1, (char *)&a[i__ + j * a_dim1], (ftnlen)sizeof(
00995                     real));
00996         }
00997         e_rsle();
00998 /* L170: */
00999     }
01000     io___52.ciunit = *niunit;
01001     s_rsle(&io___52);
01002     do_lio(&c__4, &c__1, (char *)&rcdein, (ftnlen)sizeof(real));
01003     do_lio(&c__4, &c__1, (char *)&rcdvin, (ftnlen)sizeof(real));
01004     e_rsle();
01005 
01006     sget24_(&c_true, &c__22, thresh, &iseed[1], nounit, &n, &a[a_offset], lda, 
01007              &h__[h_offset], &ht[ht_offset], &wr[1], &wi[1], &wrt[1], &wit[1], 
01008              &wrtmp[1], &witmp[1], &vs[vs_offset], ldvs, &vs1[vs1_offset], &
01009             rcdein, &rcdvin, &nslct, islct, &result[1], &work[1], lwork, &
01010             iwork[1], &bwork[1], info);
01011 
01012 /*     Check for RESULT(j) > THRESH */
01013 
01014     ntest = 0;
01015     nfail = 0;
01016     for (j = 1; j <= 17; ++j) {
01017         if (result[j] >= 0.f) {
01018             ++ntest;
01019         }
01020         if (result[j] >= *thresh) {
01021             ++nfail;
01022         }
01023 /* L180: */
01024     }
01025 
01026     if (nfail > 0) {
01027         ++ntestf;
01028     }
01029     if (ntestf == 1) {
01030         io___53.ciunit = *nounit;
01031         s_wsfe(&io___53);
01032         do_fio(&c__1, path, (ftnlen)3);
01033         e_wsfe();
01034         io___54.ciunit = *nounit;
01035         s_wsfe(&io___54);
01036         e_wsfe();
01037         io___55.ciunit = *nounit;
01038         s_wsfe(&io___55);
01039         e_wsfe();
01040         io___56.ciunit = *nounit;
01041         s_wsfe(&io___56);
01042         e_wsfe();
01043         io___57.ciunit = *nounit;
01044         s_wsfe(&io___57);
01045         do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(real));
01046         e_wsfe();
01047         io___58.ciunit = *nounit;
01048         s_wsfe(&io___58);
01049         e_wsfe();
01050         ntestf = 2;
01051     }
01052     for (j = 1; j <= 17; ++j) {
01053         if (result[j] >= *thresh) {
01054             io___59.ciunit = *nounit;
01055             s_wsfe(&io___59);
01056             do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01057             do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01058             do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
01059             do_fio(&c__1, (char *)&result[j], (ftnlen)sizeof(real));
01060             e_wsfe();
01061         }
01062 /* L190: */
01063     }
01064 
01065     nerrs += nfail;
01066     ntestt += ntest;
01067     goto L160;
01068 L200:
01069 
01070 /*     Summary */
01071 
01072     slasum_(path, nounit, &nerrs, &ntestt);
01073 
01074 
01075 
01076     return 0;
01077 
01078 /*     End of SDRVSX */
01079 
01080 } /* sdrvsx_ */


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