121 SUBROUTINE ssytrs( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
130 INTEGER INFO, LDA, LDB, N, NRHS
134 REAL A( lda, * ), B( ldb, * )
141 parameter( one = 1.0e+0 )
146 REAL AK, AKM1, AKM1K, BK, BKM1, DENOM
161 upper = lsame( uplo,
'U' )
162 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
164 ELSE IF( n.LT.0 )
THEN
166 ELSE IF( nrhs.LT.0 )
THEN
168 ELSE IF( lda.LT.max( 1, n ) )
THEN
170 ELSE IF( ldb.LT.max( 1, n ) )
THEN
174 CALL
xerbla(
'SSYTRS', -info )
180 IF( n.EQ.0 .OR. nrhs.EQ.0 )
200 IF( ipiv( k ).GT.0 )
THEN
208 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
213 CALL
sger( k-1, nrhs, -one, a( 1, k ), 1, b( k, 1 ), ldb,
218 CALL
sscal( nrhs, one / a( k, k ), b( k, 1 ), ldb )
228 $ CALL
sswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ), ldb )
233 CALL
sger( k-2, nrhs, -one, a( 1, k ), 1, b( k, 1 ), ldb,
235 CALL
sger( k-2, nrhs, -one, a( 1, k-1 ), 1, b( k-1, 1 ),
236 $ ldb, b( 1, 1 ), ldb )
241 akm1 = a( k-1, k-1 ) / akm1k
242 ak = a( k, k ) / akm1k
243 denom = akm1*ak - one
245 bkm1 = b( k-1, j ) / akm1k
246 bk = b( k, j ) / akm1k
247 b( k-1, j ) = ( ak*bkm1-bk ) / denom
248 b( k, j ) = ( akm1*bk-bkm1 ) / denom
269 IF( ipiv( k ).GT.0 )
THEN
276 CALL
sgemv(
'Transpose', k-1, nrhs, -one, b, ldb, a( 1, k ),
277 $ 1, one, b( k, 1 ), ldb )
283 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
292 CALL
sgemv(
'Transpose', k-1, nrhs, -one, b, ldb, a( 1, k ),
293 $ 1, one, b( k, 1 ), ldb )
294 CALL
sgemv(
'Transpose', k-1, nrhs, -one, b, ldb,
295 $ a( 1, k+1 ), 1, one, b( k+1, 1 ), ldb )
301 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
325 IF( ipiv( k ).GT.0 )
THEN
333 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
339 $ CALL
sger( n-k, nrhs, -one, a( k+1, k ), 1, b( k, 1 ),
340 $ ldb, b( k+1, 1 ), ldb )
344 CALL
sscal( nrhs, one / a( k, k ), b( k, 1 ), ldb )
354 $ CALL
sswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ), ldb )
360 CALL
sger( n-k-1, nrhs, -one, a( k+2, k ), 1, b( k, 1 ),
361 $ ldb, b( k+2, 1 ), ldb )
362 CALL
sger( n-k-1, nrhs, -one, a( k+2, k+1 ), 1,
363 $ b( k+1, 1 ), ldb, b( k+2, 1 ), ldb )
369 akm1 = a( k, k ) / akm1k
370 ak = a( k+1, k+1 ) / akm1k
371 denom = akm1*ak - one
373 bkm1 = b( k, j ) / akm1k
374 bk = b( k+1, j ) / akm1k
375 b( k, j ) = ( ak*bkm1-bk ) / denom
376 b( k+1, j ) = ( akm1*bk-bkm1 ) / denom
397 IF( ipiv( k ).GT.0 )
THEN
405 $ CALL
sgemv(
'Transpose', n-k, nrhs, -one, b( k+1, 1 ),
406 $ ldb, a( k+1, k ), 1, one, b( k, 1 ), ldb )
412 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
422 CALL
sgemv(
'Transpose', n-k, nrhs, -one, b( k+1, 1 ),
423 $ ldb, a( k+1, k ), 1, one, b( k, 1 ), ldb )
424 CALL
sgemv(
'Transpose', n-k, nrhs, -one, b( k+1, 1 ),
425 $ ldb, a( k+1, k-1 ), 1, one, b( k-1, 1 ),
433 $ CALL
sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
subroutine sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER
subroutine sscal(N, SA, SX, INCX)
SSCAL