110 SUBROUTINE dtrtri( UPLO, DIAG, N, A, LDA, INFO )
122 DOUBLE PRECISION A( LDA, * )
128 DOUBLE PRECISION ONE, ZERO
129 parameter( one = 1.0d+0, zero = 0.0d+0 )
132 LOGICAL NOUNIT, UPPER
133 INTEGER J, JB, NB, NN
138 EXTERNAL lsame, ilaenv
151 upper = lsame( uplo,
'U' )
152 nounit = lsame( diag,
'N' )
153 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
155 ELSE IF( .NOT.nounit .AND. .NOT.lsame( diag,
'U' ) )
THEN
157 ELSE IF( n.LT.0 )
THEN
159 ELSE IF( lda.LT.max( 1, n ) )
THEN
163 CALL xerbla(
'DTRTRI', -info )
176 IF( a( info, info ).EQ.zero )
184 nb = ilaenv( 1,
'DTRTRI', uplo // diag, n, -1, -1, -1 )
185 IF( nb.LE.1 .OR. nb.GE.n )
THEN
189 CALL dtrti2( uplo, diag, n, a, lda, info )
199 jb = min( nb, n-j+1 )
203 CALL dtrmm(
'Left',
'Upper',
'No transpose', diag, j-1,
204 $ jb, one, a, lda, a( 1, j ), lda )
205 CALL dtrsm(
'Right',
'Upper',
'No transpose', diag, j-1,
206 $ jb, -one, a( j, j ), lda, a( 1, j ), lda )
210 CALL dtrti2(
'Upper', diag, jb, a( j, j ), lda, info )
216 nn = ( ( n-1 ) / nb )*nb + 1
218 jb = min( nb, n-j+1 )
223 CALL dtrmm(
'Left',
'Lower',
'No transpose', diag,
224 $ n-j-jb+1, jb, one, a( j+jb, j+jb ), lda,
225 $ a( j+jb, j ), lda )
226 CALL dtrsm(
'Right',
'Lower',
'No transpose', diag,
227 $ n-j-jb+1, jb, -one, a( j, j ), lda,
228 $ a( j+jb, j ), lda )
233 CALL dtrti2(
'Lower', diag, jb, a( j, j ), lda, info )
subroutine dtrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
subroutine dtrti2(UPLO, DIAG, N, A, LDA, INFO)
DTRTI2 computes the inverse of a triangular matrix (unblocked algorithm).
subroutine dtrtri(UPLO, DIAG, N, A, LDA, INFO)
DTRTRI
subroutine xerbla(SRNAME, INFO)