115 SUBROUTINE cgetri( N, A, LDA, IPIV, WORK, LWORK, INFO )
123 INTEGER info, lda, lwork, n
127 COMPLEX a( lda, * ), work( * )
134 parameter( zero = ( 0.0e+0, 0.0e+0 ),
135 $ one = ( 1.0e+0, 0.0e+0 ) )
139 INTEGER i, iws,
j, jb, jj, jp, ldwork, lwkopt, nb,
157 nb =
ilaenv( 1,
'CGETRI',
' ', n, -1, -1, -1 )
160 lquery = ( lwork.EQ.-1 )
163 ELSE IF( lda.LT.max( 1, n ) )
THEN
165 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
169 CALL
xerbla(
'CGETRI', -info )
171 ELSE IF( lquery )
THEN
183 CALL
ctrtri(
'Upper',
'Non-unit', n, a, lda, info )
189 IF( nb.GT.1 .AND. nb.LT.n )
THEN
190 iws = max( ldwork*nb, 1 )
191 IF( lwork.LT.iws )
THEN
193 nbmin = max( 2,
ilaenv( 2,
'CGETRI',
' ', n, -1, -1, -1 ) )
201 IF( nb.LT.nbmin .OR. nb.GE.n )
THEN
210 work( i ) = a( i,
j )
217 $ CALL
cgemv(
'No transpose', n, n-
j, -one, a( 1,
j+1 ),
218 $ lda, work(
j+1 ), 1, one, a( 1,
j ), 1 )
224 nn = ( ( n-1 ) / nb )*nb + 1
226 jb = min( nb, n-
j+1 )
231 DO 40 jj =
j,
j + jb - 1
233 work( i+( jj-
j )*ldwork ) = a( i, jj )
241 $ CALL
cgemm(
'No transpose',
'No transpose', n, jb,
242 $ n-
j-jb+1, -one, a( 1,
j+jb ), lda,
243 $ work(
j+jb ), ldwork, one, a( 1,
j ), lda )
244 CALL
ctrsm(
'Right',
'Lower',
'No transpose',
'Unit', n, jb,
245 $ one, work(
j ), ldwork, a( 1,
j ), lda )
251 DO 60
j = n - 1, 1, -1
254 $ CALL
cswap( n, a( 1,
j ), 1, a( 1, jp ), 1 )
subroutine ctrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRSM
subroutine ctrtri(UPLO, DIAG, N, A, LDA, INFO)
CTRTRI
subroutine cgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
CGETRI
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM