115 SUBROUTINE dgetri( N, A, LDA, IPIV, WORK, LWORK, INFO )
123 INTEGER info, lda, lwork, n
127 DOUBLE PRECISION a( lda, * ), work( * )
133 DOUBLE PRECISION zero, one
134 parameter( zero = 0.0d+0, one = 1.0d+0 )
138 INTEGER i, iws, j, jb, jj, jp, ldwork, lwkopt, nb,
156 nb =
ilaenv( 1,
'DGETRI',
' ', n, -1, -1, -1 )
159 lquery = ( lwork.EQ.-1 )
162 ELSE IF( lda.LT.max( 1, n ) )
THEN
164 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
168 CALL
xerbla(
'DGETRI', -info )
170 ELSE IF( lquery )
THEN
182 CALL
dtrtri(
'Upper',
'Non-unit', n, a, lda, info )
188 IF( nb.GT.1 .AND. nb.LT.n )
THEN
189 iws = max( ldwork*nb, 1 )
190 IF( lwork.LT.iws )
THEN
192 nbmin = max( 2,
ilaenv( 2,
'DGETRI',
' ', n, -1, -1, -1 ) )
200 IF( nb.LT.nbmin .OR. nb.GE.n )
THEN
209 work( i ) = a( i, j )
216 $ CALL
dgemv(
'No transpose', n, n-j, -one, a( 1, j+1 ),
217 $ lda, work( j+1 ), 1, one, a( 1, j ), 1 )
223 nn = ( ( n-1 ) / nb )*nb + 1
225 jb = min( nb, n-j+1 )
230 DO 40 jj = j, j + jb - 1
232 work( i+( jj-j )*ldwork ) = a( i, jj )
240 $ CALL
dgemm(
'No transpose',
'No transpose', n, jb,
241 $ n-j-jb+1, -one, a( 1, j+jb ), lda,
242 $ work( j+jb ), ldwork, one, a( 1, j ), lda )
243 CALL
dtrsm(
'Right',
'Lower',
'No transpose',
'Unit', n, jb,
244 $ one, work( j ), ldwork, a( 1, j ), lda )
250 DO 60 j = n - 1, 1, -1
253 $ CALL
dswap( n, a( 1, j ), 1, a( 1, jp ), 1 )