120 DOUBLE PRECISION d( * ), e( * ), work( * )
126 DOUBLE PRECISION zero
127 parameter( zero = 0.0d0 )
131 DOUBLE PRECISION eps, scale, safmin, sigmn, sigmx
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 dlasrt(ID, N, D, INFO)
DLASRT sorts numbers in increasing or decreasing order.
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
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 dlasq2(N, Z, INFO)
DLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix associated ...
subroutine dlasq1(N, D, E, WORK, INFO)
DLASQ1 computes the singular values of a real square bidiagonal matrix. Used by sbdsqr.
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine dlas2(F, G, H, SSMIN, SSMAX)
DLAS2 computes singular values of a 2-by-2 triangular matrix.