115 SUBROUTINE ssytri( UPLO, N, A, LDA, IPIV, WORK, INFO )
128 REAL a( lda, * ), work( * )
135 parameter( one = 1.0e+0, zero = 0.0e+0 )
140 REAL ak, akkp1, akp1, d, t, temp
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(
'SSYTRI', -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
scopy( k-1, a( 1, k ), 1, work, 1 )
224 CALL
ssymv( uplo, k-1, -one, a, lda, work, 1, zero,
226 a( k, k ) = a( k, k ) -
sdot( 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
scopy( k-1, a( 1, k ), 1, work, 1 )
249 CALL
ssymv( uplo, k-1, -one, a, lda, work, 1, zero,
251 a( k, k ) = a( k, k ) -
sdot( k-1, work, 1, a( 1, k ),
253 a( k, k+1 ) = a( k, k+1 ) -
254 $
sdot( k-1, a( 1, k ), 1, a( 1, k+1 ), 1 )
255 CALL
scopy( k-1, a( 1, k+1 ), 1, work, 1 )
256 CALL
ssymv( uplo, k-1, -one, a, lda, work, 1, zero,
258 a( k+1, k+1 ) = a( k+1, k+1 ) -
259 $
sdot( k-1, work, 1, a( 1, k+1 ), 1 )
264 kp = abs( ipiv( k ) )
270 CALL
sswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
271 CALL
sswap( 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
scopy( n-k, a( k+1, k ), 1, work, 1 )
313 CALL
ssymv( 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 ) -
sdot( 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
scopy( n-k, a( k+1, k ), 1, work, 1 )
338 CALL
ssymv( 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 ) -
sdot( n-k, work, 1, a( k+1, k ),
342 a( k, k-1 ) = a( k, k-1 ) -
343 $
sdot( n-k, a( k+1, k ), 1, a( k+1, k-1 ),
345 CALL
scopy( n-k, a( k+1, k-1 ), 1, work, 1 )
346 CALL
ssymv( 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 $
sdot( n-k, work, 1, a( k+1, k-1 ), 1 )
354 kp = abs( ipiv( k ) )
361 $ CALL
sswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ), 1 )
362 CALL
sswap( 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 )
LOGICAL function lsame(CA, CB)
LSAME
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine ssymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSYMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine ssytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
SSYTRI
REAL function sdot(N, SX, INCX, SY, INCY)
SDOT