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 dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine dgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
DGETRI
subroutine dswap(n, dx, incx, dy, incy)
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
subroutine dtrtri(UPLO, DIAG, N, A, LDA, INFO)
DTRTRI
subroutine xerbla(SRNAME, INFO)