211 SUBROUTINE dlasdq( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT,
212 $ u, ldu, c, ldc, work, info )
221 INTEGER INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU, SQRE
224 DOUBLE PRECISION C( ldc, * ), D( * ), E( * ), U( ldu, * ),
225 $ vt( ldvt, * ), work( * )
231 DOUBLE PRECISION ZERO
232 parameter ( zero = 0.0d+0 )
236 INTEGER I, ISUB, IUPLO, J, NP1, SQRE1
237 DOUBLE PRECISION CS, R, SMIN, SN
255 IF( lsame( uplo,
'U' ) )
257 IF( lsame( uplo,
'L' ) )
259 IF( iuplo.EQ.0 )
THEN
261 ELSE IF( ( sqre.LT.0 ) .OR. ( sqre.GT.1 ) )
THEN
263 ELSE IF( n.LT.0 )
THEN
265 ELSE IF( ncvt.LT.0 )
THEN
267 ELSE IF( nru.LT.0 )
THEN
269 ELSE IF( ncc.LT.0 )
THEN
271 ELSE IF( ( ncvt.EQ.0 .AND. ldvt.LT.1 ) .OR.
272 $ ( ncvt.GT.0 .AND. ldvt.LT.max( 1, n ) ) )
THEN
274 ELSE IF( ldu.LT.max( 1, nru ) )
THEN
276 ELSE IF( ( ncc.EQ.0 .AND. ldc.LT.1 ) .OR.
277 $ ( ncc.GT.0 .AND. ldc.LT.max( 1, n ) ) )
THEN
281 CALL xerbla(
'DLASDQ', -info )
289 rotate = ( ncvt.GT.0 ) .OR. ( nru.GT.0 ) .OR. ( ncc.GT.0 )
296 IF( ( iuplo.EQ.1 ) .AND. ( sqre1.EQ.1 ) )
THEN
298 CALL dlartg( d( i ), e( i ), cs, sn, r )
301 d( i+1 ) = cs*d( i+1 )
307 CALL dlartg( d( n ), e( n ), cs, sn, r )
320 $
CALL dlasr(
'L',
'V',
'F', np1, ncvt, work( 1 ),
321 $ work( np1 ), vt, ldvt )
327 IF( iuplo.EQ.2 )
THEN
329 CALL dlartg( d( i ), e( i ), cs, sn, r )
332 d( i+1 ) = cs*d( i+1 )
342 IF( sqre1.EQ.1 )
THEN
343 CALL dlartg( d( n ), e( n ), cs, sn, r )
354 IF( sqre1.EQ.0 )
THEN
355 CALL dlasr(
'R',
'V',
'F', nru, n, work( 1 ),
356 $ work( np1 ), u, ldu )
358 CALL dlasr(
'R',
'V',
'F', nru, np1, work( 1 ),
359 $ work( np1 ), u, ldu )
363 IF( sqre1.EQ.0 )
THEN
364 CALL dlasr(
'L',
'V',
'F', n, ncc, work( 1 ),
365 $ work( np1 ), c, ldc )
367 CALL dlasr(
'L',
'V',
'F', np1, ncc, work( 1 ),
368 $ work( np1 ), c, ldc )
376 CALL dbdsqr(
'U', n, ncvt, nru, ncc, d, e, vt, ldvt, u, ldu, c,
389 IF( d( j ).LT.smin )
THEN
401 $
CALL dswap( ncvt, vt( isub, 1 ), ldvt, vt( i, 1 ), ldvt )
403 $
CALL dswap( nru, u( 1, isub ), 1, u( 1, i ), 1 )
405 $
CALL dswap( ncc, c( isub, 1 ), ldc, c( i, 1 ), ldc )
subroutine dlartg(F, G, CS, SN, R)
DLARTG generates a plane rotation with real cosine and real sine.
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dlasdq(UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
DLASDQ computes the SVD of a real bidiagonal matrix with diagonal d and off-diagonal e...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
DBDSQR
subroutine dlasr(SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA)
DLASR applies a sequence of plane rotations to a general rectangular matrix.