LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ sgetri()

subroutine sgetri ( integer n,
real, dimension( lda, * ) a,
integer lda,
integer, dimension( * ) ipiv,
real, dimension( * ) work,
integer lwork,
integer info )

SGETRI

Download SGETRI + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!> SGETRI computes the inverse of a matrix using the LU factorization
!> computed by SGETRF.
!>
!> This method inverts U and then computes inv(A) by solving the system
!> inv(A)*L = inv(U) for inv(A).
!> 
Parameters
[in]N
!>          N is INTEGER
!>          The order of the matrix A.  N >= 0.
!> 
[in,out]A
!>          A is REAL array, dimension (LDA,N)
!>          On entry, the factors L and U from the factorization
!>          A = P*L*U as computed by SGETRF.
!>          On exit, if INFO = 0, the inverse of the original matrix A.
!> 
[in]LDA
!>          LDA is INTEGER
!>          The leading dimension of the array A.  LDA >= max(1,N).
!> 
[in]IPIV
!>          IPIV is INTEGER array, dimension (N)
!>          The pivot indices from SGETRF; for 1<=i<=N, row i of the
!>          matrix was interchanged with row IPIV(i).
!> 
[out]WORK
!>          WORK is REAL array, dimension (MAX(1,LWORK))
!>          On exit, if INFO=0, then WORK(1) returns the optimal LWORK.
!> 
[in]LWORK
!>          LWORK is INTEGER
!>          The dimension of the array WORK.  LWORK >= max(1,N).
!>          For optimal performance LWORK >= N*NB, where NB is
!>          the optimal blocksize returned by ILAENV.
!>
!>          If LWORK = -1, then a workspace query is assumed; the routine
!>          only calculates the optimal size of the WORK array, returns
!>          this value as the first entry of the WORK array, and no error
!>          message related to LWORK is issued by XERBLA.
!> 
[out]INFO
!>          INFO is INTEGER
!>          = 0:  successful exit
!>          < 0:  if INFO = -i, the i-th argument had an illegal value
!>          > 0:  if INFO = i, U(i,i) is exactly zero; the matrix is
!>                singular and its inverse could not be computed.
!> 
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 111 of file sgetri.f.

112*
113* -- LAPACK computational routine --
114* -- LAPACK is a software package provided by Univ. of Tennessee, --
115* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
116*
117* .. Scalar Arguments ..
118 INTEGER INFO, LDA, LWORK, N
119* ..
120* .. Array Arguments ..
121 INTEGER IPIV( * )
122 REAL A( LDA, * ), WORK( * )
123* ..
124*
125* =====================================================================
126*
127* .. Parameters ..
128 REAL ZERO, ONE
129 parameter( zero = 0.0e+0, one = 1.0e+0 )
130* ..
131* .. Local Scalars ..
132 LOGICAL LQUERY
133 INTEGER I, IWS, J, JB, JJ, JP, LDWORK, LWKOPT, NB,
134 $ NBMIN, NN
135* ..
136* .. External Functions ..
137 INTEGER ILAENV
138 EXTERNAL ilaenv
139 REAL SROUNDUP_LWORK
140 EXTERNAL sroundup_lwork
141* ..
142* .. External Subroutines ..
143 EXTERNAL sgemm, sgemv, sswap, strsm, strtri,
144 $ xerbla
145* ..
146* .. Intrinsic Functions ..
147 INTRINSIC max, min
148* ..
149* .. Executable Statements ..
150*
151* Test the input parameters.
152*
153 info = 0
154 nb = ilaenv( 1, 'SGETRI', ' ', n, -1, -1, -1 )
155 lwkopt = max( 1, n*nb )
156 work( 1 ) = sroundup_lwork( lwkopt )
157*
158 lquery = ( lwork.EQ.-1 )
159 IF( n.LT.0 ) THEN
160 info = -1
161 ELSE IF( lda.LT.max( 1, n ) ) THEN
162 info = -3
163 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery ) THEN
164 info = -6
165 END IF
166 IF( info.NE.0 ) THEN
167 CALL xerbla( 'SGETRI', -info )
168 RETURN
169 ELSE IF( lquery ) THEN
170 RETURN
171 END IF
172*
173* Quick return if possible
174*
175 IF( n.EQ.0 )
176 $ RETURN
177*
178* Form inv(U). If INFO > 0 from STRTRI, then U is singular,
179* and the inverse is not computed.
180*
181 CALL strtri( 'Upper', 'Non-unit', n, a, lda, info )
182 IF( info.GT.0 )
183 $ RETURN
184*
185 nbmin = 2
186 ldwork = n
187 IF( nb.GT.1 .AND. nb.LT.n ) THEN
188 iws = max( ldwork*nb, 1 )
189 IF( lwork.LT.iws ) THEN
190 nb = lwork / ldwork
191 nbmin = max( 2, ilaenv( 2, 'SGETRI', ' ', n, -1, -1,
192 $ -1 ) )
193 END IF
194 ELSE
195 iws = n
196 END IF
197*
198* Solve the equation inv(A)*L = inv(U) for inv(A).
199*
200 IF( nb.LT.nbmin .OR. nb.GE.n ) THEN
201*
202* Use unblocked code.
203*
204 DO 20 j = n, 1, -1
205*
206* Copy current column of L to WORK and replace with zeros.
207*
208 DO 10 i = j + 1, n
209 work( i ) = a( i, j )
210 a( i, j ) = zero
211 10 CONTINUE
212*
213* Compute current column of inv(A).
214*
215 IF( j.LT.n )
216 $ CALL sgemv( 'No transpose', n, n-j, -one, a( 1, j+1 ),
217 $ lda, work( j+1 ), 1, one, a( 1, j ), 1 )
218 20 CONTINUE
219 ELSE
220*
221* Use blocked code.
222*
223 nn = ( ( n-1 ) / nb )*nb + 1
224 DO 50 j = nn, 1, -nb
225 jb = min( nb, n-j+1 )
226*
227* Copy current block column of L to WORK and replace with
228* zeros.
229*
230 DO 40 jj = j, j + jb - 1
231 DO 30 i = jj + 1, n
232 work( i+( jj-j )*ldwork ) = a( i, jj )
233 a( i, jj ) = zero
234 30 CONTINUE
235 40 CONTINUE
236*
237* Compute current block column of inv(A).
238*
239 IF( j+jb.LE.n )
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,
244 $ jb,
245 $ one, work( j ), ldwork, a( 1, j ), lda )
246 50 CONTINUE
247 END IF
248*
249* Apply column interchanges.
250*
251 DO 60 j = n - 1, 1, -1
252 jp = ipiv( j )
253 IF( jp.NE.j )
254 $ CALL sswap( n, a( 1, j ), 1, a( 1, jp ), 1 )
255 60 CONTINUE
256*
257 work( 1 ) = sroundup_lwork( iws )
258 RETURN
259*
260* End of SGETRI
261*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine sgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
SGEMM
Definition sgemm.f:188
subroutine sgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
SGEMV
Definition sgemv.f:158
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:160
real function sroundup_lwork(lwork)
SROUNDUP_LWORK
subroutine sswap(n, sx, incx, sy, incy)
SSWAP
Definition sswap.f:82
subroutine strsm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
STRSM
Definition strsm.f:181
subroutine strtri(uplo, diag, n, a, lda, info)
STRTRI
Definition strtri.f:107
Here is the call graph for this function:
Here is the caller graph for this function: