102 SUBROUTINE dlagsy( N, K, D, A, LDA, ISEED, WORK, INFO )
110 INTEGER INFO, K, LDA, N
114 DOUBLE PRECISION A( lda, * ), D( * ), WORK( * )
120 DOUBLE PRECISION ZERO, ONE, HALF
121 parameter( zero = 0.0d+0, one = 1.0d+0, half = 0.5d+0 )
125 DOUBLE PRECISION ALPHA, TAU, WA, WB, WN
132 DOUBLE PRECISION DDOT, DNRM2
145 ELSE IF( k.LT.0 .OR. k.GT.n-1 )
THEN
147 ELSE IF( lda.LT.max( 1, n ) )
THEN
151 CALL
xerbla(
'DLAGSY', -info )
168 DO 40 i = n - 1, 1, -1
172 CALL
dlarnv( 3, iseed, n-i+1, work )
173 wn = dnrm2( n-i+1, work, 1 )
174 wa = sign( wn, work( 1 ) )
175 IF( wn.EQ.zero )
THEN
179 CALL
dscal( n-i, one / wb, work( 2 ), 1 )
189 CALL
dsymv(
'Lower', n-i+1, tau, a( i, i ), lda, work, 1, zero,
194 alpha = -half*tau*ddot( n-i+1, work( n+1 ), 1, work, 1 )
195 CALL
daxpy( n-i+1, alpha, work, 1, work( n+1 ), 1 )
199 CALL
dsyr2(
'Lower', n-i+1, -one, work, 1, work( n+1 ), 1,
205 DO 60 i = 1, n - 1 - k
209 wn = dnrm2( n-k-i+1, a( k+i, i ), 1 )
210 wa = sign( wn, a( k+i, i ) )
211 IF( wn.EQ.zero )
THEN
214 wb = a( k+i, i ) + wa
215 CALL
dscal( n-k-i, one / wb, a( k+i+1, i ), 1 )
222 CALL
dgemv(
'Transpose', n-k-i+1, k-1, one, a( k+i, i+1 ), lda,
223 $ a( k+i, i ), 1, zero, work, 1 )
224 CALL
dger( n-k-i+1, k-1, -tau, a( k+i, i ), 1, work, 1,
225 $ a( k+i, i+1 ), lda )
231 CALL
dsymv(
'Lower', n-k-i+1, tau, a( k+i, k+i ), lda,
232 $ a( k+i, i ), 1, zero, work, 1 )
236 alpha = -half*tau*ddot( n-k-i+1, work, 1, a( k+i, i ), 1 )
237 CALL
daxpy( n-k-i+1, alpha, a( k+i, i ), 1, work, 1 )
241 CALL
dsyr2(
'Lower', n-k-i+1, -one, a( k+i, i ), 1, work, 1,
242 $ a( k+i, k+i ), lda )
245 DO 50 j = k + i + 1, n
254 a( j, i ) = a( i, j )
subroutine dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
DGER
subroutine dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dsyr2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
DSYR2
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY
subroutine dsymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DSYMV
subroutine dlagsy(N, K, D, A, LDA, ISEED, WORK, INFO)
DLAGSY
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV