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
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 cscal(N, CA, CX, INCX)
CSCAL
subroutine csymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CSYMV computes a matrix-vector product for a complex symmetric matrix.
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
COMPLEX function cdotc(N, CX, INCX, CY, INCY)
CDOTC
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine clagsy(N, K, D, A, LDA, ISEED, WORK, INFO)
CLAGSY
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
REAL function scnrm2(N, X, INCX)
SCNRM2
subroutine cgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERC