211 SUBROUTINE slasdq( 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 REAL C( ldc, * ), D( * ), E( * ), U( ldu, * ),
225 $ vt( ldvt, * ), work( * )
232 parameter ( zero = 0.0e+0 )
236 INTEGER I, ISUB, IUPLO, J, NP1, SQRE1
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(
'SLASDQ', -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 slartg( d( i ), e( i ), cs, sn, r )
301 d( i+1 ) = cs*d( i+1 )
307 CALL slartg( d( n ), e( n ), cs, sn, r )
320 $
CALL slasr(
'L',
'V',
'F', np1, ncvt, work( 1 ),
321 $ work( np1 ), vt, ldvt )
327 IF( iuplo.EQ.2 )
THEN
329 CALL slartg( d( i ), e( i ), cs, sn, r )
332 d( i+1 ) = cs*d( i+1 )
342 IF( sqre1.EQ.1 )
THEN
343 CALL slartg( d( n ), e( n ), cs, sn, r )
354 IF( sqre1.EQ.0 )
THEN
355 CALL slasr(
'R',
'V',
'F', nru, n, work( 1 ),
356 $ work( np1 ), u, ldu )
358 CALL slasr(
'R',
'V',
'F', nru, np1, work( 1 ),
359 $ work( np1 ), u, ldu )
363 IF( sqre1.EQ.0 )
THEN
364 CALL slasr(
'L',
'V',
'F', n, ncc, work( 1 ),
365 $ work( np1 ), c, ldc )
367 CALL slasr(
'L',
'V',
'F', np1, ncc, work( 1 ),
368 $ work( np1 ), c, ldc )
376 CALL sbdsqr(
'U', n, ncvt, nru, ncc, d, e, vt, ldvt, u, ldu, c,
389 IF( d( j ).LT.smin )
THEN
401 $
CALL sswap( ncvt, vt( isub, 1 ), ldvt, vt( i, 1 ), ldvt )
403 $
CALL sswap( nru, u( 1, isub ), 1, u( 1, i ), 1 )
405 $
CALL sswap( ncc, c( isub, 1 ), ldc, c( i, 1 ), ldc )
subroutine slartg(F, G, CS, SN, R)
SLARTG generates a plane rotation with real cosine and real sine.
subroutine slasdq(UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SLASDQ computes the SVD of a real bidiagonal matrix with diagonal d and off-diagonal e...
subroutine slasr(SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA)
SLASR applies a sequence of plane rotations to a general rectangular matrix.
subroutine sbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SBDSQR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP