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
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 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 xerbla(SRNAME, INFO)
XERBLA
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine zsymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZSYMV computes a matrix-vector product for a complex symmetric matrix.
subroutine zlagsy(N, K, D, A, LDA, ISEED, WORK, INFO)
ZLAGSY
DOUBLE PRECISION function dznrm2(N, X, INCX)
DZNRM2
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
COMPLEX *16 function zdotc(N, ZX, INCX, ZY, INCY)
ZDOTC
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL