130 SUBROUTINE zhetrs_aa( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
131 $ work, lwork, info )
142 INTEGER N, NRHS, LDA, LDB, LWORK, INFO
146 COMPLEX*16 A( lda, * ), B( ldb, * ), WORK( * )
152 parameter ( one = 1.0d+0 )
155 LOGICAL LQUERY, UPPER
156 INTEGER K, KP, LWKOPT
171 upper = lsame( uplo,
'U' )
172 lquery = ( lwork.EQ.-1 )
173 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
175 ELSE IF( n.LT.0 )
THEN
177 ELSE IF( nrhs.LT.0 )
THEN
179 ELSE IF( lda.LT.max( 1, n ) )
THEN
181 ELSE IF( ldb.LT.max( 1, n ) )
THEN
183 ELSE IF( lwork.LT.max( 1, 3*n-2 ) .AND. .NOT.lquery )
THEN
187 CALL xerbla(
'ZHETRS_AA', -info )
189 ELSE IF( lquery )
THEN
197 IF( n.EQ.0 .OR. nrhs.EQ.0 )
209 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
214 CALL ztrsm(
'L',
'U',
'C',
'U', n-1, nrhs, one, a( 1, 2 ), lda,
219 CALL zlacpy(
'F', 1, n, a(1, 1), lda+1, work(n), 1)
221 CALL zlacpy(
'F', 1, n-1, a( 1, 2 ), lda+1, work( 2*n ), 1)
222 CALL zlacpy(
'F', 1, n-1, a( 1, 2 ), lda+1, work( 1 ), 1)
223 CALL zlacgv( n-1, work( 1 ), 1 )
225 CALL zgtsv(n, nrhs, work(1), work(n), work(2*n), b, ldb,
230 CALL ztrsm(
'L',
'U',
'N',
'U', n-1, nrhs, one, a( 1, 2 ), lda,
238 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
250 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
255 CALL ztrsm(
'L',
'L',
'N',
'U', n-1, nrhs, one, a( 2, 1 ), lda,
260 CALL zlacpy(
'F', 1, n, a(1, 1), lda+1, work(n), 1)
262 CALL zlacpy(
'F', 1, n-1, a( 2, 1 ), lda+1, work( 1 ), 1)
263 CALL zlacpy(
'F', 1, n-1, a( 2, 1 ), lda+1, work( 2*n ), 1)
264 CALL zlacgv( n-1, work( 2*n ), 1 )
266 CALL zgtsv(n, nrhs, work(1), work(n), work(2*n), b, ldb,
271 CALL ztrsm(
'L',
'L',
'C',
'U', n-1, nrhs, one, a( 2, 1 ), lda,
279 $
CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zhetrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZHETRS_AA
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine ztrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRSM
subroutine zgtsv(N, NRHS, DL, D, DU, B, LDB, INFO)
ZGTSV computes the solution to system of linear equations A * X = B for GT matrices ...