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 clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine cgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERC
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine chemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CHEMV
subroutine cher2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CHER2
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine claghe(N, K, D, A, LDA, ISEED, WORK, INFO)
CLAGHE