129 SUBROUTINE ssytrs_aa( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
130 $ work, lwork, info )
141 INTEGER N, NRHS, LDA, LDB, LWORK, INFO
145 REAL A( lda, * ), B( ldb, * ), WORK( * )
151 parameter ( one = 1.0e+0 )
154 LOGICAL LQUERY, UPPER
155 INTEGER K, KP, LWKOPT
170 upper = lsame( uplo,
'U' )
171 lquery = ( lwork.EQ.-1 )
172 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
174 ELSE IF( n.LT.0 )
THEN
176 ELSE IF( nrhs.LT.0 )
THEN
178 ELSE IF( lda.LT.max( 1, n ) )
THEN
180 ELSE IF( ldb.LT.max( 1, n ) )
THEN
182 ELSE IF( lwork.LT.max( 1, 3*n-2 ) .AND. .NOT.lquery )
THEN
186 CALL xerbla(
'SSYTRS_AA', -info )
188 ELSE IF( lquery )
THEN
196 IF( n.EQ.0 .OR. nrhs.EQ.0 )
209 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
215 CALL strsm(
'L',
'U',
'T',
'U', n-1, nrhs, one, a( 1, 2 ), lda,
220 CALL slacpy(
'F', 1, n, a(1, 1), lda+1, work(n), 1)
222 CALL slacpy(
'F', 1, n-1, a(1, 2), lda+1, work(1), 1)
223 CALL slacpy(
'F', 1, n-1, a(1, 2), lda+1, work(2*n), 1)
225 CALL sgtsv(n, nrhs, work(1), work(n), work(2*n), b, ldb,
231 CALL strsm(
'L',
'U',
'N',
'U', n-1, nrhs, one, a( 1, 2 ), lda,
240 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
254 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
260 CALL strsm(
'L',
'L',
'N',
'U', n-1, nrhs, one, a( 2, 1), lda,
265 CALL slacpy(
'F', 1, n, a(1, 1), lda+1, work(n), 1)
267 CALL slacpy(
'F', 1, n-1, a(2, 1), lda+1, work(1), 1)
268 CALL slacpy(
'F', 1, n-1, a(2, 1), lda+1, work(2*n), 1)
270 CALL sgtsv(n, nrhs, work(1), work(n), work(2*n), b, ldb,
275 CALL strsm(
'L',
'L',
'T',
'U', n-1, nrhs, one, a( 2, 1 ), lda,
284 $
CALL sswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
subroutine strsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
STRSM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine ssytrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
SSYTRS_AA
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sgtsv(N, NRHS, DL, D, DU, B, LDB, INFO)
SGTSV computes the solution to system of linear equations A * X = B for GT matrices ...