143 REAL A( lda, * ), WORK( * )
150 parameter( one = 1.0e+0, zero = 0.0e+0 )
155 REAL AK, AKKP1, AKP1, D, T, TEMP
173 upper = lsame( uplo,
'U' )
174 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
176 ELSE IF( n.LT.0 )
THEN
178 ELSE IF( lda.LT.max( 1, n ) )
THEN
182 CALL
xerbla(
'SSYTRI_ROOK', -info )
197 DO 10 info = n, 1, -1
198 IF( ipiv( info ).GT.0 .AND. a( info, info ).EQ.zero )
206 IF( ipiv( info ).GT.0 .AND. a( info, info ).EQ.zero )
227 IF( ipiv( k ).GT.0 )
THEN
233 a( k, k ) = one / a( k, k )
238 CALL
scopy( k-1, a( 1, k ), 1, work, 1 )
239 CALL
ssymv( uplo, k-1, -one, a, lda, work, 1, zero,
241 a( k, k ) = a( k, k ) - sdot( k-1, work, 1, a( 1, k ),
251 t = abs( a( k, k+1 ) )
253 akp1 = a( k+1, k+1 ) / t
254 akkp1 = a( k, k+1 ) / t
255 d = t*( ak*akp1-one )
257 a( k+1, k+1 ) = ak / d
258 a( k, k+1 ) = -akkp1 / d
263 CALL
scopy( k-1, a( 1, k ), 1, work, 1 )
264 CALL
ssymv( uplo, k-1, -one, a, lda, work, 1, zero,
266 a( k, k ) = a( k, k ) - sdot( k-1, work, 1, a( 1, k ),
268 a( k, k+1 ) = a( k, k+1 ) -
269 $ sdot( k-1, a( 1, k ), 1, a( 1, k+1 ), 1 )
270 CALL
scopy( k-1, a( 1, k+1 ), 1, work, 1 )
271 CALL
ssymv( uplo, k-1, -one, a, lda, work, 1, zero,
273 a( k+1, k+1 ) = a( k+1, k+1 ) -
274 $ sdot( k-1, work, 1, a( 1, k+1 ), 1 )
279 IF( kstep.EQ.1 )
THEN
287 $ CALL
sswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
288 CALL
sswap( k-kp-1, a( kp+1, k ), 1, a( kp, kp+1 ), lda )
290 a( k, k ) = a( kp, kp )
301 $ CALL
sswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
302 CALL
sswap( k-kp-1, a( kp+1, k ), 1, a( kp, kp+1 ), lda )
305 a( k, k ) = a( kp, kp )
308 a( k, k+1 ) = a( kp, k+1 )
316 $ CALL
sswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
317 CALL
sswap( k-kp-1, a( kp+1, k ), 1, a( kp, kp+1 ), lda )
319 a( k, k ) = a( kp, kp )
343 IF( ipiv( k ).GT.0 )
THEN
349 a( k, k ) = one / a( k, k )
354 CALL
scopy( n-k, a( k+1, k ), 1, work, 1 )
355 CALL
ssymv( uplo, n-k, -one, a( k+1, k+1 ), lda, work, 1,
356 $ zero, a( k+1, k ), 1 )
357 a( k, k ) = a( k, k ) - sdot( n-k, work, 1, a( k+1, k ),
367 t = abs( a( k, k-1 ) )
368 ak = a( k-1, k-1 ) / t
370 akkp1 = a( k, k-1 ) / t
371 d = t*( ak*akp1-one )
372 a( k-1, k-1 ) = akp1 / d
374 a( k, k-1 ) = -akkp1 / d
379 CALL
scopy( n-k, a( k+1, k ), 1, work, 1 )
380 CALL
ssymv( uplo, n-k, -one, a( k+1, k+1 ), lda, work, 1,
381 $ zero, a( k+1, k ), 1 )
382 a( k, k ) = a( k, k ) - sdot( n-k, work, 1, a( k+1, k ),
384 a( k, k-1 ) = a( k, k-1 ) -
385 $ sdot( n-k, a( k+1, k ), 1, a( k+1, k-1 ),
387 CALL
scopy( n-k, a( k+1, k-1 ), 1, work, 1 )
388 CALL
ssymv( uplo, n-k, -one, a( k+1, k+1 ), lda, work, 1,
389 $ zero, a( k+1, k-1 ), 1 )
390 a( k-1, k-1 ) = a( k-1, k-1 ) -
391 $ sdot( n-k, work, 1, a( k+1, k-1 ), 1 )
396 IF( kstep.EQ.1 )
THEN
404 $ CALL
sswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ), 1 )
405 CALL
sswap( kp-k-1, a( k+1, k ), 1, a( kp, k+1 ), lda )
407 a( k, k ) = a( kp, kp )
418 $ CALL
sswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ), 1 )
419 CALL
sswap( kp-k-1, a( k+1, k ), 1, a( kp, k+1 ), lda )
422 a( k, k ) = a( kp, kp )
425 a( k, k-1 ) = a( kp, k-1 )
433 $ CALL
sswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ), 1 )
434 CALL
sswap( kp-k-1, a( k+1, k ), 1, a( kp, k+1 ), lda )
436 a( k, k ) = a( kp, kp )
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_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
SSYTRI_ROOK