143 INTEGER INFO, LDA, LDB, N, NRHS
147 REAL A( LDA, * ), B( LDB, * )
154 parameter( one = 1.0e+0 )
159 REAL AK, AKM1, AKM1K, BK, BKM1, DENOM
174 upper = lsame( uplo,
'U' )
175 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
177 ELSE IF( n.LT.0 )
THEN
179 ELSE IF( nrhs.LT.0 )
THEN
181 ELSE IF( lda.LT.max( 1, n ) )
THEN
183 ELSE IF( ldb.LT.max( 1, n ) )
THEN
187 CALL xerbla(
'SSYTRS_ROOK', -info )
193 IF( n.EQ.0 .OR. nrhs.EQ.0 )
213 IF( ipiv( k ).GT.0 )
THEN
221 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
226 CALL sger( k-1, nrhs, -one, a( 1, k ), 1, b( k, 1 ), ldb,
231 CALL sscal( nrhs, one / a( k, k ), b( k, 1 ), ldb )
241 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
245 $
CALL sswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ), ldb )
251 CALL sger( k-2, nrhs, -one, a( 1, k ), 1, b( k, 1 ),
252 $ ldb, b( 1, 1 ), ldb )
253 CALL sger( k-2, nrhs, -one, a( 1, k-1 ), 1, b( k-1, 1 ),
254 $ ldb, b( 1, 1 ), ldb )
260 akm1 = a( k-1, k-1 ) / akm1k
261 ak = a( k, k ) / akm1k
262 denom = akm1*ak - one
264 bkm1 = b( k-1, j ) / akm1k
265 bk = b( k, j ) / akm1k
266 b( k-1, j ) = ( ak*bkm1-bk ) / denom
267 b( k, j ) = ( akm1*bk-bkm1 ) / denom
288 IF( ipiv( k ).GT.0 )
THEN
296 $
CALL sgemv(
'Transpose', k-1, nrhs, -one, b,
297 $ ldb, a( 1, k ), 1, one, b( k, 1 ), ldb )
303 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
313 CALL sgemv(
'Transpose', k-1, nrhs, -one, b,
314 $ ldb, a( 1, k ), 1, one, b( k, 1 ), ldb )
315 CALL sgemv(
'Transpose', k-1, nrhs, -one, b,
316 $ ldb, a( 1, k+1 ), 1, one, b( k+1, 1 ), ldb )
323 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
327 $
CALL sswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ), ldb )
352 IF( ipiv( k ).GT.0 )
THEN
360 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
366 $
CALL sger( n-k, nrhs, -one, a( k+1, k ), 1, b( k, 1 ),
367 $ ldb, b( k+1, 1 ), ldb )
371 CALL sscal( nrhs, one / a( k, k ), b( k, 1 ), ldb )
381 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
385 $
CALL sswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ), ldb )
391 CALL sger( n-k-1, nrhs, -one, a( k+2, k ), 1, b( k, 1 ),
392 $ ldb, b( k+2, 1 ), ldb )
393 CALL sger( n-k-1, nrhs, -one, a( k+2, k+1 ), 1,
394 $ b( k+1, 1 ), ldb, b( k+2, 1 ), ldb )
400 akm1 = a( k, k ) / akm1k
401 ak = a( k+1, k+1 ) / akm1k
402 denom = akm1*ak - one
404 bkm1 = b( k, j ) / akm1k
405 bk = b( k+1, j ) / akm1k
406 b( k, j ) = ( ak*bkm1-bk ) / denom
407 b( k+1, j ) = ( akm1*bk-bkm1 ) / denom
428 IF( ipiv( k ).GT.0 )
THEN
436 $
CALL sgemv(
'Transpose', n-k, nrhs, -one, b( k+1, 1 ),
437 $ ldb, a( k+1, k ), 1, one, b( k, 1 ), ldb )
443 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
453 CALL sgemv(
'Transpose', n-k, nrhs, -one, b( k+1, 1 ),
454 $ ldb, a( k+1, k ), 1, one, b( k, 1 ), ldb )
455 CALL sgemv(
'Transpose', n-k, nrhs, -one, b( k+1, 1 ),
456 $ ldb, a( k+1, k-1 ), 1, one, b( k-1, 1 ),
464 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
468 $
CALL sswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ), ldb )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ssytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS_ROOK
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV