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 sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine sbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SBDSQR
subroutine xerbla(SRNAME, INFO)
XERBLA
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...
logical function lsame(CA, CB)
LSAME
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine slasr(SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA)
SLASR applies a sequence of plane rotations to a general rectangular matrix.
subroutine slartg(F, G, CS, SN, R)
SLARTG generates a plane rotation with real cosine and real sine.