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
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 )
LOGICAL function lsame(CA, CB)
LSAME
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRSM
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dtrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRMM
subroutine dtrtri(UPLO, DIAG, N, A, LDA, INFO)
DTRTRI
subroutine dtrti2(UPLO, DIAG, N, A, LDA, INFO)
DTRTI2 computes the inverse of a triangular matrix (unblocked algorithm).