114 SUBROUTINE dlagge( M, N, KL, KU, D, A, LDA, ISEED, WORK, INFO )
122 INTEGER INFO, KL, KU, LDA, M, N
126 DOUBLE PRECISION A( lda, * ), D( * ), WORK( * )
132 DOUBLE PRECISION ZERO, ONE
133 parameter( zero = 0.0d+0, one = 1.0d+0 )
137 DOUBLE PRECISION TAU, WA, WB, WN
143 INTRINSIC max, min, sign
146 DOUBLE PRECISION DNRM2
156 ELSE IF( n.LT.0 )
THEN
158 ELSE IF( kl.LT.0 .OR. kl.GT.m-1 )
THEN
160 ELSE IF( ku.LT.0 .OR. ku.GT.n-1 )
THEN
162 ELSE IF( lda.LT.max( 1, m ) )
THEN
166 CALL xerbla(
'DLAGGE', -info )
177 DO 30 i = 1, min( m, n )
183 DO 40 i = min( m, n ), 1, -1
188 CALL dlarnv( 3, iseed, m-i+1, work )
189 wn = dnrm2( m-i+1, work, 1 )
190 wa = sign( wn, work( 1 ) )
191 IF( wn.EQ.zero )
THEN
195 CALL dscal( m-i, one / wb, work( 2 ), 1 )
202 CALL dgemv(
'Transpose', m-i+1, n-i+1, one, a( i, i ), lda,
203 $ work, 1, zero, work( m+1 ), 1 )
204 CALL dger( m-i+1, n-i+1, -tau, work, 1, work( m+1 ), 1,
211 CALL dlarnv( 3, iseed, n-i+1, work )
212 wn = dnrm2( n-i+1, work, 1 )
213 wa = sign( wn, work( 1 ) )
214 IF( wn.EQ.zero )
THEN
218 CALL dscal( n-i, one / wb, work( 2 ), 1 )
225 CALL dgemv(
'No transpose', m-i+1, n-i+1, one, a( i, i ),
226 $ lda, work, 1, zero, work( n+1 ), 1 )
227 CALL dger( m-i+1, n-i+1, -tau, work( n+1 ), 1, work, 1,
235 DO 70 i = 1, max( m-1-kl, n-1-ku )
240 IF( i.LE.min( m-1-kl, n ) )
THEN
244 wn = dnrm2( m-kl-i+1, a( kl+i, i ), 1 )
245 wa = sign( wn, a( kl+i, i ) )
246 IF( wn.EQ.zero )
THEN
249 wb = a( kl+i, i ) + wa
250 CALL dscal( m-kl-i, one / wb, a( kl+i+1, i ), 1 )
257 CALL dgemv(
'Transpose', m-kl-i+1, n-i, one,
258 $ a( kl+i, i+1 ), lda, a( kl+i, i ), 1, zero,
260 CALL dger( m-kl-i+1, n-i, -tau, a( kl+i, i ), 1, work, 1,
261 $ a( kl+i, i+1 ), lda )
265 IF( i.LE.min( n-1-ku, m ) )
THEN
269 wn = dnrm2( n-ku-i+1, a( i, ku+i ), lda )
270 wa = sign( wn, a( i, ku+i ) )
271 IF( wn.EQ.zero )
THEN
274 wb = a( i, ku+i ) + wa
275 CALL dscal( n-ku-i, one / wb, a( i, ku+i+1 ), lda )
282 CALL dgemv(
'No transpose', m-i, n-ku-i+1, one,
283 $ a( i+1, ku+i ), lda, a( i, ku+i ), lda, zero,
285 CALL dger( m-i, n-ku-i+1, -tau, work, 1, a( i, ku+i ),
286 $ lda, a( i+1, ku+i ), lda )
294 IF( i.LE.min( n-1-ku, m ) )
THEN
298 wn = dnrm2( n-ku-i+1, a( i, ku+i ), lda )
299 wa = sign( wn, a( i, ku+i ) )
300 IF( wn.EQ.zero )
THEN
303 wb = a( i, ku+i ) + wa
304 CALL dscal( n-ku-i, one / wb, a( i, ku+i+1 ), lda )
311 CALL dgemv(
'No transpose', m-i, n-ku-i+1, one,
312 $ a( i+1, ku+i ), lda, a( i, ku+i ), lda, zero,
314 CALL dger( m-i, n-ku-i+1, -tau, work, 1, a( i, ku+i ),
315 $ lda, a( i+1, ku+i ), lda )
319 IF( i.LE.min( m-1-kl, n ) )
THEN
323 wn = dnrm2( m-kl-i+1, a( kl+i, i ), 1 )
324 wa = sign( wn, a( kl+i, i ) )
325 IF( wn.EQ.zero )
THEN
328 wb = a( kl+i, i ) + wa
329 CALL dscal( m-kl-i, one / wb, a( kl+i+1, i ), 1 )
336 CALL dgemv(
'Transpose', m-kl-i+1, n-i, one,
337 $ a( kl+i, i+1 ), lda, a( kl+i, i ), 1, zero,
339 CALL dger( m-kl-i+1, n-i, -tau, a( kl+i, i ), 1, work, 1,
340 $ a( kl+i, i+1 ), lda )
345 DO 50 j = kl + i + 1, m
349 DO 60 j = ku + i + 1, n
subroutine dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
DGER
subroutine dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV
subroutine dlagge(M, N, KL, KU, D, A, LDA, ISEED, WORK, INFO)
DLAGGE