115 SUBROUTINE dsytri( UPLO, N, A, LDA, IPIV, WORK, INFO )
128 DOUBLE PRECISION A( lda, * ), WORK( * )
134 DOUBLE PRECISION ONE, ZERO
135 parameter( one = 1.0d+0, zero = 0.0d+0 )
140 DOUBLE PRECISION AK, AKKP1, AKP1, D, T, TEMP
144 DOUBLE PRECISION DDOT
158 upper = lsame( uplo,
'U' )
159 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
161 ELSE IF( n.LT.0 )
THEN
163 ELSE IF( lda.LT.max( 1, n ) )
THEN
167 CALL
xerbla(
'DSYTRI', -info )
182 DO 10 info = n, 1, -1
183 IF( ipiv( info ).GT.0 .AND. a( info, info ).EQ.zero )
191 IF( ipiv( info ).GT.0 .AND. a( info, info ).EQ.zero )
212 IF( ipiv( k ).GT.0 )
THEN
218 a( k, k ) = one / a( k, k )
223 CALL
dcopy( k-1, a( 1, k ), 1, work, 1 )
224 CALL
dsymv( uplo, k-1, -one, a, lda, work, 1, zero,
226 a( k, k ) = a( k, k ) - ddot( k-1, work, 1, a( 1, k ),
236 t = abs( a( k, k+1 ) )
238 akp1 = a( k+1, k+1 ) / t
239 akkp1 = a( k, k+1 ) / t
240 d = t*( ak*akp1-one )
242 a( k+1, k+1 ) = ak / d
243 a( k, k+1 ) = -akkp1 / d
248 CALL
dcopy( k-1, a( 1, k ), 1, work, 1 )
249 CALL
dsymv( uplo, k-1, -one, a, lda, work, 1, zero,
251 a( k, k ) = a( k, k ) - ddot( k-1, work, 1, a( 1, k ),
253 a( k, k+1 ) = a( k, k+1 ) -
254 $ ddot( k-1, a( 1, k ), 1, a( 1, k+1 ), 1 )
255 CALL
dcopy( k-1, a( 1, k+1 ), 1, work, 1 )
256 CALL
dsymv( uplo, k-1, -one, a, lda, work, 1, zero,
258 a( k+1, k+1 ) = a( k+1, k+1 ) -
259 $ ddot( k-1, work, 1, a( 1, k+1 ), 1 )
264 kp = abs( ipiv( k ) )
270 CALL
dswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
271 CALL
dswap( k-kp-1, a( kp+1, k ), 1, a( kp, kp+1 ), lda )
273 a( k, k ) = a( kp, kp )
275 IF( kstep.EQ.2 )
THEN
277 a( k, k+1 ) = a( kp, k+1 )
301 IF( ipiv( k ).GT.0 )
THEN
307 a( k, k ) = one / a( k, k )
312 CALL
dcopy( n-k, a( k+1, k ), 1, work, 1 )
313 CALL
dsymv( uplo, n-k, -one, a( k+1, k+1 ), lda, work, 1,
314 $ zero, a( k+1, k ), 1 )
315 a( k, k ) = a( k, k ) - ddot( n-k, work, 1, a( k+1, k ),
325 t = abs( a( k, k-1 ) )
326 ak = a( k-1, k-1 ) / t
328 akkp1 = a( k, k-1 ) / t
329 d = t*( ak*akp1-one )
330 a( k-1, k-1 ) = akp1 / d
332 a( k, k-1 ) = -akkp1 / d
337 CALL
dcopy( n-k, a( k+1, k ), 1, work, 1 )
338 CALL
dsymv( uplo, n-k, -one, a( k+1, k+1 ), lda, work, 1,
339 $ zero, a( k+1, k ), 1 )
340 a( k, k ) = a( k, k ) - ddot( n-k, work, 1, a( k+1, k ),
342 a( k, k-1 ) = a( k, k-1 ) -
343 $ ddot( n-k, a( k+1, k ), 1, a( k+1, k-1 ),
345 CALL
dcopy( n-k, a( k+1, k-1 ), 1, work, 1 )
346 CALL
dsymv( uplo, n-k, -one, a( k+1, k+1 ), lda, work, 1,
347 $ zero, a( k+1, k-1 ), 1 )
348 a( k-1, k-1 ) = a( k-1, k-1 ) -
349 $ ddot( n-k, work, 1, a( k+1, k-1 ), 1 )
354 kp = abs( ipiv( k ) )
361 $ CALL
dswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ), 1 )
362 CALL
dswap( kp-k-1, a( k+1, k ), 1, a( kp, k+1 ), lda )
364 a( k, k ) = a( kp, kp )
366 IF( kstep.EQ.2 )
THEN
368 a( k, k-1 ) = a( kp, k-1 )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dsytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dsymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DSYMV