129 SUBROUTINE chetrs_aa( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
130 $ work, lwork, info )
141 INTEGER N, NRHS, LDA, LDB, LWORK, INFO
145 COMPLEX 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(
'CHETRS_AA', -info )
188 ELSE IF( lquery )
THEN
196 IF( n.EQ.0 .OR. nrhs.EQ.0 )
209 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
215 CALL ctrsm(
'L',
'U',
'C',
'U', n-1, nrhs, one, a( 1, 2 ), lda,
220 CALL clacpy(
'F', 1, n, a(1, 1), lda+1, work(n), 1)
222 CALL clacpy(
'F', 1, n-1, a( 1, 2 ), lda+1, work( 2*n ), 1)
223 CALL clacpy(
'F', 1, n-1, a( 1, 2 ), lda+1, work( 1 ), 1)
224 CALL clacgv( n-1, work( 1 ), 1 )
226 CALL cgtsv(n, nrhs, work(1), work(n), work(2*n), b, ldb,
231 CALL ctrsm(
'L',
'U',
'N',
'U', n-1, nrhs, one, a( 1, 2 ), lda,
240 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
254 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
260 CALL ctrsm(
'L',
'L',
'N',
'U', n-1, nrhs, one, a( 2, 1), lda,
265 CALL clacpy(
'F', 1, n, a(1, 1), lda+1, work(n), 1)
267 CALL clacpy(
'F', 1, n-1, a( 2, 1 ), lda+1, work( 1 ), 1)
268 CALL clacpy(
'F', 1, n-1, a( 2, 1 ), lda+1, work( 2*n ), 1)
269 CALL clacgv( n-1, work( 2*n ), 1 )
271 CALL cgtsv(n, nrhs, work(1), work(n), work(2*n), b, ldb,
276 CALL ctrsm(
'L',
'L',
'C',
'U', n-1, nrhs, one, a( 2, 1 ), lda,
285 $
CALL cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
subroutine cgtsv(N, NRHS, DL, D, DU, B, LDB, INFO)
CGTSV computes the solution to system of linear equations A * X = B for GT matrices ...
subroutine chetrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CHETRS_AA
subroutine ctrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRSM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP