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