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 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 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
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
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
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
00092 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
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 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 int dlabad_(doublereal *, doublereal *);
00119 extern doublereal dznrm2_(integer *, doublecomplex *, integer *), dlamch_(
00120 char *);
00121 integer idumma[1];
00122 extern int xerbla_(char *, integer *);
00123 integer ioldsd[4];
00124 extern 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 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
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
00162
00163
00164
00165
00166
00167
00168
00169
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 --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
00482
00483
00484
00485 s_copy(path, "Zomplex precision", (ftnlen)1, (ftnlen)17);
00486 s_copy(path + 1, "EV", (ftnlen)2, (ftnlen)2);
00487
00488
00489
00490 ntestt = 0;
00491 ntestf = 0;
00492 *info = 0;
00493
00494
00495
00496 badnn = FALSE_;
00497 nmax = 0;
00498 i__1 = *nsizes;
00499 for (j = 1; j <= i__1; ++j) {
00500
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
00507 }
00508
00509
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 {
00530
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
00544
00545 if (*nsizes == 0 || *ntypes == 0) {
00546 return 0;
00547 }
00548
00549
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
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
00579
00580 for (j = 1; j <= 4; ++j) {
00581 ioldsd[j - 1] = iseed[j];
00582
00583 }
00584
00585
00586
00587
00588
00589
00590
00591
00592
00593
00594
00595
00596
00597
00598
00599
00600
00601 if (mtypes > 21) {
00602 goto L90;
00603 }
00604
00605 itype = ktype[jtype - 1];
00606 imode = kmode[jtype - 1];
00607
00608
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
00635
00636
00637
00638 if (itype == 1) {
00639 iinfo = 0;
00640
00641 } else if (itype == 2) {
00642
00643
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
00651 }
00652
00653 } else if (itype == 3) {
00654
00655
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
00667 }
00668
00669 } else if (itype == 4) {
00670
00671
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
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
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
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
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
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
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
00775
00776 for (iwk = 1; iwk <= 2; ++iwk) {
00777 if (iwk == 1) {
00778 nnwork = n << 1;
00779 } else {
00780
00781 i__3 = n;
00782 nnwork = n * 5 + (i__3 * i__3 << 1);
00783 }
00784 nnwork = max(nnwork,1);
00785
00786
00787
00788 for (j = 1; j <= 7; ++j) {
00789 result[j] = -1.;
00790
00791 }
00792
00793
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
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
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
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
00832
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
00851 }
00852 if (vrmx / vmx < 1. - ulp * 2.) {
00853 result[3] = ulpinv;
00854 }
00855
00856 }
00857
00858
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
00864
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
00883 }
00884 if (vrmx / vmx < 1. - ulp * 2.) {
00885 result[4] = ulpinv;
00886 }
00887
00888 }
00889
00890
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
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
00920 }
00921
00922
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
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
00953 }
00954
00955
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
00968 }
00969
00970 }
00971
00972
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
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
01003 }
01004
01005
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
01018 }
01019
01020 }
01021
01022
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
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
01079 }
01080
01081 nerrs += nfail;
01082 ntestt += ntest;
01083
01084
01085 }
01086 L260:
01087 ;
01088 }
01089
01090 }
01091
01092
01093
01094 dlasum_(path, nounit, &nerrs, &ntestt);
01095
01096
01097
01098 return 0;
01099
01100
01101
01102 }