zhbgst.c
Go to the documentation of this file.
00001 /* zhbgst.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Table of constant values */
00017 
00018 static doublecomplex c_b1 = {0.,0.};
00019 static doublecomplex c_b2 = {1.,0.};
00020 static integer c__1 = 1;
00021 
00022 /* Subroutine */ int zhbgst_(char *vect, char *uplo, integer *n, integer *ka, 
00023         integer *kb, doublecomplex *ab, integer *ldab, doublecomplex *bb, 
00024         integer *ldbb, doublecomplex *x, integer *ldx, doublecomplex *work, 
00025         doublereal *rwork, integer *info)
00026 {
00027     /* System generated locals */
00028     integer ab_dim1, ab_offset, bb_dim1, bb_offset, x_dim1, x_offset, i__1, 
00029             i__2, i__3, i__4, i__5, i__6, i__7, i__8;
00030     doublereal d__1;
00031     doublecomplex z__1, z__2, z__3, z__4, z__5, z__6, z__7, z__8, z__9, z__10;
00032 
00033     /* Builtin functions */
00034     void d_cnjg(doublecomplex *, doublecomplex *);
00035 
00036     /* Local variables */
00037     integer i__, j, k, l, m;
00038     doublecomplex t;
00039     integer i0, i1, i2, j1, j2;
00040     doublecomplex ra;
00041     integer nr, nx, ka1, kb1;
00042     doublecomplex ra1;
00043     integer j1t, j2t;
00044     doublereal bii;
00045     integer kbt, nrt, inca;
00046     extern /* Subroutine */ int zrot_(integer *, doublecomplex *, integer *, 
00047             doublecomplex *, integer *, doublereal *, doublecomplex *);
00048     extern logical lsame_(char *, char *);
00049     extern /* Subroutine */ int zgerc_(integer *, integer *, doublecomplex *, 
00050             doublecomplex *, integer *, doublecomplex *, integer *, 
00051             doublecomplex *, integer *);
00052     logical upper;
00053     extern /* Subroutine */ int zgeru_(integer *, integer *, doublecomplex *, 
00054             doublecomplex *, integer *, doublecomplex *, integer *, 
00055             doublecomplex *, integer *);
00056     logical wantx;
00057     extern /* Subroutine */ int zlar2v_(integer *, doublecomplex *, 
00058             doublecomplex *, doublecomplex *, integer *, doublereal *, 
00059             doublecomplex *, integer *), xerbla_(char *, integer *), 
00060             zdscal_(integer *, doublereal *, doublecomplex *, integer *);
00061     logical update;
00062     extern /* Subroutine */ int zlacgv_(integer *, doublecomplex *, integer *)
00063             , zlaset_(char *, integer *, integer *, doublecomplex *, 
00064             doublecomplex *, doublecomplex *, integer *), zlartg_(
00065             doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, 
00066             doublecomplex *), zlargv_(integer *, doublecomplex *, integer *, 
00067             doublecomplex *, integer *, doublereal *, integer *), zlartv_(
00068             integer *, doublecomplex *, integer *, doublecomplex *, integer *, 
00069              doublereal *, doublecomplex *, integer *);
00070 
00071 
00072 /*  -- LAPACK routine (version 3.2) -- */
00073 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00074 /*     November 2006 */
00075 
00076 /*     .. Scalar Arguments .. */
00077 /*     .. */
00078 /*     .. Array Arguments .. */
00079 /*     .. */
00080 
00081 /*  Purpose */
00082 /*  ======= */
00083 
00084 /*  ZHBGST reduces a complex Hermitian-definite banded generalized */
00085 /*  eigenproblem  A*x = lambda*B*x  to standard form  C*y = lambda*y, */
00086 /*  such that C has the same bandwidth as A. */
00087 
00088 /*  B must have been previously factorized as S**H*S by ZPBSTF, using a */
00089 /*  split Cholesky factorization. A is overwritten by C = X**H*A*X, where */
00090 /*  X = S**(-1)*Q and Q is a unitary matrix chosen to preserve the */
00091 /*  bandwidth of A. */
00092 
00093 /*  Arguments */
00094 /*  ========= */
00095 
00096 /*  VECT    (input) CHARACTER*1 */
00097 /*          = 'N':  do not form the transformation matrix X; */
00098 /*          = 'V':  form X. */
00099 
00100 /*  UPLO    (input) CHARACTER*1 */
00101 /*          = 'U':  Upper triangle of A is stored; */
00102 /*          = 'L':  Lower triangle of A is stored. */
00103 
00104 /*  N       (input) INTEGER */
00105 /*          The order of the matrices A and B.  N >= 0. */
00106 
00107 /*  KA      (input) INTEGER */
00108 /*          The number of superdiagonals of the matrix A if UPLO = 'U', */
00109 /*          or the number of subdiagonals if UPLO = 'L'.  KA >= 0. */
00110 
00111 /*  KB      (input) INTEGER */
00112 /*          The number of superdiagonals of the matrix B if UPLO = 'U', */
00113 /*          or the number of subdiagonals if UPLO = 'L'.  KA >= KB >= 0. */
00114 
00115 /*  AB      (input/output) COMPLEX*16 array, dimension (LDAB,N) */
00116 /*          On entry, the upper or lower triangle of the Hermitian band */
00117 /*          matrix A, stored in the first ka+1 rows of the array.  The */
00118 /*          j-th column of A is stored in the j-th column of the array AB */
00119 /*          as follows: */
00120 /*          if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j; */
00121 /*          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+ka). */
00122 
00123 /*          On exit, the transformed matrix X**H*A*X, stored in the same */
00124 /*          format as A. */
00125 
00126 /*  LDAB    (input) INTEGER */
00127 /*          The leading dimension of the array AB.  LDAB >= KA+1. */
00128 
00129 /*  BB      (input) COMPLEX*16 array, dimension (LDBB,N) */
00130 /*          The banded factor S from the split Cholesky factorization of */
00131 /*          B, as returned by ZPBSTF, stored in the first kb+1 rows of */
00132 /*          the array. */
00133 
00134 /*  LDBB    (input) INTEGER */
00135 /*          The leading dimension of the array BB.  LDBB >= KB+1. */
00136 
00137 /*  X       (output) COMPLEX*16 array, dimension (LDX,N) */
00138 /*          If VECT = 'V', the n-by-n matrix X. */
00139 /*          If VECT = 'N', the array X is not referenced. */
00140 
00141 /*  LDX     (input) INTEGER */
00142 /*          The leading dimension of the array X. */
00143 /*          LDX >= max(1,N) if VECT = 'V'; LDX >= 1 otherwise. */
00144 
00145 /*  WORK    (workspace) COMPLEX*16 array, dimension (N) */
00146 
00147 /*  RWORK   (workspace) DOUBLE PRECISION array, dimension (N) */
00148 
00149 /*  INFO    (output) INTEGER */
00150 /*          = 0:  successful exit */
00151 /*          < 0:  if INFO = -i, the i-th argument had an illegal value. */
00152 
00153 /*  ===================================================================== */
00154 
00155 /*     .. Parameters .. */
00156 /*     .. */
00157 /*     .. Local Scalars .. */
00158 /*     .. */
00159 /*     .. External Functions .. */
00160 /*     .. */
00161 /*     .. External Subroutines .. */
00162 /*     .. */
00163 /*     .. Intrinsic Functions .. */
00164 /*     .. */
00165 /*     .. Executable Statements .. */
00166 
00167 /*     Test the input parameters */
00168 
00169     /* Parameter adjustments */
00170     ab_dim1 = *ldab;
00171     ab_offset = 1 + ab_dim1;
00172     ab -= ab_offset;
00173     bb_dim1 = *ldbb;
00174     bb_offset = 1 + bb_dim1;
00175     bb -= bb_offset;
00176     x_dim1 = *ldx;
00177     x_offset = 1 + x_dim1;
00178     x -= x_offset;
00179     --work;
00180     --rwork;
00181 
00182     /* Function Body */
00183     wantx = lsame_(vect, "V");
00184     upper = lsame_(uplo, "U");
00185     ka1 = *ka + 1;
00186     kb1 = *kb + 1;
00187     *info = 0;
00188     if (! wantx && ! lsame_(vect, "N")) {
00189         *info = -1;
00190     } else if (! upper && ! lsame_(uplo, "L")) {
00191         *info = -2;
00192     } else if (*n < 0) {
00193         *info = -3;
00194     } else if (*ka < 0) {
00195         *info = -4;
00196     } else if (*kb < 0 || *kb > *ka) {
00197         *info = -5;
00198     } else if (*ldab < *ka + 1) {
00199         *info = -7;
00200     } else if (*ldbb < *kb + 1) {
00201         *info = -9;
00202     } else if (*ldx < 1 || wantx && *ldx < max(1,*n)) {
00203         *info = -11;
00204     }
00205     if (*info != 0) {
00206         i__1 = -(*info);
00207         xerbla_("ZHBGST", &i__1);
00208         return 0;
00209     }
00210 
00211 /*     Quick return if possible */
00212 
00213     if (*n == 0) {
00214         return 0;
00215     }
00216 
00217     inca = *ldab * ka1;
00218 
00219 /*     Initialize X to the unit matrix, if needed */
00220 
00221     if (wantx) {
00222         zlaset_("Full", n, n, &c_b1, &c_b2, &x[x_offset], ldx);
00223     }
00224 
00225 /*     Set M to the splitting point m. It must be the same value as is */
00226 /*     used in ZPBSTF. The chosen value allows the arrays WORK and RWORK */
00227 /*     to be of dimension (N). */
00228 
00229     m = (*n + *kb) / 2;
00230 
00231 /*     The routine works in two phases, corresponding to the two halves */
00232 /*     of the split Cholesky factorization of B as S**H*S where */
00233 
00234 /*     S = ( U    ) */
00235 /*         ( M  L ) */
00236 
00237 /*     with U upper triangular of order m, and L lower triangular of */
00238 /*     order n-m. S has the same bandwidth as B. */
00239 
00240 /*     S is treated as a product of elementary matrices: */
00241 
00242 /*     S = S(m)*S(m-1)*...*S(2)*S(1)*S(m+1)*S(m+2)*...*S(n-1)*S(n) */
00243 
00244 /*     where S(i) is determined by the i-th row of S. */
00245 
00246 /*     In phase 1, the index i takes the values n, n-1, ... , m+1; */
00247 /*     in phase 2, it takes the values 1, 2, ... , m. */
00248 
00249 /*     For each value of i, the current matrix A is updated by forming */
00250 /*     inv(S(i))**H*A*inv(S(i)). This creates a triangular bulge outside */
00251 /*     the band of A. The bulge is then pushed down toward the bottom of */
00252 /*     A in phase 1, and up toward the top of A in phase 2, by applying */
00253 /*     plane rotations. */
00254 
00255 /*     There are kb*(kb+1)/2 elements in the bulge, but at most 2*kb-1 */
00256 /*     of them are linearly independent, so annihilating a bulge requires */
00257 /*     only 2*kb-1 plane rotations. The rotations are divided into a 1st */
00258 /*     set of kb-1 rotations, and a 2nd set of kb rotations. */
00259 
00260 /*     Wherever possible, rotations are generated and applied in vector */
00261 /*     operations of length NR between the indices J1 and J2 (sometimes */
00262 /*     replaced by modified values NRT, J1T or J2T). */
00263 
00264 /*     The real cosines and complex sines of the rotations are stored in */
00265 /*     the arrays RWORK and WORK, those of the 1st set in elements */
00266 /*     2:m-kb-1, and those of the 2nd set in elements m-kb+1:n. */
00267 
00268 /*     The bulges are not formed explicitly; nonzero elements outside the */
00269 /*     band are created only when they are required for generating new */
00270 /*     rotations; they are stored in the array WORK, in positions where */
00271 /*     they are later overwritten by the sines of the rotations which */
00272 /*     annihilate them. */
00273 
00274 /*     **************************** Phase 1 ***************************** */
00275 
00276 /*     The logical structure of this phase is: */
00277 
00278 /*     UPDATE = .TRUE. */
00279 /*     DO I = N, M + 1, -1 */
00280 /*        use S(i) to update A and create a new bulge */
00281 /*        apply rotations to push all bulges KA positions downward */
00282 /*     END DO */
00283 /*     UPDATE = .FALSE. */
00284 /*     DO I = M + KA + 1, N - 1 */
00285 /*        apply rotations to push all bulges KA positions downward */
00286 /*     END DO */
00287 
00288 /*     To avoid duplicating code, the two loops are merged. */
00289 
00290     update = TRUE_;
00291     i__ = *n + 1;
00292 L10:
00293     if (update) {
00294         --i__;
00295 /* Computing MIN */
00296         i__1 = *kb, i__2 = i__ - 1;
00297         kbt = min(i__1,i__2);
00298         i0 = i__ - 1;
00299 /* Computing MIN */
00300         i__1 = *n, i__2 = i__ + *ka;
00301         i1 = min(i__1,i__2);
00302         i2 = i__ - kbt + ka1;
00303         if (i__ < m + 1) {
00304             update = FALSE_;
00305             ++i__;
00306             i0 = m;
00307             if (*ka == 0) {
00308                 goto L480;
00309             }
00310             goto L10;
00311         }
00312     } else {
00313         i__ += *ka;
00314         if (i__ > *n - 1) {
00315             goto L480;
00316         }
00317     }
00318 
00319     if (upper) {
00320 
00321 /*        Transform A, working with the upper triangle */
00322 
00323         if (update) {
00324 
00325 /*           Form  inv(S(i))**H * A * inv(S(i)) */
00326 
00327             i__1 = kb1 + i__ * bb_dim1;
00328             bii = bb[i__1].r;
00329             i__1 = ka1 + i__ * ab_dim1;
00330             i__2 = ka1 + i__ * ab_dim1;
00331             d__1 = ab[i__2].r / bii / bii;
00332             ab[i__1].r = d__1, ab[i__1].i = 0.;
00333             i__1 = i1;
00334             for (j = i__ + 1; j <= i__1; ++j) {
00335                 i__2 = i__ - j + ka1 + j * ab_dim1;
00336                 i__3 = i__ - j + ka1 + j * ab_dim1;
00337                 z__1.r = ab[i__3].r / bii, z__1.i = ab[i__3].i / bii;
00338                 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00339 /* L20: */
00340             }
00341 /* Computing MAX */
00342             i__1 = 1, i__2 = i__ - *ka;
00343             i__3 = i__ - 1;
00344             for (j = max(i__1,i__2); j <= i__3; ++j) {
00345                 i__1 = j - i__ + ka1 + i__ * ab_dim1;
00346                 i__2 = j - i__ + ka1 + i__ * ab_dim1;
00347                 z__1.r = ab[i__2].r / bii, z__1.i = ab[i__2].i / bii;
00348                 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00349 /* L30: */
00350             }
00351             i__3 = i__ - 1;
00352             for (k = i__ - kbt; k <= i__3; ++k) {
00353                 i__1 = k;
00354                 for (j = i__ - kbt; j <= i__1; ++j) {
00355                     i__2 = j - k + ka1 + k * ab_dim1;
00356                     i__4 = j - k + ka1 + k * ab_dim1;
00357                     i__5 = j - i__ + kb1 + i__ * bb_dim1;
00358                     d_cnjg(&z__5, &ab[k - i__ + ka1 + i__ * ab_dim1]);
00359                     z__4.r = bb[i__5].r * z__5.r - bb[i__5].i * z__5.i, 
00360                             z__4.i = bb[i__5].r * z__5.i + bb[i__5].i * 
00361                             z__5.r;
00362                     z__3.r = ab[i__4].r - z__4.r, z__3.i = ab[i__4].i - 
00363                             z__4.i;
00364                     d_cnjg(&z__7, &bb[k - i__ + kb1 + i__ * bb_dim1]);
00365                     i__6 = j - i__ + ka1 + i__ * ab_dim1;
00366                     z__6.r = z__7.r * ab[i__6].r - z__7.i * ab[i__6].i, 
00367                             z__6.i = z__7.r * ab[i__6].i + z__7.i * ab[i__6]
00368                             .r;
00369                     z__2.r = z__3.r - z__6.r, z__2.i = z__3.i - z__6.i;
00370                     i__7 = ka1 + i__ * ab_dim1;
00371                     d__1 = ab[i__7].r;
00372                     i__8 = j - i__ + kb1 + i__ * bb_dim1;
00373                     z__9.r = d__1 * bb[i__8].r, z__9.i = d__1 * bb[i__8].i;
00374                     d_cnjg(&z__10, &bb[k - i__ + kb1 + i__ * bb_dim1]);
00375                     z__8.r = z__9.r * z__10.r - z__9.i * z__10.i, z__8.i = 
00376                             z__9.r * z__10.i + z__9.i * z__10.r;
00377                     z__1.r = z__2.r + z__8.r, z__1.i = z__2.i + z__8.i;
00378                     ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00379 /* L40: */
00380                 }
00381 /* Computing MAX */
00382                 i__1 = 1, i__2 = i__ - *ka;
00383                 i__4 = i__ - kbt - 1;
00384                 for (j = max(i__1,i__2); j <= i__4; ++j) {
00385                     i__1 = j - k + ka1 + k * ab_dim1;
00386                     i__2 = j - k + ka1 + k * ab_dim1;
00387                     d_cnjg(&z__3, &bb[k - i__ + kb1 + i__ * bb_dim1]);
00388                     i__5 = j - i__ + ka1 + i__ * ab_dim1;
00389                     z__2.r = z__3.r * ab[i__5].r - z__3.i * ab[i__5].i, 
00390                             z__2.i = z__3.r * ab[i__5].i + z__3.i * ab[i__5]
00391                             .r;
00392                     z__1.r = ab[i__2].r - z__2.r, z__1.i = ab[i__2].i - 
00393                             z__2.i;
00394                     ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00395 /* L50: */
00396                 }
00397 /* L60: */
00398             }
00399             i__3 = i1;
00400             for (j = i__; j <= i__3; ++j) {
00401 /* Computing MAX */
00402                 i__4 = j - *ka, i__1 = i__ - kbt;
00403                 i__2 = i__ - 1;
00404                 for (k = max(i__4,i__1); k <= i__2; ++k) {
00405                     i__4 = k - j + ka1 + j * ab_dim1;
00406                     i__1 = k - j + ka1 + j * ab_dim1;
00407                     i__5 = k - i__ + kb1 + i__ * bb_dim1;
00408                     i__6 = i__ - j + ka1 + j * ab_dim1;
00409                     z__2.r = bb[i__5].r * ab[i__6].r - bb[i__5].i * ab[i__6]
00410                             .i, z__2.i = bb[i__5].r * ab[i__6].i + bb[i__5].i 
00411                             * ab[i__6].r;
00412                     z__1.r = ab[i__1].r - z__2.r, z__1.i = ab[i__1].i - 
00413                             z__2.i;
00414                     ab[i__4].r = z__1.r, ab[i__4].i = z__1.i;
00415 /* L70: */
00416                 }
00417 /* L80: */
00418             }
00419 
00420             if (wantx) {
00421 
00422 /*              post-multiply X by inv(S(i)) */
00423 
00424                 i__3 = *n - m;
00425                 d__1 = 1. / bii;
00426                 zdscal_(&i__3, &d__1, &x[m + 1 + i__ * x_dim1], &c__1);
00427                 if (kbt > 0) {
00428                     i__3 = *n - m;
00429                     z__1.r = -1., z__1.i = -0.;
00430                     zgerc_(&i__3, &kbt, &z__1, &x[m + 1 + i__ * x_dim1], &
00431                             c__1, &bb[kb1 - kbt + i__ * bb_dim1], &c__1, &x[m 
00432                             + 1 + (i__ - kbt) * x_dim1], ldx);
00433                 }
00434             }
00435 
00436 /*           store a(i,i1) in RA1 for use in next loop over K */
00437 
00438             i__3 = i__ - i1 + ka1 + i1 * ab_dim1;
00439             ra1.r = ab[i__3].r, ra1.i = ab[i__3].i;
00440         }
00441 
00442 /*        Generate and apply vectors of rotations to chase all the */
00443 /*        existing bulges KA positions down toward the bottom of the */
00444 /*        band */
00445 
00446         i__3 = *kb - 1;
00447         for (k = 1; k <= i__3; ++k) {
00448             if (update) {
00449 
00450 /*              Determine the rotations which would annihilate the bulge */
00451 /*              which has in theory just been created */
00452 
00453                 if (i__ - k + *ka < *n && i__ - k > 1) {
00454 
00455 /*                 generate rotation to annihilate a(i,i-k+ka+1) */
00456 
00457                     zlartg_(&ab[k + 1 + (i__ - k + *ka) * ab_dim1], &ra1, &
00458                             rwork[i__ - k + *ka - m], &work[i__ - k + *ka - m]
00459 , &ra);
00460 
00461 /*                 create nonzero element a(i-k,i-k+ka+1) outside the */
00462 /*                 band and store it in WORK(i-k) */
00463 
00464                     i__2 = kb1 - k + i__ * bb_dim1;
00465                     z__2.r = -bb[i__2].r, z__2.i = -bb[i__2].i;
00466                     z__1.r = z__2.r * ra1.r - z__2.i * ra1.i, z__1.i = z__2.r 
00467                             * ra1.i + z__2.i * ra1.r;
00468                     t.r = z__1.r, t.i = z__1.i;
00469                     i__2 = i__ - k;
00470                     i__4 = i__ - k + *ka - m;
00471                     z__2.r = rwork[i__4] * t.r, z__2.i = rwork[i__4] * t.i;
00472                     d_cnjg(&z__4, &work[i__ - k + *ka - m]);
00473                     i__1 = (i__ - k + *ka) * ab_dim1 + 1;
00474                     z__3.r = z__4.r * ab[i__1].r - z__4.i * ab[i__1].i, 
00475                             z__3.i = z__4.r * ab[i__1].i + z__4.i * ab[i__1]
00476                             .r;
00477                     z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
00478                     work[i__2].r = z__1.r, work[i__2].i = z__1.i;
00479                     i__2 = (i__ - k + *ka) * ab_dim1 + 1;
00480                     i__4 = i__ - k + *ka - m;
00481                     z__2.r = work[i__4].r * t.r - work[i__4].i * t.i, z__2.i =
00482                              work[i__4].r * t.i + work[i__4].i * t.r;
00483                     i__1 = i__ - k + *ka - m;
00484                     i__5 = (i__ - k + *ka) * ab_dim1 + 1;
00485                     z__3.r = rwork[i__1] * ab[i__5].r, z__3.i = rwork[i__1] * 
00486                             ab[i__5].i;
00487                     z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
00488                     ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00489                     ra1.r = ra.r, ra1.i = ra.i;
00490                 }
00491             }
00492 /* Computing MAX */
00493             i__2 = 1, i__4 = k - i0 + 2;
00494             j2 = i__ - k - 1 + max(i__2,i__4) * ka1;
00495             nr = (*n - j2 + *ka) / ka1;
00496             j1 = j2 + (nr - 1) * ka1;
00497             if (update) {
00498 /* Computing MAX */
00499                 i__2 = j2, i__4 = i__ + (*ka << 1) - k + 1;
00500                 j2t = max(i__2,i__4);
00501             } else {
00502                 j2t = j2;
00503             }
00504             nrt = (*n - j2t + *ka) / ka1;
00505             i__2 = j1;
00506             i__4 = ka1;
00507             for (j = j2t; i__4 < 0 ? j >= i__2 : j <= i__2; j += i__4) {
00508 
00509 /*              create nonzero element a(j-ka,j+1) outside the band */
00510 /*              and store it in WORK(j-m) */
00511 
00512                 i__1 = j - m;
00513                 i__5 = j - m;
00514                 i__6 = (j + 1) * ab_dim1 + 1;
00515                 z__1.r = work[i__5].r * ab[i__6].r - work[i__5].i * ab[i__6]
00516                         .i, z__1.i = work[i__5].r * ab[i__6].i + work[i__5].i 
00517                         * ab[i__6].r;
00518                 work[i__1].r = z__1.r, work[i__1].i = z__1.i;
00519                 i__1 = (j + 1) * ab_dim1 + 1;
00520                 i__5 = j - m;
00521                 i__6 = (j + 1) * ab_dim1 + 1;
00522                 z__1.r = rwork[i__5] * ab[i__6].r, z__1.i = rwork[i__5] * ab[
00523                         i__6].i;
00524                 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00525 /* L90: */
00526             }
00527 
00528 /*           generate rotations in 1st set to annihilate elements which */
00529 /*           have been created outside the band */
00530 
00531             if (nrt > 0) {
00532                 zlargv_(&nrt, &ab[j2t * ab_dim1 + 1], &inca, &work[j2t - m], &
00533                         ka1, &rwork[j2t - m], &ka1);
00534             }
00535             if (nr > 0) {
00536 
00537 /*              apply rotations in 1st set from the right */
00538 
00539                 i__4 = *ka - 1;
00540                 for (l = 1; l <= i__4; ++l) {
00541                     zlartv_(&nr, &ab[ka1 - l + j2 * ab_dim1], &inca, &ab[*ka 
00542                             - l + (j2 + 1) * ab_dim1], &inca, &rwork[j2 - m], 
00543                             &work[j2 - m], &ka1);
00544 /* L100: */
00545                 }
00546 
00547 /*              apply rotations in 1st set from both sides to diagonal */
00548 /*              blocks */
00549 
00550                 zlar2v_(&nr, &ab[ka1 + j2 * ab_dim1], &ab[ka1 + (j2 + 1) * 
00551                         ab_dim1], &ab[*ka + (j2 + 1) * ab_dim1], &inca, &
00552                         rwork[j2 - m], &work[j2 - m], &ka1);
00553 
00554                 zlacgv_(&nr, &work[j2 - m], &ka1);
00555             }
00556 
00557 /*           start applying rotations in 1st set from the left */
00558 
00559             i__4 = *kb - k + 1;
00560             for (l = *ka - 1; l >= i__4; --l) {
00561                 nrt = (*n - j2 + l) / ka1;
00562                 if (nrt > 0) {
00563                     zlartv_(&nrt, &ab[l + (j2 + ka1 - l) * ab_dim1], &inca, &
00564                             ab[l + 1 + (j2 + ka1 - l) * ab_dim1], &inca, &
00565                             rwork[j2 - m], &work[j2 - m], &ka1);
00566                 }
00567 /* L110: */
00568             }
00569 
00570             if (wantx) {
00571 
00572 /*              post-multiply X by product of rotations in 1st set */
00573 
00574                 i__4 = j1;
00575                 i__2 = ka1;
00576                 for (j = j2; i__2 < 0 ? j >= i__4 : j <= i__4; j += i__2) {
00577                     i__1 = *n - m;
00578                     d_cnjg(&z__1, &work[j - m]);
00579                     zrot_(&i__1, &x[m + 1 + j * x_dim1], &c__1, &x[m + 1 + (j 
00580                             + 1) * x_dim1], &c__1, &rwork[j - m], &z__1);
00581 /* L120: */
00582                 }
00583             }
00584 /* L130: */
00585         }
00586 
00587         if (update) {
00588             if (i2 <= *n && kbt > 0) {
00589 
00590 /*              create nonzero element a(i-kbt,i-kbt+ka+1) outside the */
00591 /*              band and store it in WORK(i-kbt) */
00592 
00593                 i__3 = i__ - kbt;
00594                 i__2 = kb1 - kbt + i__ * bb_dim1;
00595                 z__2.r = -bb[i__2].r, z__2.i = -bb[i__2].i;
00596                 z__1.r = z__2.r * ra1.r - z__2.i * ra1.i, z__1.i = z__2.r * 
00597                         ra1.i + z__2.i * ra1.r;
00598                 work[i__3].r = z__1.r, work[i__3].i = z__1.i;
00599             }
00600         }
00601 
00602         for (k = *kb; k >= 1; --k) {
00603             if (update) {
00604 /* Computing MAX */
00605                 i__3 = 2, i__2 = k - i0 + 1;
00606                 j2 = i__ - k - 1 + max(i__3,i__2) * ka1;
00607             } else {
00608 /* Computing MAX */
00609                 i__3 = 1, i__2 = k - i0 + 1;
00610                 j2 = i__ - k - 1 + max(i__3,i__2) * ka1;
00611             }
00612 
00613 /*           finish applying rotations in 2nd set from the left */
00614 
00615             for (l = *kb - k; l >= 1; --l) {
00616                 nrt = (*n - j2 + *ka + l) / ka1;
00617                 if (nrt > 0) {
00618                     zlartv_(&nrt, &ab[l + (j2 - l + 1) * ab_dim1], &inca, &ab[
00619                             l + 1 + (j2 - l + 1) * ab_dim1], &inca, &rwork[j2 
00620                             - *ka], &work[j2 - *ka], &ka1);
00621                 }
00622 /* L140: */
00623             }
00624             nr = (*n - j2 + *ka) / ka1;
00625             j1 = j2 + (nr - 1) * ka1;
00626             i__3 = j2;
00627             i__2 = -ka1;
00628             for (j = j1; i__2 < 0 ? j >= i__3 : j <= i__3; j += i__2) {
00629                 i__4 = j;
00630                 i__1 = j - *ka;
00631                 work[i__4].r = work[i__1].r, work[i__4].i = work[i__1].i;
00632                 rwork[j] = rwork[j - *ka];
00633 /* L150: */
00634             }
00635             i__2 = j1;
00636             i__3 = ka1;
00637             for (j = j2; i__3 < 0 ? j >= i__2 : j <= i__2; j += i__3) {
00638 
00639 /*              create nonzero element a(j-ka,j+1) outside the band */
00640 /*              and store it in WORK(j) */
00641 
00642                 i__4 = j;
00643                 i__1 = j;
00644                 i__5 = (j + 1) * ab_dim1 + 1;
00645                 z__1.r = work[i__1].r * ab[i__5].r - work[i__1].i * ab[i__5]
00646                         .i, z__1.i = work[i__1].r * ab[i__5].i + work[i__1].i 
00647                         * ab[i__5].r;
00648                 work[i__4].r = z__1.r, work[i__4].i = z__1.i;
00649                 i__4 = (j + 1) * ab_dim1 + 1;
00650                 i__1 = j;
00651                 i__5 = (j + 1) * ab_dim1 + 1;
00652                 z__1.r = rwork[i__1] * ab[i__5].r, z__1.i = rwork[i__1] * ab[
00653                         i__5].i;
00654                 ab[i__4].r = z__1.r, ab[i__4].i = z__1.i;
00655 /* L160: */
00656             }
00657             if (update) {
00658                 if (i__ - k < *n - *ka && k <= kbt) {
00659                     i__3 = i__ - k + *ka;
00660                     i__2 = i__ - k;
00661                     work[i__3].r = work[i__2].r, work[i__3].i = work[i__2].i;
00662                 }
00663             }
00664 /* L170: */
00665         }
00666 
00667         for (k = *kb; k >= 1; --k) {
00668 /* Computing MAX */
00669             i__3 = 1, i__2 = k - i0 + 1;
00670             j2 = i__ - k - 1 + max(i__3,i__2) * ka1;
00671             nr = (*n - j2 + *ka) / ka1;
00672             j1 = j2 + (nr - 1) * ka1;
00673             if (nr > 0) {
00674 
00675 /*              generate rotations in 2nd set to annihilate elements */
00676 /*              which have been created outside the band */
00677 
00678                 zlargv_(&nr, &ab[j2 * ab_dim1 + 1], &inca, &work[j2], &ka1, &
00679                         rwork[j2], &ka1);
00680 
00681 /*              apply rotations in 2nd set from the right */
00682 
00683                 i__3 = *ka - 1;
00684                 for (l = 1; l <= i__3; ++l) {
00685                     zlartv_(&nr, &ab[ka1 - l + j2 * ab_dim1], &inca, &ab[*ka 
00686                             - l + (j2 + 1) * ab_dim1], &inca, &rwork[j2], &
00687                             work[j2], &ka1);
00688 /* L180: */
00689                 }
00690 
00691 /*              apply rotations in 2nd set from both sides to diagonal */
00692 /*              blocks */
00693 
00694                 zlar2v_(&nr, &ab[ka1 + j2 * ab_dim1], &ab[ka1 + (j2 + 1) * 
00695                         ab_dim1], &ab[*ka + (j2 + 1) * ab_dim1], &inca, &
00696                         rwork[j2], &work[j2], &ka1);
00697 
00698                 zlacgv_(&nr, &work[j2], &ka1);
00699             }
00700 
00701 /*           start applying rotations in 2nd set from the left */
00702 
00703             i__3 = *kb - k + 1;
00704             for (l = *ka - 1; l >= i__3; --l) {
00705                 nrt = (*n - j2 + l) / ka1;
00706                 if (nrt > 0) {
00707                     zlartv_(&nrt, &ab[l + (j2 + ka1 - l) * ab_dim1], &inca, &
00708                             ab[l + 1 + (j2 + ka1 - l) * ab_dim1], &inca, &
00709                             rwork[j2], &work[j2], &ka1);
00710                 }
00711 /* L190: */
00712             }
00713 
00714             if (wantx) {
00715 
00716 /*              post-multiply X by product of rotations in 2nd set */
00717 
00718                 i__3 = j1;
00719                 i__2 = ka1;
00720                 for (j = j2; i__2 < 0 ? j >= i__3 : j <= i__3; j += i__2) {
00721                     i__4 = *n - m;
00722                     d_cnjg(&z__1, &work[j]);
00723                     zrot_(&i__4, &x[m + 1 + j * x_dim1], &c__1, &x[m + 1 + (j 
00724                             + 1) * x_dim1], &c__1, &rwork[j], &z__1);
00725 /* L200: */
00726                 }
00727             }
00728 /* L210: */
00729         }
00730 
00731         i__2 = *kb - 1;
00732         for (k = 1; k <= i__2; ++k) {
00733 /* Computing MAX */
00734             i__3 = 1, i__4 = k - i0 + 2;
00735             j2 = i__ - k - 1 + max(i__3,i__4) * ka1;
00736 
00737 /*           finish applying rotations in 1st set from the left */
00738 
00739             for (l = *kb - k; l >= 1; --l) {
00740                 nrt = (*n - j2 + l) / ka1;
00741                 if (nrt > 0) {
00742                     zlartv_(&nrt, &ab[l + (j2 + ka1 - l) * ab_dim1], &inca, &
00743                             ab[l + 1 + (j2 + ka1 - l) * ab_dim1], &inca, &
00744                             rwork[j2 - m], &work[j2 - m], &ka1);
00745                 }
00746 /* L220: */
00747             }
00748 /* L230: */
00749         }
00750 
00751         if (*kb > 1) {
00752             i__2 = i2 + *ka;
00753             for (j = *n - 1; j >= i__2; --j) {
00754                 rwork[j - m] = rwork[j - *ka - m];
00755                 i__3 = j - m;
00756                 i__4 = j - *ka - m;
00757                 work[i__3].r = work[i__4].r, work[i__3].i = work[i__4].i;
00758 /* L240: */
00759             }
00760         }
00761 
00762     } else {
00763 
00764 /*        Transform A, working with the lower triangle */
00765 
00766         if (update) {
00767 
00768 /*           Form  inv(S(i))**H * A * inv(S(i)) */
00769 
00770             i__2 = i__ * bb_dim1 + 1;
00771             bii = bb[i__2].r;
00772             i__2 = i__ * ab_dim1 + 1;
00773             i__3 = i__ * ab_dim1 + 1;
00774             d__1 = ab[i__3].r / bii / bii;
00775             ab[i__2].r = d__1, ab[i__2].i = 0.;
00776             i__2 = i1;
00777             for (j = i__ + 1; j <= i__2; ++j) {
00778                 i__3 = j - i__ + 1 + i__ * ab_dim1;
00779                 i__4 = j - i__ + 1 + i__ * ab_dim1;
00780                 z__1.r = ab[i__4].r / bii, z__1.i = ab[i__4].i / bii;
00781                 ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
00782 /* L250: */
00783             }
00784 /* Computing MAX */
00785             i__2 = 1, i__3 = i__ - *ka;
00786             i__4 = i__ - 1;
00787             for (j = max(i__2,i__3); j <= i__4; ++j) {
00788                 i__2 = i__ - j + 1 + j * ab_dim1;
00789                 i__3 = i__ - j + 1 + j * ab_dim1;
00790                 z__1.r = ab[i__3].r / bii, z__1.i = ab[i__3].i / bii;
00791                 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00792 /* L260: */
00793             }
00794             i__4 = i__ - 1;
00795             for (k = i__ - kbt; k <= i__4; ++k) {
00796                 i__2 = k;
00797                 for (j = i__ - kbt; j <= i__2; ++j) {
00798                     i__3 = k - j + 1 + j * ab_dim1;
00799                     i__1 = k - j + 1 + j * ab_dim1;
00800                     i__5 = i__ - j + 1 + j * bb_dim1;
00801                     d_cnjg(&z__5, &ab[i__ - k + 1 + k * ab_dim1]);
00802                     z__4.r = bb[i__5].r * z__5.r - bb[i__5].i * z__5.i, 
00803                             z__4.i = bb[i__5].r * z__5.i + bb[i__5].i * 
00804                             z__5.r;
00805                     z__3.r = ab[i__1].r - z__4.r, z__3.i = ab[i__1].i - 
00806                             z__4.i;
00807                     d_cnjg(&z__7, &bb[i__ - k + 1 + k * bb_dim1]);
00808                     i__6 = i__ - j + 1 + j * ab_dim1;
00809                     z__6.r = z__7.r * ab[i__6].r - z__7.i * ab[i__6].i, 
00810                             z__6.i = z__7.r * ab[i__6].i + z__7.i * ab[i__6]
00811                             .r;
00812                     z__2.r = z__3.r - z__6.r, z__2.i = z__3.i - z__6.i;
00813                     i__7 = i__ * ab_dim1 + 1;
00814                     d__1 = ab[i__7].r;
00815                     i__8 = i__ - j + 1 + j * bb_dim1;
00816                     z__9.r = d__1 * bb[i__8].r, z__9.i = d__1 * bb[i__8].i;
00817                     d_cnjg(&z__10, &bb[i__ - k + 1 + k * bb_dim1]);
00818                     z__8.r = z__9.r * z__10.r - z__9.i * z__10.i, z__8.i = 
00819                             z__9.r * z__10.i + z__9.i * z__10.r;
00820                     z__1.r = z__2.r + z__8.r, z__1.i = z__2.i + z__8.i;
00821                     ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
00822 /* L270: */
00823                 }
00824 /* Computing MAX */
00825                 i__2 = 1, i__3 = i__ - *ka;
00826                 i__1 = i__ - kbt - 1;
00827                 for (j = max(i__2,i__3); j <= i__1; ++j) {
00828                     i__2 = k - j + 1 + j * ab_dim1;
00829                     i__3 = k - j + 1 + j * ab_dim1;
00830                     d_cnjg(&z__3, &bb[i__ - k + 1 + k * bb_dim1]);
00831                     i__5 = i__ - j + 1 + j * ab_dim1;
00832                     z__2.r = z__3.r * ab[i__5].r - z__3.i * ab[i__5].i, 
00833                             z__2.i = z__3.r * ab[i__5].i + z__3.i * ab[i__5]
00834                             .r;
00835                     z__1.r = ab[i__3].r - z__2.r, z__1.i = ab[i__3].i - 
00836                             z__2.i;
00837                     ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00838 /* L280: */
00839                 }
00840 /* L290: */
00841             }
00842             i__4 = i1;
00843             for (j = i__; j <= i__4; ++j) {
00844 /* Computing MAX */
00845                 i__1 = j - *ka, i__2 = i__ - kbt;
00846                 i__3 = i__ - 1;
00847                 for (k = max(i__1,i__2); k <= i__3; ++k) {
00848                     i__1 = j - k + 1 + k * ab_dim1;
00849                     i__2 = j - k + 1 + k * ab_dim1;
00850                     i__5 = i__ - k + 1 + k * bb_dim1;
00851                     i__6 = j - i__ + 1 + i__ * ab_dim1;
00852                     z__2.r = bb[i__5].r * ab[i__6].r - bb[i__5].i * ab[i__6]
00853                             .i, z__2.i = bb[i__5].r * ab[i__6].i + bb[i__5].i 
00854                             * ab[i__6].r;
00855                     z__1.r = ab[i__2].r - z__2.r, z__1.i = ab[i__2].i - 
00856                             z__2.i;
00857                     ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00858 /* L300: */
00859                 }
00860 /* L310: */
00861             }
00862 
00863             if (wantx) {
00864 
00865 /*              post-multiply X by inv(S(i)) */
00866 
00867                 i__4 = *n - m;
00868                 d__1 = 1. / bii;
00869                 zdscal_(&i__4, &d__1, &x[m + 1 + i__ * x_dim1], &c__1);
00870                 if (kbt > 0) {
00871                     i__4 = *n - m;
00872                     z__1.r = -1., z__1.i = -0.;
00873                     i__3 = *ldbb - 1;
00874                     zgeru_(&i__4, &kbt, &z__1, &x[m + 1 + i__ * x_dim1], &
00875                             c__1, &bb[kbt + 1 + (i__ - kbt) * bb_dim1], &i__3, 
00876                              &x[m + 1 + (i__ - kbt) * x_dim1], ldx);
00877                 }
00878             }
00879 
00880 /*           store a(i1,i) in RA1 for use in next loop over K */
00881 
00882             i__4 = i1 - i__ + 1 + i__ * ab_dim1;
00883             ra1.r = ab[i__4].r, ra1.i = ab[i__4].i;
00884         }
00885 
00886 /*        Generate and apply vectors of rotations to chase all the */
00887 /*        existing bulges KA positions down toward the bottom of the */
00888 /*        band */
00889 
00890         i__4 = *kb - 1;
00891         for (k = 1; k <= i__4; ++k) {
00892             if (update) {
00893 
00894 /*              Determine the rotations which would annihilate the bulge */
00895 /*              which has in theory just been created */
00896 
00897                 if (i__ - k + *ka < *n && i__ - k > 1) {
00898 
00899 /*                 generate rotation to annihilate a(i-k+ka+1,i) */
00900 
00901                     zlartg_(&ab[ka1 - k + i__ * ab_dim1], &ra1, &rwork[i__ - 
00902                             k + *ka - m], &work[i__ - k + *ka - m], &ra);
00903 
00904 /*                 create nonzero element a(i-k+ka+1,i-k) outside the */
00905 /*                 band and store it in WORK(i-k) */
00906 
00907                     i__3 = k + 1 + (i__ - k) * bb_dim1;
00908                     z__2.r = -bb[i__3].r, z__2.i = -bb[i__3].i;
00909                     z__1.r = z__2.r * ra1.r - z__2.i * ra1.i, z__1.i = z__2.r 
00910                             * ra1.i + z__2.i * ra1.r;
00911                     t.r = z__1.r, t.i = z__1.i;
00912                     i__3 = i__ - k;
00913                     i__1 = i__ - k + *ka - m;
00914                     z__2.r = rwork[i__1] * t.r, z__2.i = rwork[i__1] * t.i;
00915                     d_cnjg(&z__4, &work[i__ - k + *ka - m]);
00916                     i__2 = ka1 + (i__ - k) * ab_dim1;
00917                     z__3.r = z__4.r * ab[i__2].r - z__4.i * ab[i__2].i, 
00918                             z__3.i = z__4.r * ab[i__2].i + z__4.i * ab[i__2]
00919                             .r;
00920                     z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
00921                     work[i__3].r = z__1.r, work[i__3].i = z__1.i;
00922                     i__3 = ka1 + (i__ - k) * ab_dim1;
00923                     i__1 = i__ - k + *ka - m;
00924                     z__2.r = work[i__1].r * t.r - work[i__1].i * t.i, z__2.i =
00925                              work[i__1].r * t.i + work[i__1].i * t.r;
00926                     i__2 = i__ - k + *ka - m;
00927                     i__5 = ka1 + (i__ - k) * ab_dim1;
00928                     z__3.r = rwork[i__2] * ab[i__5].r, z__3.i = rwork[i__2] * 
00929                             ab[i__5].i;
00930                     z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
00931                     ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
00932                     ra1.r = ra.r, ra1.i = ra.i;
00933                 }
00934             }
00935 /* Computing MAX */
00936             i__3 = 1, i__1 = k - i0 + 2;
00937             j2 = i__ - k - 1 + max(i__3,i__1) * ka1;
00938             nr = (*n - j2 + *ka) / ka1;
00939             j1 = j2 + (nr - 1) * ka1;
00940             if (update) {
00941 /* Computing MAX */
00942                 i__3 = j2, i__1 = i__ + (*ka << 1) - k + 1;
00943                 j2t = max(i__3,i__1);
00944             } else {
00945                 j2t = j2;
00946             }
00947             nrt = (*n - j2t + *ka) / ka1;
00948             i__3 = j1;
00949             i__1 = ka1;
00950             for (j = j2t; i__1 < 0 ? j >= i__3 : j <= i__3; j += i__1) {
00951 
00952 /*              create nonzero element a(j+1,j-ka) outside the band */
00953 /*              and store it in WORK(j-m) */
00954 
00955                 i__2 = j - m;
00956                 i__5 = j - m;
00957                 i__6 = ka1 + (j - *ka + 1) * ab_dim1;
00958                 z__1.r = work[i__5].r * ab[i__6].r - work[i__5].i * ab[i__6]
00959                         .i, z__1.i = work[i__5].r * ab[i__6].i + work[i__5].i 
00960                         * ab[i__6].r;
00961                 work[i__2].r = z__1.r, work[i__2].i = z__1.i;
00962                 i__2 = ka1 + (j - *ka + 1) * ab_dim1;
00963                 i__5 = j - m;
00964                 i__6 = ka1 + (j - *ka + 1) * ab_dim1;
00965                 z__1.r = rwork[i__5] * ab[i__6].r, z__1.i = rwork[i__5] * ab[
00966                         i__6].i;
00967                 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00968 /* L320: */
00969             }
00970 
00971 /*           generate rotations in 1st set to annihilate elements which */
00972 /*           have been created outside the band */
00973 
00974             if (nrt > 0) {
00975                 zlargv_(&nrt, &ab[ka1 + (j2t - *ka) * ab_dim1], &inca, &work[
00976                         j2t - m], &ka1, &rwork[j2t - m], &ka1);
00977             }
00978             if (nr > 0) {
00979 
00980 /*              apply rotations in 1st set from the left */
00981 
00982                 i__1 = *ka - 1;
00983                 for (l = 1; l <= i__1; ++l) {
00984                     zlartv_(&nr, &ab[l + 1 + (j2 - l) * ab_dim1], &inca, &ab[
00985                             l + 2 + (j2 - l) * ab_dim1], &inca, &rwork[j2 - m]
00986 , &work[j2 - m], &ka1);
00987 /* L330: */
00988                 }
00989 
00990 /*              apply rotations in 1st set from both sides to diagonal */
00991 /*              blocks */
00992 
00993                 zlar2v_(&nr, &ab[j2 * ab_dim1 + 1], &ab[(j2 + 1) * ab_dim1 + 
00994                         1], &ab[j2 * ab_dim1 + 2], &inca, &rwork[j2 - m], &
00995                         work[j2 - m], &ka1);
00996 
00997                 zlacgv_(&nr, &work[j2 - m], &ka1);
00998             }
00999 
01000 /*           start applying rotations in 1st set from the right */
01001 
01002             i__1 = *kb - k + 1;
01003             for (l = *ka - 1; l >= i__1; --l) {
01004                 nrt = (*n - j2 + l) / ka1;
01005                 if (nrt > 0) {
01006                     zlartv_(&nrt, &ab[ka1 - l + 1 + j2 * ab_dim1], &inca, &ab[
01007                             ka1 - l + (j2 + 1) * ab_dim1], &inca, &rwork[j2 - 
01008                             m], &work[j2 - m], &ka1);
01009                 }
01010 /* L340: */
01011             }
01012 
01013             if (wantx) {
01014 
01015 /*              post-multiply X by product of rotations in 1st set */
01016 
01017                 i__1 = j1;
01018                 i__3 = ka1;
01019                 for (j = j2; i__3 < 0 ? j >= i__1 : j <= i__1; j += i__3) {
01020                     i__2 = *n - m;
01021                     zrot_(&i__2, &x[m + 1 + j * x_dim1], &c__1, &x[m + 1 + (j 
01022                             + 1) * x_dim1], &c__1, &rwork[j - m], &work[j - m]
01023 );
01024 /* L350: */
01025                 }
01026             }
01027 /* L360: */
01028         }
01029 
01030         if (update) {
01031             if (i2 <= *n && kbt > 0) {
01032 
01033 /*              create nonzero element a(i-kbt+ka+1,i-kbt) outside the */
01034 /*              band and store it in WORK(i-kbt) */
01035 
01036                 i__4 = i__ - kbt;
01037                 i__3 = kbt + 1 + (i__ - kbt) * bb_dim1;
01038                 z__2.r = -bb[i__3].r, z__2.i = -bb[i__3].i;
01039                 z__1.r = z__2.r * ra1.r - z__2.i * ra1.i, z__1.i = z__2.r * 
01040                         ra1.i + z__2.i * ra1.r;
01041                 work[i__4].r = z__1.r, work[i__4].i = z__1.i;
01042             }
01043         }
01044 
01045         for (k = *kb; k >= 1; --k) {
01046             if (update) {
01047 /* Computing MAX */
01048                 i__4 = 2, i__3 = k - i0 + 1;
01049                 j2 = i__ - k - 1 + max(i__4,i__3) * ka1;
01050             } else {
01051 /* Computing MAX */
01052                 i__4 = 1, i__3 = k - i0 + 1;
01053                 j2 = i__ - k - 1 + max(i__4,i__3) * ka1;
01054             }
01055 
01056 /*           finish applying rotations in 2nd set from the right */
01057 
01058             for (l = *kb - k; l >= 1; --l) {
01059                 nrt = (*n - j2 + *ka + l) / ka1;
01060                 if (nrt > 0) {
01061                     zlartv_(&nrt, &ab[ka1 - l + 1 + (j2 - *ka) * ab_dim1], &
01062                             inca, &ab[ka1 - l + (j2 - *ka + 1) * ab_dim1], &
01063                             inca, &rwork[j2 - *ka], &work[j2 - *ka], &ka1);
01064                 }
01065 /* L370: */
01066             }
01067             nr = (*n - j2 + *ka) / ka1;
01068             j1 = j2 + (nr - 1) * ka1;
01069             i__4 = j2;
01070             i__3 = -ka1;
01071             for (j = j1; i__3 < 0 ? j >= i__4 : j <= i__4; j += i__3) {
01072                 i__1 = j;
01073                 i__2 = j - *ka;
01074                 work[i__1].r = work[i__2].r, work[i__1].i = work[i__2].i;
01075                 rwork[j] = rwork[j - *ka];
01076 /* L380: */
01077             }
01078             i__3 = j1;
01079             i__4 = ka1;
01080             for (j = j2; i__4 < 0 ? j >= i__3 : j <= i__3; j += i__4) {
01081 
01082 /*              create nonzero element a(j+1,j-ka) outside the band */
01083 /*              and store it in WORK(j) */
01084 
01085                 i__1 = j;
01086                 i__2 = j;
01087                 i__5 = ka1 + (j - *ka + 1) * ab_dim1;
01088                 z__1.r = work[i__2].r * ab[i__5].r - work[i__2].i * ab[i__5]
01089                         .i, z__1.i = work[i__2].r * ab[i__5].i + work[i__2].i 
01090                         * ab[i__5].r;
01091                 work[i__1].r = z__1.r, work[i__1].i = z__1.i;
01092                 i__1 = ka1 + (j - *ka + 1) * ab_dim1;
01093                 i__2 = j;
01094                 i__5 = ka1 + (j - *ka + 1) * ab_dim1;
01095                 z__1.r = rwork[i__2] * ab[i__5].r, z__1.i = rwork[i__2] * ab[
01096                         i__5].i;
01097                 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
01098 /* L390: */
01099             }
01100             if (update) {
01101                 if (i__ - k < *n - *ka && k <= kbt) {
01102                     i__4 = i__ - k + *ka;
01103                     i__3 = i__ - k;
01104                     work[i__4].r = work[i__3].r, work[i__4].i = work[i__3].i;
01105                 }
01106             }
01107 /* L400: */
01108         }
01109 
01110         for (k = *kb; k >= 1; --k) {
01111 /* Computing MAX */
01112             i__4 = 1, i__3 = k - i0 + 1;
01113             j2 = i__ - k - 1 + max(i__4,i__3) * ka1;
01114             nr = (*n - j2 + *ka) / ka1;
01115             j1 = j2 + (nr - 1) * ka1;
01116             if (nr > 0) {
01117 
01118 /*              generate rotations in 2nd set to annihilate elements */
01119 /*              which have been created outside the band */
01120 
01121                 zlargv_(&nr, &ab[ka1 + (j2 - *ka) * ab_dim1], &inca, &work[j2]
01122 , &ka1, &rwork[j2], &ka1);
01123 
01124 /*              apply rotations in 2nd set from the left */
01125 
01126                 i__4 = *ka - 1;
01127                 for (l = 1; l <= i__4; ++l) {
01128                     zlartv_(&nr, &ab[l + 1 + (j2 - l) * ab_dim1], &inca, &ab[
01129                             l + 2 + (j2 - l) * ab_dim1], &inca, &rwork[j2], &
01130                             work[j2], &ka1);
01131 /* L410: */
01132                 }
01133 
01134 /*              apply rotations in 2nd set from both sides to diagonal */
01135 /*              blocks */
01136 
01137                 zlar2v_(&nr, &ab[j2 * ab_dim1 + 1], &ab[(j2 + 1) * ab_dim1 + 
01138                         1], &ab[j2 * ab_dim1 + 2], &inca, &rwork[j2], &work[
01139                         j2], &ka1);
01140 
01141                 zlacgv_(&nr, &work[j2], &ka1);
01142             }
01143 
01144 /*           start applying rotations in 2nd set from the right */
01145 
01146             i__4 = *kb - k + 1;
01147             for (l = *ka - 1; l >= i__4; --l) {
01148                 nrt = (*n - j2 + l) / ka1;
01149                 if (nrt > 0) {
01150                     zlartv_(&nrt, &ab[ka1 - l + 1 + j2 * ab_dim1], &inca, &ab[
01151                             ka1 - l + (j2 + 1) * ab_dim1], &inca, &rwork[j2], 
01152                             &work[j2], &ka1);
01153                 }
01154 /* L420: */
01155             }
01156 
01157             if (wantx) {
01158 
01159 /*              post-multiply X by product of rotations in 2nd set */
01160 
01161                 i__4 = j1;
01162                 i__3 = ka1;
01163                 for (j = j2; i__3 < 0 ? j >= i__4 : j <= i__4; j += i__3) {
01164                     i__1 = *n - m;
01165                     zrot_(&i__1, &x[m + 1 + j * x_dim1], &c__1, &x[m + 1 + (j 
01166                             + 1) * x_dim1], &c__1, &rwork[j], &work[j]);
01167 /* L430: */
01168                 }
01169             }
01170 /* L440: */
01171         }
01172 
01173         i__3 = *kb - 1;
01174         for (k = 1; k <= i__3; ++k) {
01175 /* Computing MAX */
01176             i__4 = 1, i__1 = k - i0 + 2;
01177             j2 = i__ - k - 1 + max(i__4,i__1) * ka1;
01178 
01179 /*           finish applying rotations in 1st set from the right */
01180 
01181             for (l = *kb - k; l >= 1; --l) {
01182                 nrt = (*n - j2 + l) / ka1;
01183                 if (nrt > 0) {
01184                     zlartv_(&nrt, &ab[ka1 - l + 1 + j2 * ab_dim1], &inca, &ab[
01185                             ka1 - l + (j2 + 1) * ab_dim1], &inca, &rwork[j2 - 
01186                             m], &work[j2 - m], &ka1);
01187                 }
01188 /* L450: */
01189             }
01190 /* L460: */
01191         }
01192 
01193         if (*kb > 1) {
01194             i__3 = i2 + *ka;
01195             for (j = *n - 1; j >= i__3; --j) {
01196                 rwork[j - m] = rwork[j - *ka - m];
01197                 i__4 = j - m;
01198                 i__1 = j - *ka - m;
01199                 work[i__4].r = work[i__1].r, work[i__4].i = work[i__1].i;
01200 /* L470: */
01201             }
01202         }
01203 
01204     }
01205 
01206     goto L10;
01207 
01208 L480:
01209 
01210 /*     **************************** Phase 2 ***************************** */
01211 
01212 /*     The logical structure of this phase is: */
01213 
01214 /*     UPDATE = .TRUE. */
01215 /*     DO I = 1, M */
01216 /*        use S(i) to update A and create a new bulge */
01217 /*        apply rotations to push all bulges KA positions upward */
01218 /*     END DO */
01219 /*     UPDATE = .FALSE. */
01220 /*     DO I = M - KA - 1, 2, -1 */
01221 /*        apply rotations to push all bulges KA positions upward */
01222 /*     END DO */
01223 
01224 /*     To avoid duplicating code, the two loops are merged. */
01225 
01226     update = TRUE_;
01227     i__ = 0;
01228 L490:
01229     if (update) {
01230         ++i__;
01231 /* Computing MIN */
01232         i__3 = *kb, i__4 = m - i__;
01233         kbt = min(i__3,i__4);
01234         i0 = i__ + 1;
01235 /* Computing MAX */
01236         i__3 = 1, i__4 = i__ - *ka;
01237         i1 = max(i__3,i__4);
01238         i2 = i__ + kbt - ka1;
01239         if (i__ > m) {
01240             update = FALSE_;
01241             --i__;
01242             i0 = m + 1;
01243             if (*ka == 0) {
01244                 return 0;
01245             }
01246             goto L490;
01247         }
01248     } else {
01249         i__ -= *ka;
01250         if (i__ < 2) {
01251             return 0;
01252         }
01253     }
01254 
01255     if (i__ < m - kbt) {
01256         nx = m;
01257     } else {
01258         nx = *n;
01259     }
01260 
01261     if (upper) {
01262 
01263 /*        Transform A, working with the upper triangle */
01264 
01265         if (update) {
01266 
01267 /*           Form  inv(S(i))**H * A * inv(S(i)) */
01268 
01269             i__3 = kb1 + i__ * bb_dim1;
01270             bii = bb[i__3].r;
01271             i__3 = ka1 + i__ * ab_dim1;
01272             i__4 = ka1 + i__ * ab_dim1;
01273             d__1 = ab[i__4].r / bii / bii;
01274             ab[i__3].r = d__1, ab[i__3].i = 0.;
01275             i__3 = i__ - 1;
01276             for (j = i1; j <= i__3; ++j) {
01277                 i__4 = j - i__ + ka1 + i__ * ab_dim1;
01278                 i__1 = j - i__ + ka1 + i__ * ab_dim1;
01279                 z__1.r = ab[i__1].r / bii, z__1.i = ab[i__1].i / bii;
01280                 ab[i__4].r = z__1.r, ab[i__4].i = z__1.i;
01281 /* L500: */
01282             }
01283 /* Computing MIN */
01284             i__4 = *n, i__1 = i__ + *ka;
01285             i__3 = min(i__4,i__1);
01286             for (j = i__ + 1; j <= i__3; ++j) {
01287                 i__4 = i__ - j + ka1 + j * ab_dim1;
01288                 i__1 = i__ - j + ka1 + j * ab_dim1;
01289                 z__1.r = ab[i__1].r / bii, z__1.i = ab[i__1].i / bii;
01290                 ab[i__4].r = z__1.r, ab[i__4].i = z__1.i;
01291 /* L510: */
01292             }
01293             i__3 = i__ + kbt;
01294             for (k = i__ + 1; k <= i__3; ++k) {
01295                 i__4 = i__ + kbt;
01296                 for (j = k; j <= i__4; ++j) {
01297                     i__1 = k - j + ka1 + j * ab_dim1;
01298                     i__2 = k - j + ka1 + j * ab_dim1;
01299                     i__5 = i__ - j + kb1 + j * bb_dim1;
01300                     d_cnjg(&z__5, &ab[i__ - k + ka1 + k * ab_dim1]);
01301                     z__4.r = bb[i__5].r * z__5.r - bb[i__5].i * z__5.i, 
01302                             z__4.i = bb[i__5].r * z__5.i + bb[i__5].i * 
01303                             z__5.r;
01304                     z__3.r = ab[i__2].r - z__4.r, z__3.i = ab[i__2].i - 
01305                             z__4.i;
01306                     d_cnjg(&z__7, &bb[i__ - k + kb1 + k * bb_dim1]);
01307                     i__6 = i__ - j + ka1 + j * ab_dim1;
01308                     z__6.r = z__7.r * ab[i__6].r - z__7.i * ab[i__6].i, 
01309                             z__6.i = z__7.r * ab[i__6].i + z__7.i * ab[i__6]
01310                             .r;
01311                     z__2.r = z__3.r - z__6.r, z__2.i = z__3.i - z__6.i;
01312                     i__7 = ka1 + i__ * ab_dim1;
01313                     d__1 = ab[i__7].r;
01314                     i__8 = i__ - j + kb1 + j * bb_dim1;
01315                     z__9.r = d__1 * bb[i__8].r, z__9.i = d__1 * bb[i__8].i;
01316                     d_cnjg(&z__10, &bb[i__ - k + kb1 + k * bb_dim1]);
01317                     z__8.r = z__9.r * z__10.r - z__9.i * z__10.i, z__8.i = 
01318                             z__9.r * z__10.i + z__9.i * z__10.r;
01319                     z__1.r = z__2.r + z__8.r, z__1.i = z__2.i + z__8.i;
01320                     ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
01321 /* L520: */
01322                 }
01323 /* Computing MIN */
01324                 i__1 = *n, i__2 = i__ + *ka;
01325                 i__4 = min(i__1,i__2);
01326                 for (j = i__ + kbt + 1; j <= i__4; ++j) {
01327                     i__1 = k - j + ka1 + j * ab_dim1;
01328                     i__2 = k - j + ka1 + j * ab_dim1;
01329                     d_cnjg(&z__3, &bb[i__ - k + kb1 + k * bb_dim1]);
01330                     i__5 = i__ - j + ka1 + j * ab_dim1;
01331                     z__2.r = z__3.r * ab[i__5].r - z__3.i * ab[i__5].i, 
01332                             z__2.i = z__3.r * ab[i__5].i + z__3.i * ab[i__5]
01333                             .r;
01334                     z__1.r = ab[i__2].r - z__2.r, z__1.i = ab[i__2].i - 
01335                             z__2.i;
01336                     ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
01337 /* L530: */
01338                 }
01339 /* L540: */
01340             }
01341             i__3 = i__;
01342             for (j = i1; j <= i__3; ++j) {
01343 /* Computing MIN */
01344                 i__1 = j + *ka, i__2 = i__ + kbt;
01345                 i__4 = min(i__1,i__2);
01346                 for (k = i__ + 1; k <= i__4; ++k) {
01347                     i__1 = j - k + ka1 + k * ab_dim1;
01348                     i__2 = j - k + ka1 + k * ab_dim1;
01349                     i__5 = i__ - k + kb1 + k * bb_dim1;
01350                     i__6 = j - i__ + ka1 + i__ * ab_dim1;
01351                     z__2.r = bb[i__5].r * ab[i__6].r - bb[i__5].i * ab[i__6]
01352                             .i, z__2.i = bb[i__5].r * ab[i__6].i + bb[i__5].i 
01353                             * ab[i__6].r;
01354                     z__1.r = ab[i__2].r - z__2.r, z__1.i = ab[i__2].i - 
01355                             z__2.i;
01356                     ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
01357 /* L550: */
01358                 }
01359 /* L560: */
01360             }
01361 
01362             if (wantx) {
01363 
01364 /*              post-multiply X by inv(S(i)) */
01365 
01366                 d__1 = 1. / bii;
01367                 zdscal_(&nx, &d__1, &x[i__ * x_dim1 + 1], &c__1);
01368                 if (kbt > 0) {
01369                     z__1.r = -1., z__1.i = -0.;
01370                     i__3 = *ldbb - 1;
01371                     zgeru_(&nx, &kbt, &z__1, &x[i__ * x_dim1 + 1], &c__1, &bb[
01372                             *kb + (i__ + 1) * bb_dim1], &i__3, &x[(i__ + 1) * 
01373                             x_dim1 + 1], ldx);
01374                 }
01375             }
01376 
01377 /*           store a(i1,i) in RA1 for use in next loop over K */
01378 
01379             i__3 = i1 - i__ + ka1 + i__ * ab_dim1;
01380             ra1.r = ab[i__3].r, ra1.i = ab[i__3].i;
01381         }
01382 
01383 /*        Generate and apply vectors of rotations to chase all the */
01384 /*        existing bulges KA positions up toward the top of the band */
01385 
01386         i__3 = *kb - 1;
01387         for (k = 1; k <= i__3; ++k) {
01388             if (update) {
01389 
01390 /*              Determine the rotations which would annihilate the bulge */
01391 /*              which has in theory just been created */
01392 
01393                 if (i__ + k - ka1 > 0 && i__ + k < m) {
01394 
01395 /*                 generate rotation to annihilate a(i+k-ka-1,i) */
01396 
01397                     zlartg_(&ab[k + 1 + i__ * ab_dim1], &ra1, &rwork[i__ + k 
01398                             - *ka], &work[i__ + k - *ka], &ra);
01399 
01400 /*                 create nonzero element a(i+k-ka-1,i+k) outside the */
01401 /*                 band and store it in WORK(m-kb+i+k) */
01402 
01403                     i__4 = kb1 - k + (i__ + k) * bb_dim1;
01404                     z__2.r = -bb[i__4].r, z__2.i = -bb[i__4].i;
01405                     z__1.r = z__2.r * ra1.r - z__2.i * ra1.i, z__1.i = z__2.r 
01406                             * ra1.i + z__2.i * ra1.r;
01407                     t.r = z__1.r, t.i = z__1.i;
01408                     i__4 = m - *kb + i__ + k;
01409                     i__1 = i__ + k - *ka;
01410                     z__2.r = rwork[i__1] * t.r, z__2.i = rwork[i__1] * t.i;
01411                     d_cnjg(&z__4, &work[i__ + k - *ka]);
01412                     i__2 = (i__ + k) * ab_dim1 + 1;
01413                     z__3.r = z__4.r * ab[i__2].r - z__4.i * ab[i__2].i, 
01414                             z__3.i = z__4.r * ab[i__2].i + z__4.i * ab[i__2]
01415                             .r;
01416                     z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
01417                     work[i__4].r = z__1.r, work[i__4].i = z__1.i;
01418                     i__4 = (i__ + k) * ab_dim1 + 1;
01419                     i__1 = i__ + k - *ka;
01420                     z__2.r = work[i__1].r * t.r - work[i__1].i * t.i, z__2.i =
01421                              work[i__1].r * t.i + work[i__1].i * t.r;
01422                     i__2 = i__ + k - *ka;
01423                     i__5 = (i__ + k) * ab_dim1 + 1;
01424                     z__3.r = rwork[i__2] * ab[i__5].r, z__3.i = rwork[i__2] * 
01425                             ab[i__5].i;
01426                     z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
01427                     ab[i__4].r = z__1.r, ab[i__4].i = z__1.i;
01428                     ra1.r = ra.r, ra1.i = ra.i;
01429                 }
01430             }
01431 /* Computing MAX */
01432             i__4 = 1, i__1 = k + i0 - m + 1;
01433             j2 = i__ + k + 1 - max(i__4,i__1) * ka1;
01434             nr = (j2 + *ka - 1) / ka1;
01435             j1 = j2 - (nr - 1) * ka1;
01436             if (update) {
01437 /* Computing MIN */
01438                 i__4 = j2, i__1 = i__ - (*ka << 1) + k - 1;
01439                 j2t = min(i__4,i__1);
01440             } else {
01441                 j2t = j2;
01442             }
01443             nrt = (j2t + *ka - 1) / ka1;
01444             i__4 = j2t;
01445             i__1 = ka1;
01446             for (j = j1; i__1 < 0 ? j >= i__4 : j <= i__4; j += i__1) {
01447 
01448 /*              create nonzero element a(j-1,j+ka) outside the band */
01449 /*              and store it in WORK(j) */
01450 
01451                 i__2 = j;
01452                 i__5 = j;
01453                 i__6 = (j + *ka - 1) * ab_dim1 + 1;
01454                 z__1.r = work[i__5].r * ab[i__6].r - work[i__5].i * ab[i__6]
01455                         .i, z__1.i = work[i__5].r * ab[i__6].i + work[i__5].i 
01456                         * ab[i__6].r;
01457                 work[i__2].r = z__1.r, work[i__2].i = z__1.i;
01458                 i__2 = (j + *ka - 1) * ab_dim1 + 1;
01459                 i__5 = j;
01460                 i__6 = (j + *ka - 1) * ab_dim1 + 1;
01461                 z__1.r = rwork[i__5] * ab[i__6].r, z__1.i = rwork[i__5] * ab[
01462                         i__6].i;
01463                 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
01464 /* L570: */
01465             }
01466 
01467 /*           generate rotations in 1st set to annihilate elements which */
01468 /*           have been created outside the band */
01469 
01470             if (nrt > 0) {
01471                 zlargv_(&nrt, &ab[(j1 + *ka) * ab_dim1 + 1], &inca, &work[j1], 
01472                          &ka1, &rwork[j1], &ka1);
01473             }
01474             if (nr > 0) {
01475 
01476 /*              apply rotations in 1st set from the left */
01477 
01478                 i__1 = *ka - 1;
01479                 for (l = 1; l <= i__1; ++l) {
01480                     zlartv_(&nr, &ab[ka1 - l + (j1 + l) * ab_dim1], &inca, &
01481                             ab[*ka - l + (j1 + l) * ab_dim1], &inca, &rwork[
01482                             j1], &work[j1], &ka1);
01483 /* L580: */
01484                 }
01485 
01486 /*              apply rotations in 1st set from both sides to diagonal */
01487 /*              blocks */
01488 
01489                 zlar2v_(&nr, &ab[ka1 + j1 * ab_dim1], &ab[ka1 + (j1 - 1) * 
01490                         ab_dim1], &ab[*ka + j1 * ab_dim1], &inca, &rwork[j1], 
01491                         &work[j1], &ka1);
01492 
01493                 zlacgv_(&nr, &work[j1], &ka1);
01494             }
01495 
01496 /*           start applying rotations in 1st set from the right */
01497 
01498             i__1 = *kb - k + 1;
01499             for (l = *ka - 1; l >= i__1; --l) {
01500                 nrt = (j2 + l - 1) / ka1;
01501                 j1t = j2 - (nrt - 1) * ka1;
01502                 if (nrt > 0) {
01503                     zlartv_(&nrt, &ab[l + j1t * ab_dim1], &inca, &ab[l + 1 + (
01504                             j1t - 1) * ab_dim1], &inca, &rwork[j1t], &work[
01505                             j1t], &ka1);
01506                 }
01507 /* L590: */
01508             }
01509 
01510             if (wantx) {
01511 
01512 /*              post-multiply X by product of rotations in 1st set */
01513 
01514                 i__1 = j2;
01515                 i__4 = ka1;
01516                 for (j = j1; i__4 < 0 ? j >= i__1 : j <= i__1; j += i__4) {
01517                     zrot_(&nx, &x[j * x_dim1 + 1], &c__1, &x[(j - 1) * x_dim1 
01518                             + 1], &c__1, &rwork[j], &work[j]);
01519 /* L600: */
01520                 }
01521             }
01522 /* L610: */
01523         }
01524 
01525         if (update) {
01526             if (i2 > 0 && kbt > 0) {
01527 
01528 /*              create nonzero element a(i+kbt-ka-1,i+kbt) outside the */
01529 /*              band and store it in WORK(m-kb+i+kbt) */
01530 
01531                 i__3 = m - *kb + i__ + kbt;
01532                 i__4 = kb1 - kbt + (i__ + kbt) * bb_dim1;
01533                 z__2.r = -bb[i__4].r, z__2.i = -bb[i__4].i;
01534                 z__1.r = z__2.r * ra1.r - z__2.i * ra1.i, z__1.i = z__2.r * 
01535                         ra1.i + z__2.i * ra1.r;
01536                 work[i__3].r = z__1.r, work[i__3].i = z__1.i;
01537             }
01538         }
01539 
01540         for (k = *kb; k >= 1; --k) {
01541             if (update) {
01542 /* Computing MAX */
01543                 i__3 = 2, i__4 = k + i0 - m;
01544                 j2 = i__ + k + 1 - max(i__3,i__4) * ka1;
01545             } else {
01546 /* Computing MAX */
01547                 i__3 = 1, i__4 = k + i0 - m;
01548                 j2 = i__ + k + 1 - max(i__3,i__4) * ka1;
01549             }
01550 
01551 /*           finish applying rotations in 2nd set from the right */
01552 
01553             for (l = *kb - k; l >= 1; --l) {
01554                 nrt = (j2 + *ka + l - 1) / ka1;
01555                 j1t = j2 - (nrt - 1) * ka1;
01556                 if (nrt > 0) {
01557                     zlartv_(&nrt, &ab[l + (j1t + *ka) * ab_dim1], &inca, &ab[
01558                             l + 1 + (j1t + *ka - 1) * ab_dim1], &inca, &rwork[
01559                             m - *kb + j1t + *ka], &work[m - *kb + j1t + *ka], 
01560                             &ka1);
01561                 }
01562 /* L620: */
01563             }
01564             nr = (j2 + *ka - 1) / ka1;
01565             j1 = j2 - (nr - 1) * ka1;
01566             i__3 = j2;
01567             i__4 = ka1;
01568             for (j = j1; i__4 < 0 ? j >= i__3 : j <= i__3; j += i__4) {
01569                 i__1 = m - *kb + j;
01570                 i__2 = m - *kb + j + *ka;
01571                 work[i__1].r = work[i__2].r, work[i__1].i = work[i__2].i;
01572                 rwork[m - *kb + j] = rwork[m - *kb + j + *ka];
01573 /* L630: */
01574             }
01575             i__4 = j2;
01576             i__3 = ka1;
01577             for (j = j1; i__3 < 0 ? j >= i__4 : j <= i__4; j += i__3) {
01578 
01579 /*              create nonzero element a(j-1,j+ka) outside the band */
01580 /*              and store it in WORK(m-kb+j) */
01581 
01582                 i__1 = m - *kb + j;
01583                 i__2 = m - *kb + j;
01584                 i__5 = (j + *ka - 1) * ab_dim1 + 1;
01585                 z__1.r = work[i__2].r * ab[i__5].r - work[i__2].i * ab[i__5]
01586                         .i, z__1.i = work[i__2].r * ab[i__5].i + work[i__2].i 
01587                         * ab[i__5].r;
01588                 work[i__1].r = z__1.r, work[i__1].i = z__1.i;
01589                 i__1 = (j + *ka - 1) * ab_dim1 + 1;
01590                 i__2 = m - *kb + j;
01591                 i__5 = (j + *ka - 1) * ab_dim1 + 1;
01592                 z__1.r = rwork[i__2] * ab[i__5].r, z__1.i = rwork[i__2] * ab[
01593                         i__5].i;
01594                 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
01595 /* L640: */
01596             }
01597             if (update) {
01598                 if (i__ + k > ka1 && k <= kbt) {
01599                     i__3 = m - *kb + i__ + k - *ka;
01600                     i__4 = m - *kb + i__ + k;
01601                     work[i__3].r = work[i__4].r, work[i__3].i = work[i__4].i;
01602                 }
01603             }
01604 /* L650: */
01605         }
01606 
01607         for (k = *kb; k >= 1; --k) {
01608 /* Computing MAX */
01609             i__3 = 1, i__4 = k + i0 - m;
01610             j2 = i__ + k + 1 - max(i__3,i__4) * ka1;
01611             nr = (j2 + *ka - 1) / ka1;
01612             j1 = j2 - (nr - 1) * ka1;
01613             if (nr > 0) {
01614 
01615 /*              generate rotations in 2nd set to annihilate elements */
01616 /*              which have been created outside the band */
01617 
01618                 zlargv_(&nr, &ab[(j1 + *ka) * ab_dim1 + 1], &inca, &work[m - *
01619                         kb + j1], &ka1, &rwork[m - *kb + j1], &ka1);
01620 
01621 /*              apply rotations in 2nd set from the left */
01622 
01623                 i__3 = *ka - 1;
01624                 for (l = 1; l <= i__3; ++l) {
01625                     zlartv_(&nr, &ab[ka1 - l + (j1 + l) * ab_dim1], &inca, &
01626                             ab[*ka - l + (j1 + l) * ab_dim1], &inca, &rwork[m 
01627                             - *kb + j1], &work[m - *kb + j1], &ka1);
01628 /* L660: */
01629                 }
01630 
01631 /*              apply rotations in 2nd set from both sides to diagonal */
01632 /*              blocks */
01633 
01634                 zlar2v_(&nr, &ab[ka1 + j1 * ab_dim1], &ab[ka1 + (j1 - 1) * 
01635                         ab_dim1], &ab[*ka + j1 * ab_dim1], &inca, &rwork[m - *
01636                         kb + j1], &work[m - *kb + j1], &ka1);
01637 
01638                 zlacgv_(&nr, &work[m - *kb + j1], &ka1);
01639             }
01640 
01641 /*           start applying rotations in 2nd set from the right */
01642 
01643             i__3 = *kb - k + 1;
01644             for (l = *ka - 1; l >= i__3; --l) {
01645                 nrt = (j2 + l - 1) / ka1;
01646                 j1t = j2 - (nrt - 1) * ka1;
01647                 if (nrt > 0) {
01648                     zlartv_(&nrt, &ab[l + j1t * ab_dim1], &inca, &ab[l + 1 + (
01649                             j1t - 1) * ab_dim1], &inca, &rwork[m - *kb + j1t], 
01650                              &work[m - *kb + j1t], &ka1);
01651                 }
01652 /* L670: */
01653             }
01654 
01655             if (wantx) {
01656 
01657 /*              post-multiply X by product of rotations in 2nd set */
01658 
01659                 i__3 = j2;
01660                 i__4 = ka1;
01661                 for (j = j1; i__4 < 0 ? j >= i__3 : j <= i__3; j += i__4) {
01662                     zrot_(&nx, &x[j * x_dim1 + 1], &c__1, &x[(j - 1) * x_dim1 
01663                             + 1], &c__1, &rwork[m - *kb + j], &work[m - *kb + 
01664                             j]);
01665 /* L680: */
01666                 }
01667             }
01668 /* L690: */
01669         }
01670 
01671         i__4 = *kb - 1;
01672         for (k = 1; k <= i__4; ++k) {
01673 /* Computing MAX */
01674             i__3 = 1, i__1 = k + i0 - m + 1;
01675             j2 = i__ + k + 1 - max(i__3,i__1) * ka1;
01676 
01677 /*           finish applying rotations in 1st set from the right */
01678 
01679             for (l = *kb - k; l >= 1; --l) {
01680                 nrt = (j2 + l - 1) / ka1;
01681                 j1t = j2 - (nrt - 1) * ka1;
01682                 if (nrt > 0) {
01683                     zlartv_(&nrt, &ab[l + j1t * ab_dim1], &inca, &ab[l + 1 + (
01684                             j1t - 1) * ab_dim1], &inca, &rwork[j1t], &work[
01685                             j1t], &ka1);
01686                 }
01687 /* L700: */
01688             }
01689 /* L710: */
01690         }
01691 
01692         if (*kb > 1) {
01693             i__4 = i2 - *ka;
01694             for (j = 2; j <= i__4; ++j) {
01695                 rwork[j] = rwork[j + *ka];
01696                 i__3 = j;
01697                 i__1 = j + *ka;
01698                 work[i__3].r = work[i__1].r, work[i__3].i = work[i__1].i;
01699 /* L720: */
01700             }
01701         }
01702 
01703     } else {
01704 
01705 /*        Transform A, working with the lower triangle */
01706 
01707         if (update) {
01708 
01709 /*           Form  inv(S(i))**H * A * inv(S(i)) */
01710 
01711             i__4 = i__ * bb_dim1 + 1;
01712             bii = bb[i__4].r;
01713             i__4 = i__ * ab_dim1 + 1;
01714             i__3 = i__ * ab_dim1 + 1;
01715             d__1 = ab[i__3].r / bii / bii;
01716             ab[i__4].r = d__1, ab[i__4].i = 0.;
01717             i__4 = i__ - 1;
01718             for (j = i1; j <= i__4; ++j) {
01719                 i__3 = i__ - j + 1 + j * ab_dim1;
01720                 i__1 = i__ - j + 1 + j * ab_dim1;
01721                 z__1.r = ab[i__1].r / bii, z__1.i = ab[i__1].i / bii;
01722                 ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
01723 /* L730: */
01724             }
01725 /* Computing MIN */
01726             i__3 = *n, i__1 = i__ + *ka;
01727             i__4 = min(i__3,i__1);
01728             for (j = i__ + 1; j <= i__4; ++j) {
01729                 i__3 = j - i__ + 1 + i__ * ab_dim1;
01730                 i__1 = j - i__ + 1 + i__ * ab_dim1;
01731                 z__1.r = ab[i__1].r / bii, z__1.i = ab[i__1].i / bii;
01732                 ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
01733 /* L740: */
01734             }
01735             i__4 = i__ + kbt;
01736             for (k = i__ + 1; k <= i__4; ++k) {
01737                 i__3 = i__ + kbt;
01738                 for (j = k; j <= i__3; ++j) {
01739                     i__1 = j - k + 1 + k * ab_dim1;
01740                     i__2 = j - k + 1 + k * ab_dim1;
01741                     i__5 = j - i__ + 1 + i__ * bb_dim1;
01742                     d_cnjg(&z__5, &ab[k - i__ + 1 + i__ * ab_dim1]);
01743                     z__4.r = bb[i__5].r * z__5.r - bb[i__5].i * z__5.i, 
01744                             z__4.i = bb[i__5].r * z__5.i + bb[i__5].i * 
01745                             z__5.r;
01746                     z__3.r = ab[i__2].r - z__4.r, z__3.i = ab[i__2].i - 
01747                             z__4.i;
01748                     d_cnjg(&z__7, &bb[k - i__ + 1 + i__ * bb_dim1]);
01749                     i__6 = j - i__ + 1 + i__ * ab_dim1;
01750                     z__6.r = z__7.r * ab[i__6].r - z__7.i * ab[i__6].i, 
01751                             z__6.i = z__7.r * ab[i__6].i + z__7.i * ab[i__6]
01752                             .r;
01753                     z__2.r = z__3.r - z__6.r, z__2.i = z__3.i - z__6.i;
01754                     i__7 = i__ * ab_dim1 + 1;
01755                     d__1 = ab[i__7].r;
01756                     i__8 = j - i__ + 1 + i__ * bb_dim1;
01757                     z__9.r = d__1 * bb[i__8].r, z__9.i = d__1 * bb[i__8].i;
01758                     d_cnjg(&z__10, &bb[k - i__ + 1 + i__ * bb_dim1]);
01759                     z__8.r = z__9.r * z__10.r - z__9.i * z__10.i, z__8.i = 
01760                             z__9.r * z__10.i + z__9.i * z__10.r;
01761                     z__1.r = z__2.r + z__8.r, z__1.i = z__2.i + z__8.i;
01762                     ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
01763 /* L750: */
01764                 }
01765 /* Computing MIN */
01766                 i__1 = *n, i__2 = i__ + *ka;
01767                 i__3 = min(i__1,i__2);
01768                 for (j = i__ + kbt + 1; j <= i__3; ++j) {
01769                     i__1 = j - k + 1 + k * ab_dim1;
01770                     i__2 = j - k + 1 + k * ab_dim1;
01771                     d_cnjg(&z__3, &bb[k - i__ + 1 + i__ * bb_dim1]);
01772                     i__5 = j - i__ + 1 + i__ * ab_dim1;
01773                     z__2.r = z__3.r * ab[i__5].r - z__3.i * ab[i__5].i, 
01774                             z__2.i = z__3.r * ab[i__5].i + z__3.i * ab[i__5]
01775                             .r;
01776                     z__1.r = ab[i__2].r - z__2.r, z__1.i = ab[i__2].i - 
01777                             z__2.i;
01778                     ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
01779 /* L760: */
01780                 }
01781 /* L770: */
01782             }
01783             i__4 = i__;
01784             for (j = i1; j <= i__4; ++j) {
01785 /* Computing MIN */
01786                 i__1 = j + *ka, i__2 = i__ + kbt;
01787                 i__3 = min(i__1,i__2);
01788                 for (k = i__ + 1; k <= i__3; ++k) {
01789                     i__1 = k - j + 1 + j * ab_dim1;
01790                     i__2 = k - j + 1 + j * ab_dim1;
01791                     i__5 = k - i__ + 1 + i__ * bb_dim1;
01792                     i__6 = i__ - j + 1 + j * ab_dim1;
01793                     z__2.r = bb[i__5].r * ab[i__6].r - bb[i__5].i * ab[i__6]
01794                             .i, z__2.i = bb[i__5].r * ab[i__6].i + bb[i__5].i 
01795                             * ab[i__6].r;
01796                     z__1.r = ab[i__2].r - z__2.r, z__1.i = ab[i__2].i - 
01797                             z__2.i;
01798                     ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
01799 /* L780: */
01800                 }
01801 /* L790: */
01802             }
01803 
01804             if (wantx) {
01805 
01806 /*              post-multiply X by inv(S(i)) */
01807 
01808                 d__1 = 1. / bii;
01809                 zdscal_(&nx, &d__1, &x[i__ * x_dim1 + 1], &c__1);
01810                 if (kbt > 0) {
01811                     z__1.r = -1., z__1.i = -0.;
01812                     zgerc_(&nx, &kbt, &z__1, &x[i__ * x_dim1 + 1], &c__1, &bb[
01813                             i__ * bb_dim1 + 2], &c__1, &x[(i__ + 1) * x_dim1 
01814                             + 1], ldx);
01815                 }
01816             }
01817 
01818 /*           store a(i,i1) in RA1 for use in next loop over K */
01819 
01820             i__4 = i__ - i1 + 1 + i1 * ab_dim1;
01821             ra1.r = ab[i__4].r, ra1.i = ab[i__4].i;
01822         }
01823 
01824 /*        Generate and apply vectors of rotations to chase all the */
01825 /*        existing bulges KA positions up toward the top of the band */
01826 
01827         i__4 = *kb - 1;
01828         for (k = 1; k <= i__4; ++k) {
01829             if (update) {
01830 
01831 /*              Determine the rotations which would annihilate the bulge */
01832 /*              which has in theory just been created */
01833 
01834                 if (i__ + k - ka1 > 0 && i__ + k < m) {
01835 
01836 /*                 generate rotation to annihilate a(i,i+k-ka-1) */
01837 
01838                     zlartg_(&ab[ka1 - k + (i__ + k - *ka) * ab_dim1], &ra1, &
01839                             rwork[i__ + k - *ka], &work[i__ + k - *ka], &ra);
01840 
01841 /*                 create nonzero element a(i+k,i+k-ka-1) outside the */
01842 /*                 band and store it in WORK(m-kb+i+k) */
01843 
01844                     i__3 = k + 1 + i__ * bb_dim1;
01845                     z__2.r = -bb[i__3].r, z__2.i = -bb[i__3].i;
01846                     z__1.r = z__2.r * ra1.r - z__2.i * ra1.i, z__1.i = z__2.r 
01847                             * ra1.i + z__2.i * ra1.r;
01848                     t.r = z__1.r, t.i = z__1.i;
01849                     i__3 = m - *kb + i__ + k;
01850                     i__1 = i__ + k - *ka;
01851                     z__2.r = rwork[i__1] * t.r, z__2.i = rwork[i__1] * t.i;
01852                     d_cnjg(&z__4, &work[i__ + k - *ka]);
01853                     i__2 = ka1 + (i__ + k - *ka) * ab_dim1;
01854                     z__3.r = z__4.r * ab[i__2].r - z__4.i * ab[i__2].i, 
01855                             z__3.i = z__4.r * ab[i__2].i + z__4.i * ab[i__2]
01856                             .r;
01857                     z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
01858                     work[i__3].r = z__1.r, work[i__3].i = z__1.i;
01859                     i__3 = ka1 + (i__ + k - *ka) * ab_dim1;
01860                     i__1 = i__ + k - *ka;
01861                     z__2.r = work[i__1].r * t.r - work[i__1].i * t.i, z__2.i =
01862                              work[i__1].r * t.i + work[i__1].i * t.r;
01863                     i__2 = i__ + k - *ka;
01864                     i__5 = ka1 + (i__ + k - *ka) * ab_dim1;
01865                     z__3.r = rwork[i__2] * ab[i__5].r, z__3.i = rwork[i__2] * 
01866                             ab[i__5].i;
01867                     z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
01868                     ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
01869                     ra1.r = ra.r, ra1.i = ra.i;
01870                 }
01871             }
01872 /* Computing MAX */
01873             i__3 = 1, i__1 = k + i0 - m + 1;
01874             j2 = i__ + k + 1 - max(i__3,i__1) * ka1;
01875             nr = (j2 + *ka - 1) / ka1;
01876             j1 = j2 - (nr - 1) * ka1;
01877             if (update) {
01878 /* Computing MIN */
01879                 i__3 = j2, i__1 = i__ - (*ka << 1) + k - 1;
01880                 j2t = min(i__3,i__1);
01881             } else {
01882                 j2t = j2;
01883             }
01884             nrt = (j2t + *ka - 1) / ka1;
01885             i__3 = j2t;
01886             i__1 = ka1;
01887             for (j = j1; i__1 < 0 ? j >= i__3 : j <= i__3; j += i__1) {
01888 
01889 /*              create nonzero element a(j+ka,j-1) outside the band */
01890 /*              and store it in WORK(j) */
01891 
01892                 i__2 = j;
01893                 i__5 = j;
01894                 i__6 = ka1 + (j - 1) * ab_dim1;
01895                 z__1.r = work[i__5].r * ab[i__6].r - work[i__5].i * ab[i__6]
01896                         .i, z__1.i = work[i__5].r * ab[i__6].i + work[i__5].i 
01897                         * ab[i__6].r;
01898                 work[i__2].r = z__1.r, work[i__2].i = z__1.i;
01899                 i__2 = ka1 + (j - 1) * ab_dim1;
01900                 i__5 = j;
01901                 i__6 = ka1 + (j - 1) * ab_dim1;
01902                 z__1.r = rwork[i__5] * ab[i__6].r, z__1.i = rwork[i__5] * ab[
01903                         i__6].i;
01904                 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
01905 /* L800: */
01906             }
01907 
01908 /*           generate rotations in 1st set to annihilate elements which */
01909 /*           have been created outside the band */
01910 
01911             if (nrt > 0) {
01912                 zlargv_(&nrt, &ab[ka1 + j1 * ab_dim1], &inca, &work[j1], &ka1, 
01913                          &rwork[j1], &ka1);
01914             }
01915             if (nr > 0) {
01916 
01917 /*              apply rotations in 1st set from the right */
01918 
01919                 i__1 = *ka - 1;
01920                 for (l = 1; l <= i__1; ++l) {
01921                     zlartv_(&nr, &ab[l + 1 + j1 * ab_dim1], &inca, &ab[l + 2 
01922                             + (j1 - 1) * ab_dim1], &inca, &rwork[j1], &work[
01923                             j1], &ka1);
01924 /* L810: */
01925                 }
01926 
01927 /*              apply rotations in 1st set from both sides to diagonal */
01928 /*              blocks */
01929 
01930                 zlar2v_(&nr, &ab[j1 * ab_dim1 + 1], &ab[(j1 - 1) * ab_dim1 + 
01931                         1], &ab[(j1 - 1) * ab_dim1 + 2], &inca, &rwork[j1], &
01932                         work[j1], &ka1);
01933 
01934                 zlacgv_(&nr, &work[j1], &ka1);
01935             }
01936 
01937 /*           start applying rotations in 1st set from the left */
01938 
01939             i__1 = *kb - k + 1;
01940             for (l = *ka - 1; l >= i__1; --l) {
01941                 nrt = (j2 + l - 1) / ka1;
01942                 j1t = j2 - (nrt - 1) * ka1;
01943                 if (nrt > 0) {
01944                     zlartv_(&nrt, &ab[ka1 - l + 1 + (j1t - ka1 + l) * ab_dim1]
01945 , &inca, &ab[ka1 - l + (j1t - ka1 + l) * ab_dim1], 
01946                              &inca, &rwork[j1t], &work[j1t], &ka1);
01947                 }
01948 /* L820: */
01949             }
01950 
01951             if (wantx) {
01952 
01953 /*              post-multiply X by product of rotations in 1st set */
01954 
01955                 i__1 = j2;
01956                 i__3 = ka1;
01957                 for (j = j1; i__3 < 0 ? j >= i__1 : j <= i__1; j += i__3) {
01958                     d_cnjg(&z__1, &work[j]);
01959                     zrot_(&nx, &x[j * x_dim1 + 1], &c__1, &x[(j - 1) * x_dim1 
01960                             + 1], &c__1, &rwork[j], &z__1);
01961 /* L830: */
01962                 }
01963             }
01964 /* L840: */
01965         }
01966 
01967         if (update) {
01968             if (i2 > 0 && kbt > 0) {
01969 
01970 /*              create nonzero element a(i+kbt,i+kbt-ka-1) outside the */
01971 /*              band and store it in WORK(m-kb+i+kbt) */
01972 
01973                 i__4 = m - *kb + i__ + kbt;
01974                 i__3 = kbt + 1 + i__ * bb_dim1;
01975                 z__2.r = -bb[i__3].r, z__2.i = -bb[i__3].i;
01976                 z__1.r = z__2.r * ra1.r - z__2.i * ra1.i, z__1.i = z__2.r * 
01977                         ra1.i + z__2.i * ra1.r;
01978                 work[i__4].r = z__1.r, work[i__4].i = z__1.i;
01979             }
01980         }
01981 
01982         for (k = *kb; k >= 1; --k) {
01983             if (update) {
01984 /* Computing MAX */
01985                 i__4 = 2, i__3 = k + i0 - m;
01986                 j2 = i__ + k + 1 - max(i__4,i__3) * ka1;
01987             } else {
01988 /* Computing MAX */
01989                 i__4 = 1, i__3 = k + i0 - m;
01990                 j2 = i__ + k + 1 - max(i__4,i__3) * ka1;
01991             }
01992 
01993 /*           finish applying rotations in 2nd set from the left */
01994 
01995             for (l = *kb - k; l >= 1; --l) {
01996                 nrt = (j2 + *ka + l - 1) / ka1;
01997                 j1t = j2 - (nrt - 1) * ka1;
01998                 if (nrt > 0) {
01999                     zlartv_(&nrt, &ab[ka1 - l + 1 + (j1t + l - 1) * ab_dim1], 
02000                             &inca, &ab[ka1 - l + (j1t + l - 1) * ab_dim1], &
02001                             inca, &rwork[m - *kb + j1t + *ka], &work[m - *kb 
02002                             + j1t + *ka], &ka1);
02003                 }
02004 /* L850: */
02005             }
02006             nr = (j2 + *ka - 1) / ka1;
02007             j1 = j2 - (nr - 1) * ka1;
02008             i__4 = j2;
02009             i__3 = ka1;
02010             for (j = j1; i__3 < 0 ? j >= i__4 : j <= i__4; j += i__3) {
02011                 i__1 = m - *kb + j;
02012                 i__2 = m - *kb + j + *ka;
02013                 work[i__1].r = work[i__2].r, work[i__1].i = work[i__2].i;
02014                 rwork[m - *kb + j] = rwork[m - *kb + j + *ka];
02015 /* L860: */
02016             }
02017             i__3 = j2;
02018             i__4 = ka1;
02019             for (j = j1; i__4 < 0 ? j >= i__3 : j <= i__3; j += i__4) {
02020 
02021 /*              create nonzero element a(j+ka,j-1) outside the band */
02022 /*              and store it in WORK(m-kb+j) */
02023 
02024                 i__1 = m - *kb + j;
02025                 i__2 = m - *kb + j;
02026                 i__5 = ka1 + (j - 1) * ab_dim1;
02027                 z__1.r = work[i__2].r * ab[i__5].r - work[i__2].i * ab[i__5]
02028                         .i, z__1.i = work[i__2].r * ab[i__5].i + work[i__2].i 
02029                         * ab[i__5].r;
02030                 work[i__1].r = z__1.r, work[i__1].i = z__1.i;
02031                 i__1 = ka1 + (j - 1) * ab_dim1;
02032                 i__2 = m - *kb + j;
02033                 i__5 = ka1 + (j - 1) * ab_dim1;
02034                 z__1.r = rwork[i__2] * ab[i__5].r, z__1.i = rwork[i__2] * ab[
02035                         i__5].i;
02036                 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
02037 /* L870: */
02038             }
02039             if (update) {
02040                 if (i__ + k > ka1 && k <= kbt) {
02041                     i__4 = m - *kb + i__ + k - *ka;
02042                     i__3 = m - *kb + i__ + k;
02043                     work[i__4].r = work[i__3].r, work[i__4].i = work[i__3].i;
02044                 }
02045             }
02046 /* L880: */
02047         }
02048 
02049         for (k = *kb; k >= 1; --k) {
02050 /* Computing MAX */
02051             i__4 = 1, i__3 = k + i0 - m;
02052             j2 = i__ + k + 1 - max(i__4,i__3) * ka1;
02053             nr = (j2 + *ka - 1) / ka1;
02054             j1 = j2 - (nr - 1) * ka1;
02055             if (nr > 0) {
02056 
02057 /*              generate rotations in 2nd set to annihilate elements */
02058 /*              which have been created outside the band */
02059 
02060                 zlargv_(&nr, &ab[ka1 + j1 * ab_dim1], &inca, &work[m - *kb + 
02061                         j1], &ka1, &rwork[m - *kb + j1], &ka1);
02062 
02063 /*              apply rotations in 2nd set from the right */
02064 
02065                 i__4 = *ka - 1;
02066                 for (l = 1; l <= i__4; ++l) {
02067                     zlartv_(&nr, &ab[l + 1 + j1 * ab_dim1], &inca, &ab[l + 2 
02068                             + (j1 - 1) * ab_dim1], &inca, &rwork[m - *kb + j1]
02069 , &work[m - *kb + j1], &ka1);
02070 /* L890: */
02071                 }
02072 
02073 /*              apply rotations in 2nd set from both sides to diagonal */
02074 /*              blocks */
02075 
02076                 zlar2v_(&nr, &ab[j1 * ab_dim1 + 1], &ab[(j1 - 1) * ab_dim1 + 
02077                         1], &ab[(j1 - 1) * ab_dim1 + 2], &inca, &rwork[m - *
02078                         kb + j1], &work[m - *kb + j1], &ka1);
02079 
02080                 zlacgv_(&nr, &work[m - *kb + j1], &ka1);
02081             }
02082 
02083 /*           start applying rotations in 2nd set from the left */
02084 
02085             i__4 = *kb - k + 1;
02086             for (l = *ka - 1; l >= i__4; --l) {
02087                 nrt = (j2 + l - 1) / ka1;
02088                 j1t = j2 - (nrt - 1) * ka1;
02089                 if (nrt > 0) {
02090                     zlartv_(&nrt, &ab[ka1 - l + 1 + (j1t - ka1 + l) * ab_dim1]
02091 , &inca, &ab[ka1 - l + (j1t - ka1 + l) * ab_dim1], 
02092                              &inca, &rwork[m - *kb + j1t], &work[m - *kb + 
02093                             j1t], &ka1);
02094                 }
02095 /* L900: */
02096             }
02097 
02098             if (wantx) {
02099 
02100 /*              post-multiply X by product of rotations in 2nd set */
02101 
02102                 i__4 = j2;
02103                 i__3 = ka1;
02104                 for (j = j1; i__3 < 0 ? j >= i__4 : j <= i__4; j += i__3) {
02105                     d_cnjg(&z__1, &work[m - *kb + j]);
02106                     zrot_(&nx, &x[j * x_dim1 + 1], &c__1, &x[(j - 1) * x_dim1 
02107                             + 1], &c__1, &rwork[m - *kb + j], &z__1);
02108 /* L910: */
02109                 }
02110             }
02111 /* L920: */
02112         }
02113 
02114         i__3 = *kb - 1;
02115         for (k = 1; k <= i__3; ++k) {
02116 /* Computing MAX */
02117             i__4 = 1, i__1 = k + i0 - m + 1;
02118             j2 = i__ + k + 1 - max(i__4,i__1) * ka1;
02119 
02120 /*           finish applying rotations in 1st set from the left */
02121 
02122             for (l = *kb - k; l >= 1; --l) {
02123                 nrt = (j2 + l - 1) / ka1;
02124                 j1t = j2 - (nrt - 1) * ka1;
02125                 if (nrt > 0) {
02126                     zlartv_(&nrt, &ab[ka1 - l + 1 + (j1t - ka1 + l) * ab_dim1]
02127 , &inca, &ab[ka1 - l + (j1t - ka1 + l) * ab_dim1], 
02128                              &inca, &rwork[j1t], &work[j1t], &ka1);
02129                 }
02130 /* L930: */
02131             }
02132 /* L940: */
02133         }
02134 
02135         if (*kb > 1) {
02136             i__3 = i2 - *ka;
02137             for (j = 2; j <= i__3; ++j) {
02138                 rwork[j] = rwork[j + *ka];
02139                 i__4 = j;
02140                 i__1 = j + *ka;
02141                 work[i__4].r = work[i__1].r, work[i__4].i = work[i__1].i;
02142 /* L950: */
02143             }
02144         }
02145 
02146     }
02147 
02148     goto L490;
02149 
02150 /*     End of ZHBGST */
02151 
02152 } /* zhbgst_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:36