130 SUBROUTINE ssytri_rook( UPLO, N, A, LDA, IPIV, WORK, INFO )
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 ssytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
SSYTRI_ROOK
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine ssymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSYMV
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY