119 SUBROUTINE ssytrs( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
127 INTEGER INFO, LDA, LDB, N, NRHS
131 REAL A( LDA, * ), B( LDB, * )
138 parameter( one = 1.0e+0 )
143 REAL AK, AKM1, AKM1K, BK, BKM1, DENOM
158 upper = lsame( uplo,
'U' )
159 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
161 ELSE IF( n.LT.0 )
THEN
163 ELSE IF( nrhs.LT.0 )
THEN
165 ELSE IF( lda.LT.max( 1, n ) )
THEN
167 ELSE IF( ldb.LT.max( 1, n ) )
THEN
171 CALL xerbla(
'SSYTRS', -info )
177 IF( n.EQ.0 .OR. nrhs.EQ.0 )
197 IF( ipiv( k ).GT.0 )
THEN
205 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
210 CALL sger( k-1, nrhs, -one, a( 1, k ), 1, b( k, 1 ), ldb,
215 CALL sscal( nrhs, one / a( k, k ), b( k, 1 ), ldb )
225 $
CALL sswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ), ldb )
230 CALL sger( k-2, nrhs, -one, a( 1, k ), 1, b( k, 1 ), ldb,
232 CALL sger( k-2, nrhs, -one, a( 1, k-1 ), 1, b( k-1, 1 ),
233 $ ldb, b( 1, 1 ), ldb )
238 akm1 = a( k-1, k-1 ) / akm1k
239 ak = a( k, k ) / akm1k
240 denom = akm1*ak - one
242 bkm1 = b( k-1, j ) / akm1k
243 bk = b( k, j ) / akm1k
244 b( k-1, j ) = ( ak*bkm1-bk ) / denom
245 b( k, j ) = ( akm1*bk-bkm1 ) / denom
266 IF( ipiv( k ).GT.0 )
THEN
273 CALL sgemv(
'Transpose', k-1, nrhs, -one, b, ldb, a( 1, k ),
274 $ 1, one, b( k, 1 ), ldb )
280 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
289 CALL sgemv(
'Transpose', k-1, nrhs, -one, b, ldb, a( 1, k ),
290 $ 1, one, b( k, 1 ), ldb )
291 CALL sgemv(
'Transpose', k-1, nrhs, -one, b, ldb,
292 $ a( 1, k+1 ), 1, one, b( k+1, 1 ), ldb )
298 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
322 IF( ipiv( k ).GT.0 )
THEN
330 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
336 $
CALL sger( n-k, nrhs, -one, a( k+1, k ), 1, b( k, 1 ),
337 $ ldb, b( k+1, 1 ), ldb )
341 CALL sscal( nrhs, one / a( k, k ), b( k, 1 ), ldb )
351 $
CALL sswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ), ldb )
357 CALL sger( n-k-1, nrhs, -one, a( k+2, k ), 1, b( k, 1 ),
358 $ ldb, b( k+2, 1 ), ldb )
359 CALL sger( n-k-1, nrhs, -one, a( k+2, k+1 ), 1,
360 $ b( k+1, 1 ), ldb, b( k+2, 1 ), ldb )
366 akm1 = a( k, k ) / akm1k
367 ak = a( k+1, k+1 ) / akm1k
368 denom = akm1*ak - one
370 bkm1 = b( k, j ) / akm1k
371 bk = b( k+1, j ) / akm1k
372 b( k, j ) = ( ak*bkm1-bk ) / denom
373 b( k+1, j ) = ( akm1*bk-bkm1 ) / denom
394 IF( ipiv( k ).GT.0 )
THEN
402 $
CALL sgemv(
'Transpose', n-k, nrhs, -one, b( k+1, 1 ),
403 $ ldb, a( k+1, k ), 1, one, b( k, 1 ), ldb )
409 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
419 CALL sgemv(
'Transpose', n-k, nrhs, -one, b( k+1, 1 ),
420 $ ldb, a( k+1, k ), 1, one, b( k, 1 ), ldb )
421 CALL sgemv(
'Transpose', n-k, nrhs, -one, b( k+1, 1 ),
422 $ ldb, a( k+1, k-1 ), 1, one, b( k-1, 1 ),
430 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
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