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__1 = 1;
00021 static integer c__2 = 2;
00022
00023 int zhgeqz_(char *job, char *compq, char *compz, integer *n,
00024 integer *ilo, integer *ihi, doublecomplex *h__, integer *ldh,
00025 doublecomplex *t, integer *ldt, doublecomplex *alpha, doublecomplex *
00026 beta, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *
00027 ldz, doublecomplex *work, integer *lwork, doublereal *rwork, integer *
00028 info)
00029 {
00030
00031 integer h_dim1, h_offset, q_dim1, q_offset, t_dim1, t_offset, z_dim1,
00032 z_offset, i__1, i__2, i__3, i__4, i__5, i__6;
00033 doublereal d__1, d__2, d__3, d__4, d__5, d__6;
00034 doublecomplex z__1, z__2, z__3, z__4, z__5, z__6;
00035
00036
00037 double z_abs(doublecomplex *);
00038 void d_cnjg(doublecomplex *, doublecomplex *);
00039 double d_imag(doublecomplex *);
00040 void z_div(doublecomplex *, doublecomplex *, doublecomplex *), pow_zi(
00041 doublecomplex *, doublecomplex *, integer *), z_sqrt(
00042 doublecomplex *, doublecomplex *);
00043
00044
00045 doublereal c__;
00046 integer j;
00047 doublecomplex s, t1;
00048 integer jc, in;
00049 doublecomplex u12;
00050 integer jr;
00051 doublecomplex ad11, ad12, ad21, ad22;
00052 integer jch;
00053 logical ilq, ilz;
00054 doublereal ulp;
00055 doublecomplex abi22;
00056 doublereal absb, atol, btol, temp;
00057 extern int zrot_(integer *, doublecomplex *, integer *,
00058 doublecomplex *, integer *, doublereal *, doublecomplex *);
00059 doublereal temp2;
00060 extern logical lsame_(char *, char *);
00061 doublecomplex ctemp;
00062 integer iiter, ilast, jiter;
00063 doublereal anorm, bnorm;
00064 integer maxit;
00065 doublecomplex shift;
00066 extern int zscal_(integer *, doublecomplex *,
00067 doublecomplex *, integer *);
00068 doublereal tempr;
00069 doublecomplex ctemp2, ctemp3;
00070 logical ilazr2;
00071 doublereal ascale, bscale;
00072 extern doublereal dlamch_(char *);
00073 doublecomplex signbc;
00074 doublereal safmin;
00075 extern int xerbla_(char *, integer *);
00076 doublecomplex eshift;
00077 logical ilschr;
00078 integer icompq, ilastm;
00079 doublecomplex rtdisc;
00080 integer ischur;
00081 extern doublereal zlanhs_(char *, integer *, doublecomplex *, integer *,
00082 doublereal *);
00083 logical ilazro;
00084 integer icompz, ifirst;
00085 extern int zlartg_(doublecomplex *, doublecomplex *,
00086 doublereal *, doublecomplex *, doublecomplex *);
00087 integer ifrstm;
00088 extern int zlaset_(char *, integer *, integer *,
00089 doublecomplex *, doublecomplex *, doublecomplex *, integer *);
00090 integer istart;
00091 logical lquery;
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 h_dim1 = *ldh;
00292 h_offset = 1 + h_dim1;
00293 h__ -= h_offset;
00294 t_dim1 = *ldt;
00295 t_offset = 1 + t_dim1;
00296 t -= t_offset;
00297 --alpha;
00298 --beta;
00299 q_dim1 = *ldq;
00300 q_offset = 1 + q_dim1;
00301 q -= q_offset;
00302 z_dim1 = *ldz;
00303 z_offset = 1 + z_dim1;
00304 z__ -= z_offset;
00305 --work;
00306 --rwork;
00307
00308
00309 if (lsame_(job, "E")) {
00310 ilschr = FALSE_;
00311 ischur = 1;
00312 } else if (lsame_(job, "S")) {
00313 ilschr = TRUE_;
00314 ischur = 2;
00315 } else {
00316 ischur = 0;
00317 }
00318
00319 if (lsame_(compq, "N")) {
00320 ilq = FALSE_;
00321 icompq = 1;
00322 } else if (lsame_(compq, "V")) {
00323 ilq = TRUE_;
00324 icompq = 2;
00325 } else if (lsame_(compq, "I")) {
00326 ilq = TRUE_;
00327 icompq = 3;
00328 } else {
00329 icompq = 0;
00330 }
00331
00332 if (lsame_(compz, "N")) {
00333 ilz = FALSE_;
00334 icompz = 1;
00335 } else if (lsame_(compz, "V")) {
00336 ilz = TRUE_;
00337 icompz = 2;
00338 } else if (lsame_(compz, "I")) {
00339 ilz = TRUE_;
00340 icompz = 3;
00341 } else {
00342 icompz = 0;
00343 }
00344
00345
00346
00347 *info = 0;
00348 i__1 = max(1,*n);
00349 work[1].r = (doublereal) i__1, work[1].i = 0.;
00350 lquery = *lwork == -1;
00351 if (ischur == 0) {
00352 *info = -1;
00353 } else if (icompq == 0) {
00354 *info = -2;
00355 } else if (icompz == 0) {
00356 *info = -3;
00357 } else if (*n < 0) {
00358 *info = -4;
00359 } else if (*ilo < 1) {
00360 *info = -5;
00361 } else if (*ihi > *n || *ihi < *ilo - 1) {
00362 *info = -6;
00363 } else if (*ldh < *n) {
00364 *info = -8;
00365 } else if (*ldt < *n) {
00366 *info = -10;
00367 } else if (*ldq < 1 || ilq && *ldq < *n) {
00368 *info = -14;
00369 } else if (*ldz < 1 || ilz && *ldz < *n) {
00370 *info = -16;
00371 } else if (*lwork < max(1,*n) && ! lquery) {
00372 *info = -18;
00373 }
00374 if (*info != 0) {
00375 i__1 = -(*info);
00376 xerbla_("ZHGEQZ", &i__1);
00377 return 0;
00378 } else if (lquery) {
00379 return 0;
00380 }
00381
00382
00383
00384
00385 if (*n <= 0) {
00386 work[1].r = 1., work[1].i = 0.;
00387 return 0;
00388 }
00389
00390
00391
00392 if (icompq == 3) {
00393 zlaset_("Full", n, n, &c_b1, &c_b2, &q[q_offset], ldq);
00394 }
00395 if (icompz == 3) {
00396 zlaset_("Full", n, n, &c_b1, &c_b2, &z__[z_offset], ldz);
00397 }
00398
00399
00400
00401 in = *ihi + 1 - *ilo;
00402 safmin = dlamch_("S");
00403 ulp = dlamch_("E") * dlamch_("B");
00404 anorm = zlanhs_("F", &in, &h__[*ilo + *ilo * h_dim1], ldh, &rwork[1]);
00405 bnorm = zlanhs_("F", &in, &t[*ilo + *ilo * t_dim1], ldt, &rwork[1]);
00406
00407 d__1 = safmin, d__2 = ulp * anorm;
00408 atol = max(d__1,d__2);
00409
00410 d__1 = safmin, d__2 = ulp * bnorm;
00411 btol = max(d__1,d__2);
00412 ascale = 1. / max(safmin,anorm);
00413 bscale = 1. / max(safmin,bnorm);
00414
00415
00416
00417
00418 i__1 = *n;
00419 for (j = *ihi + 1; j <= i__1; ++j) {
00420 absb = z_abs(&t[j + j * t_dim1]);
00421 if (absb > safmin) {
00422 i__2 = j + j * t_dim1;
00423 z__2.r = t[i__2].r / absb, z__2.i = t[i__2].i / absb;
00424 d_cnjg(&z__1, &z__2);
00425 signbc.r = z__1.r, signbc.i = z__1.i;
00426 i__2 = j + j * t_dim1;
00427 t[i__2].r = absb, t[i__2].i = 0.;
00428 if (ilschr) {
00429 i__2 = j - 1;
00430 zscal_(&i__2, &signbc, &t[j * t_dim1 + 1], &c__1);
00431 zscal_(&j, &signbc, &h__[j * h_dim1 + 1], &c__1);
00432 } else {
00433 i__2 = j + j * h_dim1;
00434 i__3 = j + j * h_dim1;
00435 z__1.r = h__[i__3].r * signbc.r - h__[i__3].i * signbc.i,
00436 z__1.i = h__[i__3].r * signbc.i + h__[i__3].i *
00437 signbc.r;
00438 h__[i__2].r = z__1.r, h__[i__2].i = z__1.i;
00439 }
00440 if (ilz) {
00441 zscal_(n, &signbc, &z__[j * z_dim1 + 1], &c__1);
00442 }
00443 } else {
00444 i__2 = j + j * t_dim1;
00445 t[i__2].r = 0., t[i__2].i = 0.;
00446 }
00447 i__2 = j;
00448 i__3 = j + j * h_dim1;
00449 alpha[i__2].r = h__[i__3].r, alpha[i__2].i = h__[i__3].i;
00450 i__2 = j;
00451 i__3 = j + j * t_dim1;
00452 beta[i__2].r = t[i__3].r, beta[i__2].i = t[i__3].i;
00453
00454 }
00455
00456
00457
00458 if (*ihi < *ilo) {
00459 goto L190;
00460 }
00461
00462
00463
00464
00465
00466
00467
00468
00469
00470
00471
00472
00473
00474
00475
00476
00477 ilast = *ihi;
00478 if (ilschr) {
00479 ifrstm = 1;
00480 ilastm = *n;
00481 } else {
00482 ifrstm = *ilo;
00483 ilastm = *ihi;
00484 }
00485 iiter = 0;
00486 eshift.r = 0., eshift.i = 0.;
00487 maxit = (*ihi - *ilo + 1) * 30;
00488
00489 i__1 = maxit;
00490 for (jiter = 1; jiter <= i__1; ++jiter) {
00491
00492
00493
00494 if (jiter > maxit) {
00495 goto L180;
00496 }
00497
00498
00499
00500
00501
00502
00503
00504
00505
00506 if (ilast == *ilo) {
00507 goto L60;
00508 } else {
00509 i__2 = ilast + (ilast - 1) * h_dim1;
00510 if ((d__1 = h__[i__2].r, abs(d__1)) + (d__2 = d_imag(&h__[ilast +
00511 (ilast - 1) * h_dim1]), abs(d__2)) <= atol) {
00512 i__2 = ilast + (ilast - 1) * h_dim1;
00513 h__[i__2].r = 0., h__[i__2].i = 0.;
00514 goto L60;
00515 }
00516 }
00517
00518 if (z_abs(&t[ilast + ilast * t_dim1]) <= btol) {
00519 i__2 = ilast + ilast * t_dim1;
00520 t[i__2].r = 0., t[i__2].i = 0.;
00521 goto L50;
00522 }
00523
00524
00525
00526 i__2 = *ilo;
00527 for (j = ilast - 1; j >= i__2; --j) {
00528
00529
00530
00531 if (j == *ilo) {
00532 ilazro = TRUE_;
00533 } else {
00534 i__3 = j + (j - 1) * h_dim1;
00535 if ((d__1 = h__[i__3].r, abs(d__1)) + (d__2 = d_imag(&h__[j +
00536 (j - 1) * h_dim1]), abs(d__2)) <= atol) {
00537 i__3 = j + (j - 1) * h_dim1;
00538 h__[i__3].r = 0., h__[i__3].i = 0.;
00539 ilazro = TRUE_;
00540 } else {
00541 ilazro = FALSE_;
00542 }
00543 }
00544
00545
00546
00547 if (z_abs(&t[j + j * t_dim1]) < btol) {
00548 i__3 = j + j * t_dim1;
00549 t[i__3].r = 0., t[i__3].i = 0.;
00550
00551
00552
00553 ilazr2 = FALSE_;
00554 if (! ilazro) {
00555 i__3 = j + (j - 1) * h_dim1;
00556 i__4 = j + 1 + j * h_dim1;
00557 i__5 = j + j * h_dim1;
00558 if (((d__1 = h__[i__3].r, abs(d__1)) + (d__2 = d_imag(&
00559 h__[j + (j - 1) * h_dim1]), abs(d__2))) * (ascale
00560 * ((d__3 = h__[i__4].r, abs(d__3)) + (d__4 =
00561 d_imag(&h__[j + 1 + j * h_dim1]), abs(d__4)))) <=
00562 ((d__5 = h__[i__5].r, abs(d__5)) + (d__6 = d_imag(
00563 &h__[j + j * h_dim1]), abs(d__6))) * (ascale *
00564 atol)) {
00565 ilazr2 = TRUE_;
00566 }
00567 }
00568
00569
00570
00571
00572
00573
00574
00575 if (ilazro || ilazr2) {
00576 i__3 = ilast - 1;
00577 for (jch = j; jch <= i__3; ++jch) {
00578 i__4 = jch + jch * h_dim1;
00579 ctemp.r = h__[i__4].r, ctemp.i = h__[i__4].i;
00580 zlartg_(&ctemp, &h__[jch + 1 + jch * h_dim1], &c__, &
00581 s, &h__[jch + jch * h_dim1]);
00582 i__4 = jch + 1 + jch * h_dim1;
00583 h__[i__4].r = 0., h__[i__4].i = 0.;
00584 i__4 = ilastm - jch;
00585 zrot_(&i__4, &h__[jch + (jch + 1) * h_dim1], ldh, &
00586 h__[jch + 1 + (jch + 1) * h_dim1], ldh, &c__,
00587 &s);
00588 i__4 = ilastm - jch;
00589 zrot_(&i__4, &t[jch + (jch + 1) * t_dim1], ldt, &t[
00590 jch + 1 + (jch + 1) * t_dim1], ldt, &c__, &s);
00591 if (ilq) {
00592 d_cnjg(&z__1, &s);
00593 zrot_(n, &q[jch * q_dim1 + 1], &c__1, &q[(jch + 1)
00594 * q_dim1 + 1], &c__1, &c__, &z__1);
00595 }
00596 if (ilazr2) {
00597 i__4 = jch + (jch - 1) * h_dim1;
00598 i__5 = jch + (jch - 1) * h_dim1;
00599 z__1.r = c__ * h__[i__5].r, z__1.i = c__ * h__[
00600 i__5].i;
00601 h__[i__4].r = z__1.r, h__[i__4].i = z__1.i;
00602 }
00603 ilazr2 = FALSE_;
00604 i__4 = jch + 1 + (jch + 1) * t_dim1;
00605 if ((d__1 = t[i__4].r, abs(d__1)) + (d__2 = d_imag(&t[
00606 jch + 1 + (jch + 1) * t_dim1]), abs(d__2)) >=
00607 btol) {
00608 if (jch + 1 >= ilast) {
00609 goto L60;
00610 } else {
00611 ifirst = jch + 1;
00612 goto L70;
00613 }
00614 }
00615 i__4 = jch + 1 + (jch + 1) * t_dim1;
00616 t[i__4].r = 0., t[i__4].i = 0.;
00617
00618 }
00619 goto L50;
00620 } else {
00621
00622
00623
00624
00625 i__3 = ilast - 1;
00626 for (jch = j; jch <= i__3; ++jch) {
00627 i__4 = jch + (jch + 1) * t_dim1;
00628 ctemp.r = t[i__4].r, ctemp.i = t[i__4].i;
00629 zlartg_(&ctemp, &t[jch + 1 + (jch + 1) * t_dim1], &
00630 c__, &s, &t[jch + (jch + 1) * t_dim1]);
00631 i__4 = jch + 1 + (jch + 1) * t_dim1;
00632 t[i__4].r = 0., t[i__4].i = 0.;
00633 if (jch < ilastm - 1) {
00634 i__4 = ilastm - jch - 1;
00635 zrot_(&i__4, &t[jch + (jch + 2) * t_dim1], ldt, &
00636 t[jch + 1 + (jch + 2) * t_dim1], ldt, &
00637 c__, &s);
00638 }
00639 i__4 = ilastm - jch + 2;
00640 zrot_(&i__4, &h__[jch + (jch - 1) * h_dim1], ldh, &
00641 h__[jch + 1 + (jch - 1) * h_dim1], ldh, &c__,
00642 &s);
00643 if (ilq) {
00644 d_cnjg(&z__1, &s);
00645 zrot_(n, &q[jch * q_dim1 + 1], &c__1, &q[(jch + 1)
00646 * q_dim1 + 1], &c__1, &c__, &z__1);
00647 }
00648 i__4 = jch + 1 + jch * h_dim1;
00649 ctemp.r = h__[i__4].r, ctemp.i = h__[i__4].i;
00650 zlartg_(&ctemp, &h__[jch + 1 + (jch - 1) * h_dim1], &
00651 c__, &s, &h__[jch + 1 + jch * h_dim1]);
00652 i__4 = jch + 1 + (jch - 1) * h_dim1;
00653 h__[i__4].r = 0., h__[i__4].i = 0.;
00654 i__4 = jch + 1 - ifrstm;
00655 zrot_(&i__4, &h__[ifrstm + jch * h_dim1], &c__1, &h__[
00656 ifrstm + (jch - 1) * h_dim1], &c__1, &c__, &s)
00657 ;
00658 i__4 = jch - ifrstm;
00659 zrot_(&i__4, &t[ifrstm + jch * t_dim1], &c__1, &t[
00660 ifrstm + (jch - 1) * t_dim1], &c__1, &c__, &s)
00661 ;
00662 if (ilz) {
00663 zrot_(n, &z__[jch * z_dim1 + 1], &c__1, &z__[(jch
00664 - 1) * z_dim1 + 1], &c__1, &c__, &s);
00665 }
00666
00667 }
00668 goto L50;
00669 }
00670 } else if (ilazro) {
00671
00672
00673
00674 ifirst = j;
00675 goto L70;
00676 }
00677
00678
00679
00680
00681 }
00682
00683
00684
00685 *info = (*n << 1) + 1;
00686 goto L210;
00687
00688
00689
00690
00691 L50:
00692 i__2 = ilast + ilast * h_dim1;
00693 ctemp.r = h__[i__2].r, ctemp.i = h__[i__2].i;
00694 zlartg_(&ctemp, &h__[ilast + (ilast - 1) * h_dim1], &c__, &s, &h__[
00695 ilast + ilast * h_dim1]);
00696 i__2 = ilast + (ilast - 1) * h_dim1;
00697 h__[i__2].r = 0., h__[i__2].i = 0.;
00698 i__2 = ilast - ifrstm;
00699 zrot_(&i__2, &h__[ifrstm + ilast * h_dim1], &c__1, &h__[ifrstm + (
00700 ilast - 1) * h_dim1], &c__1, &c__, &s);
00701 i__2 = ilast - ifrstm;
00702 zrot_(&i__2, &t[ifrstm + ilast * t_dim1], &c__1, &t[ifrstm + (ilast -
00703 1) * t_dim1], &c__1, &c__, &s);
00704 if (ilz) {
00705 zrot_(n, &z__[ilast * z_dim1 + 1], &c__1, &z__[(ilast - 1) *
00706 z_dim1 + 1], &c__1, &c__, &s);
00707 }
00708
00709
00710
00711 L60:
00712 absb = z_abs(&t[ilast + ilast * t_dim1]);
00713 if (absb > safmin) {
00714 i__2 = ilast + ilast * t_dim1;
00715 z__2.r = t[i__2].r / absb, z__2.i = t[i__2].i / absb;
00716 d_cnjg(&z__1, &z__2);
00717 signbc.r = z__1.r, signbc.i = z__1.i;
00718 i__2 = ilast + ilast * t_dim1;
00719 t[i__2].r = absb, t[i__2].i = 0.;
00720 if (ilschr) {
00721 i__2 = ilast - ifrstm;
00722 zscal_(&i__2, &signbc, &t[ifrstm + ilast * t_dim1], &c__1);
00723 i__2 = ilast + 1 - ifrstm;
00724 zscal_(&i__2, &signbc, &h__[ifrstm + ilast * h_dim1], &c__1);
00725 } else {
00726 i__2 = ilast + ilast * h_dim1;
00727 i__3 = ilast + ilast * h_dim1;
00728 z__1.r = h__[i__3].r * signbc.r - h__[i__3].i * signbc.i,
00729 z__1.i = h__[i__3].r * signbc.i + h__[i__3].i *
00730 signbc.r;
00731 h__[i__2].r = z__1.r, h__[i__2].i = z__1.i;
00732 }
00733 if (ilz) {
00734 zscal_(n, &signbc, &z__[ilast * z_dim1 + 1], &c__1);
00735 }
00736 } else {
00737 i__2 = ilast + ilast * t_dim1;
00738 t[i__2].r = 0., t[i__2].i = 0.;
00739 }
00740 i__2 = ilast;
00741 i__3 = ilast + ilast * h_dim1;
00742 alpha[i__2].r = h__[i__3].r, alpha[i__2].i = h__[i__3].i;
00743 i__2 = ilast;
00744 i__3 = ilast + ilast * t_dim1;
00745 beta[i__2].r = t[i__3].r, beta[i__2].i = t[i__3].i;
00746
00747
00748
00749 --ilast;
00750 if (ilast < *ilo) {
00751 goto L190;
00752 }
00753
00754
00755
00756 iiter = 0;
00757 eshift.r = 0., eshift.i = 0.;
00758 if (! ilschr) {
00759 ilastm = ilast;
00760 if (ifrstm > ilast) {
00761 ifrstm = *ilo;
00762 }
00763 }
00764 goto L160;
00765
00766
00767
00768
00769
00770
00771 L70:
00772 ++iiter;
00773 if (! ilschr) {
00774 ifrstm = ifirst;
00775 }
00776
00777
00778
00779
00780
00781
00782
00783 if (iiter / 10 * 10 != iiter) {
00784
00785
00786
00787
00788
00789
00790
00791
00792 i__2 = ilast - 1 + ilast * t_dim1;
00793 z__2.r = bscale * t[i__2].r, z__2.i = bscale * t[i__2].i;
00794 i__3 = ilast + ilast * t_dim1;
00795 z__3.r = bscale * t[i__3].r, z__3.i = bscale * t[i__3].i;
00796 z_div(&z__1, &z__2, &z__3);
00797 u12.r = z__1.r, u12.i = z__1.i;
00798 i__2 = ilast - 1 + (ilast - 1) * h_dim1;
00799 z__2.r = ascale * h__[i__2].r, z__2.i = ascale * h__[i__2].i;
00800 i__3 = ilast - 1 + (ilast - 1) * t_dim1;
00801 z__3.r = bscale * t[i__3].r, z__3.i = bscale * t[i__3].i;
00802 z_div(&z__1, &z__2, &z__3);
00803 ad11.r = z__1.r, ad11.i = z__1.i;
00804 i__2 = ilast + (ilast - 1) * h_dim1;
00805 z__2.r = ascale * h__[i__2].r, z__2.i = ascale * h__[i__2].i;
00806 i__3 = ilast - 1 + (ilast - 1) * t_dim1;
00807 z__3.r = bscale * t[i__3].r, z__3.i = bscale * t[i__3].i;
00808 z_div(&z__1, &z__2, &z__3);
00809 ad21.r = z__1.r, ad21.i = z__1.i;
00810 i__2 = ilast - 1 + ilast * h_dim1;
00811 z__2.r = ascale * h__[i__2].r, z__2.i = ascale * h__[i__2].i;
00812 i__3 = ilast + ilast * t_dim1;
00813 z__3.r = bscale * t[i__3].r, z__3.i = bscale * t[i__3].i;
00814 z_div(&z__1, &z__2, &z__3);
00815 ad12.r = z__1.r, ad12.i = z__1.i;
00816 i__2 = ilast + ilast * h_dim1;
00817 z__2.r = ascale * h__[i__2].r, z__2.i = ascale * h__[i__2].i;
00818 i__3 = ilast + ilast * t_dim1;
00819 z__3.r = bscale * t[i__3].r, z__3.i = bscale * t[i__3].i;
00820 z_div(&z__1, &z__2, &z__3);
00821 ad22.r = z__1.r, ad22.i = z__1.i;
00822 z__2.r = u12.r * ad21.r - u12.i * ad21.i, z__2.i = u12.r * ad21.i
00823 + u12.i * ad21.r;
00824 z__1.r = ad22.r - z__2.r, z__1.i = ad22.i - z__2.i;
00825 abi22.r = z__1.r, abi22.i = z__1.i;
00826
00827 z__2.r = ad11.r + abi22.r, z__2.i = ad11.i + abi22.i;
00828 z__1.r = z__2.r * .5, z__1.i = z__2.i * .5;
00829 t1.r = z__1.r, t1.i = z__1.i;
00830 pow_zi(&z__4, &t1, &c__2);
00831 z__5.r = ad12.r * ad21.r - ad12.i * ad21.i, z__5.i = ad12.r *
00832 ad21.i + ad12.i * ad21.r;
00833 z__3.r = z__4.r + z__5.r, z__3.i = z__4.i + z__5.i;
00834 z__6.r = ad11.r * ad22.r - ad11.i * ad22.i, z__6.i = ad11.r *
00835 ad22.i + ad11.i * ad22.r;
00836 z__2.r = z__3.r - z__6.r, z__2.i = z__3.i - z__6.i;
00837 z_sqrt(&z__1, &z__2);
00838 rtdisc.r = z__1.r, rtdisc.i = z__1.i;
00839 z__1.r = t1.r - abi22.r, z__1.i = t1.i - abi22.i;
00840 z__2.r = t1.r - abi22.r, z__2.i = t1.i - abi22.i;
00841 temp = z__1.r * rtdisc.r + d_imag(&z__2) * d_imag(&rtdisc);
00842 if (temp <= 0.) {
00843 z__1.r = t1.r + rtdisc.r, z__1.i = t1.i + rtdisc.i;
00844 shift.r = z__1.r, shift.i = z__1.i;
00845 } else {
00846 z__1.r = t1.r - rtdisc.r, z__1.i = t1.i - rtdisc.i;
00847 shift.r = z__1.r, shift.i = z__1.i;
00848 }
00849 } else {
00850
00851
00852
00853 i__2 = ilast - 1 + ilast * h_dim1;
00854 z__4.r = ascale * h__[i__2].r, z__4.i = ascale * h__[i__2].i;
00855 i__3 = ilast - 1 + (ilast - 1) * t_dim1;
00856 z__5.r = bscale * t[i__3].r, z__5.i = bscale * t[i__3].i;
00857 z_div(&z__3, &z__4, &z__5);
00858 d_cnjg(&z__2, &z__3);
00859 z__1.r = eshift.r + z__2.r, z__1.i = eshift.i + z__2.i;
00860 eshift.r = z__1.r, eshift.i = z__1.i;
00861 shift.r = eshift.r, shift.i = eshift.i;
00862 }
00863
00864
00865
00866 i__2 = ifirst + 1;
00867 for (j = ilast - 1; j >= i__2; --j) {
00868 istart = j;
00869 i__3 = j + j * h_dim1;
00870 z__2.r = ascale * h__[i__3].r, z__2.i = ascale * h__[i__3].i;
00871 i__4 = j + j * t_dim1;
00872 z__4.r = bscale * t[i__4].r, z__4.i = bscale * t[i__4].i;
00873 z__3.r = shift.r * z__4.r - shift.i * z__4.i, z__3.i = shift.r *
00874 z__4.i + shift.i * z__4.r;
00875 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
00876 ctemp.r = z__1.r, ctemp.i = z__1.i;
00877 temp = (d__1 = ctemp.r, abs(d__1)) + (d__2 = d_imag(&ctemp), abs(
00878 d__2));
00879 i__3 = j + 1 + j * h_dim1;
00880 temp2 = ascale * ((d__1 = h__[i__3].r, abs(d__1)) + (d__2 =
00881 d_imag(&h__[j + 1 + j * h_dim1]), abs(d__2)));
00882 tempr = max(temp,temp2);
00883 if (tempr < 1. && tempr != 0.) {
00884 temp /= tempr;
00885 temp2 /= tempr;
00886 }
00887 i__3 = j + (j - 1) * h_dim1;
00888 if (((d__1 = h__[i__3].r, abs(d__1)) + (d__2 = d_imag(&h__[j + (j
00889 - 1) * h_dim1]), abs(d__2))) * temp2 <= temp * atol) {
00890 goto L90;
00891 }
00892
00893 }
00894
00895 istart = ifirst;
00896 i__2 = ifirst + ifirst * h_dim1;
00897 z__2.r = ascale * h__[i__2].r, z__2.i = ascale * h__[i__2].i;
00898 i__3 = ifirst + ifirst * t_dim1;
00899 z__4.r = bscale * t[i__3].r, z__4.i = bscale * t[i__3].i;
00900 z__3.r = shift.r * z__4.r - shift.i * z__4.i, z__3.i = shift.r *
00901 z__4.i + shift.i * z__4.r;
00902 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
00903 ctemp.r = z__1.r, ctemp.i = z__1.i;
00904 L90:
00905
00906
00907
00908
00909
00910 i__2 = istart + 1 + istart * h_dim1;
00911 z__1.r = ascale * h__[i__2].r, z__1.i = ascale * h__[i__2].i;
00912 ctemp2.r = z__1.r, ctemp2.i = z__1.i;
00913 zlartg_(&ctemp, &ctemp2, &c__, &s, &ctemp3);
00914
00915
00916
00917 i__2 = ilast - 1;
00918 for (j = istart; j <= i__2; ++j) {
00919 if (j > istart) {
00920 i__3 = j + (j - 1) * h_dim1;
00921 ctemp.r = h__[i__3].r, ctemp.i = h__[i__3].i;
00922 zlartg_(&ctemp, &h__[j + 1 + (j - 1) * h_dim1], &c__, &s, &
00923 h__[j + (j - 1) * h_dim1]);
00924 i__3 = j + 1 + (j - 1) * h_dim1;
00925 h__[i__3].r = 0., h__[i__3].i = 0.;
00926 }
00927
00928 i__3 = ilastm;
00929 for (jc = j; jc <= i__3; ++jc) {
00930 i__4 = j + jc * h_dim1;
00931 z__2.r = c__ * h__[i__4].r, z__2.i = c__ * h__[i__4].i;
00932 i__5 = j + 1 + jc * h_dim1;
00933 z__3.r = s.r * h__[i__5].r - s.i * h__[i__5].i, z__3.i = s.r *
00934 h__[i__5].i + s.i * h__[i__5].r;
00935 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
00936 ctemp.r = z__1.r, ctemp.i = z__1.i;
00937 i__4 = j + 1 + jc * h_dim1;
00938 d_cnjg(&z__4, &s);
00939 z__3.r = -z__4.r, z__3.i = -z__4.i;
00940 i__5 = j + jc * h_dim1;
00941 z__2.r = z__3.r * h__[i__5].r - z__3.i * h__[i__5].i, z__2.i =
00942 z__3.r * h__[i__5].i + z__3.i * h__[i__5].r;
00943 i__6 = j + 1 + jc * h_dim1;
00944 z__5.r = c__ * h__[i__6].r, z__5.i = c__ * h__[i__6].i;
00945 z__1.r = z__2.r + z__5.r, z__1.i = z__2.i + z__5.i;
00946 h__[i__4].r = z__1.r, h__[i__4].i = z__1.i;
00947 i__4 = j + jc * h_dim1;
00948 h__[i__4].r = ctemp.r, h__[i__4].i = ctemp.i;
00949 i__4 = j + jc * t_dim1;
00950 z__2.r = c__ * t[i__4].r, z__2.i = c__ * t[i__4].i;
00951 i__5 = j + 1 + jc * t_dim1;
00952 z__3.r = s.r * t[i__5].r - s.i * t[i__5].i, z__3.i = s.r * t[
00953 i__5].i + s.i * t[i__5].r;
00954 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
00955 ctemp2.r = z__1.r, ctemp2.i = z__1.i;
00956 i__4 = j + 1 + jc * t_dim1;
00957 d_cnjg(&z__4, &s);
00958 z__3.r = -z__4.r, z__3.i = -z__4.i;
00959 i__5 = j + jc * t_dim1;
00960 z__2.r = z__3.r * t[i__5].r - z__3.i * t[i__5].i, z__2.i =
00961 z__3.r * t[i__5].i + z__3.i * t[i__5].r;
00962 i__6 = j + 1 + jc * t_dim1;
00963 z__5.r = c__ * t[i__6].r, z__5.i = c__ * t[i__6].i;
00964 z__1.r = z__2.r + z__5.r, z__1.i = z__2.i + z__5.i;
00965 t[i__4].r = z__1.r, t[i__4].i = z__1.i;
00966 i__4 = j + jc * t_dim1;
00967 t[i__4].r = ctemp2.r, t[i__4].i = ctemp2.i;
00968
00969 }
00970 if (ilq) {
00971 i__3 = *n;
00972 for (jr = 1; jr <= i__3; ++jr) {
00973 i__4 = jr + j * q_dim1;
00974 z__2.r = c__ * q[i__4].r, z__2.i = c__ * q[i__4].i;
00975 d_cnjg(&z__4, &s);
00976 i__5 = jr + (j + 1) * q_dim1;
00977 z__3.r = z__4.r * q[i__5].r - z__4.i * q[i__5].i, z__3.i =
00978 z__4.r * q[i__5].i + z__4.i * q[i__5].r;
00979 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
00980 ctemp.r = z__1.r, ctemp.i = z__1.i;
00981 i__4 = jr + (j + 1) * q_dim1;
00982 z__3.r = -s.r, z__3.i = -s.i;
00983 i__5 = jr + j * q_dim1;
00984 z__2.r = z__3.r * q[i__5].r - z__3.i * q[i__5].i, z__2.i =
00985 z__3.r * q[i__5].i + z__3.i * q[i__5].r;
00986 i__6 = jr + (j + 1) * q_dim1;
00987 z__4.r = c__ * q[i__6].r, z__4.i = c__ * q[i__6].i;
00988 z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
00989 q[i__4].r = z__1.r, q[i__4].i = z__1.i;
00990 i__4 = jr + j * q_dim1;
00991 q[i__4].r = ctemp.r, q[i__4].i = ctemp.i;
00992
00993 }
00994 }
00995
00996 i__3 = j + 1 + (j + 1) * t_dim1;
00997 ctemp.r = t[i__3].r, ctemp.i = t[i__3].i;
00998 zlartg_(&ctemp, &t[j + 1 + j * t_dim1], &c__, &s, &t[j + 1 + (j +
00999 1) * t_dim1]);
01000 i__3 = j + 1 + j * t_dim1;
01001 t[i__3].r = 0., t[i__3].i = 0.;
01002
01003
01004 i__4 = j + 2;
01005 i__3 = min(i__4,ilast);
01006 for (jr = ifrstm; jr <= i__3; ++jr) {
01007 i__4 = jr + (j + 1) * h_dim1;
01008 z__2.r = c__ * h__[i__4].r, z__2.i = c__ * h__[i__4].i;
01009 i__5 = jr + j * h_dim1;
01010 z__3.r = s.r * h__[i__5].r - s.i * h__[i__5].i, z__3.i = s.r *
01011 h__[i__5].i + s.i * h__[i__5].r;
01012 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
01013 ctemp.r = z__1.r, ctemp.i = z__1.i;
01014 i__4 = jr + j * h_dim1;
01015 d_cnjg(&z__4, &s);
01016 z__3.r = -z__4.r, z__3.i = -z__4.i;
01017 i__5 = jr + (j + 1) * h_dim1;
01018 z__2.r = z__3.r * h__[i__5].r - z__3.i * h__[i__5].i, z__2.i =
01019 z__3.r * h__[i__5].i + z__3.i * h__[i__5].r;
01020 i__6 = jr + j * h_dim1;
01021 z__5.r = c__ * h__[i__6].r, z__5.i = c__ * h__[i__6].i;
01022 z__1.r = z__2.r + z__5.r, z__1.i = z__2.i + z__5.i;
01023 h__[i__4].r = z__1.r, h__[i__4].i = z__1.i;
01024 i__4 = jr + (j + 1) * h_dim1;
01025 h__[i__4].r = ctemp.r, h__[i__4].i = ctemp.i;
01026
01027 }
01028 i__3 = j;
01029 for (jr = ifrstm; jr <= i__3; ++jr) {
01030 i__4 = jr + (j + 1) * t_dim1;
01031 z__2.r = c__ * t[i__4].r, z__2.i = c__ * t[i__4].i;
01032 i__5 = jr + j * t_dim1;
01033 z__3.r = s.r * t[i__5].r - s.i * t[i__5].i, z__3.i = s.r * t[
01034 i__5].i + s.i * t[i__5].r;
01035 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
01036 ctemp.r = z__1.r, ctemp.i = z__1.i;
01037 i__4 = jr + j * t_dim1;
01038 d_cnjg(&z__4, &s);
01039 z__3.r = -z__4.r, z__3.i = -z__4.i;
01040 i__5 = jr + (j + 1) * t_dim1;
01041 z__2.r = z__3.r * t[i__5].r - z__3.i * t[i__5].i, z__2.i =
01042 z__3.r * t[i__5].i + z__3.i * t[i__5].r;
01043 i__6 = jr + j * t_dim1;
01044 z__5.r = c__ * t[i__6].r, z__5.i = c__ * t[i__6].i;
01045 z__1.r = z__2.r + z__5.r, z__1.i = z__2.i + z__5.i;
01046 t[i__4].r = z__1.r, t[i__4].i = z__1.i;
01047 i__4 = jr + (j + 1) * t_dim1;
01048 t[i__4].r = ctemp.r, t[i__4].i = ctemp.i;
01049
01050 }
01051 if (ilz) {
01052 i__3 = *n;
01053 for (jr = 1; jr <= i__3; ++jr) {
01054 i__4 = jr + (j + 1) * z_dim1;
01055 z__2.r = c__ * z__[i__4].r, z__2.i = c__ * z__[i__4].i;
01056 i__5 = jr + j * z_dim1;
01057 z__3.r = s.r * z__[i__5].r - s.i * z__[i__5].i, z__3.i =
01058 s.r * z__[i__5].i + s.i * z__[i__5].r;
01059 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
01060 ctemp.r = z__1.r, ctemp.i = z__1.i;
01061 i__4 = jr + j * z_dim1;
01062 d_cnjg(&z__4, &s);
01063 z__3.r = -z__4.r, z__3.i = -z__4.i;
01064 i__5 = jr + (j + 1) * z_dim1;
01065 z__2.r = z__3.r * z__[i__5].r - z__3.i * z__[i__5].i,
01066 z__2.i = z__3.r * z__[i__5].i + z__3.i * z__[i__5]
01067 .r;
01068 i__6 = jr + j * z_dim1;
01069 z__5.r = c__ * z__[i__6].r, z__5.i = c__ * z__[i__6].i;
01070 z__1.r = z__2.r + z__5.r, z__1.i = z__2.i + z__5.i;
01071 z__[i__4].r = z__1.r, z__[i__4].i = z__1.i;
01072 i__4 = jr + (j + 1) * z_dim1;
01073 z__[i__4].r = ctemp.r, z__[i__4].i = ctemp.i;
01074
01075 }
01076 }
01077
01078 }
01079
01080 L160:
01081
01082
01083 ;
01084 }
01085
01086
01087
01088 L180:
01089 *info = ilast;
01090 goto L210;
01091
01092
01093
01094 L190:
01095
01096
01097
01098 i__1 = *ilo - 1;
01099 for (j = 1; j <= i__1; ++j) {
01100 absb = z_abs(&t[j + j * t_dim1]);
01101 if (absb > safmin) {
01102 i__2 = j + j * t_dim1;
01103 z__2.r = t[i__2].r / absb, z__2.i = t[i__2].i / absb;
01104 d_cnjg(&z__1, &z__2);
01105 signbc.r = z__1.r, signbc.i = z__1.i;
01106 i__2 = j + j * t_dim1;
01107 t[i__2].r = absb, t[i__2].i = 0.;
01108 if (ilschr) {
01109 i__2 = j - 1;
01110 zscal_(&i__2, &signbc, &t[j * t_dim1 + 1], &c__1);
01111 zscal_(&j, &signbc, &h__[j * h_dim1 + 1], &c__1);
01112 } else {
01113 i__2 = j + j * h_dim1;
01114 i__3 = j + j * h_dim1;
01115 z__1.r = h__[i__3].r * signbc.r - h__[i__3].i * signbc.i,
01116 z__1.i = h__[i__3].r * signbc.i + h__[i__3].i *
01117 signbc.r;
01118 h__[i__2].r = z__1.r, h__[i__2].i = z__1.i;
01119 }
01120 if (ilz) {
01121 zscal_(n, &signbc, &z__[j * z_dim1 + 1], &c__1);
01122 }
01123 } else {
01124 i__2 = j + j * t_dim1;
01125 t[i__2].r = 0., t[i__2].i = 0.;
01126 }
01127 i__2 = j;
01128 i__3 = j + j * h_dim1;
01129 alpha[i__2].r = h__[i__3].r, alpha[i__2].i = h__[i__3].i;
01130 i__2 = j;
01131 i__3 = j + j * t_dim1;
01132 beta[i__2].r = t[i__3].r, beta[i__2].i = t[i__3].i;
01133
01134 }
01135
01136
01137
01138 *info = 0;
01139
01140
01141
01142 L210:
01143 z__1.r = (doublereal) (*n), z__1.i = 0.;
01144 work[1].r = z__1.r, work[1].i = z__1.i;
01145 return 0;
01146
01147
01148
01149 }