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 doublereal c_b15 = -.125;
00019 static integer c__1 = 1;
00020 static doublereal c_b49 = 1.;
00021 static doublereal c_b72 = -1.;
00022
00023 int dbdsqr_(char *uplo, integer *n, integer *ncvt, integer *
00024 nru, integer *ncc, doublereal *d__, doublereal *e, doublereal *vt,
00025 integer *ldvt, doublereal *u, integer *ldu, doublereal *c__, integer *
00026 ldc, doublereal *work, integer *info)
00027 {
00028
00029 integer c_dim1, c_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1,
00030 i__2;
00031 doublereal d__1, d__2, d__3, d__4;
00032
00033
00034 double pow_dd(doublereal *, doublereal *), sqrt(doublereal), d_sign(
00035 doublereal *, doublereal *);
00036
00037
00038 doublereal f, g, h__;
00039 integer i__, j, m;
00040 doublereal r__, cs;
00041 integer ll;
00042 doublereal sn, mu;
00043 integer nm1, nm12, nm13, lll;
00044 doublereal eps, sll, tol, abse;
00045 integer idir;
00046 doublereal abss;
00047 integer oldm;
00048 doublereal cosl;
00049 integer isub, iter;
00050 doublereal unfl, sinl, cosr, smin, smax, sinr;
00051 extern int drot_(integer *, doublereal *, integer *,
00052 doublereal *, integer *, doublereal *, doublereal *), dlas2_(
00053 doublereal *, doublereal *, doublereal *, doublereal *,
00054 doublereal *), dscal_(integer *, doublereal *, doublereal *,
00055 integer *);
00056 extern logical lsame_(char *, char *);
00057 doublereal oldcs;
00058 extern int dlasr_(char *, char *, char *, integer *,
00059 integer *, doublereal *, doublereal *, doublereal *, integer *);
00060 integer oldll;
00061 doublereal shift, sigmn, oldsn;
00062 extern int dswap_(integer *, doublereal *, integer *,
00063 doublereal *, integer *);
00064 integer maxit;
00065 doublereal sminl, sigmx;
00066 logical lower;
00067 extern int dlasq1_(integer *, doublereal *, doublereal *,
00068 doublereal *, integer *), dlasv2_(doublereal *, doublereal *,
00069 doublereal *, doublereal *, doublereal *, doublereal *,
00070 doublereal *, doublereal *, doublereal *);
00071 extern doublereal dlamch_(char *);
00072 extern int dlartg_(doublereal *, doublereal *,
00073 doublereal *, doublereal *, doublereal *), xerbla_(char *,
00074 integer *);
00075 doublereal sminoa, thresh;
00076 logical rotate;
00077 doublereal tolmul;
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
00179
00180
00181
00182
00183
00184
00185
00186
00187
00188
00189
00190
00191
00192
00193
00194
00195
00196
00197
00198
00199
00200
00201
00202
00203
00204
00205
00206
00207
00208
00209
00210
00211
00212
00213
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236
00237
00238
00239 --d__;
00240 --e;
00241 vt_dim1 = *ldvt;
00242 vt_offset = 1 + vt_dim1;
00243 vt -= vt_offset;
00244 u_dim1 = *ldu;
00245 u_offset = 1 + u_dim1;
00246 u -= u_offset;
00247 c_dim1 = *ldc;
00248 c_offset = 1 + c_dim1;
00249 c__ -= c_offset;
00250 --work;
00251
00252
00253 *info = 0;
00254 lower = lsame_(uplo, "L");
00255 if (! lsame_(uplo, "U") && ! lower) {
00256 *info = -1;
00257 } else if (*n < 0) {
00258 *info = -2;
00259 } else if (*ncvt < 0) {
00260 *info = -3;
00261 } else if (*nru < 0) {
00262 *info = -4;
00263 } else if (*ncc < 0) {
00264 *info = -5;
00265 } else if (*ncvt == 0 && *ldvt < 1 || *ncvt > 0 && *ldvt < max(1,*n)) {
00266 *info = -9;
00267 } else if (*ldu < max(1,*nru)) {
00268 *info = -11;
00269 } else if (*ncc == 0 && *ldc < 1 || *ncc > 0 && *ldc < max(1,*n)) {
00270 *info = -13;
00271 }
00272 if (*info != 0) {
00273 i__1 = -(*info);
00274 xerbla_("DBDSQR", &i__1);
00275 return 0;
00276 }
00277 if (*n == 0) {
00278 return 0;
00279 }
00280 if (*n == 1) {
00281 goto L160;
00282 }
00283
00284
00285
00286 rotate = *ncvt > 0 || *nru > 0 || *ncc > 0;
00287
00288
00289
00290 if (! rotate) {
00291 dlasq1_(n, &d__[1], &e[1], &work[1], info);
00292 return 0;
00293 }
00294
00295 nm1 = *n - 1;
00296 nm12 = nm1 + nm1;
00297 nm13 = nm12 + nm1;
00298 idir = 0;
00299
00300
00301
00302 eps = dlamch_("Epsilon");
00303 unfl = dlamch_("Safe minimum");
00304
00305
00306
00307
00308 if (lower) {
00309 i__1 = *n - 1;
00310 for (i__ = 1; i__ <= i__1; ++i__) {
00311 dlartg_(&d__[i__], &e[i__], &cs, &sn, &r__);
00312 d__[i__] = r__;
00313 e[i__] = sn * d__[i__ + 1];
00314 d__[i__ + 1] = cs * d__[i__ + 1];
00315 work[i__] = cs;
00316 work[nm1 + i__] = sn;
00317
00318 }
00319
00320
00321
00322 if (*nru > 0) {
00323 dlasr_("R", "V", "F", nru, n, &work[1], &work[*n], &u[u_offset],
00324 ldu);
00325 }
00326 if (*ncc > 0) {
00327 dlasr_("L", "V", "F", n, ncc, &work[1], &work[*n], &c__[c_offset],
00328 ldc);
00329 }
00330 }
00331
00332
00333
00334
00335
00336
00337
00338 d__3 = 100., d__4 = pow_dd(&eps, &c_b15);
00339 d__1 = 10., d__2 = min(d__3,d__4);
00340 tolmul = max(d__1,d__2);
00341 tol = tolmul * eps;
00342
00343
00344
00345 smax = 0.;
00346 i__1 = *n;
00347 for (i__ = 1; i__ <= i__1; ++i__) {
00348
00349 d__2 = smax, d__3 = (d__1 = d__[i__], abs(d__1));
00350 smax = max(d__2,d__3);
00351
00352 }
00353 i__1 = *n - 1;
00354 for (i__ = 1; i__ <= i__1; ++i__) {
00355
00356 d__2 = smax, d__3 = (d__1 = e[i__], abs(d__1));
00357 smax = max(d__2,d__3);
00358
00359 }
00360 sminl = 0.;
00361 if (tol >= 0.) {
00362
00363
00364
00365 sminoa = abs(d__[1]);
00366 if (sminoa == 0.) {
00367 goto L50;
00368 }
00369 mu = sminoa;
00370 i__1 = *n;
00371 for (i__ = 2; i__ <= i__1; ++i__) {
00372 mu = (d__2 = d__[i__], abs(d__2)) * (mu / (mu + (d__1 = e[i__ - 1]
00373 , abs(d__1))));
00374 sminoa = min(sminoa,mu);
00375 if (sminoa == 0.) {
00376 goto L50;
00377 }
00378
00379 }
00380 L50:
00381 sminoa /= sqrt((doublereal) (*n));
00382
00383 d__1 = tol * sminoa, d__2 = *n * 6 * *n * unfl;
00384 thresh = max(d__1,d__2);
00385 } else {
00386
00387
00388
00389
00390 d__1 = abs(tol) * smax, d__2 = *n * 6 * *n * unfl;
00391 thresh = max(d__1,d__2);
00392 }
00393
00394
00395
00396
00397
00398 maxit = *n * 6 * *n;
00399 iter = 0;
00400 oldll = -1;
00401 oldm = -1;
00402
00403
00404
00405 m = *n;
00406
00407
00408
00409 L60:
00410
00411
00412
00413 if (m <= 1) {
00414 goto L160;
00415 }
00416 if (iter > maxit) {
00417 goto L200;
00418 }
00419
00420
00421
00422 if (tol < 0. && (d__1 = d__[m], abs(d__1)) <= thresh) {
00423 d__[m] = 0.;
00424 }
00425 smax = (d__1 = d__[m], abs(d__1));
00426 smin = smax;
00427 i__1 = m - 1;
00428 for (lll = 1; lll <= i__1; ++lll) {
00429 ll = m - lll;
00430 abss = (d__1 = d__[ll], abs(d__1));
00431 abse = (d__1 = e[ll], abs(d__1));
00432 if (tol < 0. && abss <= thresh) {
00433 d__[ll] = 0.;
00434 }
00435 if (abse <= thresh) {
00436 goto L80;
00437 }
00438 smin = min(smin,abss);
00439
00440 d__1 = max(smax,abss);
00441 smax = max(d__1,abse);
00442
00443 }
00444 ll = 0;
00445 goto L90;
00446 L80:
00447 e[ll] = 0.;
00448
00449
00450
00451 if (ll == m - 1) {
00452
00453
00454
00455 --m;
00456 goto L60;
00457 }
00458 L90:
00459 ++ll;
00460
00461
00462
00463 if (ll == m - 1) {
00464
00465
00466
00467 dlasv2_(&d__[m - 1], &e[m - 1], &d__[m], &sigmn, &sigmx, &sinr, &cosr,
00468 &sinl, &cosl);
00469 d__[m - 1] = sigmx;
00470 e[m - 1] = 0.;
00471 d__[m] = sigmn;
00472
00473
00474
00475 if (*ncvt > 0) {
00476 drot_(ncvt, &vt[m - 1 + vt_dim1], ldvt, &vt[m + vt_dim1], ldvt, &
00477 cosr, &sinr);
00478 }
00479 if (*nru > 0) {
00480 drot_(nru, &u[(m - 1) * u_dim1 + 1], &c__1, &u[m * u_dim1 + 1], &
00481 c__1, &cosl, &sinl);
00482 }
00483 if (*ncc > 0) {
00484 drot_(ncc, &c__[m - 1 + c_dim1], ldc, &c__[m + c_dim1], ldc, &
00485 cosl, &sinl);
00486 }
00487 m += -2;
00488 goto L60;
00489 }
00490
00491
00492
00493
00494 if (ll > oldm || m < oldll) {
00495 if ((d__1 = d__[ll], abs(d__1)) >= (d__2 = d__[m], abs(d__2))) {
00496
00497
00498
00499 idir = 1;
00500 } else {
00501
00502
00503
00504 idir = 2;
00505 }
00506 }
00507
00508
00509
00510 if (idir == 1) {
00511
00512
00513
00514
00515 if ((d__2 = e[m - 1], abs(d__2)) <= abs(tol) * (d__1 = d__[m], abs(
00516 d__1)) || tol < 0. && (d__3 = e[m - 1], abs(d__3)) <= thresh)
00517 {
00518 e[m - 1] = 0.;
00519 goto L60;
00520 }
00521
00522 if (tol >= 0.) {
00523
00524
00525
00526
00527 mu = (d__1 = d__[ll], abs(d__1));
00528 sminl = mu;
00529 i__1 = m - 1;
00530 for (lll = ll; lll <= i__1; ++lll) {
00531 if ((d__1 = e[lll], abs(d__1)) <= tol * mu) {
00532 e[lll] = 0.;
00533 goto L60;
00534 }
00535 mu = (d__2 = d__[lll + 1], abs(d__2)) * (mu / (mu + (d__1 = e[
00536 lll], abs(d__1))));
00537 sminl = min(sminl,mu);
00538
00539 }
00540 }
00541
00542 } else {
00543
00544
00545
00546
00547 if ((d__2 = e[ll], abs(d__2)) <= abs(tol) * (d__1 = d__[ll], abs(d__1)
00548 ) || tol < 0. && (d__3 = e[ll], abs(d__3)) <= thresh) {
00549 e[ll] = 0.;
00550 goto L60;
00551 }
00552
00553 if (tol >= 0.) {
00554
00555
00556
00557
00558 mu = (d__1 = d__[m], abs(d__1));
00559 sminl = mu;
00560 i__1 = ll;
00561 for (lll = m - 1; lll >= i__1; --lll) {
00562 if ((d__1 = e[lll], abs(d__1)) <= tol * mu) {
00563 e[lll] = 0.;
00564 goto L60;
00565 }
00566 mu = (d__2 = d__[lll], abs(d__2)) * (mu / (mu + (d__1 = e[lll]
00567 , abs(d__1))));
00568 sminl = min(sminl,mu);
00569
00570 }
00571 }
00572 }
00573 oldll = ll;
00574 oldm = m;
00575
00576
00577
00578
00579
00580 d__1 = eps, d__2 = tol * .01;
00581 if (tol >= 0. && *n * tol * (sminl / smax) <= max(d__1,d__2)) {
00582
00583
00584
00585 shift = 0.;
00586 } else {
00587
00588
00589
00590 if (idir == 1) {
00591 sll = (d__1 = d__[ll], abs(d__1));
00592 dlas2_(&d__[m - 1], &e[m - 1], &d__[m], &shift, &r__);
00593 } else {
00594 sll = (d__1 = d__[m], abs(d__1));
00595 dlas2_(&d__[ll], &e[ll], &d__[ll + 1], &shift, &r__);
00596 }
00597
00598
00599
00600 if (sll > 0.) {
00601
00602 d__1 = shift / sll;
00603 if (d__1 * d__1 < eps) {
00604 shift = 0.;
00605 }
00606 }
00607 }
00608
00609
00610
00611 iter = iter + m - ll;
00612
00613
00614
00615 if (shift == 0.) {
00616 if (idir == 1) {
00617
00618
00619
00620
00621 cs = 1.;
00622 oldcs = 1.;
00623 i__1 = m - 1;
00624 for (i__ = ll; i__ <= i__1; ++i__) {
00625 d__1 = d__[i__] * cs;
00626 dlartg_(&d__1, &e[i__], &cs, &sn, &r__);
00627 if (i__ > ll) {
00628 e[i__ - 1] = oldsn * r__;
00629 }
00630 d__1 = oldcs * r__;
00631 d__2 = d__[i__ + 1] * sn;
00632 dlartg_(&d__1, &d__2, &oldcs, &oldsn, &d__[i__]);
00633 work[i__ - ll + 1] = cs;
00634 work[i__ - ll + 1 + nm1] = sn;
00635 work[i__ - ll + 1 + nm12] = oldcs;
00636 work[i__ - ll + 1 + nm13] = oldsn;
00637
00638 }
00639 h__ = d__[m] * cs;
00640 d__[m] = h__ * oldcs;
00641 e[m - 1] = h__ * oldsn;
00642
00643
00644
00645 if (*ncvt > 0) {
00646 i__1 = m - ll + 1;
00647 dlasr_("L", "V", "F", &i__1, ncvt, &work[1], &work[*n], &vt[
00648 ll + vt_dim1], ldvt);
00649 }
00650 if (*nru > 0) {
00651 i__1 = m - ll + 1;
00652 dlasr_("R", "V", "F", nru, &i__1, &work[nm12 + 1], &work[nm13
00653 + 1], &u[ll * u_dim1 + 1], ldu);
00654 }
00655 if (*ncc > 0) {
00656 i__1 = m - ll + 1;
00657 dlasr_("L", "V", "F", &i__1, ncc, &work[nm12 + 1], &work[nm13
00658 + 1], &c__[ll + c_dim1], ldc);
00659 }
00660
00661
00662
00663 if ((d__1 = e[m - 1], abs(d__1)) <= thresh) {
00664 e[m - 1] = 0.;
00665 }
00666
00667 } else {
00668
00669
00670
00671
00672 cs = 1.;
00673 oldcs = 1.;
00674 i__1 = ll + 1;
00675 for (i__ = m; i__ >= i__1; --i__) {
00676 d__1 = d__[i__] * cs;
00677 dlartg_(&d__1, &e[i__ - 1], &cs, &sn, &r__);
00678 if (i__ < m) {
00679 e[i__] = oldsn * r__;
00680 }
00681 d__1 = oldcs * r__;
00682 d__2 = d__[i__ - 1] * sn;
00683 dlartg_(&d__1, &d__2, &oldcs, &oldsn, &d__[i__]);
00684 work[i__ - ll] = cs;
00685 work[i__ - ll + nm1] = -sn;
00686 work[i__ - ll + nm12] = oldcs;
00687 work[i__ - ll + nm13] = -oldsn;
00688
00689 }
00690 h__ = d__[ll] * cs;
00691 d__[ll] = h__ * oldcs;
00692 e[ll] = h__ * oldsn;
00693
00694
00695
00696 if (*ncvt > 0) {
00697 i__1 = m - ll + 1;
00698 dlasr_("L", "V", "B", &i__1, ncvt, &work[nm12 + 1], &work[
00699 nm13 + 1], &vt[ll + vt_dim1], ldvt);
00700 }
00701 if (*nru > 0) {
00702 i__1 = m - ll + 1;
00703 dlasr_("R", "V", "B", nru, &i__1, &work[1], &work[*n], &u[ll *
00704 u_dim1 + 1], ldu);
00705 }
00706 if (*ncc > 0) {
00707 i__1 = m - ll + 1;
00708 dlasr_("L", "V", "B", &i__1, ncc, &work[1], &work[*n], &c__[
00709 ll + c_dim1], ldc);
00710 }
00711
00712
00713
00714 if ((d__1 = e[ll], abs(d__1)) <= thresh) {
00715 e[ll] = 0.;
00716 }
00717 }
00718 } else {
00719
00720
00721
00722 if (idir == 1) {
00723
00724
00725
00726
00727 f = ((d__1 = d__[ll], abs(d__1)) - shift) * (d_sign(&c_b49, &d__[
00728 ll]) + shift / d__[ll]);
00729 g = e[ll];
00730 i__1 = m - 1;
00731 for (i__ = ll; i__ <= i__1; ++i__) {
00732 dlartg_(&f, &g, &cosr, &sinr, &r__);
00733 if (i__ > ll) {
00734 e[i__ - 1] = r__;
00735 }
00736 f = cosr * d__[i__] + sinr * e[i__];
00737 e[i__] = cosr * e[i__] - sinr * d__[i__];
00738 g = sinr * d__[i__ + 1];
00739 d__[i__ + 1] = cosr * d__[i__ + 1];
00740 dlartg_(&f, &g, &cosl, &sinl, &r__);
00741 d__[i__] = r__;
00742 f = cosl * e[i__] + sinl * d__[i__ + 1];
00743 d__[i__ + 1] = cosl * d__[i__ + 1] - sinl * e[i__];
00744 if (i__ < m - 1) {
00745 g = sinl * e[i__ + 1];
00746 e[i__ + 1] = cosl * e[i__ + 1];
00747 }
00748 work[i__ - ll + 1] = cosr;
00749 work[i__ - ll + 1 + nm1] = sinr;
00750 work[i__ - ll + 1 + nm12] = cosl;
00751 work[i__ - ll + 1 + nm13] = sinl;
00752
00753 }
00754 e[m - 1] = f;
00755
00756
00757
00758 if (*ncvt > 0) {
00759 i__1 = m - ll + 1;
00760 dlasr_("L", "V", "F", &i__1, ncvt, &work[1], &work[*n], &vt[
00761 ll + vt_dim1], ldvt);
00762 }
00763 if (*nru > 0) {
00764 i__1 = m - ll + 1;
00765 dlasr_("R", "V", "F", nru, &i__1, &work[nm12 + 1], &work[nm13
00766 + 1], &u[ll * u_dim1 + 1], ldu);
00767 }
00768 if (*ncc > 0) {
00769 i__1 = m - ll + 1;
00770 dlasr_("L", "V", "F", &i__1, ncc, &work[nm12 + 1], &work[nm13
00771 + 1], &c__[ll + c_dim1], ldc);
00772 }
00773
00774
00775
00776 if ((d__1 = e[m - 1], abs(d__1)) <= thresh) {
00777 e[m - 1] = 0.;
00778 }
00779
00780 } else {
00781
00782
00783
00784
00785 f = ((d__1 = d__[m], abs(d__1)) - shift) * (d_sign(&c_b49, &d__[m]
00786 ) + shift / d__[m]);
00787 g = e[m - 1];
00788 i__1 = ll + 1;
00789 for (i__ = m; i__ >= i__1; --i__) {
00790 dlartg_(&f, &g, &cosr, &sinr, &r__);
00791 if (i__ < m) {
00792 e[i__] = r__;
00793 }
00794 f = cosr * d__[i__] + sinr * e[i__ - 1];
00795 e[i__ - 1] = cosr * e[i__ - 1] - sinr * d__[i__];
00796 g = sinr * d__[i__ - 1];
00797 d__[i__ - 1] = cosr * d__[i__ - 1];
00798 dlartg_(&f, &g, &cosl, &sinl, &r__);
00799 d__[i__] = r__;
00800 f = cosl * e[i__ - 1] + sinl * d__[i__ - 1];
00801 d__[i__ - 1] = cosl * d__[i__ - 1] - sinl * e[i__ - 1];
00802 if (i__ > ll + 1) {
00803 g = sinl * e[i__ - 2];
00804 e[i__ - 2] = cosl * e[i__ - 2];
00805 }
00806 work[i__ - ll] = cosr;
00807 work[i__ - ll + nm1] = -sinr;
00808 work[i__ - ll + nm12] = cosl;
00809 work[i__ - ll + nm13] = -sinl;
00810
00811 }
00812 e[ll] = f;
00813
00814
00815
00816 if ((d__1 = e[ll], abs(d__1)) <= thresh) {
00817 e[ll] = 0.;
00818 }
00819
00820
00821
00822 if (*ncvt > 0) {
00823 i__1 = m - ll + 1;
00824 dlasr_("L", "V", "B", &i__1, ncvt, &work[nm12 + 1], &work[
00825 nm13 + 1], &vt[ll + vt_dim1], ldvt);
00826 }
00827 if (*nru > 0) {
00828 i__1 = m - ll + 1;
00829 dlasr_("R", "V", "B", nru, &i__1, &work[1], &work[*n], &u[ll *
00830 u_dim1 + 1], ldu);
00831 }
00832 if (*ncc > 0) {
00833 i__1 = m - ll + 1;
00834 dlasr_("L", "V", "B", &i__1, ncc, &work[1], &work[*n], &c__[
00835 ll + c_dim1], ldc);
00836 }
00837 }
00838 }
00839
00840
00841
00842 goto L60;
00843
00844
00845
00846 L160:
00847 i__1 = *n;
00848 for (i__ = 1; i__ <= i__1; ++i__) {
00849 if (d__[i__] < 0.) {
00850 d__[i__] = -d__[i__];
00851
00852
00853
00854 if (*ncvt > 0) {
00855 dscal_(ncvt, &c_b72, &vt[i__ + vt_dim1], ldvt);
00856 }
00857 }
00858
00859 }
00860
00861
00862
00863
00864 i__1 = *n - 1;
00865 for (i__ = 1; i__ <= i__1; ++i__) {
00866
00867
00868
00869 isub = 1;
00870 smin = d__[1];
00871 i__2 = *n + 1 - i__;
00872 for (j = 2; j <= i__2; ++j) {
00873 if (d__[j] <= smin) {
00874 isub = j;
00875 smin = d__[j];
00876 }
00877
00878 }
00879 if (isub != *n + 1 - i__) {
00880
00881
00882
00883 d__[isub] = d__[*n + 1 - i__];
00884 d__[*n + 1 - i__] = smin;
00885 if (*ncvt > 0) {
00886 dswap_(ncvt, &vt[isub + vt_dim1], ldvt, &vt[*n + 1 - i__ +
00887 vt_dim1], ldvt);
00888 }
00889 if (*nru > 0) {
00890 dswap_(nru, &u[isub * u_dim1 + 1], &c__1, &u[(*n + 1 - i__) *
00891 u_dim1 + 1], &c__1);
00892 }
00893 if (*ncc > 0) {
00894 dswap_(ncc, &c__[isub + c_dim1], ldc, &c__[*n + 1 - i__ +
00895 c_dim1], ldc);
00896 }
00897 }
00898
00899 }
00900 goto L220;
00901
00902
00903
00904 L200:
00905 *info = 0;
00906 i__1 = *n - 1;
00907 for (i__ = 1; i__ <= i__1; ++i__) {
00908 if (e[i__] != 0.) {
00909 ++(*info);
00910 }
00911
00912 }
00913 L220:
00914 return 0;
00915
00916
00917
00918 }