115 SUBROUTINE sgetri( N, A, LDA, IPIV, WORK, LWORK, INFO )
123 INTEGER info, lda, lwork, n
127 REAL a( lda, * ), work( * )
134 parameter( zero = 0.0e+0, one = 1.0e+0 )
138 INTEGER i, iws,
j, jb, jj, jp, ldwork, lwkopt, nb,
156 nb =
ilaenv( 1,
'SGETRI',
' ', 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(
'SGETRI', -info )
170 ELSE IF( lquery )
THEN
182 CALL
strtri(
'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,
'SGETRI',
' ', n, -1, -1, -1 ) )
200 IF( nb.LT.nbmin .OR. nb.GE.n )
THEN
209 work( i ) = a( i,
j )
216 $ CALL
sgemv(
'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
sgemm(
'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
strsm(
'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
sswap( n, a( 1,
j ), 1, a( 1, jp ), 1 )
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine sgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
SGETRI
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine strtri(UPLO, DIAG, N, A, LDA, INFO)
STRTRI
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine strsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
STRSM