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 )
subroutine dgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
DGETRI
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRSM
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV
subroutine dtrtri(UPLO, DIAG, N, A, LDA, INFO)
DTRTRI