115 SUBROUTINE zlagge( M, N, KL, KU, D, A, LDA, ISEED, WORK, INFO )
123 INTEGER INFO, KL, KU, LDA, M, N
127 DOUBLE PRECISION D( * )
128 COMPLEX*16 A( lda, * ), WORK( * )
135 parameter( zero = ( 0.0d+0, 0.0d+0 ),
136 $ one = ( 1.0d+0, 0.0d+0 ) )
141 COMPLEX*16 TAU, WA, WB
147 INTRINSIC abs, dble, max, min
150 DOUBLE PRECISION DZNRM2
160 ELSE IF( n.LT.0 )
THEN
162 ELSE IF( kl.LT.0 .OR. kl.GT.m-1 )
THEN
164 ELSE IF( ku.LT.0 .OR. ku.GT.n-1 )
THEN
166 ELSE IF( lda.LT.max( 1, m ) )
THEN
170 CALL xerbla(
'ZLAGGE', -info )
181 DO 30 i = 1, min( m, n )
187 DO 40 i = min( m, n ), 1, -1
192 CALL zlarnv( 3, iseed, m-i+1, work )
193 wn = dznrm2( m-i+1, work, 1 )
194 wa = ( wn / abs( work( 1 ) ) )*work( 1 )
195 IF( wn.EQ.zero )
THEN
199 CALL zscal( m-i, one / wb, work( 2 ), 1 )
201 tau = dble( wb / wa )
206 CALL zgemv(
'Conjugate transpose', m-i+1, n-i+1, one,
207 $ a( i, i ), lda, work, 1, zero, work( m+1 ), 1 )
208 CALL zgerc( m-i+1, n-i+1, -tau, work, 1, work( m+1 ), 1,
215 CALL zlarnv( 3, iseed, n-i+1, work )
216 wn = dznrm2( n-i+1, work, 1 )
217 wa = ( wn / abs( work( 1 ) ) )*work( 1 )
218 IF( wn.EQ.zero )
THEN
222 CALL zscal( n-i, one / wb, work( 2 ), 1 )
224 tau = dble( wb / wa )
229 CALL zgemv(
'No transpose', m-i+1, n-i+1, one, a( i, i ),
230 $ lda, work, 1, zero, work( n+1 ), 1 )
231 CALL zgerc( m-i+1, n-i+1, -tau, work( n+1 ), 1, work, 1,
239 DO 70 i = 1, max( m-1-kl, n-1-ku )
244 IF( i.LE.min( m-1-kl, n ) )
THEN
248 wn = dznrm2( m-kl-i+1, a( kl+i, i ), 1 )
249 wa = ( wn / abs( a( kl+i, i ) ) )*a( kl+i, i )
250 IF( wn.EQ.zero )
THEN
253 wb = a( kl+i, i ) + wa
254 CALL zscal( m-kl-i, one / wb, a( kl+i+1, i ), 1 )
256 tau = dble( wb / wa )
261 CALL zgemv(
'Conjugate transpose', m-kl-i+1, n-i, one,
262 $ a( kl+i, i+1 ), lda, a( kl+i, i ), 1, zero,
264 CALL zgerc( m-kl-i+1, n-i, -tau, a( kl+i, i ), 1, work,
265 $ 1, a( kl+i, i+1 ), lda )
269 IF( i.LE.min( n-1-ku, m ) )
THEN
273 wn = dznrm2( n-ku-i+1, a( i, ku+i ), lda )
274 wa = ( wn / abs( a( i, ku+i ) ) )*a( i, ku+i )
275 IF( wn.EQ.zero )
THEN
278 wb = a( i, ku+i ) + wa
279 CALL zscal( n-ku-i, one / wb, a( i, ku+i+1 ), lda )
281 tau = dble( wb / wa )
286 CALL zlacgv( n-ku-i+1, a( i, ku+i ), lda )
287 CALL zgemv(
'No transpose', m-i, n-ku-i+1, one,
288 $ a( i+1, ku+i ), lda, a( i, ku+i ), lda, zero,
290 CALL zgerc( m-i, n-ku-i+1, -tau, work, 1, a( i, ku+i ),
291 $ lda, a( i+1, ku+i ), lda )
299 IF( i.LE.min( n-1-ku, m ) )
THEN
303 wn = dznrm2( n-ku-i+1, a( i, ku+i ), lda )
304 wa = ( wn / abs( a( i, ku+i ) ) )*a( i, ku+i )
305 IF( wn.EQ.zero )
THEN
308 wb = a( i, ku+i ) + wa
309 CALL zscal( n-ku-i, one / wb, a( i, ku+i+1 ), lda )
311 tau = dble( wb / wa )
316 CALL zlacgv( n-ku-i+1, a( i, ku+i ), lda )
317 CALL zgemv(
'No transpose', m-i, n-ku-i+1, one,
318 $ a( i+1, ku+i ), lda, a( i, ku+i ), lda, zero,
320 CALL zgerc( m-i, n-ku-i+1, -tau, work, 1, a( i, ku+i ),
321 $ lda, a( i+1, ku+i ), lda )
325 IF( i.LE.min( m-1-kl, n ) )
THEN
329 wn = dznrm2( m-kl-i+1, a( kl+i, i ), 1 )
330 wa = ( wn / abs( a( kl+i, i ) ) )*a( kl+i, i )
331 IF( wn.EQ.zero )
THEN
334 wb = a( kl+i, i ) + wa
335 CALL zscal( m-kl-i, one / wb, a( kl+i+1, i ), 1 )
337 tau = dble( wb / wa )
342 CALL zgemv(
'Conjugate transpose', m-kl-i+1, n-i, one,
343 $ a( kl+i, i+1 ), lda, a( kl+i, i ), 1, zero,
345 CALL zgerc( m-kl-i+1, n-i, -tau, a( kl+i, i ), 1, work,
346 $ 1, a( kl+i, i+1 ), lda )
351 DO 50 j = kl + i + 1, m
355 DO 60 j = ku + i + 1, n
subroutine zlagge(M, N, KL, KU, D, A, LDA, ISEED, WORK, INFO)
ZLAGGE
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERC
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL