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


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