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
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
complex *16 function zdotc(N, ZX, INCX, ZY, INCY)
ZDOTC
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zlaghe(N, K, D, A, LDA, ISEED, WORK, INFO)
ZLAGHE
subroutine zhemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZHEMV
double precision function dznrm2(N, X, INCX)
DZNRM2
subroutine zher2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZHER2
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL