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 )