cdrgev.c
Go to the documentation of this file.
00001 /* cdrgev.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Table of constant values */
00017 
00018 static complex c_b1 = {0.f,0.f};
00019 static integer c__1 = 1;
00020 static integer c_n1 = -1;
00021 static integer c__2 = 2;
00022 static real c_b28 = 1.f;
00023 static integer c__3 = 3;
00024 static integer c__4 = 4;
00025 static logical c_true = TRUE_;
00026 static logical c_false = FALSE_;
00027 static integer c__0 = 0;
00028 
00029 /* Subroutine */ int cdrgev_(integer *nsizes, integer *nn, integer *ntypes, 
00030         logical *dotype, integer *iseed, real *thresh, integer *nounit, 
00031         complex *a, integer *lda, complex *b, complex *s, complex *t, complex 
00032         *q, integer *ldq, complex *z__, complex *qe, integer *ldqe, complex *
00033         alpha, complex *beta, complex *alpha1, complex *beta1, complex *work, 
00034         integer *lwork, real *rwork, real *result, integer *info)
00035 {
00036     /* Initialized data */
00037 
00038     static integer kclass[26] = { 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,
00039             2,2,2,3 };
00040     static integer kbmagn[26] = { 1,1,1,1,1,1,1,1,3,2,3,2,2,3,1,1,1,1,1,1,1,3,
00041             2,3,2,1 };
00042     static integer ktrian[26] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,
00043             1,1,1,1 };
00044     static logical lasign[26] = { FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
00045             TRUE_,FALSE_,TRUE_,TRUE_,FALSE_,FALSE_,TRUE_,TRUE_,TRUE_,FALSE_,
00046             TRUE_,FALSE_,FALSE_,FALSE_,TRUE_,TRUE_,TRUE_,TRUE_,TRUE_,FALSE_ };
00047     static logical lbsign[26] = { FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
00048             FALSE_,TRUE_,FALSE_,FALSE_,TRUE_,TRUE_,FALSE_,FALSE_,TRUE_,FALSE_,
00049             TRUE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
00050             FALSE_ };
00051     static integer kz1[6] = { 0,1,2,1,3,3 };
00052     static integer kz2[6] = { 0,0,1,2,1,1 };
00053     static integer kadd[6] = { 0,0,0,0,3,2 };
00054     static integer katype[26] = { 0,1,0,1,2,3,4,1,4,4,1,1,4,4,4,2,4,5,8,7,9,4,
00055             4,4,4,0 };
00056     static integer kbtype[26] = { 0,0,1,1,2,-3,1,4,1,1,4,4,1,1,-4,2,-4,8,8,8,
00057             8,8,8,8,8,0 };
00058     static integer kazero[26] = { 1,1,1,1,1,1,2,1,2,2,1,1,2,2,3,1,3,5,5,5,5,3,
00059             3,3,3,1 };
00060     static integer kbzero[26] = { 1,1,1,1,1,1,1,2,1,1,2,2,1,1,4,1,4,6,6,6,6,4,
00061             4,4,4,1 };
00062     static integer kamagn[26] = { 1,1,1,1,1,1,1,1,2,3,2,3,2,3,1,1,1,1,1,1,1,2,
00063             3,3,2,1 };
00064 
00065     /* Format strings */
00066     static char fmt_9999[] = "(\002 CDRGEV: \002,a,\002 returned INFO=\002,i"
00067             "6,\002.\002,/3x,\002N=\002,i6,\002, JTYPE=\002,i6,\002, ISEED="
00068             "(\002,3(i5,\002,\002),i5,\002)\002)";
00069     static char fmt_9998[] = "(\002 CDRGEV: \002,a,\002 Eigenvectors from"
00070             " \002,a,\002 incorrectly \002,\002normalized.\002,/\002 Bits of "
00071             "error=\002,0p,g10.3,\002,\002,3x,\002N=\002,i4,\002, JTYPE=\002,"
00072             "i3,\002, ISEED=(\002,3(i4,\002,\002),i5,\002)\002)";
00073     static char fmt_9997[] = "(/1x,a3,\002 -- Complex Generalized eigenvalue"
00074             " problem \002,\002driver\002)";
00075     static char fmt_9996[] = "(\002 Matrix types (see CDRGEV for details):"
00076             " \002)";
00077     static char fmt_9995[] = "(\002 Special Matrices:\002,23x,\002(J'=transp"
00078             "osed Jordan block)\002,/\002   1=(0,0)  2=(I,0)  3=(0,I)  4=(I,I"
00079             ")  5=(J',J')  \002,\0026=(diag(J',I), diag(I,J'))\002,/\002 Diag"
00080             "onal Matrices:  ( \002,\002D=diag(0,1,2,...) )\002,/\002   7=(D,"
00081             "I)   9=(large*D, small*I\002,\002)  11=(large*I, small*D)  13=(l"
00082             "arge*D, large*I)\002,/\002   8=(I,D)  10=(small*D, large*I)  12="
00083             "(small*I, large*D) \002,\002 14=(small*D, small*I)\002,/\002  15"
00084             "=(D, reversed D)\002)";
00085     static char fmt_9994[] = "(\002 Matrices Rotated by Random \002,a,\002 M"
00086             "atrices U, V:\002,/\002  16=Transposed Jordan Blocks            "
00087             " 19=geometric \002,\002alpha, beta=0,1\002,/\002  17=arithm. alp"
00088             "ha&beta             \002,\002      20=arithmetic alpha, beta=0,"
00089             "1\002,/\002  18=clustered \002,\002alpha, beta=0,1            21"
00090             "=random alpha, beta=0,1\002,/\002 Large & Small Matrices:\002,"
00091             "/\002  22=(large, small)   \002,\00223=(small,large)    24=(smal"
00092             "l,small)    25=(large,large)\002,/\002  26=random O(1) matrices"
00093             ".\002)";
00094     static char fmt_9993[] = "(/\002 Tests performed:    \002,/\002 1 = max "
00095             "| ( b A - a B )'*l | / const.,\002,/\002 2 = | |VR(i)| - 1 | / u"
00096             "lp,\002,/\002 3 = max | ( b A - a B )*r | / const.\002,/\002 4 ="
00097             " | |VL(i)| - 1 | / ulp,\002,/\002 5 = 0 if W same no matter if r"
00098             " or l computed,\002,/\002 6 = 0 if l same no matter if l compute"
00099             "d,\002,/\002 7 = 0 if r same no matter if r computed,\002,/1x)";
00100     static char fmt_9992[] = "(\002 Matrix order=\002,i5,\002, type=\002,i2"
00101             ",\002, seed=\002,4(i4,\002,\002),\002 result \002,i2,\002 is\002"
00102             ",0p,f8.2)";
00103     static char fmt_9991[] = "(\002 Matrix order=\002,i5,\002, type=\002,i2"
00104             ",\002, seed=\002,4(i4,\002,\002),\002 result \002,i2,\002 is\002"
00105             ",1p,e10.3)";
00106 
00107     /* System generated locals */
00108     integer a_dim1, a_offset, b_dim1, b_offset, q_dim1, q_offset, qe_dim1, 
00109             qe_offset, s_dim1, s_offset, t_dim1, t_offset, z_dim1, z_offset, 
00110             i__1, i__2, i__3, i__4, i__5, i__6, i__7;
00111     real r__1, r__2;
00112     complex q__1, q__2, q__3;
00113 
00114     /* Builtin functions */
00115     double r_sign(real *, real *), c_abs(complex *);
00116     void r_cnjg(complex *, complex *);
00117     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00118 
00119     /* Local variables */
00120     integer i__, j, n, n1, jc, nb, in, jr;
00121     real ulp;
00122     integer iadd, ierr, nmax;
00123     logical badnn;
00124     extern /* Subroutine */ int cget52_(logical *, integer *, complex *, 
00125             integer *, complex *, integer *, complex *, integer *, complex *, 
00126             complex *, complex *, real *, real *), cggev_(char *, char *, 
00127             integer *, complex *, integer *, complex *, integer *, complex *, 
00128             complex *, complex *, integer *, complex *, integer *, complex *, 
00129             integer *, real *, integer *);
00130     real rmagn[4];
00131     complex ctemp;
00132     integer nmats, jsize, nerrs, jtype;
00133     extern /* Subroutine */ int clatm4_(integer *, integer *, integer *, 
00134             integer *, logical *, real *, real *, real *, integer *, integer *
00135 , complex *, integer *), cunm2r_(char *, char *, integer *, 
00136             integer *, integer *, complex *, integer *, complex *, complex *, 
00137             integer *, complex *, integer *), slabad_(real *, 
00138             real *), clarfg_(integer *, complex *, complex *, integer *, 
00139             complex *);
00140     extern /* Complex */ VOID clarnd_(complex *, integer *, integer *);
00141     extern doublereal slamch_(char *);
00142     extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex 
00143             *, integer *, complex *, integer *), claset_(char *, 
00144             integer *, integer *, complex *, complex *, complex *, integer *);
00145     real safmin, safmax;
00146     integer ioldsd[4];
00147     extern integer ilaenv_(integer *, char *, char *, integer *, integer *, 
00148             integer *, integer *);
00149     extern /* Subroutine */ int alasvm_(char *, integer *, integer *, integer 
00150             *, integer *), xerbla_(char *, integer *);
00151     integer minwrk, maxwrk;
00152     real ulpinv;
00153     integer mtypes, ntestt;
00154 
00155     /* Fortran I/O blocks */
00156     static cilist io___40 = { 0, 0, 0, fmt_9999, 0 };
00157     static cilist io___42 = { 0, 0, 0, fmt_9999, 0 };
00158     static cilist io___43 = { 0, 0, 0, fmt_9998, 0 };
00159     static cilist io___44 = { 0, 0, 0, fmt_9998, 0 };
00160     static cilist io___45 = { 0, 0, 0, fmt_9999, 0 };
00161     static cilist io___46 = { 0, 0, 0, fmt_9999, 0 };
00162     static cilist io___47 = { 0, 0, 0, fmt_9999, 0 };
00163     static cilist io___48 = { 0, 0, 0, fmt_9997, 0 };
00164     static cilist io___49 = { 0, 0, 0, fmt_9996, 0 };
00165     static cilist io___50 = { 0, 0, 0, fmt_9995, 0 };
00166     static cilist io___51 = { 0, 0, 0, fmt_9994, 0 };
00167     static cilist io___52 = { 0, 0, 0, fmt_9993, 0 };
00168     static cilist io___53 = { 0, 0, 0, fmt_9992, 0 };
00169     static cilist io___54 = { 0, 0, 0, fmt_9991, 0 };
00170 
00171 
00172 
00173 /*  -- LAPACK test routine (version 3.1.1) -- */
00174 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00175 /*     February 2007 */
00176 
00177 /*     .. Scalar Arguments .. */
00178 /*     .. */
00179 /*     .. Array Arguments .. */
00180 /*     .. */
00181 
00182 /*  Purpose */
00183 /*  ======= */
00184 
00185 /*  CDRGEV checks the nonsymmetric generalized eigenvalue problem driver */
00186 /*  routine CGGEV. */
00187 
00188 /*  CGGEV computes for a pair of n-by-n nonsymmetric matrices (A,B) the */
00189 /*  generalized eigenvalues and, optionally, the left and right */
00190 /*  eigenvectors. */
00191 
00192 /*  A generalized eigenvalue for a pair of matrices (A,B) is a scalar w */
00193 /*  or a ratio  alpha/beta = w, such that A - w*B is singular.  It is */
00194 /*  usually represented as the pair (alpha,beta), as there is reasonalbe */
00195 /*  interpretation for beta=0, and even for both being zero. */
00196 
00197 /*  A right generalized eigenvector corresponding to a generalized */
00198 /*  eigenvalue  w  for a pair of matrices (A,B) is a vector r  such that */
00199 /*  (A - wB) * r = 0.  A left generalized eigenvector is a vector l such */
00200 /*  that l**H * (A - wB) = 0, where l**H is the conjugate-transpose of l. */
00201 
00202 /*  When CDRGEV is called, a number of matrix "sizes" ("n's") and a */
00203 /*  number of matrix "types" are specified.  For each size ("n") */
00204 /*  and each type of matrix, a pair of matrices (A, B) will be generated */
00205 /*  and used for testing.  For each matrix pair, the following tests */
00206 /*  will be performed and compared with the threshhold THRESH. */
00207 
00208 /*  Results from CGGEV: */
00209 
00210 /*  (1)  max over all left eigenvalue/-vector pairs (alpha/beta,l) of */
00211 
00212 /*       | VL**H * (beta A - alpha B) |/( ulp max(|beta A|, |alpha B|) ) */
00213 
00214 /*       where VL**H is the conjugate-transpose of VL. */
00215 
00216 /*  (2)  | |VL(i)| - 1 | / ulp and whether largest component real */
00217 
00218 /*       VL(i) denotes the i-th column of VL. */
00219 
00220 /*  (3)  max over all left eigenvalue/-vector pairs (alpha/beta,r) of */
00221 
00222 /*       | (beta A - alpha B) * VR | / ( ulp max(|beta A|, |alpha B|) ) */
00223 
00224 /*  (4)  | |VR(i)| - 1 | / ulp and whether largest component real */
00225 
00226 /*       VR(i) denotes the i-th column of VR. */
00227 
00228 /*  (5)  W(full) = W(partial) */
00229 /*       W(full) denotes the eigenvalues computed when both l and r */
00230 /*       are also computed, and W(partial) denotes the eigenvalues */
00231 /*       computed when only W, only W and r, or only W and l are */
00232 /*       computed. */
00233 
00234 /*  (6)  VL(full) = VL(partial) */
00235 /*       VL(full) denotes the left eigenvectors computed when both l */
00236 /*       and r are computed, and VL(partial) denotes the result */
00237 /*       when only l is computed. */
00238 
00239 /*  (7)  VR(full) = VR(partial) */
00240 /*       VR(full) denotes the right eigenvectors computed when both l */
00241 /*       and r are also computed, and VR(partial) denotes the result */
00242 /*       when only l is computed. */
00243 
00244 
00245 /*  Test Matrices */
00246 /*  ---- -------- */
00247 
00248 /*  The sizes of the test matrices are specified by an array */
00249 /*  NN(1:NSIZES); the value of each element NN(j) specifies one size. */
00250 /*  The "types" are specified by a logical array DOTYPE( 1:NTYPES ); if */
00251 /*  DOTYPE(j) is .TRUE., then matrix type "j" will be generated. */
00252 /*  Currently, the list of possible types is: */
00253 
00254 /*  (1)  ( 0, 0 )         (a pair of zero matrices) */
00255 
00256 /*  (2)  ( I, 0 )         (an identity and a zero matrix) */
00257 
00258 /*  (3)  ( 0, I )         (an identity and a zero matrix) */
00259 
00260 /*  (4)  ( I, I )         (a pair of identity matrices) */
00261 
00262 /*          t   t */
00263 /*  (5)  ( J , J  )       (a pair of transposed Jordan blocks) */
00264 
00265 /*                                      t                ( I   0  ) */
00266 /*  (6)  ( X, Y )         where  X = ( J   0  )  and Y = (      t ) */
00267 /*                                   ( 0   I  )          ( 0   J  ) */
00268 /*                        and I is a k x k identity and J a (k+1)x(k+1) */
00269 /*                        Jordan block; k=(N-1)/2 */
00270 
00271 /*  (7)  ( D, I )         where D is diag( 0, 1,..., N-1 ) (a diagonal */
00272 /*                        matrix with those diagonal entries.) */
00273 /*  (8)  ( I, D ) */
00274 
00275 /*  (9)  ( big*D, small*I ) where "big" is near overflow and small=1/big */
00276 
00277 /*  (10) ( small*D, big*I ) */
00278 
00279 /*  (11) ( big*I, small*D ) */
00280 
00281 /*  (12) ( small*I, big*D ) */
00282 
00283 /*  (13) ( big*D, big*I ) */
00284 
00285 /*  (14) ( small*D, small*I ) */
00286 
00287 /*  (15) ( D1, D2 )        where D1 is diag( 0, 0, 1, ..., N-3, 0 ) and */
00288 /*                         D2 is diag( 0, N-3, N-4,..., 1, 0, 0 ) */
00289 /*            t   t */
00290 /*  (16) Q ( J , J ) Z     where Q and Z are random orthogonal matrices. */
00291 
00292 /*  (17) Q ( T1, T2 ) Z    where T1 and T2 are upper triangular matrices */
00293 /*                         with random O(1) entries above the diagonal */
00294 /*                         and diagonal entries diag(T1) = */
00295 /*                         ( 0, 0, 1, ..., N-3, 0 ) and diag(T2) = */
00296 /*                         ( 0, N-3, N-4,..., 1, 0, 0 ) */
00297 
00298 /*  (18) Q ( T1, T2 ) Z    diag(T1) = ( 0, 0, 1, 1, s, ..., s, 0 ) */
00299 /*                         diag(T2) = ( 0, 1, 0, 1,..., 1, 0 ) */
00300 /*                         s = machine precision. */
00301 
00302 /*  (19) Q ( T1, T2 ) Z    diag(T1)=( 0,0,1,1, 1-d, ..., 1-(N-5)*d=s, 0 ) */
00303 /*                         diag(T2) = ( 0, 1, 0, 1, ..., 1, 0 ) */
00304 
00305 /*                                                         N-5 */
00306 /*  (20) Q ( T1, T2 ) Z    diag(T1)=( 0, 0, 1, 1, a, ..., a   =s, 0 ) */
00307 /*                         diag(T2) = ( 0, 1, 0, 1, ..., 1, 0, 0 ) */
00308 
00309 /*  (21) Q ( T1, T2 ) Z    diag(T1)=( 0, 0, 1, r1, r2, ..., r(N-4), 0 ) */
00310 /*                         diag(T2) = ( 0, 1, 0, 1, ..., 1, 0, 0 ) */
00311 /*                         where r1,..., r(N-4) are random. */
00312 
00313 /*  (22) Q ( big*T1, small*T2 ) Z    diag(T1) = ( 0, 0, 1, ..., N-3, 0 ) */
00314 /*                                   diag(T2) = ( 0, 1, ..., 1, 0, 0 ) */
00315 
00316 /*  (23) Q ( small*T1, big*T2 ) Z    diag(T1) = ( 0, 0, 1, ..., N-3, 0 ) */
00317 /*                                   diag(T2) = ( 0, 1, ..., 1, 0, 0 ) */
00318 
00319 /*  (24) Q ( small*T1, small*T2 ) Z  diag(T1) = ( 0, 0, 1, ..., N-3, 0 ) */
00320 /*                                   diag(T2) = ( 0, 1, ..., 1, 0, 0 ) */
00321 
00322 /*  (25) Q ( big*T1, big*T2 ) Z      diag(T1) = ( 0, 0, 1, ..., N-3, 0 ) */
00323 /*                                   diag(T2) = ( 0, 1, ..., 1, 0, 0 ) */
00324 
00325 /*  (26) Q ( T1, T2 ) Z     where T1 and T2 are random upper-triangular */
00326 /*                          matrices. */
00327 
00328 
00329 /*  Arguments */
00330 /*  ========= */
00331 
00332 /*  NSIZES  (input) INTEGER */
00333 /*          The number of sizes of matrices to use.  If it is zero, */
00334 /*          CDRGES does nothing.  NSIZES >= 0. */
00335 
00336 /*  NN      (input) INTEGER array, dimension (NSIZES) */
00337 /*          An array containing the sizes to be used for the matrices. */
00338 /*          Zero values will be skipped.  NN >= 0. */
00339 
00340 /*  NTYPES  (input) INTEGER */
00341 /*          The number of elements in DOTYPE.   If it is zero, CDRGEV */
00342 /*          does nothing.  It must be at least zero.  If it is MAXTYP+1 */
00343 /*          and NSIZES is 1, then an additional type, MAXTYP+1 is */
00344 /*          defined, which is to use whatever matrix is in A.  This */
00345 /*          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and */
00346 /*          DOTYPE(MAXTYP+1) is .TRUE. . */
00347 
00348 /*  DOTYPE  (input) LOGICAL array, dimension (NTYPES) */
00349 /*          If DOTYPE(j) is .TRUE., then for each size in NN a */
00350 /*          matrix of that size and of type j will be generated. */
00351 /*          If NTYPES is smaller than the maximum number of types */
00352 /*          defined (PARAMETER MAXTYP), then types NTYPES+1 through */
00353 /*          MAXTYP will not be generated. If NTYPES is larger */
00354 /*          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) */
00355 /*          will be ignored. */
00356 
00357 /*  ISEED   (input/output) INTEGER array, dimension (4) */
00358 /*          On entry ISEED specifies the seed of the random number */
00359 /*          generator. The array elements should be between 0 and 4095; */
00360 /*          if not they will be reduced mod 4096. Also, ISEED(4) must */
00361 /*          be odd.  The random number generator uses a linear */
00362 /*          congruential sequence limited to small integers, and so */
00363 /*          should produce machine independent random numbers. The */
00364 /*          values of ISEED are changed on exit, and can be used in the */
00365 /*          next call to CDRGES to continue the same random number */
00366 /*          sequence. */
00367 
00368 /*  THRESH  (input) REAL */
00369 /*          A test will count as "failed" if the "error", computed as */
00370 /*          described above, exceeds THRESH.  Note that the error is */
00371 /*          scaled to be O(1), so THRESH should be a reasonably small */
00372 /*          multiple of 1, e.g., 10 or 100.  In particular, it should */
00373 /*          not depend on the precision (single vs. double) or the size */
00374 /*          of the matrix.  It must be at least zero. */
00375 
00376 /*  NOUNIT  (input) INTEGER */
00377 /*          The FORTRAN unit number for printing out error messages */
00378 /*          (e.g., if a routine returns IERR not equal to 0.) */
00379 
00380 /*  A       (input/workspace) COMPLEX array, dimension(LDA, max(NN)) */
00381 /*          Used to hold the original A matrix.  Used as input only */
00382 /*          if NTYPES=MAXTYP+1, DOTYPE(1:MAXTYP)=.FALSE., and */
00383 /*          DOTYPE(MAXTYP+1)=.TRUE. */
00384 
00385 /*  LDA     (input) INTEGER */
00386 /*          The leading dimension of A, B, S, and T. */
00387 /*          It must be at least 1 and at least max( NN ). */
00388 
00389 /*  B       (input/workspace) COMPLEX array, dimension(LDA, max(NN)) */
00390 /*          Used to hold the original B matrix.  Used as input only */
00391 /*          if NTYPES=MAXTYP+1, DOTYPE(1:MAXTYP)=.FALSE., and */
00392 /*          DOTYPE(MAXTYP+1)=.TRUE. */
00393 
00394 /*  S       (workspace) COMPLEX array, dimension (LDA, max(NN)) */
00395 /*          The Schur form matrix computed from A by CGGEV.  On exit, S */
00396 /*          contains the Schur form matrix corresponding to the matrix */
00397 /*          in A. */
00398 
00399 /*  T       (workspace) COMPLEX array, dimension (LDA, max(NN)) */
00400 /*          The upper triangular matrix computed from B by CGGEV. */
00401 
00402 /*  Q      (workspace) COMPLEX array, dimension (LDQ, max(NN)) */
00403 /*          The (left) eigenvectors matrix computed by CGGEV. */
00404 
00405 /*  LDQ     (input) INTEGER */
00406 /*          The leading dimension of Q and Z. It must */
00407 /*          be at least 1 and at least max( NN ). */
00408 
00409 /*  Z       (workspace) COMPLEX array, dimension( LDQ, max(NN) ) */
00410 /*          The (right) orthogonal matrix computed by CGGEV. */
00411 
00412 /*  QE      (workspace) COMPLEX array, dimension( LDQ, max(NN) ) */
00413 /*          QE holds the computed right or left eigenvectors. */
00414 
00415 /*  LDQE    (input) INTEGER */
00416 /*          The leading dimension of QE. LDQE >= max(1,max(NN)). */
00417 
00418 /*  ALPHA   (workspace) COMPLEX array, dimension (max(NN)) */
00419 /*  BETA    (workspace) COMPLEX array, dimension (max(NN)) */
00420 /*          The generalized eigenvalues of (A,B) computed by CGGEV. */
00421 /*          ( ALPHAR(k)+ALPHAI(k)*i ) / BETA(k) is the k-th */
00422 /*          generalized eigenvalue of A and B. */
00423 
00424 /*  ALPHA1  (workspace) COMPLEX array, dimension (max(NN)) */
00425 /*  BETA1   (workspace) COMPLEX array, dimension (max(NN)) */
00426 /*          Like ALPHAR, ALPHAI, BETA, these arrays contain the */
00427 /*          eigenvalues of A and B, but those computed when CGGEV only */
00428 /*          computes a partial eigendecomposition, i.e. not the */
00429 /*          eigenvalues and left and right eigenvectors. */
00430 
00431 /*  WORK    (workspace) COMPLEX array, dimension (LWORK) */
00432 
00433 /*  LWORK   (input) INTEGER */
00434 /*          The number of entries in WORK.  LWORK >= N*(N+1) */
00435 
00436 /*  RWORK   (workspace) REAL array, dimension (8*N) */
00437 /*          Real workspace. */
00438 
00439 /*  RESULT  (output) REAL array, dimension (2) */
00440 /*          The values computed by the tests described above. */
00441 /*          The values are currently limited to 1/ulp, to avoid overflow. */
00442 
00443 /*  INFO    (output) INTEGER */
00444 /*          = 0:  successful exit */
00445 /*          < 0:  if INFO = -i, the i-th argument had an illegal value. */
00446 /*          > 0:  A routine returned an error code.  INFO is the */
00447 /*                absolute value of the INFO value returned. */
00448 
00449 /*  ===================================================================== */
00450 
00451 /*     .. Parameters .. */
00452 /*     .. */
00453 /*     .. Local Scalars .. */
00454 /*     .. */
00455 /*     .. Local Arrays .. */
00456 /*     .. */
00457 /*     .. External Functions .. */
00458 /*     .. */
00459 /*     .. External Subroutines .. */
00460 /*     .. */
00461 /*     .. Intrinsic Functions .. */
00462 /*     .. */
00463 /*     .. Data statements .. */
00464     /* Parameter adjustments */
00465     --nn;
00466     --dotype;
00467     --iseed;
00468     t_dim1 = *lda;
00469     t_offset = 1 + t_dim1;
00470     t -= t_offset;
00471     s_dim1 = *lda;
00472     s_offset = 1 + s_dim1;
00473     s -= s_offset;
00474     b_dim1 = *lda;
00475     b_offset = 1 + b_dim1;
00476     b -= b_offset;
00477     a_dim1 = *lda;
00478     a_offset = 1 + a_dim1;
00479     a -= a_offset;
00480     z_dim1 = *ldq;
00481     z_offset = 1 + z_dim1;
00482     z__ -= z_offset;
00483     q_dim1 = *ldq;
00484     q_offset = 1 + q_dim1;
00485     q -= q_offset;
00486     qe_dim1 = *ldqe;
00487     qe_offset = 1 + qe_dim1;
00488     qe -= qe_offset;
00489     --alpha;
00490     --beta;
00491     --alpha1;
00492     --beta1;
00493     --work;
00494     --rwork;
00495     --result;
00496 
00497     /* Function Body */
00498 /*     .. */
00499 /*     .. Executable Statements .. */
00500 
00501 /*     Check for errors */
00502 
00503     *info = 0;
00504 
00505     badnn = FALSE_;
00506     nmax = 1;
00507     i__1 = *nsizes;
00508     for (j = 1; j <= i__1; ++j) {
00509 /* Computing MAX */
00510         i__2 = nmax, i__3 = nn[j];
00511         nmax = max(i__2,i__3);
00512         if (nn[j] < 0) {
00513             badnn = TRUE_;
00514         }
00515 /* L10: */
00516     }
00517 
00518     if (*nsizes < 0) {
00519         *info = -1;
00520     } else if (badnn) {
00521         *info = -2;
00522     } else if (*ntypes < 0) {
00523         *info = -3;
00524     } else if (*thresh < 0.f) {
00525         *info = -6;
00526     } else if (*lda <= 1 || *lda < nmax) {
00527         *info = -9;
00528     } else if (*ldq <= 1 || *ldq < nmax) {
00529         *info = -14;
00530     } else if (*ldqe <= 1 || *ldqe < nmax) {
00531         *info = -17;
00532     }
00533 
00534 /*     Compute workspace */
00535 /*      (Note: Comments in the code beginning "Workspace:" describe the */
00536 /*       minimal amount of workspace needed at that point in the code, */
00537 /*       as well as the preferred amount for good performance. */
00538 /*       NB refers to the optimal block size for the immediately */
00539 /*       following subroutine, as returned by ILAENV. */
00540 
00541     minwrk = 1;
00542     if (*info == 0 && *lwork >= 1) {
00543         minwrk = nmax * (nmax + 1);
00544 /* Computing MAX */
00545         i__1 = 1, i__2 = ilaenv_(&c__1, "CGEQRF", " ", &nmax, &nmax, &c_n1, &
00546                 c_n1), i__1 = max(i__1,i__2), i__2 = 
00547                 ilaenv_(&c__1, "CUNMQR", "LC", &nmax, &nmax, &nmax, &c_n1), i__1 = max(i__1,i__2), i__2 = ilaenv_(&
00548                 c__1, "CUNGQR", " ", &nmax, &nmax, &nmax, &c_n1);
00549         nb = max(i__1,i__2);
00550 /* Computing MAX */
00551         i__1 = nmax << 1, i__2 = nmax * (nb + 1), i__1 = max(i__1,i__2), i__2 
00552                 = nmax * (nmax + 1);
00553         maxwrk = max(i__1,i__2);
00554         work[1].r = (real) maxwrk, work[1].i = 0.f;
00555     }
00556 
00557     if (*lwork < minwrk) {
00558         *info = -23;
00559     }
00560 
00561     if (*info != 0) {
00562         i__1 = -(*info);
00563         xerbla_("CDRGEV", &i__1);
00564         return 0;
00565     }
00566 
00567 /*     Quick return if possible */
00568 
00569     if (*nsizes == 0 || *ntypes == 0) {
00570         return 0;
00571     }
00572 
00573     ulp = slamch_("Precision");
00574     safmin = slamch_("Safe minimum");
00575     safmin /= ulp;
00576     safmax = 1.f / safmin;
00577     slabad_(&safmin, &safmax);
00578     ulpinv = 1.f / ulp;
00579 
00580 /*     The values RMAGN(2:3) depend on N, see below. */
00581 
00582     rmagn[0] = 0.f;
00583     rmagn[1] = 1.f;
00584 
00585 /*     Loop over sizes, types */
00586 
00587     ntestt = 0;
00588     nerrs = 0;
00589     nmats = 0;
00590 
00591     i__1 = *nsizes;
00592     for (jsize = 1; jsize <= i__1; ++jsize) {
00593         n = nn[jsize];
00594         n1 = max(1,n);
00595         rmagn[2] = safmax * ulp / (real) n1;
00596         rmagn[3] = safmin * ulpinv * n1;
00597 
00598         if (*nsizes != 1) {
00599             mtypes = min(26,*ntypes);
00600         } else {
00601             mtypes = min(27,*ntypes);
00602         }
00603 
00604         i__2 = mtypes;
00605         for (jtype = 1; jtype <= i__2; ++jtype) {
00606             if (! dotype[jtype]) {
00607                 goto L210;
00608             }
00609             ++nmats;
00610 
00611 /*           Save ISEED in case of an error. */
00612 
00613             for (j = 1; j <= 4; ++j) {
00614                 ioldsd[j - 1] = iseed[j];
00615 /* L20: */
00616             }
00617 
00618 /*           Generate test matrices A and B */
00619 
00620 /*           Description of control parameters: */
00621 
00622 /*           KCLASS: =1 means w/o rotation, =2 means w/ rotation, */
00623 /*                   =3 means random. */
00624 /*           KATYPE: the "type" to be passed to CLATM4 for computing A. */
00625 /*           KAZERO: the pattern of zeros on the diagonal for A: */
00626 /*                   =1: ( xxx ), =2: (0, xxx ) =3: ( 0, 0, xxx, 0 ), */
00627 /*                   =4: ( 0, xxx, 0, 0 ), =5: ( 0, 0, 1, xxx, 0 ), */
00628 /*                   =6: ( 0, 1, 0, xxx, 0 ).  (xxx means a string of */
00629 /*                   non-zero entries.) */
00630 /*           KAMAGN: the magnitude of the matrix: =0: zero, =1: O(1), */
00631 /*                   =2: large, =3: small. */
00632 /*           LASIGN: .TRUE. if the diagonal elements of A are to be */
00633 /*                   multiplied by a random magnitude 1 number. */
00634 /*           KBTYPE, KBZERO, KBMAGN, LBSIGN: the same, but for B. */
00635 /*           KTRIAN: =0: don't fill in the upper triangle, =1: do. */
00636 /*           KZ1, KZ2, KADD: used to implement KAZERO and KBZERO. */
00637 /*           RMAGN: used to implement KAMAGN and KBMAGN. */
00638 
00639             if (mtypes > 26) {
00640                 goto L100;
00641             }
00642             ierr = 0;
00643             if (kclass[jtype - 1] < 3) {
00644 
00645 /*              Generate A (w/o rotation) */
00646 
00647                 if ((i__3 = katype[jtype - 1], abs(i__3)) == 3) {
00648                     in = ((n - 1) / 2 << 1) + 1;
00649                     if (in != n) {
00650                         claset_("Full", &n, &n, &c_b1, &c_b1, &a[a_offset], 
00651                                 lda);
00652                     }
00653                 } else {
00654                     in = n;
00655                 }
00656                 clatm4_(&katype[jtype - 1], &in, &kz1[kazero[jtype - 1] - 1], 
00657                         &kz2[kazero[jtype - 1] - 1], &lasign[jtype - 1], &
00658                         rmagn[kamagn[jtype - 1]], &ulp, &rmagn[ktrian[jtype - 
00659                         1] * kamagn[jtype - 1]], &c__2, &iseed[1], &a[
00660                         a_offset], lda);
00661                 iadd = kadd[kazero[jtype - 1] - 1];
00662                 if (iadd > 0 && iadd <= n) {
00663                     i__3 = iadd + iadd * a_dim1;
00664                     i__4 = kamagn[jtype - 1];
00665                     a[i__3].r = rmagn[i__4], a[i__3].i = 0.f;
00666                 }
00667 
00668 /*              Generate B (w/o rotation) */
00669 
00670                 if ((i__3 = kbtype[jtype - 1], abs(i__3)) == 3) {
00671                     in = ((n - 1) / 2 << 1) + 1;
00672                     if (in != n) {
00673                         claset_("Full", &n, &n, &c_b1, &c_b1, &b[b_offset], 
00674                                 lda);
00675                     }
00676                 } else {
00677                     in = n;
00678                 }
00679                 clatm4_(&kbtype[jtype - 1], &in, &kz1[kbzero[jtype - 1] - 1], 
00680                         &kz2[kbzero[jtype - 1] - 1], &lbsign[jtype - 1], &
00681                         rmagn[kbmagn[jtype - 1]], &c_b28, &rmagn[ktrian[jtype 
00682                         - 1] * kbmagn[jtype - 1]], &c__2, &iseed[1], &b[
00683                         b_offset], lda);
00684                 iadd = kadd[kbzero[jtype - 1] - 1];
00685                 if (iadd != 0 && iadd <= n) {
00686                     i__3 = iadd + iadd * b_dim1;
00687                     i__4 = kbmagn[jtype - 1];
00688                     b[i__3].r = rmagn[i__4], b[i__3].i = 0.f;
00689                 }
00690 
00691                 if (kclass[jtype - 1] == 2 && n > 0) {
00692 
00693 /*                 Include rotations */
00694 
00695 /*                 Generate Q, Z as Householder transformations times */
00696 /*                 a diagonal matrix. */
00697 
00698                     i__3 = n - 1;
00699                     for (jc = 1; jc <= i__3; ++jc) {
00700                         i__4 = n;
00701                         for (jr = jc; jr <= i__4; ++jr) {
00702                             i__5 = jr + jc * q_dim1;
00703                             clarnd_(&q__1, &c__3, &iseed[1]);
00704                             q[i__5].r = q__1.r, q[i__5].i = q__1.i;
00705                             i__5 = jr + jc * z_dim1;
00706                             clarnd_(&q__1, &c__3, &iseed[1]);
00707                             z__[i__5].r = q__1.r, z__[i__5].i = q__1.i;
00708 /* L30: */
00709                         }
00710                         i__4 = n + 1 - jc;
00711                         clarfg_(&i__4, &q[jc + jc * q_dim1], &q[jc + 1 + jc * 
00712                                 q_dim1], &c__1, &work[jc]);
00713                         i__4 = (n << 1) + jc;
00714                         i__5 = jc + jc * q_dim1;
00715                         r__2 = q[i__5].r;
00716                         r__1 = r_sign(&c_b28, &r__2);
00717                         work[i__4].r = r__1, work[i__4].i = 0.f;
00718                         i__4 = jc + jc * q_dim1;
00719                         q[i__4].r = 1.f, q[i__4].i = 0.f;
00720                         i__4 = n + 1 - jc;
00721                         clarfg_(&i__4, &z__[jc + jc * z_dim1], &z__[jc + 1 + 
00722                                 jc * z_dim1], &c__1, &work[n + jc]);
00723                         i__4 = n * 3 + jc;
00724                         i__5 = jc + jc * z_dim1;
00725                         r__2 = z__[i__5].r;
00726                         r__1 = r_sign(&c_b28, &r__2);
00727                         work[i__4].r = r__1, work[i__4].i = 0.f;
00728                         i__4 = jc + jc * z_dim1;
00729                         z__[i__4].r = 1.f, z__[i__4].i = 0.f;
00730 /* L40: */
00731                     }
00732                     clarnd_(&q__1, &c__3, &iseed[1]);
00733                     ctemp.r = q__1.r, ctemp.i = q__1.i;
00734                     i__3 = n + n * q_dim1;
00735                     q[i__3].r = 1.f, q[i__3].i = 0.f;
00736                     i__3 = n;
00737                     work[i__3].r = 0.f, work[i__3].i = 0.f;
00738                     i__3 = n * 3;
00739                     r__1 = c_abs(&ctemp);
00740                     q__1.r = ctemp.r / r__1, q__1.i = ctemp.i / r__1;
00741                     work[i__3].r = q__1.r, work[i__3].i = q__1.i;
00742                     clarnd_(&q__1, &c__3, &iseed[1]);
00743                     ctemp.r = q__1.r, ctemp.i = q__1.i;
00744                     i__3 = n + n * z_dim1;
00745                     z__[i__3].r = 1.f, z__[i__3].i = 0.f;
00746                     i__3 = n << 1;
00747                     work[i__3].r = 0.f, work[i__3].i = 0.f;
00748                     i__3 = n << 2;
00749                     r__1 = c_abs(&ctemp);
00750                     q__1.r = ctemp.r / r__1, q__1.i = ctemp.i / r__1;
00751                     work[i__3].r = q__1.r, work[i__3].i = q__1.i;
00752 
00753 /*                 Apply the diagonal matrices */
00754 
00755                     i__3 = n;
00756                     for (jc = 1; jc <= i__3; ++jc) {
00757                         i__4 = n;
00758                         for (jr = 1; jr <= i__4; ++jr) {
00759                             i__5 = jr + jc * a_dim1;
00760                             i__6 = (n << 1) + jr;
00761                             r_cnjg(&q__3, &work[n * 3 + jc]);
00762                             q__2.r = work[i__6].r * q__3.r - work[i__6].i * 
00763                                     q__3.i, q__2.i = work[i__6].r * q__3.i + 
00764                                     work[i__6].i * q__3.r;
00765                             i__7 = jr + jc * a_dim1;
00766                             q__1.r = q__2.r * a[i__7].r - q__2.i * a[i__7].i, 
00767                                     q__1.i = q__2.r * a[i__7].i + q__2.i * a[
00768                                     i__7].r;
00769                             a[i__5].r = q__1.r, a[i__5].i = q__1.i;
00770                             i__5 = jr + jc * b_dim1;
00771                             i__6 = (n << 1) + jr;
00772                             r_cnjg(&q__3, &work[n * 3 + jc]);
00773                             q__2.r = work[i__6].r * q__3.r - work[i__6].i * 
00774                                     q__3.i, q__2.i = work[i__6].r * q__3.i + 
00775                                     work[i__6].i * q__3.r;
00776                             i__7 = jr + jc * b_dim1;
00777                             q__1.r = q__2.r * b[i__7].r - q__2.i * b[i__7].i, 
00778                                     q__1.i = q__2.r * b[i__7].i + q__2.i * b[
00779                                     i__7].r;
00780                             b[i__5].r = q__1.r, b[i__5].i = q__1.i;
00781 /* L50: */
00782                         }
00783 /* L60: */
00784                     }
00785                     i__3 = n - 1;
00786                     cunm2r_("L", "N", &n, &n, &i__3, &q[q_offset], ldq, &work[
00787                             1], &a[a_offset], lda, &work[(n << 1) + 1], &ierr);
00788                     if (ierr != 0) {
00789                         goto L90;
00790                     }
00791                     i__3 = n - 1;
00792                     cunm2r_("R", "C", &n, &n, &i__3, &z__[z_offset], ldq, &
00793                             work[n + 1], &a[a_offset], lda, &work[(n << 1) + 
00794                             1], &ierr);
00795                     if (ierr != 0) {
00796                         goto L90;
00797                     }
00798                     i__3 = n - 1;
00799                     cunm2r_("L", "N", &n, &n, &i__3, &q[q_offset], ldq, &work[
00800                             1], &b[b_offset], lda, &work[(n << 1) + 1], &ierr);
00801                     if (ierr != 0) {
00802                         goto L90;
00803                     }
00804                     i__3 = n - 1;
00805                     cunm2r_("R", "C", &n, &n, &i__3, &z__[z_offset], ldq, &
00806                             work[n + 1], &b[b_offset], lda, &work[(n << 1) + 
00807                             1], &ierr);
00808                     if (ierr != 0) {
00809                         goto L90;
00810                     }
00811                 }
00812             } else {
00813 
00814 /*              Random matrices */
00815 
00816                 i__3 = n;
00817                 for (jc = 1; jc <= i__3; ++jc) {
00818                     i__4 = n;
00819                     for (jr = 1; jr <= i__4; ++jr) {
00820                         i__5 = jr + jc * a_dim1;
00821                         i__6 = kamagn[jtype - 1];
00822                         clarnd_(&q__2, &c__4, &iseed[1]);
00823                         q__1.r = rmagn[i__6] * q__2.r, q__1.i = rmagn[i__6] * 
00824                                 q__2.i;
00825                         a[i__5].r = q__1.r, a[i__5].i = q__1.i;
00826                         i__5 = jr + jc * b_dim1;
00827                         i__6 = kbmagn[jtype - 1];
00828                         clarnd_(&q__2, &c__4, &iseed[1]);
00829                         q__1.r = rmagn[i__6] * q__2.r, q__1.i = rmagn[i__6] * 
00830                                 q__2.i;
00831                         b[i__5].r = q__1.r, b[i__5].i = q__1.i;
00832 /* L70: */
00833                     }
00834 /* L80: */
00835                 }
00836             }
00837 
00838 L90:
00839 
00840             if (ierr != 0) {
00841                 io___40.ciunit = *nounit;
00842                 s_wsfe(&io___40);
00843                 do_fio(&c__1, "Generator", (ftnlen)9);
00844                 do_fio(&c__1, (char *)&ierr, (ftnlen)sizeof(integer));
00845                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00846                 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00847                 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00848                 e_wsfe();
00849                 *info = abs(ierr);
00850                 return 0;
00851             }
00852 
00853 L100:
00854 
00855             for (i__ = 1; i__ <= 7; ++i__) {
00856                 result[i__] = -1.f;
00857 /* L110: */
00858             }
00859 
00860 /*           Call CGGEV to compute eigenvalues and eigenvectors. */
00861 
00862             clacpy_(" ", &n, &n, &a[a_offset], lda, &s[s_offset], lda);
00863             clacpy_(" ", &n, &n, &b[b_offset], lda, &t[t_offset], lda);
00864             cggev_("V", "V", &n, &s[s_offset], lda, &t[t_offset], lda, &alpha[
00865                     1], &beta[1], &q[q_offset], ldq, &z__[z_offset], ldq, &
00866                     work[1], lwork, &rwork[1], &ierr);
00867             if (ierr != 0 && ierr != n + 1) {
00868                 result[1] = ulpinv;
00869                 io___42.ciunit = *nounit;
00870                 s_wsfe(&io___42);
00871                 do_fio(&c__1, "CGGEV1", (ftnlen)6);
00872                 do_fio(&c__1, (char *)&ierr, (ftnlen)sizeof(integer));
00873                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00874                 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00875                 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00876                 e_wsfe();
00877                 *info = abs(ierr);
00878                 goto L190;
00879             }
00880 
00881 /*           Do the tests (1) and (2) */
00882 
00883             cget52_(&c_true, &n, &a[a_offset], lda, &b[b_offset], lda, &q[
00884                     q_offset], ldq, &alpha[1], &beta[1], &work[1], &rwork[1], 
00885                     &result[1]);
00886             if (result[2] > *thresh) {
00887                 io___43.ciunit = *nounit;
00888                 s_wsfe(&io___43);
00889                 do_fio(&c__1, "Left", (ftnlen)4);
00890                 do_fio(&c__1, "CGGEV1", (ftnlen)6);
00891                 do_fio(&c__1, (char *)&result[2], (ftnlen)sizeof(real));
00892                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00893                 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00894                 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00895                 e_wsfe();
00896             }
00897 
00898 /*           Do the tests (3) and (4) */
00899 
00900             cget52_(&c_false, &n, &a[a_offset], lda, &b[b_offset], lda, &z__[
00901                     z_offset], ldq, &alpha[1], &beta[1], &work[1], &rwork[1], 
00902                     &result[3]);
00903             if (result[4] > *thresh) {
00904                 io___44.ciunit = *nounit;
00905                 s_wsfe(&io___44);
00906                 do_fio(&c__1, "Right", (ftnlen)5);
00907                 do_fio(&c__1, "CGGEV1", (ftnlen)6);
00908                 do_fio(&c__1, (char *)&result[4], (ftnlen)sizeof(real));
00909                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00910                 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00911                 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00912                 e_wsfe();
00913             }
00914 
00915 /*           Do test (5) */
00916 
00917             clacpy_(" ", &n, &n, &a[a_offset], lda, &s[s_offset], lda);
00918             clacpy_(" ", &n, &n, &b[b_offset], lda, &t[t_offset], lda);
00919             cggev_("N", "N", &n, &s[s_offset], lda, &t[t_offset], lda, &
00920                     alpha1[1], &beta1[1], &q[q_offset], ldq, &z__[z_offset], 
00921                     ldq, &work[1], lwork, &rwork[1], &ierr);
00922             if (ierr != 0 && ierr != n + 1) {
00923                 result[1] = ulpinv;
00924                 io___45.ciunit = *nounit;
00925                 s_wsfe(&io___45);
00926                 do_fio(&c__1, "CGGEV2", (ftnlen)6);
00927                 do_fio(&c__1, (char *)&ierr, (ftnlen)sizeof(integer));
00928                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00929                 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00930                 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00931                 e_wsfe();
00932                 *info = abs(ierr);
00933                 goto L190;
00934             }
00935 
00936             i__3 = n;
00937             for (j = 1; j <= i__3; ++j) {
00938                 i__4 = j;
00939                 i__5 = j;
00940                 i__6 = j;
00941                 i__7 = j;
00942                 if (alpha[i__4].r != alpha1[i__5].r || alpha[i__4].i != 
00943                         alpha1[i__5].i || (beta[i__6].r != beta1[i__7].r || 
00944                         beta[i__6].i != beta1[i__7].i)) {
00945                     result[5] = ulpinv;
00946                 }
00947 /* L120: */
00948             }
00949 
00950 /*           Do test (6): Compute eigenvalues and left eigenvectors, */
00951 /*           and test them */
00952 
00953             clacpy_(" ", &n, &n, &a[a_offset], lda, &s[s_offset], lda);
00954             clacpy_(" ", &n, &n, &b[b_offset], lda, &t[t_offset], lda);
00955             cggev_("V", "N", &n, &s[s_offset], lda, &t[t_offset], lda, &
00956                     alpha1[1], &beta1[1], &qe[qe_offset], ldqe, &z__[z_offset]
00957 , ldq, &work[1], lwork, &rwork[1], &ierr);
00958             if (ierr != 0 && ierr != n + 1) {
00959                 result[1] = ulpinv;
00960                 io___46.ciunit = *nounit;
00961                 s_wsfe(&io___46);
00962                 do_fio(&c__1, "CGGEV3", (ftnlen)6);
00963                 do_fio(&c__1, (char *)&ierr, (ftnlen)sizeof(integer));
00964                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00965                 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00966                 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00967                 e_wsfe();
00968                 *info = abs(ierr);
00969                 goto L190;
00970             }
00971 
00972             i__3 = n;
00973             for (j = 1; j <= i__3; ++j) {
00974                 i__4 = j;
00975                 i__5 = j;
00976                 i__6 = j;
00977                 i__7 = j;
00978                 if (alpha[i__4].r != alpha1[i__5].r || alpha[i__4].i != 
00979                         alpha1[i__5].i || (beta[i__6].r != beta1[i__7].r || 
00980                         beta[i__6].i != beta1[i__7].i)) {
00981                     result[6] = ulpinv;
00982                 }
00983 /* L130: */
00984             }
00985 
00986             i__3 = n;
00987             for (j = 1; j <= i__3; ++j) {
00988                 i__4 = n;
00989                 for (jc = 1; jc <= i__4; ++jc) {
00990                     i__5 = j + jc * q_dim1;
00991                     i__6 = j + jc * qe_dim1;
00992                     if (q[i__5].r != qe[i__6].r || q[i__5].i != qe[i__6].i) {
00993                         result[6] = ulpinv;
00994                     }
00995 /* L140: */
00996                 }
00997 /* L150: */
00998             }
00999 
01000 /*           Do test (7): Compute eigenvalues and right eigenvectors, */
01001 /*           and test them */
01002 
01003             clacpy_(" ", &n, &n, &a[a_offset], lda, &s[s_offset], lda);
01004             clacpy_(" ", &n, &n, &b[b_offset], lda, &t[t_offset], lda);
01005             cggev_("N", "V", &n, &s[s_offset], lda, &t[t_offset], lda, &
01006                     alpha1[1], &beta1[1], &q[q_offset], ldq, &qe[qe_offset], 
01007                     ldqe, &work[1], lwork, &rwork[1], &ierr);
01008             if (ierr != 0 && ierr != n + 1) {
01009                 result[1] = ulpinv;
01010                 io___47.ciunit = *nounit;
01011                 s_wsfe(&io___47);
01012                 do_fio(&c__1, "CGGEV4", (ftnlen)6);
01013                 do_fio(&c__1, (char *)&ierr, (ftnlen)sizeof(integer));
01014                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01015                 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01016                 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01017                 e_wsfe();
01018                 *info = abs(ierr);
01019                 goto L190;
01020             }
01021 
01022             i__3 = n;
01023             for (j = 1; j <= i__3; ++j) {
01024                 i__4 = j;
01025                 i__5 = j;
01026                 i__6 = j;
01027                 i__7 = j;
01028                 if (alpha[i__4].r != alpha1[i__5].r || alpha[i__4].i != 
01029                         alpha1[i__5].i || (beta[i__6].r != beta1[i__7].r || 
01030                         beta[i__6].i != beta1[i__7].i)) {
01031                     result[7] = ulpinv;
01032                 }
01033 /* L160: */
01034             }
01035 
01036             i__3 = n;
01037             for (j = 1; j <= i__3; ++j) {
01038                 i__4 = n;
01039                 for (jc = 1; jc <= i__4; ++jc) {
01040                     i__5 = j + jc * z_dim1;
01041                     i__6 = j + jc * qe_dim1;
01042                     if (z__[i__5].r != qe[i__6].r || z__[i__5].i != qe[i__6]
01043                             .i) {
01044                         result[7] = ulpinv;
01045                     }
01046 /* L170: */
01047                 }
01048 /* L180: */
01049             }
01050 
01051 /*           End of Loop -- Check for RESULT(j) > THRESH */
01052 
01053 L190:
01054 
01055             ntestt += 7;
01056 
01057 /*           Print out tests which fail. */
01058 
01059             for (jr = 1; jr <= 7; ++jr) {
01060                 if (result[jr] >= *thresh) {
01061 
01062 /*                 If this is the first test to fail, */
01063 /*                 print a header to the data file. */
01064 
01065                     if (nerrs == 0) {
01066                         io___48.ciunit = *nounit;
01067                         s_wsfe(&io___48);
01068                         do_fio(&c__1, "CGV", (ftnlen)3);
01069                         e_wsfe();
01070 
01071 /*                    Matrix types */
01072 
01073                         io___49.ciunit = *nounit;
01074                         s_wsfe(&io___49);
01075                         e_wsfe();
01076                         io___50.ciunit = *nounit;
01077                         s_wsfe(&io___50);
01078                         e_wsfe();
01079                         io___51.ciunit = *nounit;
01080                         s_wsfe(&io___51);
01081                         do_fio(&c__1, "Orthogonal", (ftnlen)10);
01082                         e_wsfe();
01083 
01084 /*                    Tests performed */
01085 
01086                         io___52.ciunit = *nounit;
01087                         s_wsfe(&io___52);
01088                         e_wsfe();
01089 
01090                     }
01091                     ++nerrs;
01092                     if (result[jr] < 1e4f) {
01093                         io___53.ciunit = *nounit;
01094                         s_wsfe(&io___53);
01095                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01096                         do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01097                                 ;
01098                         do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01099                                 integer));
01100                         do_fio(&c__1, (char *)&jr, (ftnlen)sizeof(integer));
01101                         do_fio(&c__1, (char *)&result[jr], (ftnlen)sizeof(
01102                                 real));
01103                         e_wsfe();
01104                     } else {
01105                         io___54.ciunit = *nounit;
01106                         s_wsfe(&io___54);
01107                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01108                         do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01109                                 ;
01110                         do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01111                                 integer));
01112                         do_fio(&c__1, (char *)&jr, (ftnlen)sizeof(integer));
01113                         do_fio(&c__1, (char *)&result[jr], (ftnlen)sizeof(
01114                                 real));
01115                         e_wsfe();
01116                     }
01117                 }
01118 /* L200: */
01119             }
01120 
01121 L210:
01122             ;
01123         }
01124 /* L220: */
01125     }
01126 
01127 /*     Summary */
01128 
01129     alasvm_("CGV", nounit, &nerrs, &ntestt, &c__0);
01130 
01131     work[1].r = (real) maxwrk, work[1].i = 0.f;
01132 
01133     return 0;
01134 
01135 
01136 
01137 
01138 
01139 
01140 
01141 /*     End of CDRGEV */
01142 
01143 } /* cdrgev_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:20