103 SUBROUTINE zlagsy( 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, 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(
'ZLAGSY', -info )
174 DO 60 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 zlacgv( n-i+1, work, 1 )
196 CALL zsymv(
'Lower', n-i+1, tau, a( i, i ), lda, work, 1, zero,
198 CALL zlacgv( n-i+1, work, 1 )
202 alpha = -half*tau*zdotc( n-i+1, work, 1, work( n+1 ), 1 )
203 CALL zaxpy( n-i+1, alpha, work, 1, work( n+1 ), 1 )
212 a( ii, jj ) = a( ii, jj ) -
213 $ work( ii-i+1 )*work( n+jj-i+1 ) -
214 $ work( n+ii-i+1 )*work( jj-i+1 )
221 DO 100 i = 1, n - 1 - k
225 wn = dznrm2( n-k-i+1, a( k+i, i ), 1 )
226 wa = ( wn / abs( a( k+i, i ) ) )*a( k+i, i )
227 IF( wn.EQ.zero )
THEN
230 wb = a( k+i, i ) + wa
231 CALL zscal( n-k-i, one / wb, a( k+i+1, i ), 1 )
233 tau = dble( wb / wa )
238 CALL zgemv(
'Conjugate transpose', n-k-i+1, k-1, one,
239 $ a( k+i, i+1 ), lda, a( k+i, i ), 1, zero, work, 1 )
240 CALL zgerc( n-k-i+1, k-1, -tau, a( k+i, i ), 1, work, 1,
241 $ a( k+i, i+1 ), lda )
247 CALL zlacgv( n-k-i+1, a( k+i, i ), 1 )
248 CALL zsymv(
'Lower', n-k-i+1, tau, a( k+i, k+i ), lda,
249 $ a( k+i, i ), 1, zero, work, 1 )
250 CALL zlacgv( n-k-i+1, a( k+i, i ), 1 )
254 alpha = -half*tau*zdotc( n-k-i+1, a( k+i, i ), 1, work, 1 )
255 CALL zaxpy( n-k-i+1, alpha, a( k+i, i ), 1, work, 1 )
264 a( ii, jj ) = a( ii, jj ) - a( ii, i )*work( jj-k-i+1 ) -
265 $ work( ii-k-i+1 )*a( jj, i )
270 DO 90 j = k + i + 1, n
279 a( j, i ) = a( i, j )
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 zlagsy(N, K, D, A, LDA, ISEED, WORK, INFO)
ZLAGSY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zsymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZSYMV computes a matrix-vector product for a complex symmetric matrix.
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.