109 SUBROUTINE dlasq1( N, D, E, WORK, INFO )
120 DOUBLE PRECISION D( * ), E( * ), WORK( * )
126 DOUBLE PRECISION ZERO
127 parameter ( zero = 0.0d0 )
131 DOUBLE PRECISION EPS, SCALE, SAFMIN, SIGMN, SIGMX
137 DOUBLE PRECISION DLAMCH
141 INTRINSIC abs, max, sqrt
148 CALL xerbla(
'DLASQ1', -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 dlas2( 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 dlasrt(
'D', n, d, iinfo )
179 sigmx = max( sigmx, d( i ) )
185 eps = dlamch(
'Precision' )
186 safmin = dlamch(
'Safe minimum' )
187 scale = sqrt( eps / safmin )
188 CALL dcopy( n, d, 1, work( 1 ), 2 )
189 CALL dcopy( n-1, e, 1, work( 2 ), 2 )
190 CALL dlascl(
'G', 0, 0, sigmx, scale, 2*n-1, 1, work, 2*n-1,
196 work( i ) = work( i )**2
200 CALL dlasq2( n, work, info )
204 d( i ) = sqrt( work( i ) )
206 CALL dlascl(
'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 dlascl(
'G', 0, 0, scale, sigmx, n, 1, d, n, iinfo )
217 CALL dlascl(
'G', 0, 0, scale, sigmx, n, 1, e, n, iinfo )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine dlasq1(N, D, E, WORK, INFO)
DLASQ1 computes the singular values of a real square bidiagonal matrix. Used by sbdsqr.
subroutine dlasq2(N, Z, INFO)
DLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix associated ...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlasrt(ID, N, D, INFO)
DLASRT sorts numbers in increasing or decreasing order.
subroutine dlas2(F, G, H, SSMIN, SSMAX)
DLAS2 computes singular values of a 2-by-2 triangular matrix.