00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
00017
00018 static doublecomplex c_b1 = {0.,0.};
00019 static doublecomplex c_b2 = {1.,0.};
00020 static integer c__1 = 1;
00021
00022 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
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
00034 void d_cnjg(doublecomplex *, doublecomplex *);
00035 double z_abs(doublecomplex *);
00036
00037
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 int zrot_(integer *, doublecomplex *, integer *,
00048 doublecomplex *, integer *, doublereal *, doublecomplex *);
00049 extern logical lsame_(char *, char *);
00050 logical wantb, wantc;
00051 extern int zscal_(integer *, doublecomplex *,
00052 doublecomplex *, integer *);
00053 integer minmn;
00054 logical wantq;
00055 extern 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 int zlartv_(integer *, doublecomplex *, integer *,
00063 doublecomplex *, integer *, doublereal *, doublecomplex *,
00064 integer *);
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
00157
00158
00159
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178 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
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
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
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
00249
00250
00251
00252 if (*ku > 0) {
00253 ml0 = 1;
00254 mu0 = 2;
00255 } else {
00256 ml0 = 2;
00257 mu0 = 1;
00258 }
00259
00260
00261
00262
00263
00264
00265
00266
00267 i__1 = *m - 1;
00268 klm = min(i__1,*kl);
00269
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
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
00292
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
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
00315 }
00316
00317 if (ml > ml0) {
00318 if (ml <= *m - i__ + 1) {
00319
00320
00321
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
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
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
00356 }
00357 }
00358
00359 if (wantc) {
00360
00361
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
00370 }
00371 }
00372
00373 if (j2 + kun > *n) {
00374
00375
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
00386
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
00402 }
00403
00404
00405
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
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
00427 }
00428
00429 if (ml == ml0 && mu > mu0) {
00430 if (mu <= *n - i__ + 1) {
00431
00432
00433
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
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
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
00465 }
00466 }
00467
00468 if (j2 + kb > *m) {
00469
00470
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
00481
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
00497 }
00498
00499 if (ml > ml0) {
00500 --ml;
00501 } else {
00502 --mu;
00503 }
00504
00505 }
00506
00507 }
00508 }
00509
00510 if (*ku == 0 && *kl > 0) {
00511
00512
00513
00514
00515
00516
00517
00518
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
00547 }
00548 } else {
00549
00550
00551
00552
00553 if (*ku > 0 && *m < *n) {
00554
00555
00556
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
00583 }
00584 }
00585 }
00586
00587
00588
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
00649 }
00650 return 0;
00651
00652
00653
00654 }