113 SUBROUTINE sgetri( N, A, LDA, IPIV, WORK, LWORK, INFO )
120 INTEGER INFO, LDA, LWORK, N
124 REAL A( LDA, * ), WORK( * )
131 parameter( zero = 0.0e+0, one = 1.0e+0 )
135 INTEGER I, IWS, J, JB, JJ, JP, LDWORK, LWKOPT, NB,
153 nb = ilaenv( 1,
'SGETRI',
' ', n, -1, -1, -1 )
156 lquery = ( lwork.EQ.-1 )
159 ELSE IF( lda.LT.max( 1, n ) )
THEN
161 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
165 CALL xerbla(
'SGETRI', -info )
167 ELSE IF( lquery )
THEN
179 CALL strtri(
'Upper',
'Non-unit', n, a, lda, info )
185 IF( nb.GT.1 .AND. nb.LT.n )
THEN
186 iws = max( ldwork*nb, 1 )
187 IF( lwork.LT.iws )
THEN
189 nbmin = max( 2, ilaenv( 2,
'SGETRI',
' ', n, -1, -1, -1 ) )
197 IF( nb.LT.nbmin .OR. nb.GE.n )
THEN
206 work( i ) = a( i, j )
213 $
CALL sgemv(
'No transpose', n, n-j, -one, a( 1, j+1 ),
214 $ lda, work( j+1 ), 1, one, a( 1, j ), 1 )
220 nn = ( ( n-1 ) / nb )*nb + 1
222 jb = min( nb, n-j+1 )
227 DO 40 jj = j, j + jb - 1
229 work( i+( jj-j )*ldwork ) = a( i, jj )
237 $
CALL sgemm(
'No transpose',
'No transpose', n, jb,
238 $ n-j-jb+1, -one, a( 1, j+jb ), lda,
239 $ work( j+jb ), ldwork, one, a( 1, j ), lda )
240 CALL strsm(
'Right',
'Lower',
'No transpose',
'Unit', n, jb,
241 $ one, work( j ), ldwork, a( 1, j ), lda )
247 DO 60 j = n - 1, 1, -1
250 $
CALL sswap( n, a( 1, j ), 1, a( 1, jp ), 1 )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
SGETRI
subroutine strtri(UPLO, DIAG, N, A, LDA, INFO)
STRTRI
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine strsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
STRSM
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM