103 SUBROUTINE clagsy( 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, 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(
'CLAGSY', -info )
174 DO 60 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 clacgv( n-i+1, work, 1 )
196 CALL csymv(
'Lower', n-i+1, tau, a( i, i ), lda, work, 1, zero,
198 CALL clacgv( n-i+1, work, 1 )
202 alpha = -half*tau*cdotc( n-i+1, work, 1, work( n+1 ), 1 )
203 CALL caxpy( 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 = scnrm2( 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 cscal( n-k-i, one / wb, a( k+i+1, i ), 1 )
233 tau =
REAL( wb / wa )
238 CALL cgemv(
'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 cgerc( n-k-i+1, k-1, -tau, a( k+i, i ), 1, work, 1,
241 $ a( k+i, i+1 ), lda )
247 CALL clacgv( n-k-i+1, a( k+i, i ), 1 )
248 CALL csymv(
'Lower', n-k-i+1, tau, a( k+i, k+i ), lda,
249 $ a( k+i, i ), 1, zero, work, 1 )
250 CALL clacgv( n-k-i+1, a( k+i, i ), 1 )
254 alpha = -half*tau*cdotc( n-k-i+1, a( k+i, i ), 1, work, 1 )
255 CALL caxpy( 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 csymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CSYMV computes a matrix-vector product for a complex symmetric matrix.
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 clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine clagsy(N, K, D, A, LDA, ISEED, WORK, INFO)
CLAGSY