109 SUBROUTINE slasq1( N, D, E, WORK, INFO )
120 REAL D( * ), E( * ), WORK( * )
127 parameter ( zero = 0.0e0 )
131 REAL EPS, SCALE, SAFMIN, SIGMN, SIGMX
141 INTRINSIC abs, max, sqrt
148 CALL xerbla(
'SLASQ1', -info )
150 ELSE IF( n.EQ.0 )
THEN
152 ELSE IF( n.EQ.1 )
THEN
153 d( 1 ) = abs( d( 1 ) )
155 ELSE IF( n.EQ.2 )
THEN
156 CALL slas2( d( 1 ), e( 1 ), d( 2 ), sigmn, sigmx )
166 d( i ) = abs( d( i ) )
167 sigmx = max( sigmx, abs( e( i ) ) )
169 d( n ) = abs( d( n ) )
173 IF( sigmx.EQ.zero )
THEN
174 CALL slasrt(
'D', n, d, iinfo )
179 sigmx = max( sigmx, d( i ) )
185 eps = slamch(
'Precision' )
186 safmin = slamch(
'Safe minimum' )
187 scale = sqrt( eps / safmin )
188 CALL scopy( n, d, 1, work( 1 ), 2 )
189 CALL scopy( n-1, e, 1, work( 2 ), 2 )
190 CALL slascl(
'G', 0, 0, sigmx, scale, 2*n-1, 1, work, 2*n-1,
196 work( i ) = work( i )**2
200 CALL slasq2( n, work, info )
204 d( i ) = sqrt( work( i ) )
206 CALL slascl(
'G', 0, 0, scale, sigmx, n, 1, d, n, iinfo )
207 ELSE IF( info.EQ.2 )
THEN
213 d( i ) = sqrt( work( 2*i-1 ) )
214 e( i ) = sqrt( work( 2*i ) )
216 CALL slascl(
'G', 0, 0, scale, sigmx, n, 1, d, n, iinfo )
217 CALL slascl(
'G', 0, 0, scale, sigmx, n, 1, e, n, iinfo )
subroutine slasq1(N, D, E, WORK, INFO)
SLASQ1 computes the singular values of a real square bidiagonal matrix. Used by sbdsqr.
subroutine slasrt(ID, N, D, INFO)
SLASRT sorts numbers in increasing or decreasing order.
subroutine slas2(F, G, H, SSMIN, SSMAX)
SLAS2 computes singular values of a 2-by-2 triangular matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine slasq2(N, Z, INFO)
SLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix associated ...
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY