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 slasq2(N, Z, INFO)
SLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix associated ...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
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 slas2(F, G, H, SSMIN, SSMAX)
SLAS2 computes singular values of a 2-by-2 triangular matrix.
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.