103 SUBROUTINE zlaghe( N, K, D, A, LDA, ISEED, WORK, INFO )
111 INTEGER INFO, K, LDA, N
115 DOUBLE PRECISION D( * )
116 COMPLEX*16 A( lda, * ), WORK( * )
122 COMPLEX*16 ZERO, ONE, HALF
123 parameter( zero = ( 0.0d+0, 0.0d+0 ),
124 $ one = ( 1.0d+0, 0.0d+0 ),
125 $ half = ( 0.5d+0, 0.0d+0 ) )
130 COMPLEX*16 ALPHA, TAU, WA, WB
137 DOUBLE PRECISION DZNRM2
139 EXTERNAL dznrm2, zdotc
142 INTRINSIC abs, dble, dconjg, max
151 ELSE IF( k.LT.0 .OR. k.GT.n-1 )
THEN
153 ELSE IF( lda.LT.max( 1, n ) )
THEN
157 CALL
xerbla(
'ZLAGHE', -info )
174 DO 40 i = n - 1, 1, -1
178 CALL
zlarnv( 3, iseed, n-i+1, work )
179 wn = dznrm2( n-i+1, work, 1 )
180 wa = ( wn / abs( work( 1 ) ) )*work( 1 )
181 IF( wn.EQ.zero )
THEN
185 CALL
zscal( n-i, one / wb, work( 2 ), 1 )
187 tau = dble( wb / wa )
195 CALL
zhemv(
'Lower', n-i+1, tau, a( i, i ), lda, work, 1, zero,
200 alpha = -half*tau*zdotc( n-i+1, work( n+1 ), 1, work, 1 )
201 CALL
zaxpy( n-i+1, alpha, work, 1, work( n+1 ), 1 )
205 CALL
zher2(
'Lower', n-i+1, -one, work, 1, work( n+1 ), 1,
211 DO 60 i = 1, n - 1 - k
215 wn = dznrm2( n-k-i+1, a( k+i, i ), 1 )
216 wa = ( wn / abs( a( k+i, i ) ) )*a( k+i, i )
217 IF( wn.EQ.zero )
THEN
220 wb = a( k+i, i ) + wa
221 CALL
zscal( n-k-i, one / wb, a( k+i+1, i ), 1 )
223 tau = dble( wb / wa )
228 CALL
zgemv(
'Conjugate transpose', n-k-i+1, k-1, one,
229 $ a( k+i, i+1 ), lda, a( k+i, i ), 1, zero, work, 1 )
230 CALL
zgerc( n-k-i+1, k-1, -tau, a( k+i, i ), 1, work, 1,
231 $ a( k+i, i+1 ), lda )
237 CALL
zhemv(
'Lower', n-k-i+1, tau, a( k+i, k+i ), lda,
238 $ a( k+i, i ), 1, zero, work, 1 )
242 alpha = -half*tau*zdotc( n-k-i+1, work, 1, a( k+i, i ), 1 )
243 CALL
zaxpy( n-k-i+1, alpha, a( k+i, i ), 1, work, 1 )
247 CALL
zher2(
'Lower', n-k-i+1, -one, a( k+i, i ), 1, work, 1,
248 $ a( k+i, k+i ), lda )
251 DO 50 j = k + i + 1, n
260 a( j, i ) = dconjg( a( i, j ) )
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 zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine zlaghe(N, K, D, A, LDA, ISEED, WORK, INFO)
ZLAGHE
subroutine zhemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZHEMV
subroutine zher2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZHER2
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL