LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dlasd2.f
Go to the documentation of this file.
00001 *> \brief \b DLASD2
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download DLASD2 + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasd2.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasd2.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasd2.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
00022 *                          LDVT, DSIGMA, U2, LDU2, VT2, LDVT2, IDXP, IDX,
00023 *                          IDXC, IDXQ, COLTYP, INFO )
00024 * 
00025 *       .. Scalar Arguments ..
00026 *       INTEGER            INFO, K, LDU, LDU2, LDVT, LDVT2, NL, NR, SQRE
00027 *       DOUBLE PRECISION   ALPHA, BETA
00028 *       ..
00029 *       .. Array Arguments ..
00030 *       INTEGER            COLTYP( * ), IDX( * ), IDXC( * ), IDXP( * ),
00031 *      $                   IDXQ( * )
00032 *       DOUBLE PRECISION   D( * ), DSIGMA( * ), U( LDU, * ),
00033 *      $                   U2( LDU2, * ), VT( LDVT, * ), VT2( LDVT2, * ),
00034 *      $                   Z( * )
00035 *       ..
00036 *  
00037 *
00038 *> \par Purpose:
00039 *  =============
00040 *>
00041 *> \verbatim
00042 *>
00043 *> DLASD2 merges the two sets of singular values together into a single
00044 *> sorted set.  Then it tries to deflate the size of the problem.
00045 *> There are two ways in which deflation can occur:  when two or more
00046 *> singular values are close together or if there is a tiny entry in the
00047 *> Z vector.  For each such occurrence the order of the related secular
00048 *> equation problem is reduced by one.
00049 *>
00050 *> DLASD2 is called from DLASD1.
00051 *> \endverbatim
00052 *
00053 *  Arguments:
00054 *  ==========
00055 *
00056 *> \param[in] NL
00057 *> \verbatim
00058 *>          NL is INTEGER
00059 *>         The row dimension of the upper block.  NL >= 1.
00060 *> \endverbatim
00061 *>
00062 *> \param[in] NR
00063 *> \verbatim
00064 *>          NR is INTEGER
00065 *>         The row dimension of the lower block.  NR >= 1.
00066 *> \endverbatim
00067 *>
00068 *> \param[in] SQRE
00069 *> \verbatim
00070 *>          SQRE is INTEGER
00071 *>         = 0: the lower block is an NR-by-NR square matrix.
00072 *>         = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
00073 *>
00074 *>         The bidiagonal matrix has N = NL + NR + 1 rows and
00075 *>         M = N + SQRE >= N columns.
00076 *> \endverbatim
00077 *>
00078 *> \param[out] K
00079 *> \verbatim
00080 *>          K is INTEGER
00081 *>         Contains the dimension of the non-deflated matrix,
00082 *>         This is the order of the related secular equation. 1 <= K <=N.
00083 *> \endverbatim
00084 *>
00085 *> \param[in,out] D
00086 *> \verbatim
00087 *>          D is DOUBLE PRECISION array, dimension(N)
00088 *>         On entry D contains the singular values of the two submatrices
00089 *>         to be combined.  On exit D contains the trailing (N-K) updated
00090 *>         singular values (those which were deflated) sorted into
00091 *>         increasing order.
00092 *> \endverbatim
00093 *>
00094 *> \param[out] Z
00095 *> \verbatim
00096 *>          Z is DOUBLE PRECISION array, dimension(N)
00097 *>         On exit Z contains the updating row vector in the secular
00098 *>         equation.
00099 *> \endverbatim
00100 *>
00101 *> \param[in] ALPHA
00102 *> \verbatim
00103 *>          ALPHA is DOUBLE PRECISION
00104 *>         Contains the diagonal element associated with the added row.
00105 *> \endverbatim
00106 *>
00107 *> \param[in] BETA
00108 *> \verbatim
00109 *>          BETA is DOUBLE PRECISION
00110 *>         Contains the off-diagonal element associated with the added
00111 *>         row.
00112 *> \endverbatim
00113 *>
00114 *> \param[in,out] U
00115 *> \verbatim
00116 *>          U is DOUBLE PRECISION array, dimension(LDU,N)
00117 *>         On entry U contains the left singular vectors of two
00118 *>         submatrices in the two square blocks with corners at (1,1),
00119 *>         (NL, NL), and (NL+2, NL+2), (N,N).
00120 *>         On exit U contains the trailing (N-K) updated left singular
00121 *>         vectors (those which were deflated) in its last N-K columns.
00122 *> \endverbatim
00123 *>
00124 *> \param[in] LDU
00125 *> \verbatim
00126 *>          LDU is INTEGER
00127 *>         The leading dimension of the array U.  LDU >= N.
00128 *> \endverbatim
00129 *>
00130 *> \param[in,out] VT
00131 *> \verbatim
00132 *>          VT is DOUBLE PRECISION array, dimension(LDVT,M)
00133 *>         On entry VT**T contains the right singular vectors of two
00134 *>         submatrices in the two square blocks with corners at (1,1),
00135 *>         (NL+1, NL+1), and (NL+2, NL+2), (M,M).
00136 *>         On exit VT**T contains the trailing (N-K) updated right singular
00137 *>         vectors (those which were deflated) in its last N-K columns.
00138 *>         In case SQRE =1, the last row of VT spans the right null
00139 *>         space.
00140 *> \endverbatim
00141 *>
00142 *> \param[in] LDVT
00143 *> \verbatim
00144 *>          LDVT is INTEGER
00145 *>         The leading dimension of the array VT.  LDVT >= M.
00146 *> \endverbatim
00147 *>
00148 *> \param[out] DSIGMA
00149 *> \verbatim
00150 *>          DSIGMA is DOUBLE PRECISION array, dimension (N)
00151 *>         Contains a copy of the diagonal elements (K-1 singular values
00152 *>         and one zero) in the secular equation.
00153 *> \endverbatim
00154 *>
00155 *> \param[out] U2
00156 *> \verbatim
00157 *>          U2 is DOUBLE PRECISION array, dimension(LDU2,N)
00158 *>         Contains a copy of the first K-1 left singular vectors which
00159 *>         will be used by DLASD3 in a matrix multiply (DGEMM) to solve
00160 *>         for the new left singular vectors. U2 is arranged into four
00161 *>         blocks. The first block contains a column with 1 at NL+1 and
00162 *>         zero everywhere else; the second block contains non-zero
00163 *>         entries only at and above NL; the third contains non-zero
00164 *>         entries only below NL+1; and the fourth is dense.
00165 *> \endverbatim
00166 *>
00167 *> \param[in] LDU2
00168 *> \verbatim
00169 *>          LDU2 is INTEGER
00170 *>         The leading dimension of the array U2.  LDU2 >= N.
00171 *> \endverbatim
00172 *>
00173 *> \param[out] VT2
00174 *> \verbatim
00175 *>          VT2 is DOUBLE PRECISION array, dimension(LDVT2,N)
00176 *>         VT2**T contains a copy of the first K right singular vectors
00177 *>         which will be used by DLASD3 in a matrix multiply (DGEMM) to
00178 *>         solve for the new right singular vectors. VT2 is arranged into
00179 *>         three blocks. The first block contains a row that corresponds
00180 *>         to the special 0 diagonal element in SIGMA; the second block
00181 *>         contains non-zeros only at and before NL +1; the third block
00182 *>         contains non-zeros only at and after  NL +2.
00183 *> \endverbatim
00184 *>
00185 *> \param[in] LDVT2
00186 *> \verbatim
00187 *>          LDVT2 is INTEGER
00188 *>         The leading dimension of the array VT2.  LDVT2 >= M.
00189 *> \endverbatim
00190 *>
00191 *> \param[out] IDXP
00192 *> \verbatim
00193 *>          IDXP is INTEGER array dimension(N)
00194 *>         This will contain the permutation used to place deflated
00195 *>         values of D at the end of the array. On output IDXP(2:K)
00196 *>         points to the nondeflated D-values and IDXP(K+1:N)
00197 *>         points to the deflated singular values.
00198 *> \endverbatim
00199 *>
00200 *> \param[out] IDX
00201 *> \verbatim
00202 *>          IDX is INTEGER array dimension(N)
00203 *>         This will contain the permutation used to sort the contents of
00204 *>         D into ascending order.
00205 *> \endverbatim
00206 *>
00207 *> \param[out] IDXC
00208 *> \verbatim
00209 *>          IDXC is INTEGER array dimension(N)
00210 *>         This will contain the permutation used to arrange the columns
00211 *>         of the deflated U matrix into three groups:  the first group
00212 *>         contains non-zero entries only at and above NL, the second
00213 *>         contains non-zero entries only below NL+2, and the third is
00214 *>         dense.
00215 *> \endverbatim
00216 *>
00217 *> \param[in,out] IDXQ
00218 *> \verbatim
00219 *>          IDXQ is INTEGER array dimension(N)
00220 *>         This contains the permutation which separately sorts the two
00221 *>         sub-problems in D into ascending order.  Note that entries in
00222 *>         the first hlaf of this permutation must first be moved one
00223 *>         position backward; and entries in the second half
00224 *>         must first have NL+1 added to their values.
00225 *> \endverbatim
00226 *>
00227 *> \param[out] COLTYP
00228 *> \verbatim
00229 *>          COLTYP is INTEGER array dimension(N)
00230 *>         As workspace, this will contain a label which will indicate
00231 *>         which of the following types a column in the U2 matrix or a
00232 *>         row in the VT2 matrix is:
00233 *>         1 : non-zero in the upper half only
00234 *>         2 : non-zero in the lower half only
00235 *>         3 : dense
00236 *>         4 : deflated
00237 *>
00238 *>         On exit, it is an array of dimension 4, with COLTYP(I) being
00239 *>         the dimension of the I-th type columns.
00240 *> \endverbatim
00241 *>
00242 *> \param[out] INFO
00243 *> \verbatim
00244 *>          INFO is INTEGER
00245 *>          = 0:  successful exit.
00246 *>          < 0:  if INFO = -i, the i-th argument had an illegal value.
00247 *> \endverbatim
00248 *
00249 *  Authors:
00250 *  ========
00251 *
00252 *> \author Univ. of Tennessee 
00253 *> \author Univ. of California Berkeley 
00254 *> \author Univ. of Colorado Denver 
00255 *> \author NAG Ltd. 
00256 *
00257 *> \date November 2011
00258 *
00259 *> \ingroup auxOTHERauxiliary
00260 *
00261 *> \par Contributors:
00262 *  ==================
00263 *>
00264 *>     Ming Gu and Huan Ren, Computer Science Division, University of
00265 *>     California at Berkeley, USA
00266 *>
00267 *  =====================================================================
00268       SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
00269      $                   LDVT, DSIGMA, U2, LDU2, VT2, LDVT2, IDXP, IDX,
00270      $                   IDXC, IDXQ, COLTYP, INFO )
00271 *
00272 *  -- LAPACK auxiliary routine (version 3.4.0) --
00273 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00274 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00275 *     November 2011
00276 *
00277 *     .. Scalar Arguments ..
00278       INTEGER            INFO, K, LDU, LDU2, LDVT, LDVT2, NL, NR, SQRE
00279       DOUBLE PRECISION   ALPHA, BETA
00280 *     ..
00281 *     .. Array Arguments ..
00282       INTEGER            COLTYP( * ), IDX( * ), IDXC( * ), IDXP( * ),
00283      $                   IDXQ( * )
00284       DOUBLE PRECISION   D( * ), DSIGMA( * ), U( LDU, * ),
00285      $                   U2( LDU2, * ), VT( LDVT, * ), VT2( LDVT2, * ),
00286      $                   Z( * )
00287 *     ..
00288 *
00289 *  =====================================================================
00290 *
00291 *     .. Parameters ..
00292       DOUBLE PRECISION   ZERO, ONE, TWO, EIGHT
00293       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0,
00294      $                   EIGHT = 8.0D+0 )
00295 *     ..
00296 *     .. Local Arrays ..
00297       INTEGER            CTOT( 4 ), PSM( 4 )
00298 *     ..
00299 *     .. Local Scalars ..
00300       INTEGER            CT, I, IDXI, IDXJ, IDXJP, J, JP, JPREV, K2, M,
00301      $                   N, NLP1, NLP2
00302       DOUBLE PRECISION   C, EPS, HLFTOL, S, TAU, TOL, Z1
00303 *     ..
00304 *     .. External Functions ..
00305       DOUBLE PRECISION   DLAMCH, DLAPY2
00306       EXTERNAL           DLAMCH, DLAPY2
00307 *     ..
00308 *     .. External Subroutines ..
00309       EXTERNAL           DCOPY, DLACPY, DLAMRG, DLASET, DROT, XERBLA
00310 *     ..
00311 *     .. Intrinsic Functions ..
00312       INTRINSIC          ABS, MAX
00313 *     ..
00314 *     .. Executable Statements ..
00315 *
00316 *     Test the input parameters.
00317 *
00318       INFO = 0
00319 *
00320       IF( NL.LT.1 ) THEN
00321          INFO = -1
00322       ELSE IF( NR.LT.1 ) THEN
00323          INFO = -2
00324       ELSE IF( ( SQRE.NE.1 ) .AND. ( SQRE.NE.0 ) ) THEN
00325          INFO = -3
00326       END IF
00327 *
00328       N = NL + NR + 1
00329       M = N + SQRE
00330 *
00331       IF( LDU.LT.N ) THEN
00332          INFO = -10
00333       ELSE IF( LDVT.LT.M ) THEN
00334          INFO = -12
00335       ELSE IF( LDU2.LT.N ) THEN
00336          INFO = -15
00337       ELSE IF( LDVT2.LT.M ) THEN
00338          INFO = -17
00339       END IF
00340       IF( INFO.NE.0 ) THEN
00341          CALL XERBLA( 'DLASD2', -INFO )
00342          RETURN
00343       END IF
00344 *
00345       NLP1 = NL + 1
00346       NLP2 = NL + 2
00347 *
00348 *     Generate the first part of the vector Z; and move the singular
00349 *     values in the first part of D one position backward.
00350 *
00351       Z1 = ALPHA*VT( NLP1, NLP1 )
00352       Z( 1 ) = Z1
00353       DO 10 I = NL, 1, -1
00354          Z( I+1 ) = ALPHA*VT( I, NLP1 )
00355          D( I+1 ) = D( I )
00356          IDXQ( I+1 ) = IDXQ( I ) + 1
00357    10 CONTINUE
00358 *
00359 *     Generate the second part of the vector Z.
00360 *
00361       DO 20 I = NLP2, M
00362          Z( I ) = BETA*VT( I, NLP2 )
00363    20 CONTINUE
00364 *
00365 *     Initialize some reference arrays.
00366 *
00367       DO 30 I = 2, NLP1
00368          COLTYP( I ) = 1
00369    30 CONTINUE
00370       DO 40 I = NLP2, N
00371          COLTYP( I ) = 2
00372    40 CONTINUE
00373 *
00374 *     Sort the singular values into increasing order
00375 *
00376       DO 50 I = NLP2, N
00377          IDXQ( I ) = IDXQ( I ) + NLP1
00378    50 CONTINUE
00379 *
00380 *     DSIGMA, IDXC, IDXC, and the first column of U2
00381 *     are used as storage space.
00382 *
00383       DO 60 I = 2, N
00384          DSIGMA( I ) = D( IDXQ( I ) )
00385          U2( I, 1 ) = Z( IDXQ( I ) )
00386          IDXC( I ) = COLTYP( IDXQ( I ) )
00387    60 CONTINUE
00388 *
00389       CALL DLAMRG( NL, NR, DSIGMA( 2 ), 1, 1, IDX( 2 ) )
00390 *
00391       DO 70 I = 2, N
00392          IDXI = 1 + IDX( I )
00393          D( I ) = DSIGMA( IDXI )
00394          Z( I ) = U2( IDXI, 1 )
00395          COLTYP( I ) = IDXC( IDXI )
00396    70 CONTINUE
00397 *
00398 *     Calculate the allowable deflation tolerance
00399 *
00400       EPS = DLAMCH( 'Epsilon' )
00401       TOL = MAX( ABS( ALPHA ), ABS( BETA ) )
00402       TOL = EIGHT*EPS*MAX( ABS( D( N ) ), TOL )
00403 *
00404 *     There are 2 kinds of deflation -- first a value in the z-vector
00405 *     is small, second two (or more) singular values are very close
00406 *     together (their difference is small).
00407 *
00408 *     If the value in the z-vector is small, we simply permute the
00409 *     array so that the corresponding singular value is moved to the
00410 *     end.
00411 *
00412 *     If two values in the D-vector are close, we perform a two-sided
00413 *     rotation designed to make one of the corresponding z-vector
00414 *     entries zero, and then permute the array so that the deflated
00415 *     singular value is moved to the end.
00416 *
00417 *     If there are multiple singular values then the problem deflates.
00418 *     Here the number of equal singular values are found.  As each equal
00419 *     singular value is found, an elementary reflector is computed to
00420 *     rotate the corresponding singular subspace so that the
00421 *     corresponding components of Z are zero in this new basis.
00422 *
00423       K = 1
00424       K2 = N + 1
00425       DO 80 J = 2, N
00426          IF( ABS( Z( J ) ).LE.TOL ) THEN
00427 *
00428 *           Deflate due to small z component.
00429 *
00430             K2 = K2 - 1
00431             IDXP( K2 ) = J
00432             COLTYP( J ) = 4
00433             IF( J.EQ.N )
00434      $         GO TO 120
00435          ELSE
00436             JPREV = J
00437             GO TO 90
00438          END IF
00439    80 CONTINUE
00440    90 CONTINUE
00441       J = JPREV
00442   100 CONTINUE
00443       J = J + 1
00444       IF( J.GT.N )
00445      $   GO TO 110
00446       IF( ABS( Z( J ) ).LE.TOL ) THEN
00447 *
00448 *        Deflate due to small z component.
00449 *
00450          K2 = K2 - 1
00451          IDXP( K2 ) = J
00452          COLTYP( J ) = 4
00453       ELSE
00454 *
00455 *        Check if singular values are close enough to allow deflation.
00456 *
00457          IF( ABS( D( J )-D( JPREV ) ).LE.TOL ) THEN
00458 *
00459 *           Deflation is possible.
00460 *
00461             S = Z( JPREV )
00462             C = Z( J )
00463 *
00464 *           Find sqrt(a**2+b**2) without overflow or
00465 *           destructive underflow.
00466 *
00467             TAU = DLAPY2( C, S )
00468             C = C / TAU
00469             S = -S / TAU
00470             Z( J ) = TAU
00471             Z( JPREV ) = ZERO
00472 *
00473 *           Apply back the Givens rotation to the left and right
00474 *           singular vector matrices.
00475 *
00476             IDXJP = IDXQ( IDX( JPREV )+1 )
00477             IDXJ = IDXQ( IDX( J )+1 )
00478             IF( IDXJP.LE.NLP1 ) THEN
00479                IDXJP = IDXJP - 1
00480             END IF
00481             IF( IDXJ.LE.NLP1 ) THEN
00482                IDXJ = IDXJ - 1
00483             END IF
00484             CALL DROT( N, U( 1, IDXJP ), 1, U( 1, IDXJ ), 1, C, S )
00485             CALL DROT( M, VT( IDXJP, 1 ), LDVT, VT( IDXJ, 1 ), LDVT, C,
00486      $                 S )
00487             IF( COLTYP( J ).NE.COLTYP( JPREV ) ) THEN
00488                COLTYP( J ) = 3
00489             END IF
00490             COLTYP( JPREV ) = 4
00491             K2 = K2 - 1
00492             IDXP( K2 ) = JPREV
00493             JPREV = J
00494          ELSE
00495             K = K + 1
00496             U2( K, 1 ) = Z( JPREV )
00497             DSIGMA( K ) = D( JPREV )
00498             IDXP( K ) = JPREV
00499             JPREV = J
00500          END IF
00501       END IF
00502       GO TO 100
00503   110 CONTINUE
00504 *
00505 *     Record the last singular value.
00506 *
00507       K = K + 1
00508       U2( K, 1 ) = Z( JPREV )
00509       DSIGMA( K ) = D( JPREV )
00510       IDXP( K ) = JPREV
00511 *
00512   120 CONTINUE
00513 *
00514 *     Count up the total number of the various types of columns, then
00515 *     form a permutation which positions the four column types into
00516 *     four groups of uniform structure (although one or more of these
00517 *     groups may be empty).
00518 *
00519       DO 130 J = 1, 4
00520          CTOT( J ) = 0
00521   130 CONTINUE
00522       DO 140 J = 2, N
00523          CT = COLTYP( J )
00524          CTOT( CT ) = CTOT( CT ) + 1
00525   140 CONTINUE
00526 *
00527 *     PSM(*) = Position in SubMatrix (of types 1 through 4)
00528 *
00529       PSM( 1 ) = 2
00530       PSM( 2 ) = 2 + CTOT( 1 )
00531       PSM( 3 ) = PSM( 2 ) + CTOT( 2 )
00532       PSM( 4 ) = PSM( 3 ) + CTOT( 3 )
00533 *
00534 *     Fill out the IDXC array so that the permutation which it induces
00535 *     will place all type-1 columns first, all type-2 columns next,
00536 *     then all type-3's, and finally all type-4's, starting from the
00537 *     second column. This applies similarly to the rows of VT.
00538 *
00539       DO 150 J = 2, N
00540          JP = IDXP( J )
00541          CT = COLTYP( JP )
00542          IDXC( PSM( CT ) ) = J
00543          PSM( CT ) = PSM( CT ) + 1
00544   150 CONTINUE
00545 *
00546 *     Sort the singular values and corresponding singular vectors into
00547 *     DSIGMA, U2, and VT2 respectively.  The singular values/vectors
00548 *     which were not deflated go into the first K slots of DSIGMA, U2,
00549 *     and VT2 respectively, while those which were deflated go into the
00550 *     last N - K slots, except that the first column/row will be treated
00551 *     separately.
00552 *
00553       DO 160 J = 2, N
00554          JP = IDXP( J )
00555          DSIGMA( J ) = D( JP )
00556          IDXJ = IDXQ( IDX( IDXP( IDXC( J ) ) )+1 )
00557          IF( IDXJ.LE.NLP1 ) THEN
00558             IDXJ = IDXJ - 1
00559          END IF
00560          CALL DCOPY( N, U( 1, IDXJ ), 1, U2( 1, J ), 1 )
00561          CALL DCOPY( M, VT( IDXJ, 1 ), LDVT, VT2( J, 1 ), LDVT2 )
00562   160 CONTINUE
00563 *
00564 *     Determine DSIGMA(1), DSIGMA(2) and Z(1)
00565 *
00566       DSIGMA( 1 ) = ZERO
00567       HLFTOL = TOL / TWO
00568       IF( ABS( DSIGMA( 2 ) ).LE.HLFTOL )
00569      $   DSIGMA( 2 ) = HLFTOL
00570       IF( M.GT.N ) THEN
00571          Z( 1 ) = DLAPY2( Z1, Z( M ) )
00572          IF( Z( 1 ).LE.TOL ) THEN
00573             C = ONE
00574             S = ZERO
00575             Z( 1 ) = TOL
00576          ELSE
00577             C = Z1 / Z( 1 )
00578             S = Z( M ) / Z( 1 )
00579          END IF
00580       ELSE
00581          IF( ABS( Z1 ).LE.TOL ) THEN
00582             Z( 1 ) = TOL
00583          ELSE
00584             Z( 1 ) = Z1
00585          END IF
00586       END IF
00587 *
00588 *     Move the rest of the updating row to Z.
00589 *
00590       CALL DCOPY( K-1, U2( 2, 1 ), 1, Z( 2 ), 1 )
00591 *
00592 *     Determine the first column of U2, the first row of VT2 and the
00593 *     last row of VT.
00594 *
00595       CALL DLASET( 'A', N, 1, ZERO, ZERO, U2, LDU2 )
00596       U2( NLP1, 1 ) = ONE
00597       IF( M.GT.N ) THEN
00598          DO 170 I = 1, NLP1
00599             VT( M, I ) = -S*VT( NLP1, I )
00600             VT2( 1, I ) = C*VT( NLP1, I )
00601   170    CONTINUE
00602          DO 180 I = NLP2, M
00603             VT2( 1, I ) = S*VT( M, I )
00604             VT( M, I ) = C*VT( M, I )
00605   180    CONTINUE
00606       ELSE
00607          CALL DCOPY( M, VT( NLP1, 1 ), LDVT, VT2( 1, 1 ), LDVT2 )
00608       END IF
00609       IF( M.GT.N ) THEN
00610          CALL DCOPY( M, VT( M, 1 ), LDVT, VT2( M, 1 ), LDVT2 )
00611       END IF
00612 *
00613 *     The deflated singular values and their corresponding vectors go
00614 *     into the back of D, U, and V respectively.
00615 *
00616       IF( N.GT.K ) THEN
00617          CALL DCOPY( N-K, DSIGMA( K+1 ), 1, D( K+1 ), 1 )
00618          CALL DLACPY( 'A', N, N-K, U2( 1, K+1 ), LDU2, U( 1, K+1 ),
00619      $                LDU )
00620          CALL DLACPY( 'A', N-K, M, VT2( K+1, 1 ), LDVT2, VT( K+1, 1 ),
00621      $                LDVT )
00622       END IF
00623 *
00624 *     Copy CTOT into COLTYP for referencing in DLASD3.
00625 *
00626       DO 190 J = 1, 4
00627          COLTYP( J ) = CTOT( J )
00628   190 CONTINUE
00629 *
00630       RETURN
00631 *
00632 *     End of DLASD2
00633 *
00634       END
 All Files Functions