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 zhemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZHEMV
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
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 zlaghe(N, K, D, A, LDA, ISEED, WORK, INFO)
ZLAGHE
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zher2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZHER2
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL