00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
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 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
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
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
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
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
00120 integer i__, j, n, n1, jc, nb, in, jr;
00121 real ulp;
00122 integer iadd, ierr, nmax;
00123 logical badnn;
00124 extern 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 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 VOID clarnd_(complex *, integer *, integer *);
00141 extern doublereal slamch_(char *);
00142 extern 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 int alasvm_(char *, integer *, integer *, integer
00150 *, integer *), xerbla_(char *, integer *);
00151 integer minwrk, maxwrk;
00152 real ulpinv;
00153 integer mtypes, ntestt;
00154
00155
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
00174
00175
00176
00177
00178
00179
00180
00181
00182
00183
00184
00185
00186
00187
00188
00189
00190
00191
00192
00193
00194
00195
00196
00197
00198
00199
00200
00201
00202
00203
00204
00205
00206
00207
00208
00209
00210
00211
00212
00213
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249
00250
00251
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264
00265
00266
00267
00268
00269
00270
00271
00272
00273
00274
00275
00276
00277
00278
00279
00280
00281
00282
00283
00284
00285
00286
00287
00288
00289
00290
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301
00302
00303
00304
00305
00306
00307
00308
00309
00310
00311
00312
00313
00314
00315
00316
00317
00318
00319
00320
00321
00322
00323
00324
00325
00326
00327
00328
00329
00330
00331
00332
00333
00334
00335
00336
00337
00338
00339
00340
00341
00342
00343
00344
00345
00346
00347
00348
00349
00350
00351
00352
00353
00354
00355
00356
00357
00358
00359
00360
00361
00362
00363
00364
00365
00366
00367
00368
00369
00370
00371
00372
00373
00374
00375
00376
00377
00378
00379
00380
00381
00382
00383
00384
00385
00386
00387
00388
00389
00390
00391
00392
00393
00394
00395
00396
00397
00398
00399
00400
00401
00402
00403
00404
00405
00406
00407
00408
00409
00410
00411
00412
00413
00414
00415
00416
00417
00418
00419
00420
00421
00422
00423
00424
00425
00426
00427
00428
00429
00430
00431
00432
00433
00434
00435
00436
00437
00438
00439
00440
00441
00442
00443
00444
00445
00446
00447
00448
00449
00450
00451
00452
00453
00454
00455
00456
00457
00458
00459
00460
00461
00462
00463
00464
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
00498
00499
00500
00501
00502
00503 *info = 0;
00504
00505 badnn = FALSE_;
00506 nmax = 1;
00507 i__1 = *nsizes;
00508 for (j = 1; j <= i__1; ++j) {
00509
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
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
00535
00536
00537
00538
00539
00540
00541 minwrk = 1;
00542 if (*info == 0 && *lwork >= 1) {
00543 minwrk = nmax * (nmax + 1);
00544
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
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
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
00581
00582 rmagn[0] = 0.f;
00583 rmagn[1] = 1.f;
00584
00585
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
00612
00613 for (j = 1; j <= 4; ++j) {
00614 ioldsd[j - 1] = iseed[j];
00615
00616 }
00617
00618
00619
00620
00621
00622
00623
00624
00625
00626
00627
00628
00629
00630
00631
00632
00633
00634
00635
00636
00637
00638
00639 if (mtypes > 26) {
00640 goto L100;
00641 }
00642 ierr = 0;
00643 if (kclass[jtype - 1] < 3) {
00644
00645
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
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
00694
00695
00696
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
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
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
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
00782 }
00783
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
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
00833 }
00834
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
00858 }
00859
00860
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
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
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
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
00948 }
00949
00950
00951
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
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
00996 }
00997
00998 }
00999
01000
01001
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
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
01047 }
01048
01049 }
01050
01051
01052
01053 L190:
01054
01055 ntestt += 7;
01056
01057
01058
01059 for (jr = 1; jr <= 7; ++jr) {
01060 if (result[jr] >= *thresh) {
01061
01062
01063
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
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
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
01119 }
01120
01121 L210:
01122 ;
01123 }
01124
01125 }
01126
01127
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
01142
01143 }