zgbbrd.c
Go to the documentation of this file.
00001 /* zgbbrd.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 zgbbrd_(char *vect, integer *m, integer *n, integer *ncc, 
00023          integer *kl, integer *ku, doublecomplex *ab, integer *ldab, 
00024         doublereal *d__, doublereal *e, doublecomplex *q, integer *ldq, 
00025         doublecomplex *pt, integer *ldpt, doublecomplex *c__, integer *ldc, 
00026         doublecomplex *work, doublereal *rwork, integer *info)
00027 {
00028     /* System generated locals */
00029     integer ab_dim1, ab_offset, c_dim1, c_offset, pt_dim1, pt_offset, q_dim1, 
00030             q_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7;
00031     doublecomplex z__1, z__2, z__3;
00032 
00033     /* Builtin functions */
00034     void d_cnjg(doublecomplex *, doublecomplex *);
00035     double z_abs(doublecomplex *);
00036 
00037     /* Local variables */
00038     integer i__, j, l;
00039     doublecomplex t;
00040     integer j1, j2, kb;
00041     doublecomplex ra, rb;
00042     doublereal rc;
00043     integer kk, ml, nr, mu;
00044     doublecomplex rs;
00045     integer kb1, ml0, mu0, klm, kun, nrt, klu1, inca;
00046     doublereal abst;
00047     extern /* Subroutine */ int zrot_(integer *, doublecomplex *, integer *, 
00048             doublecomplex *, integer *, doublereal *, doublecomplex *);
00049     extern logical lsame_(char *, char *);
00050     logical wantb, wantc;
00051     extern /* Subroutine */ int zscal_(integer *, doublecomplex *, 
00052             doublecomplex *, integer *);
00053     integer minmn;
00054     logical wantq;
00055     extern /* Subroutine */ int xerbla_(char *, integer *), zlaset_(
00056             char *, integer *, integer *, doublecomplex *, doublecomplex *, 
00057             doublecomplex *, integer *), zlartg_(doublecomplex *, 
00058             doublecomplex *, doublereal *, doublecomplex *, doublecomplex *), 
00059             zlargv_(integer *, doublecomplex *, integer *, doublecomplex *, 
00060             integer *, doublereal *, integer *);
00061     logical wantpt;
00062     extern /* Subroutine */ int zlartv_(integer *, doublecomplex *, integer *, 
00063              doublecomplex *, integer *, doublereal *, doublecomplex *, 
00064             integer *);
00065 
00066 
00067 /*  -- LAPACK routine (version 3.2) -- */
00068 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00069 /*     November 2006 */
00070 
00071 /*     .. Scalar Arguments .. */
00072 /*     .. */
00073 /*     .. Array Arguments .. */
00074 /*     .. */
00075 
00076 /*  Purpose */
00077 /*  ======= */
00078 
00079 /*  ZGBBRD reduces a complex general m-by-n band matrix A to real upper */
00080 /*  bidiagonal form B by a unitary transformation: Q' * A * P = B. */
00081 
00082 /*  The routine computes B, and optionally forms Q or P', or computes */
00083 /*  Q'*C for a given matrix C. */
00084 
00085 /*  Arguments */
00086 /*  ========= */
00087 
00088 /*  VECT    (input) CHARACTER*1 */
00089 /*          Specifies whether or not the matrices Q and P' are to be */
00090 /*          formed. */
00091 /*          = 'N': do not form Q or P'; */
00092 /*          = 'Q': form Q only; */
00093 /*          = 'P': form P' only; */
00094 /*          = 'B': form both. */
00095 
00096 /*  M       (input) INTEGER */
00097 /*          The number of rows of the matrix A.  M >= 0. */
00098 
00099 /*  N       (input) INTEGER */
00100 /*          The number of columns of the matrix A.  N >= 0. */
00101 
00102 /*  NCC     (input) INTEGER */
00103 /*          The number of columns of the matrix C.  NCC >= 0. */
00104 
00105 /*  KL      (input) INTEGER */
00106 /*          The number of subdiagonals of the matrix A. KL >= 0. */
00107 
00108 /*  KU      (input) INTEGER */
00109 /*          The number of superdiagonals of the matrix A. KU >= 0. */
00110 
00111 /*  AB      (input/output) COMPLEX*16 array, dimension (LDAB,N) */
00112 /*          On entry, the m-by-n band matrix A, stored in rows 1 to */
00113 /*          KL+KU+1. The j-th column of A is stored in the j-th column of */
00114 /*          the array AB as follows: */
00115 /*          AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl). */
00116 /*          On exit, A is overwritten by values generated during the */
00117 /*          reduction. */
00118 
00119 /*  LDAB    (input) INTEGER */
00120 /*          The leading dimension of the array A. LDAB >= KL+KU+1. */
00121 
00122 /*  D       (output) DOUBLE PRECISION array, dimension (min(M,N)) */
00123 /*          The diagonal elements of the bidiagonal matrix B. */
00124 
00125 /*  E       (output) DOUBLE PRECISION array, dimension (min(M,N)-1) */
00126 /*          The superdiagonal elements of the bidiagonal matrix B. */
00127 
00128 /*  Q       (output) COMPLEX*16 array, dimension (LDQ,M) */
00129 /*          If VECT = 'Q' or 'B', the m-by-m unitary matrix Q. */
00130 /*          If VECT = 'N' or 'P', the array Q is not referenced. */
00131 
00132 /*  LDQ     (input) INTEGER */
00133 /*          The leading dimension of the array Q. */
00134 /*          LDQ >= max(1,M) if VECT = 'Q' or 'B'; LDQ >= 1 otherwise. */
00135 
00136 /*  PT      (output) COMPLEX*16 array, dimension (LDPT,N) */
00137 /*          If VECT = 'P' or 'B', the n-by-n unitary matrix P'. */
00138 /*          If VECT = 'N' or 'Q', the array PT is not referenced. */
00139 
00140 /*  LDPT    (input) INTEGER */
00141 /*          The leading dimension of the array PT. */
00142 /*          LDPT >= max(1,N) if VECT = 'P' or 'B'; LDPT >= 1 otherwise. */
00143 
00144 /*  C       (input/output) COMPLEX*16 array, dimension (LDC,NCC) */
00145 /*          On entry, an m-by-ncc matrix C. */
00146 /*          On exit, C is overwritten by Q'*C. */
00147 /*          C is not referenced if NCC = 0. */
00148 
00149 /*  LDC     (input) INTEGER */
00150 /*          The leading dimension of the array C. */
00151 /*          LDC >= max(1,M) if NCC > 0; LDC >= 1 if NCC = 0. */
00152 
00153 /*  WORK    (workspace) COMPLEX*16 array, dimension (max(M,N)) */
00154 
00155 /*  RWORK   (workspace) DOUBLE PRECISION array, dimension (max(M,N)) */
00156 
00157 /*  INFO    (output) INTEGER */
00158 /*          = 0:  successful exit. */
00159 /*          < 0:  if INFO = -i, the i-th argument had an illegal value. */
00160 
00161 /*  ===================================================================== */
00162 
00163 /*     .. Parameters .. */
00164 /*     .. */
00165 /*     .. Local Scalars .. */
00166 /*     .. */
00167 /*     .. External Subroutines .. */
00168 /*     .. */
00169 /*     .. Intrinsic Functions .. */
00170 /*     .. */
00171 /*     .. External Functions .. */
00172 /*     .. */
00173 /*     .. Executable Statements .. */
00174 
00175 /*     Test the input parameters */
00176 
00177     /* Parameter adjustments */
00178     ab_dim1 = *ldab;
00179     ab_offset = 1 + ab_dim1;
00180     ab -= ab_offset;
00181     --d__;
00182     --e;
00183     q_dim1 = *ldq;
00184     q_offset = 1 + q_dim1;
00185     q -= q_offset;
00186     pt_dim1 = *ldpt;
00187     pt_offset = 1 + pt_dim1;
00188     pt -= pt_offset;
00189     c_dim1 = *ldc;
00190     c_offset = 1 + c_dim1;
00191     c__ -= c_offset;
00192     --work;
00193     --rwork;
00194 
00195     /* Function Body */
00196     wantb = lsame_(vect, "B");
00197     wantq = lsame_(vect, "Q") || wantb;
00198     wantpt = lsame_(vect, "P") || wantb;
00199     wantc = *ncc > 0;
00200     klu1 = *kl + *ku + 1;
00201     *info = 0;
00202     if (! wantq && ! wantpt && ! lsame_(vect, "N")) {
00203         *info = -1;
00204     } else if (*m < 0) {
00205         *info = -2;
00206     } else if (*n < 0) {
00207         *info = -3;
00208     } else if (*ncc < 0) {
00209         *info = -4;
00210     } else if (*kl < 0) {
00211         *info = -5;
00212     } else if (*ku < 0) {
00213         *info = -6;
00214     } else if (*ldab < klu1) {
00215         *info = -8;
00216     } else if (*ldq < 1 || wantq && *ldq < max(1,*m)) {
00217         *info = -12;
00218     } else if (*ldpt < 1 || wantpt && *ldpt < max(1,*n)) {
00219         *info = -14;
00220     } else if (*ldc < 1 || wantc && *ldc < max(1,*m)) {
00221         *info = -16;
00222     }
00223     if (*info != 0) {
00224         i__1 = -(*info);
00225         xerbla_("ZGBBRD", &i__1);
00226         return 0;
00227     }
00228 
00229 /*     Initialize Q and P' to the unit matrix, if needed */
00230 
00231     if (wantq) {
00232         zlaset_("Full", m, m, &c_b1, &c_b2, &q[q_offset], ldq);
00233     }
00234     if (wantpt) {
00235         zlaset_("Full", n, n, &c_b1, &c_b2, &pt[pt_offset], ldpt);
00236     }
00237 
00238 /*     Quick return if possible. */
00239 
00240     if (*m == 0 || *n == 0) {
00241         return 0;
00242     }
00243 
00244     minmn = min(*m,*n);
00245 
00246     if (*kl + *ku > 1) {
00247 
00248 /*        Reduce to upper bidiagonal form if KU > 0; if KU = 0, reduce */
00249 /*        first to lower bidiagonal form and then transform to upper */
00250 /*        bidiagonal */
00251 
00252         if (*ku > 0) {
00253             ml0 = 1;
00254             mu0 = 2;
00255         } else {
00256             ml0 = 2;
00257             mu0 = 1;
00258         }
00259 
00260 /*        Wherever possible, plane rotations are generated and applied in */
00261 /*        vector operations of length NR over the index set J1:J2:KLU1. */
00262 
00263 /*        The complex sines of the plane rotations are stored in WORK, */
00264 /*        and the real cosines in RWORK. */
00265 
00266 /* Computing MIN */
00267         i__1 = *m - 1;
00268         klm = min(i__1,*kl);
00269 /* Computing MIN */
00270         i__1 = *n - 1;
00271         kun = min(i__1,*ku);
00272         kb = klm + kun;
00273         kb1 = kb + 1;
00274         inca = kb1 * *ldab;
00275         nr = 0;
00276         j1 = klm + 2;
00277         j2 = 1 - kun;
00278 
00279         i__1 = minmn;
00280         for (i__ = 1; i__ <= i__1; ++i__) {
00281 
00282 /*           Reduce i-th column and i-th row of matrix to bidiagonal form */
00283 
00284             ml = klm + 1;
00285             mu = kun + 1;
00286             i__2 = kb;
00287             for (kk = 1; kk <= i__2; ++kk) {
00288                 j1 += kb;
00289                 j2 += kb;
00290 
00291 /*              generate plane rotations to annihilate nonzero elements */
00292 /*              which have been created below the band */
00293 
00294                 if (nr > 0) {
00295                     zlargv_(&nr, &ab[klu1 + (j1 - klm - 1) * ab_dim1], &inca, 
00296                             &work[j1], &kb1, &rwork[j1], &kb1);
00297                 }
00298 
00299 /*              apply plane rotations from the left */
00300 
00301                 i__3 = kb;
00302                 for (l = 1; l <= i__3; ++l) {
00303                     if (j2 - klm + l - 1 > *n) {
00304                         nrt = nr - 1;
00305                     } else {
00306                         nrt = nr;
00307                     }
00308                     if (nrt > 0) {
00309                         zlartv_(&nrt, &ab[klu1 - l + (j1 - klm + l - 1) * 
00310                                 ab_dim1], &inca, &ab[klu1 - l + 1 + (j1 - klm 
00311                                 + l - 1) * ab_dim1], &inca, &rwork[j1], &work[
00312                                 j1], &kb1);
00313                     }
00314 /* L10: */
00315                 }
00316 
00317                 if (ml > ml0) {
00318                     if (ml <= *m - i__ + 1) {
00319 
00320 /*                    generate plane rotation to annihilate a(i+ml-1,i) */
00321 /*                    within the band, and apply rotation from the left */
00322 
00323                         zlartg_(&ab[*ku + ml - 1 + i__ * ab_dim1], &ab[*ku + 
00324                                 ml + i__ * ab_dim1], &rwork[i__ + ml - 1], &
00325                                 work[i__ + ml - 1], &ra);
00326                         i__3 = *ku + ml - 1 + i__ * ab_dim1;
00327                         ab[i__3].r = ra.r, ab[i__3].i = ra.i;
00328                         if (i__ < *n) {
00329 /* Computing MIN */
00330                             i__4 = *ku + ml - 2, i__5 = *n - i__;
00331                             i__3 = min(i__4,i__5);
00332                             i__6 = *ldab - 1;
00333                             i__7 = *ldab - 1;
00334                             zrot_(&i__3, &ab[*ku + ml - 2 + (i__ + 1) * 
00335                                     ab_dim1], &i__6, &ab[*ku + ml - 1 + (i__ 
00336                                     + 1) * ab_dim1], &i__7, &rwork[i__ + ml - 
00337                                     1], &work[i__ + ml - 1]);
00338                         }
00339                     }
00340                     ++nr;
00341                     j1 -= kb1;
00342                 }
00343 
00344                 if (wantq) {
00345 
00346 /*                 accumulate product of plane rotations in Q */
00347 
00348                     i__3 = j2;
00349                     i__4 = kb1;
00350                     for (j = j1; i__4 < 0 ? j >= i__3 : j <= i__3; j += i__4) 
00351                             {
00352                         d_cnjg(&z__1, &work[j]);
00353                         zrot_(m, &q[(j - 1) * q_dim1 + 1], &c__1, &q[j * 
00354                                 q_dim1 + 1], &c__1, &rwork[j], &z__1);
00355 /* L20: */
00356                     }
00357                 }
00358 
00359                 if (wantc) {
00360 
00361 /*                 apply plane rotations to C */
00362 
00363                     i__4 = j2;
00364                     i__3 = kb1;
00365                     for (j = j1; i__3 < 0 ? j >= i__4 : j <= i__4; j += i__3) 
00366                             {
00367                         zrot_(ncc, &c__[j - 1 + c_dim1], ldc, &c__[j + c_dim1]
00368 , ldc, &rwork[j], &work[j]);
00369 /* L30: */
00370                     }
00371                 }
00372 
00373                 if (j2 + kun > *n) {
00374 
00375 /*                 adjust J2 to keep within the bounds of the matrix */
00376 
00377                     --nr;
00378                     j2 -= kb1;
00379                 }
00380 
00381                 i__3 = j2;
00382                 i__4 = kb1;
00383                 for (j = j1; i__4 < 0 ? j >= i__3 : j <= i__3; j += i__4) {
00384 
00385 /*                 create nonzero element a(j-1,j+ku) above the band */
00386 /*                 and store it in WORK(n+1:2*n) */
00387 
00388                     i__5 = j + kun;
00389                     i__6 = j;
00390                     i__7 = (j + kun) * ab_dim1 + 1;
00391                     z__1.r = work[i__6].r * ab[i__7].r - work[i__6].i * ab[
00392                             i__7].i, z__1.i = work[i__6].r * ab[i__7].i + 
00393                             work[i__6].i * ab[i__7].r;
00394                     work[i__5].r = z__1.r, work[i__5].i = z__1.i;
00395                     i__5 = (j + kun) * ab_dim1 + 1;
00396                     i__6 = j;
00397                     i__7 = (j + kun) * ab_dim1 + 1;
00398                     z__1.r = rwork[i__6] * ab[i__7].r, z__1.i = rwork[i__6] * 
00399                             ab[i__7].i;
00400                     ab[i__5].r = z__1.r, ab[i__5].i = z__1.i;
00401 /* L40: */
00402                 }
00403 
00404 /*              generate plane rotations to annihilate nonzero elements */
00405 /*              which have been generated above the band */
00406 
00407                 if (nr > 0) {
00408                     zlargv_(&nr, &ab[(j1 + kun - 1) * ab_dim1 + 1], &inca, &
00409                             work[j1 + kun], &kb1, &rwork[j1 + kun], &kb1);
00410                 }
00411 
00412 /*              apply plane rotations from the right */
00413 
00414                 i__4 = kb;
00415                 for (l = 1; l <= i__4; ++l) {
00416                     if (j2 + l - 1 > *m) {
00417                         nrt = nr - 1;
00418                     } else {
00419                         nrt = nr;
00420                     }
00421                     if (nrt > 0) {
00422                         zlartv_(&nrt, &ab[l + 1 + (j1 + kun - 1) * ab_dim1], &
00423                                 inca, &ab[l + (j1 + kun) * ab_dim1], &inca, &
00424                                 rwork[j1 + kun], &work[j1 + kun], &kb1);
00425                     }
00426 /* L50: */
00427                 }
00428 
00429                 if (ml == ml0 && mu > mu0) {
00430                     if (mu <= *n - i__ + 1) {
00431 
00432 /*                    generate plane rotation to annihilate a(i,i+mu-1) */
00433 /*                    within the band, and apply rotation from the right */
00434 
00435                         zlartg_(&ab[*ku - mu + 3 + (i__ + mu - 2) * ab_dim1], 
00436                                 &ab[*ku - mu + 2 + (i__ + mu - 1) * ab_dim1], 
00437                                 &rwork[i__ + mu - 1], &work[i__ + mu - 1], &
00438                                 ra);
00439                         i__4 = *ku - mu + 3 + (i__ + mu - 2) * ab_dim1;
00440                         ab[i__4].r = ra.r, ab[i__4].i = ra.i;
00441 /* Computing MIN */
00442                         i__3 = *kl + mu - 2, i__5 = *m - i__;
00443                         i__4 = min(i__3,i__5);
00444                         zrot_(&i__4, &ab[*ku - mu + 4 + (i__ + mu - 2) * 
00445                                 ab_dim1], &c__1, &ab[*ku - mu + 3 + (i__ + mu 
00446                                 - 1) * ab_dim1], &c__1, &rwork[i__ + mu - 1], 
00447                                 &work[i__ + mu - 1]);
00448                     }
00449                     ++nr;
00450                     j1 -= kb1;
00451                 }
00452 
00453                 if (wantpt) {
00454 
00455 /*                 accumulate product of plane rotations in P' */
00456 
00457                     i__4 = j2;
00458                     i__3 = kb1;
00459                     for (j = j1; i__3 < 0 ? j >= i__4 : j <= i__4; j += i__3) 
00460                             {
00461                         d_cnjg(&z__1, &work[j + kun]);
00462                         zrot_(n, &pt[j + kun - 1 + pt_dim1], ldpt, &pt[j + 
00463                                 kun + pt_dim1], ldpt, &rwork[j + kun], &z__1);
00464 /* L60: */
00465                     }
00466                 }
00467 
00468                 if (j2 + kb > *m) {
00469 
00470 /*                 adjust J2 to keep within the bounds of the matrix */
00471 
00472                     --nr;
00473                     j2 -= kb1;
00474                 }
00475 
00476                 i__3 = j2;
00477                 i__4 = kb1;
00478                 for (j = j1; i__4 < 0 ? j >= i__3 : j <= i__3; j += i__4) {
00479 
00480 /*                 create nonzero element a(j+kl+ku,j+ku-1) below the */
00481 /*                 band and store it in WORK(1:n) */
00482 
00483                     i__5 = j + kb;
00484                     i__6 = j + kun;
00485                     i__7 = klu1 + (j + kun) * ab_dim1;
00486                     z__1.r = work[i__6].r * ab[i__7].r - work[i__6].i * ab[
00487                             i__7].i, z__1.i = work[i__6].r * ab[i__7].i + 
00488                             work[i__6].i * ab[i__7].r;
00489                     work[i__5].r = z__1.r, work[i__5].i = z__1.i;
00490                     i__5 = klu1 + (j + kun) * ab_dim1;
00491                     i__6 = j + kun;
00492                     i__7 = klu1 + (j + kun) * ab_dim1;
00493                     z__1.r = rwork[i__6] * ab[i__7].r, z__1.i = rwork[i__6] * 
00494                             ab[i__7].i;
00495                     ab[i__5].r = z__1.r, ab[i__5].i = z__1.i;
00496 /* L70: */
00497                 }
00498 
00499                 if (ml > ml0) {
00500                     --ml;
00501                 } else {
00502                     --mu;
00503                 }
00504 /* L80: */
00505             }
00506 /* L90: */
00507         }
00508     }
00509 
00510     if (*ku == 0 && *kl > 0) {
00511 
00512 /*        A has been reduced to complex lower bidiagonal form */
00513 
00514 /*        Transform lower bidiagonal form to upper bidiagonal by applying */
00515 /*        plane rotations from the left, overwriting superdiagonal */
00516 /*        elements on subdiagonal elements */
00517 
00518 /* Computing MIN */
00519         i__2 = *m - 1;
00520         i__1 = min(i__2,*n);
00521         for (i__ = 1; i__ <= i__1; ++i__) {
00522             zlartg_(&ab[i__ * ab_dim1 + 1], &ab[i__ * ab_dim1 + 2], &rc, &rs, 
00523                     &ra);
00524             i__2 = i__ * ab_dim1 + 1;
00525             ab[i__2].r = ra.r, ab[i__2].i = ra.i;
00526             if (i__ < *n) {
00527                 i__2 = i__ * ab_dim1 + 2;
00528                 i__4 = (i__ + 1) * ab_dim1 + 1;
00529                 z__1.r = rs.r * ab[i__4].r - rs.i * ab[i__4].i, z__1.i = rs.r 
00530                         * ab[i__4].i + rs.i * ab[i__4].r;
00531                 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00532                 i__2 = (i__ + 1) * ab_dim1 + 1;
00533                 i__4 = (i__ + 1) * ab_dim1 + 1;
00534                 z__1.r = rc * ab[i__4].r, z__1.i = rc * ab[i__4].i;
00535                 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00536             }
00537             if (wantq) {
00538                 d_cnjg(&z__1, &rs);
00539                 zrot_(m, &q[i__ * q_dim1 + 1], &c__1, &q[(i__ + 1) * q_dim1 + 
00540                         1], &c__1, &rc, &z__1);
00541             }
00542             if (wantc) {
00543                 zrot_(ncc, &c__[i__ + c_dim1], ldc, &c__[i__ + 1 + c_dim1], 
00544                         ldc, &rc, &rs);
00545             }
00546 /* L100: */
00547         }
00548     } else {
00549 
00550 /*        A has been reduced to complex upper bidiagonal form or is */
00551 /*        diagonal */
00552 
00553         if (*ku > 0 && *m < *n) {
00554 
00555 /*           Annihilate a(m,m+1) by applying plane rotations from the */
00556 /*           right */
00557 
00558             i__1 = *ku + (*m + 1) * ab_dim1;
00559             rb.r = ab[i__1].r, rb.i = ab[i__1].i;
00560             for (i__ = *m; i__ >= 1; --i__) {
00561                 zlartg_(&ab[*ku + 1 + i__ * ab_dim1], &rb, &rc, &rs, &ra);
00562                 i__1 = *ku + 1 + i__ * ab_dim1;
00563                 ab[i__1].r = ra.r, ab[i__1].i = ra.i;
00564                 if (i__ > 1) {
00565                     d_cnjg(&z__3, &rs);
00566                     z__2.r = -z__3.r, z__2.i = -z__3.i;
00567                     i__1 = *ku + i__ * ab_dim1;
00568                     z__1.r = z__2.r * ab[i__1].r - z__2.i * ab[i__1].i, 
00569                             z__1.i = z__2.r * ab[i__1].i + z__2.i * ab[i__1]
00570                             .r;
00571                     rb.r = z__1.r, rb.i = z__1.i;
00572                     i__1 = *ku + i__ * ab_dim1;
00573                     i__2 = *ku + i__ * ab_dim1;
00574                     z__1.r = rc * ab[i__2].r, z__1.i = rc * ab[i__2].i;
00575                     ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00576                 }
00577                 if (wantpt) {
00578                     d_cnjg(&z__1, &rs);
00579                     zrot_(n, &pt[i__ + pt_dim1], ldpt, &pt[*m + 1 + pt_dim1], 
00580                             ldpt, &rc, &z__1);
00581                 }
00582 /* L110: */
00583             }
00584         }
00585     }
00586 
00587 /*     Make diagonal and superdiagonal elements real, storing them in D */
00588 /*     and E */
00589 
00590     i__1 = *ku + 1 + ab_dim1;
00591     t.r = ab[i__1].r, t.i = ab[i__1].i;
00592     i__1 = minmn;
00593     for (i__ = 1; i__ <= i__1; ++i__) {
00594         abst = z_abs(&t);
00595         d__[i__] = abst;
00596         if (abst != 0.) {
00597             z__1.r = t.r / abst, z__1.i = t.i / abst;
00598             t.r = z__1.r, t.i = z__1.i;
00599         } else {
00600             t.r = 1., t.i = 0.;
00601         }
00602         if (wantq) {
00603             zscal_(m, &t, &q[i__ * q_dim1 + 1], &c__1);
00604         }
00605         if (wantc) {
00606             d_cnjg(&z__1, &t);
00607             zscal_(ncc, &z__1, &c__[i__ + c_dim1], ldc);
00608         }
00609         if (i__ < minmn) {
00610             if (*ku == 0 && *kl == 0) {
00611                 e[i__] = 0.;
00612                 i__2 = (i__ + 1) * ab_dim1 + 1;
00613                 t.r = ab[i__2].r, t.i = ab[i__2].i;
00614             } else {
00615                 if (*ku == 0) {
00616                     i__2 = i__ * ab_dim1 + 2;
00617                     d_cnjg(&z__2, &t);
00618                     z__1.r = ab[i__2].r * z__2.r - ab[i__2].i * z__2.i, 
00619                             z__1.i = ab[i__2].r * z__2.i + ab[i__2].i * 
00620                             z__2.r;
00621                     t.r = z__1.r, t.i = z__1.i;
00622                 } else {
00623                     i__2 = *ku + (i__ + 1) * ab_dim1;
00624                     d_cnjg(&z__2, &t);
00625                     z__1.r = ab[i__2].r * z__2.r - ab[i__2].i * z__2.i, 
00626                             z__1.i = ab[i__2].r * z__2.i + ab[i__2].i * 
00627                             z__2.r;
00628                     t.r = z__1.r, t.i = z__1.i;
00629                 }
00630                 abst = z_abs(&t);
00631                 e[i__] = abst;
00632                 if (abst != 0.) {
00633                     z__1.r = t.r / abst, z__1.i = t.i / abst;
00634                     t.r = z__1.r, t.i = z__1.i;
00635                 } else {
00636                     t.r = 1., t.i = 0.;
00637                 }
00638                 if (wantpt) {
00639                     zscal_(n, &t, &pt[i__ + 1 + pt_dim1], ldpt);
00640                 }
00641                 i__2 = *ku + 1 + (i__ + 1) * ab_dim1;
00642                 d_cnjg(&z__2, &t);
00643                 z__1.r = ab[i__2].r * z__2.r - ab[i__2].i * z__2.i, z__1.i = 
00644                         ab[i__2].r * z__2.i + ab[i__2].i * z__2.r;
00645                 t.r = z__1.r, t.i = z__1.i;
00646             }
00647         }
00648 /* L120: */
00649     }
00650     return 0;
00651 
00652 /*     End of ZGBBRD */
00653 
00654 } /* zgbbrd_ */


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