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 sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP