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 integer c__1 = 1;
00019 static integer c__4 = 4;
00020
00021 int dget23_(logical *comp, char *balanc, integer *jtype,
00022 doublereal *thresh, integer *iseed, integer *nounit, integer *n,
00023 doublereal *a, integer *lda, doublereal *h__, doublereal *wr,
00024 doublereal *wi, doublereal *wr1, doublereal *wi1, doublereal *vl,
00025 integer *ldvl, doublereal *vr, integer *ldvr, doublereal *lre,
00026 integer *ldlre, doublereal *rcondv, doublereal *rcndv1, doublereal *
00027 rcdvin, doublereal *rconde, doublereal *rcnde1, doublereal *rcdein,
00028 doublereal *scale, doublereal *scale1, doublereal *result, doublereal
00029 *work, integer *lwork, integer *iwork, integer *info)
00030 {
00031
00032
00033 static char sens[1*2] = "N" "V";
00034
00035
00036 static char fmt_9998[] = "(\002 DGET23: \002,a,\002 returned INFO=\002,i"
00037 "6,\002.\002,/9x,\002N=\002,i6,\002, JTYPE=\002,i6,\002, BALANC = "
00038 "\002,a,\002, ISEED=(\002,3(i5,\002,\002),i5,\002)\002)";
00039 static char fmt_9999[] = "(\002 DGET23: \002,a,\002 returned INFO=\002,i"
00040 "6,\002.\002,/9x,\002N=\002,i6,\002, INPUT EXAMPLE NUMBER = \002,"
00041 "i4)";
00042
00043
00044 integer a_dim1, a_offset, h_dim1, h_offset, lre_dim1, lre_offset, vl_dim1,
00045 vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3;
00046 doublereal d__1, d__2, d__3, d__4, d__5;
00047
00048
00049 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00050
00051
00052 integer i__, j;
00053 doublereal v;
00054 integer jj, ihi, ilo;
00055 doublereal dum[1], eps, res[2], tol, ulp, vmx;
00056 integer ihi1, ilo1, kmin;
00057 doublereal vmax, tnrm, vrmx, vtst;
00058 extern doublereal dnrm2_(integer *, doublereal *, integer *);
00059 logical balok, nobal;
00060 extern int dget22_(char *, char *, char *, integer *,
00061 doublereal *, integer *, doublereal *, integer *, doublereal *,
00062 doublereal *, doublereal *, doublereal *);
00063 doublereal abnrm;
00064 extern logical lsame_(char *, char *);
00065 integer iinfo;
00066 char sense[1];
00067 integer isens;
00068 doublereal vimin, tolin, vrmin, abnrm1;
00069 extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *);
00070 extern int dlacpy_(char *, integer *, integer *,
00071 doublereal *, integer *, doublereal *, integer *),
00072 xerbla_(char *, integer *), dgeevx_(char *, char *, char *
00073 , char *, integer *, doublereal *, integer *, doublereal *,
00074 doublereal *, doublereal *, integer *, doublereal *, integer *,
00075 integer *, integer *, doublereal *, doublereal *, doublereal *,
00076 doublereal *, doublereal *, integer *, integer *, integer *);
00077 integer isensm;
00078 doublereal smlnum, ulpinv;
00079
00080
00081 static cilist io___14 = { 0, 0, 0, fmt_9998, 0 };
00082 static cilist io___15 = { 0, 0, 0, fmt_9999, 0 };
00083 static cilist io___28 = { 0, 0, 0, fmt_9998, 0 };
00084 static cilist io___29 = { 0, 0, 0, fmt_9999, 0 };
00085 static cilist io___30 = { 0, 0, 0, fmt_9998, 0 };
00086 static cilist io___31 = { 0, 0, 0, fmt_9999, 0 };
00087 static cilist io___32 = { 0, 0, 0, fmt_9998, 0 };
00088 static cilist io___33 = { 0, 0, 0, fmt_9999, 0 };
00089 static cilist io___34 = { 0, 0, 0, fmt_9999, 0 };
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
00157
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 --iseed;
00341 h_dim1 = *lda;
00342 h_offset = 1 + h_dim1;
00343 h__ -= h_offset;
00344 a_dim1 = *lda;
00345 a_offset = 1 + a_dim1;
00346 a -= a_offset;
00347 --wr;
00348 --wi;
00349 --wr1;
00350 --wi1;
00351 vl_dim1 = *ldvl;
00352 vl_offset = 1 + vl_dim1;
00353 vl -= vl_offset;
00354 vr_dim1 = *ldvr;
00355 vr_offset = 1 + vr_dim1;
00356 vr -= vr_offset;
00357 lre_dim1 = *ldlre;
00358 lre_offset = 1 + lre_dim1;
00359 lre -= lre_offset;
00360 --rcondv;
00361 --rcndv1;
00362 --rcdvin;
00363 --rconde;
00364 --rcnde1;
00365 --rcdein;
00366 --scale;
00367 --scale1;
00368 --result;
00369 --work;
00370 --iwork;
00371
00372
00373
00374
00375
00376
00377
00378 nobal = lsame_(balanc, "N");
00379 balok = nobal || lsame_(balanc, "P") || lsame_(
00380 balanc, "S") || lsame_(balanc, "B");
00381 *info = 0;
00382 if (! balok) {
00383 *info = -2;
00384 } else if (*thresh < 0.) {
00385 *info = -4;
00386 } else if (*nounit <= 0) {
00387 *info = -6;
00388 } else if (*n < 0) {
00389 *info = -7;
00390 } else if (*lda < 1 || *lda < *n) {
00391 *info = -9;
00392 } else if (*ldvl < 1 || *ldvl < *n) {
00393 *info = -16;
00394 } else if (*ldvr < 1 || *ldvr < *n) {
00395 *info = -18;
00396 } else if (*ldlre < 1 || *ldlre < *n) {
00397 *info = -20;
00398 } else if (*lwork < *n * 3 || *comp && *lwork < *n * 6 + *n * *n) {
00399 *info = -31;
00400 }
00401
00402 if (*info != 0) {
00403 i__1 = -(*info);
00404 xerbla_("DGET23", &i__1);
00405 return 0;
00406 }
00407
00408
00409
00410 for (i__ = 1; i__ <= 11; ++i__) {
00411 result[i__] = -1.;
00412
00413 }
00414
00415 if (*n == 0) {
00416 return 0;
00417 }
00418
00419
00420
00421 ulp = dlamch_("Precision");
00422 smlnum = dlamch_("S");
00423 ulpinv = 1. / ulp;
00424
00425
00426
00427 if (*lwork >= *n * 6 + *n * *n) {
00428 *(unsigned char *)sense = 'B';
00429 isensm = 2;
00430 } else {
00431 *(unsigned char *)sense = 'E';
00432 isensm = 1;
00433 }
00434 dlacpy_("F", n, n, &a[a_offset], lda, &h__[h_offset], lda);
00435 dgeevx_(balanc, "V", "V", sense, n, &h__[h_offset], lda, &wr[1], &wi[1], &
00436 vl[vl_offset], ldvl, &vr[vr_offset], ldvr, &ilo, &ihi, &scale[1],
00437 &abnrm, &rconde[1], &rcondv[1], &work[1], lwork, &iwork[1], &
00438 iinfo);
00439 if (iinfo != 0) {
00440 result[1] = ulpinv;
00441 if (*jtype != 22) {
00442 io___14.ciunit = *nounit;
00443 s_wsfe(&io___14);
00444 do_fio(&c__1, "DGEEVX1", (ftnlen)7);
00445 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00446 do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
00447 do_fio(&c__1, (char *)&(*jtype), (ftnlen)sizeof(integer));
00448 do_fio(&c__1, balanc, (ftnlen)1);
00449 do_fio(&c__4, (char *)&iseed[1], (ftnlen)sizeof(integer));
00450 e_wsfe();
00451 } else {
00452 io___15.ciunit = *nounit;
00453 s_wsfe(&io___15);
00454 do_fio(&c__1, "DGEEVX1", (ftnlen)7);
00455 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00456 do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
00457 do_fio(&c__1, (char *)&iseed[1], (ftnlen)sizeof(integer));
00458 e_wsfe();
00459 }
00460 *info = abs(iinfo);
00461 return 0;
00462 }
00463
00464
00465
00466 dget22_("N", "N", "N", n, &a[a_offset], lda, &vr[vr_offset], ldvr, &wr[1],
00467 &wi[1], &work[1], res);
00468 result[1] = res[0];
00469
00470
00471
00472 dget22_("T", "N", "T", n, &a[a_offset], lda, &vl[vl_offset], ldvl, &wr[1],
00473 &wi[1], &work[1], res);
00474 result[2] = res[0];
00475
00476
00477
00478 i__1 = *n;
00479 for (j = 1; j <= i__1; ++j) {
00480 tnrm = 1.;
00481 if (wi[j] == 0.) {
00482 tnrm = dnrm2_(n, &vr[j * vr_dim1 + 1], &c__1);
00483 } else if (wi[j] > 0.) {
00484 d__1 = dnrm2_(n, &vr[j * vr_dim1 + 1], &c__1);
00485 d__2 = dnrm2_(n, &vr[(j + 1) * vr_dim1 + 1], &c__1);
00486 tnrm = dlapy2_(&d__1, &d__2);
00487 }
00488
00489
00490 d__4 = ulpinv, d__5 = (d__1 = tnrm - 1., abs(d__1)) / ulp;
00491 d__2 = result[3], d__3 = min(d__4,d__5);
00492 result[3] = max(d__2,d__3);
00493 if (wi[j] > 0.) {
00494 vmx = 0.;
00495 vrmx = 0.;
00496 i__2 = *n;
00497 for (jj = 1; jj <= i__2; ++jj) {
00498 vtst = dlapy2_(&vr[jj + j * vr_dim1], &vr[jj + (j + 1) *
00499 vr_dim1]);
00500 if (vtst > vmx) {
00501 vmx = vtst;
00502 }
00503 if (vr[jj + (j + 1) * vr_dim1] == 0. && (d__1 = vr[jj + j *
00504 vr_dim1], abs(d__1)) > vrmx) {
00505 vrmx = (d__2 = vr[jj + j * vr_dim1], abs(d__2));
00506 }
00507
00508 }
00509 if (vrmx / vmx < 1. - ulp * 2.) {
00510 result[3] = ulpinv;
00511 }
00512 }
00513
00514 }
00515
00516
00517
00518 i__1 = *n;
00519 for (j = 1; j <= i__1; ++j) {
00520 tnrm = 1.;
00521 if (wi[j] == 0.) {
00522 tnrm = dnrm2_(n, &vl[j * vl_dim1 + 1], &c__1);
00523 } else if (wi[j] > 0.) {
00524 d__1 = dnrm2_(n, &vl[j * vl_dim1 + 1], &c__1);
00525 d__2 = dnrm2_(n, &vl[(j + 1) * vl_dim1 + 1], &c__1);
00526 tnrm = dlapy2_(&d__1, &d__2);
00527 }
00528
00529
00530 d__4 = ulpinv, d__5 = (d__1 = tnrm - 1., abs(d__1)) / ulp;
00531 d__2 = result[4], d__3 = min(d__4,d__5);
00532 result[4] = max(d__2,d__3);
00533 if (wi[j] > 0.) {
00534 vmx = 0.;
00535 vrmx = 0.;
00536 i__2 = *n;
00537 for (jj = 1; jj <= i__2; ++jj) {
00538 vtst = dlapy2_(&vl[jj + j * vl_dim1], &vl[jj + (j + 1) *
00539 vl_dim1]);
00540 if (vtst > vmx) {
00541 vmx = vtst;
00542 }
00543 if (vl[jj + (j + 1) * vl_dim1] == 0. && (d__1 = vl[jj + j *
00544 vl_dim1], abs(d__1)) > vrmx) {
00545 vrmx = (d__2 = vl[jj + j * vl_dim1], abs(d__2));
00546 }
00547
00548 }
00549 if (vrmx / vmx < 1. - ulp * 2.) {
00550 result[4] = ulpinv;
00551 }
00552 }
00553
00554 }
00555
00556
00557
00558 i__1 = isensm;
00559 for (isens = 1; isens <= i__1; ++isens) {
00560
00561 *(unsigned char *)sense = *(unsigned char *)&sens[isens - 1];
00562
00563
00564
00565 dlacpy_("F", n, n, &a[a_offset], lda, &h__[h_offset], lda);
00566 dgeevx_(balanc, "N", "N", sense, n, &h__[h_offset], lda, &wr1[1], &
00567 wi1[1], dum, &c__1, dum, &c__1, &ilo1, &ihi1, &scale1[1], &
00568 abnrm1, &rcnde1[1], &rcndv1[1], &work[1], lwork, &iwork[1], &
00569 iinfo);
00570 if (iinfo != 0) {
00571 result[1] = ulpinv;
00572 if (*jtype != 22) {
00573 io___28.ciunit = *nounit;
00574 s_wsfe(&io___28);
00575 do_fio(&c__1, "DGEEVX2", (ftnlen)7);
00576 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00577 do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
00578 do_fio(&c__1, (char *)&(*jtype), (ftnlen)sizeof(integer));
00579 do_fio(&c__1, balanc, (ftnlen)1);
00580 do_fio(&c__4, (char *)&iseed[1], (ftnlen)sizeof(integer));
00581 e_wsfe();
00582 } else {
00583 io___29.ciunit = *nounit;
00584 s_wsfe(&io___29);
00585 do_fio(&c__1, "DGEEVX2", (ftnlen)7);
00586 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00587 do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
00588 do_fio(&c__1, (char *)&iseed[1], (ftnlen)sizeof(integer));
00589 e_wsfe();
00590 }
00591 *info = abs(iinfo);
00592 goto L190;
00593 }
00594
00595
00596
00597 i__2 = *n;
00598 for (j = 1; j <= i__2; ++j) {
00599 if (wr[j] != wr1[j] || wi[j] != wi1[j]) {
00600 result[5] = ulpinv;
00601 }
00602
00603 }
00604
00605
00606
00607 if (! nobal) {
00608 i__2 = *n;
00609 for (j = 1; j <= i__2; ++j) {
00610 if (scale[j] != scale1[j]) {
00611 result[8] = ulpinv;
00612 }
00613
00614 }
00615 if (ilo != ilo1) {
00616 result[8] = ulpinv;
00617 }
00618 if (ihi != ihi1) {
00619 result[8] = ulpinv;
00620 }
00621 if (abnrm != abnrm1) {
00622 result[8] = ulpinv;
00623 }
00624 }
00625
00626
00627
00628 if (isens == 2 && *n > 1) {
00629 i__2 = *n;
00630 for (j = 1; j <= i__2; ++j) {
00631 if (rcondv[j] != rcndv1[j]) {
00632 result[9] = ulpinv;
00633 }
00634
00635 }
00636 }
00637
00638
00639
00640 dlacpy_("F", n, n, &a[a_offset], lda, &h__[h_offset], lda);
00641 dgeevx_(balanc, "N", "V", sense, n, &h__[h_offset], lda, &wr1[1], &
00642 wi1[1], dum, &c__1, &lre[lre_offset], ldlre, &ilo1, &ihi1, &
00643 scale1[1], &abnrm1, &rcnde1[1], &rcndv1[1], &work[1], lwork, &
00644 iwork[1], &iinfo);
00645 if (iinfo != 0) {
00646 result[1] = ulpinv;
00647 if (*jtype != 22) {
00648 io___30.ciunit = *nounit;
00649 s_wsfe(&io___30);
00650 do_fio(&c__1, "DGEEVX3", (ftnlen)7);
00651 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00652 do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
00653 do_fio(&c__1, (char *)&(*jtype), (ftnlen)sizeof(integer));
00654 do_fio(&c__1, balanc, (ftnlen)1);
00655 do_fio(&c__4, (char *)&iseed[1], (ftnlen)sizeof(integer));
00656 e_wsfe();
00657 } else {
00658 io___31.ciunit = *nounit;
00659 s_wsfe(&io___31);
00660 do_fio(&c__1, "DGEEVX3", (ftnlen)7);
00661 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00662 do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
00663 do_fio(&c__1, (char *)&iseed[1], (ftnlen)sizeof(integer));
00664 e_wsfe();
00665 }
00666 *info = abs(iinfo);
00667 goto L190;
00668 }
00669
00670
00671
00672 i__2 = *n;
00673 for (j = 1; j <= i__2; ++j) {
00674 if (wr[j] != wr1[j] || wi[j] != wi1[j]) {
00675 result[5] = ulpinv;
00676 }
00677
00678 }
00679
00680
00681
00682 i__2 = *n;
00683 for (j = 1; j <= i__2; ++j) {
00684 i__3 = *n;
00685 for (jj = 1; jj <= i__3; ++jj) {
00686 if (vr[j + jj * vr_dim1] != lre[j + jj * lre_dim1]) {
00687 result[6] = ulpinv;
00688 }
00689
00690 }
00691
00692 }
00693
00694
00695
00696 if (! nobal) {
00697 i__2 = *n;
00698 for (j = 1; j <= i__2; ++j) {
00699 if (scale[j] != scale1[j]) {
00700 result[8] = ulpinv;
00701 }
00702
00703 }
00704 if (ilo != ilo1) {
00705 result[8] = ulpinv;
00706 }
00707 if (ihi != ihi1) {
00708 result[8] = ulpinv;
00709 }
00710 if (abnrm != abnrm1) {
00711 result[8] = ulpinv;
00712 }
00713 }
00714
00715
00716
00717 if (isens == 2 && *n > 1) {
00718 i__2 = *n;
00719 for (j = 1; j <= i__2; ++j) {
00720 if (rcondv[j] != rcndv1[j]) {
00721 result[9] = ulpinv;
00722 }
00723
00724 }
00725 }
00726
00727
00728
00729 dlacpy_("F", n, n, &a[a_offset], lda, &h__[h_offset], lda);
00730 dgeevx_(balanc, "V", "N", sense, n, &h__[h_offset], lda, &wr1[1], &
00731 wi1[1], &lre[lre_offset], ldlre, dum, &c__1, &ilo1, &ihi1, &
00732 scale1[1], &abnrm1, &rcnde1[1], &rcndv1[1], &work[1], lwork, &
00733 iwork[1], &iinfo);
00734 if (iinfo != 0) {
00735 result[1] = ulpinv;
00736 if (*jtype != 22) {
00737 io___32.ciunit = *nounit;
00738 s_wsfe(&io___32);
00739 do_fio(&c__1, "DGEEVX4", (ftnlen)7);
00740 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00741 do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
00742 do_fio(&c__1, (char *)&(*jtype), (ftnlen)sizeof(integer));
00743 do_fio(&c__1, balanc, (ftnlen)1);
00744 do_fio(&c__4, (char *)&iseed[1], (ftnlen)sizeof(integer));
00745 e_wsfe();
00746 } else {
00747 io___33.ciunit = *nounit;
00748 s_wsfe(&io___33);
00749 do_fio(&c__1, "DGEEVX4", (ftnlen)7);
00750 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00751 do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
00752 do_fio(&c__1, (char *)&iseed[1], (ftnlen)sizeof(integer));
00753 e_wsfe();
00754 }
00755 *info = abs(iinfo);
00756 goto L190;
00757 }
00758
00759
00760
00761 i__2 = *n;
00762 for (j = 1; j <= i__2; ++j) {
00763 if (wr[j] != wr1[j] || wi[j] != wi1[j]) {
00764 result[5] = ulpinv;
00765 }
00766
00767 }
00768
00769
00770
00771 i__2 = *n;
00772 for (j = 1; j <= i__2; ++j) {
00773 i__3 = *n;
00774 for (jj = 1; jj <= i__3; ++jj) {
00775 if (vl[j + jj * vl_dim1] != lre[j + jj * lre_dim1]) {
00776 result[7] = ulpinv;
00777 }
00778
00779 }
00780
00781 }
00782
00783
00784
00785 if (! nobal) {
00786 i__2 = *n;
00787 for (j = 1; j <= i__2; ++j) {
00788 if (scale[j] != scale1[j]) {
00789 result[8] = ulpinv;
00790 }
00791
00792 }
00793 if (ilo != ilo1) {
00794 result[8] = ulpinv;
00795 }
00796 if (ihi != ihi1) {
00797 result[8] = ulpinv;
00798 }
00799 if (abnrm != abnrm1) {
00800 result[8] = ulpinv;
00801 }
00802 }
00803
00804
00805
00806 if (isens == 2 && *n > 1) {
00807 i__2 = *n;
00808 for (j = 1; j <= i__2; ++j) {
00809 if (rcondv[j] != rcndv1[j]) {
00810 result[9] = ulpinv;
00811 }
00812
00813 }
00814 }
00815
00816 L190:
00817
00818
00819 ;
00820 }
00821
00822
00823
00824 if (*comp) {
00825 dlacpy_("F", n, n, &a[a_offset], lda, &h__[h_offset], lda);
00826 dgeevx_("N", "V", "V", "B", n, &h__[h_offset], lda, &wr[1], &wi[1], &
00827 vl[vl_offset], ldvl, &vr[vr_offset], ldvr, &ilo, &ihi, &scale[
00828 1], &abnrm, &rconde[1], &rcondv[1], &work[1], lwork, &iwork[1]
00829 , &iinfo);
00830 if (iinfo != 0) {
00831 result[1] = ulpinv;
00832 io___34.ciunit = *nounit;
00833 s_wsfe(&io___34);
00834 do_fio(&c__1, "DGEEVX5", (ftnlen)7);
00835 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00836 do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
00837 do_fio(&c__1, (char *)&iseed[1], (ftnlen)sizeof(integer));
00838 e_wsfe();
00839 *info = abs(iinfo);
00840 goto L250;
00841 }
00842
00843
00844
00845
00846 i__1 = *n - 1;
00847 for (i__ = 1; i__ <= i__1; ++i__) {
00848 kmin = i__;
00849 vrmin = wr[i__];
00850 vimin = wi[i__];
00851 i__2 = *n;
00852 for (j = i__ + 1; j <= i__2; ++j) {
00853 if (wr[j] < vrmin) {
00854 kmin = j;
00855 vrmin = wr[j];
00856 vimin = wi[j];
00857 }
00858
00859 }
00860 wr[kmin] = wr[i__];
00861 wi[kmin] = wi[i__];
00862 wr[i__] = vrmin;
00863 wi[i__] = vimin;
00864 vrmin = rconde[kmin];
00865 rconde[kmin] = rconde[i__];
00866 rconde[i__] = vrmin;
00867 vrmin = rcondv[kmin];
00868 rcondv[kmin] = rcondv[i__];
00869 rcondv[i__] = vrmin;
00870
00871 }
00872
00873
00874
00875
00876 result[10] = 0.;
00877 eps = max(5.9605e-8,ulp);
00878
00879 d__1 = (doublereal) (*n) * eps * abnrm;
00880 v = max(d__1,smlnum);
00881 if (abnrm == 0.) {
00882 v = 1.;
00883 }
00884 i__1 = *n;
00885 for (i__ = 1; i__ <= i__1; ++i__) {
00886 if (v > rcondv[i__] * rconde[i__]) {
00887 tol = rcondv[i__];
00888 } else {
00889 tol = v / rconde[i__];
00890 }
00891 if (v > rcdvin[i__] * rcdein[i__]) {
00892 tolin = rcdvin[i__];
00893 } else {
00894 tolin = v / rcdein[i__];
00895 }
00896
00897 d__1 = tol, d__2 = smlnum / eps;
00898 tol = max(d__1,d__2);
00899
00900 d__1 = tolin, d__2 = smlnum / eps;
00901 tolin = max(d__1,d__2);
00902 if (eps * (rcdvin[i__] - tolin) > rcondv[i__] + tol) {
00903 vmax = 1. / eps;
00904 } else if (rcdvin[i__] - tolin > rcondv[i__] + tol) {
00905 vmax = (rcdvin[i__] - tolin) / (rcondv[i__] + tol);
00906 } else if (rcdvin[i__] + tolin < eps * (rcondv[i__] - tol)) {
00907 vmax = 1. / eps;
00908 } else if (rcdvin[i__] + tolin < rcondv[i__] - tol) {
00909 vmax = (rcondv[i__] - tol) / (rcdvin[i__] + tolin);
00910 } else {
00911 vmax = 1.;
00912 }
00913 result[10] = max(result[10],vmax);
00914
00915 }
00916
00917
00918
00919
00920 result[11] = 0.;
00921 i__1 = *n;
00922 for (i__ = 1; i__ <= i__1; ++i__) {
00923 if (v > rcondv[i__]) {
00924 tol = 1.;
00925 } else {
00926 tol = v / rcondv[i__];
00927 }
00928 if (v > rcdvin[i__]) {
00929 tolin = 1.;
00930 } else {
00931 tolin = v / rcdvin[i__];
00932 }
00933
00934 d__1 = tol, d__2 = smlnum / eps;
00935 tol = max(d__1,d__2);
00936
00937 d__1 = tolin, d__2 = smlnum / eps;
00938 tolin = max(d__1,d__2);
00939 if (eps * (rcdein[i__] - tolin) > rconde[i__] + tol) {
00940 vmax = 1. / eps;
00941 } else if (rcdein[i__] - tolin > rconde[i__] + tol) {
00942 vmax = (rcdein[i__] - tolin) / (rconde[i__] + tol);
00943 } else if (rcdein[i__] + tolin < eps * (rconde[i__] - tol)) {
00944 vmax = 1. / eps;
00945 } else if (rcdein[i__] + tolin < rconde[i__] - tol) {
00946 vmax = (rconde[i__] - tol) / (rcdein[i__] + tolin);
00947 } else {
00948 vmax = 1.;
00949 }
00950 result[11] = max(result[11],vmax);
00951
00952 }
00953 L250:
00954
00955 ;
00956 }
00957
00958
00959 return 0;
00960
00961
00962
00963 }