103 SUBROUTINE claghe( N, K, D, A, LDA, ISEED, WORK, INFO )
111 INTEGER INFO, K, LDA, N
116 COMPLEX A( lda, * ), WORK( * )
122 COMPLEX ZERO, ONE, HALF
123 parameter( zero = ( 0.0e+0, 0.0e+0 ),
124 $ one = ( 1.0e+0, 0.0e+0 ),
125 $ half = ( 0.5e+0, 0.0e+0 ) )
130 COMPLEX ALPHA, TAU, WA, WB
139 EXTERNAL scnrm2, cdotc
142 INTRINSIC abs, conjg, max, real
151 ELSE IF( k.LT.0 .OR. k.GT.n-1 )
THEN
153 ELSE IF( lda.LT.max( 1, n ) )
THEN
157 CALL
xerbla(
'CLAGHE', -info )
174 DO 40 i = n - 1, 1, -1
178 CALL
clarnv( 3, iseed, n-i+1, work )
179 wn = scnrm2( n-i+1, work, 1 )
180 wa = ( wn / abs( work( 1 ) ) )*work( 1 )
181 IF( wn.EQ.zero )
THEN
185 CALL
cscal( n-i, one / wb, work( 2 ), 1 )
187 tau =
REAL( wb / wa )
195 CALL
chemv(
'Lower', n-i+1, tau, a( i, i ), lda, work, 1, zero,
200 alpha = -half*tau*cdotc( n-i+1, work( n+1 ), 1, work, 1 )
201 CALL
caxpy( n-i+1, alpha, work, 1, work( n+1 ), 1 )
205 CALL
cher2(
'Lower', n-i+1, -one, work, 1, work( n+1 ), 1,
211 DO 60 i = 1, n - 1 - k
215 wn = scnrm2( 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
cscal( n-k-i, one / wb, a( k+i+1, i ), 1 )
223 tau =
REAL( wb / wa )
228 CALL
cgemv(
'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
cgerc( n-k-i+1, k-1, -tau, a( k+i, i ), 1, work, 1,
231 $ a( k+i, i+1 ), lda )
237 CALL
chemv(
'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*cdotc( n-k-i+1, work, 1, a( k+i, i ), 1 )
243 CALL
caxpy( n-k-i+1, alpha, a( k+i, i ), 1, work, 1 )
247 CALL
cher2(
'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 ) = conjg( a( i, j ) )
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine chemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CHEMV
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine cher2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CHER2
subroutine claghe(N, K, D, A, LDA, ISEED, WORK, INFO)
CLAGHE
subroutine cgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERC