120 SUBROUTINE dgetrs( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
128 INTEGER INFO, LDA, LDB, N, NRHS
132 DOUBLE PRECISION A( LDA, * ), B( LDB, * )
139 parameter( one = 1.0d+0 )
159 notran = lsame( trans,
'N' )
160 IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
161 $ lsame( trans,
'C' ) )
THEN
163 ELSE IF( n.LT.0 )
THEN
165 ELSE IF( nrhs.LT.0 )
THEN
167 ELSE IF( lda.LT.max( 1, n ) )
THEN
169 ELSE IF( ldb.LT.max( 1, n ) )
THEN
173 CALL xerbla(
'DGETRS', -info )
179 IF( n.EQ.0 .OR. nrhs.EQ.0 )
188 CALL dlaswp( nrhs, b, ldb, 1, n, ipiv, 1 )
192 CALL dtrsm(
'Left',
'Lower',
'No transpose',
'Unit', n, nrhs,
193 $ one, a, lda, b, ldb )
197 CALL dtrsm(
'Left',
'Upper',
'No transpose',
'Non-unit', n,
198 $ nrhs, one, a, lda, b, ldb )
205 CALL dtrsm(
'Left',
'Upper',
'Transpose',
'Non-unit', n, nrhs,
206 $ one, a, lda, b, ldb )
210 CALL dtrsm(
'Left',
'Lower',
'Transpose',
'Unit', n, nrhs, one,
215 CALL dlaswp( nrhs, b, ldb, 1, n, ipiv, -1 )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRSM
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
subroutine dlaswp(N, A, LDA, K1, K2, IPIV, INCX)
DLASWP performs a series of row interchanges on a general rectangular matrix.