LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zsytri ( character  UPLO,
integer  N,
complex*16, dimension( lda, * )  A,
integer  LDA,
integer, dimension( * )  IPIV,
complex*16, dimension( * )  WORK,
integer  INFO 
)

ZSYTRI

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

Purpose: 
 ZSYTRI computes the inverse of a complex symmetric indefinite matrix
 A using the factorization A = U*D*U**T or A = L*D*L**T computed by
 ZSYTRF.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
          Specifies whether the details of the factorization are stored
          as an upper or lower triangular matrix.
          = 'U':  Upper triangular, form is A = U*D*U**T;
          = 'L':  Lower triangular, form is A = L*D*L**T.
[in]N
          N is INTEGER
          The order of the matrix A.  N >= 0.
[in,out]A
          A is COMPLEX*16 array, dimension (LDA,N)
          On entry, the block diagonal matrix D and the multipliers
          used to obtain the factor U or L as computed by ZSYTRF.

          On exit, if INFO = 0, the (symmetric) inverse of the original
          matrix.  If UPLO = 'U', the upper triangular part of the
          inverse is formed and the part of A below the diagonal is not
          referenced; if UPLO = 'L' the lower triangular part of the
          inverse is formed and the part of A above the diagonal is
          not referenced.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,N).
[in]IPIV
          IPIV is INTEGER array, dimension (N)
          Details of the interchanges and the block structure of D
          as determined by ZSYTRF.
[out]WORK
          WORK is COMPLEX*16 array, dimension (2*N)
[out]INFO
          INFO is INTEGER
          = 0: successful exit
          < 0: if INFO = -i, the i-th argument had an illegal value
          > 0: if INFO = i, D(i,i) = 0; 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.
Date
November 2011

Definition at line 116 of file zsytri.f.

116 *
117 * -- LAPACK computational routine (version 3.4.0) --
118 * -- LAPACK is a software package provided by Univ. of Tennessee, --
119 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
120 * November 2011
121 *
122 * .. Scalar Arguments ..
123  CHARACTER uplo
124  INTEGER info, lda, n
125 * ..
126 * .. Array Arguments ..
127  INTEGER ipiv( * )
128  COMPLEX*16 a( lda, * ), work( * )
129 * ..
130 *
131 * =====================================================================
132 *
133 * .. Parameters ..
134  COMPLEX*16 one, zero
135  parameter ( one = ( 1.0d+0, 0.0d+0 ),
136  $ zero = ( 0.0d+0, 0.0d+0 ) )
137 * ..
138 * .. Local Scalars ..
139  LOGICAL upper
140  INTEGER k, kp, kstep
141  COMPLEX*16 ak, akkp1, akp1, d, t, temp
142 * ..
143 * .. External Functions ..
144  LOGICAL lsame
145  COMPLEX*16 zdotu
146  EXTERNAL lsame, zdotu
147 * ..
148 * .. External Subroutines ..
149  EXTERNAL xerbla, zcopy, zswap, zsymv
150 * ..
151 * .. Intrinsic Functions ..
152  INTRINSIC abs, max
153 * ..
154 * .. Executable Statements ..
155 *
156 * Test the input parameters.
157 *
158  info = 0
159  upper = lsame( uplo, 'U' )
160  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
161  info = -1
162  ELSE IF( n.LT.0 ) THEN
163  info = -2
164  ELSE IF( lda.LT.max( 1, n ) ) THEN
165  info = -4
166  END IF
167  IF( info.NE.0 ) THEN
168  CALL xerbla( 'ZSYTRI', -info )
169  RETURN
170  END IF
171 *
172 * Quick return if possible
173 *
174  IF( n.EQ.0 )
175  $ RETURN
176 *
177 * Check that the diagonal matrix D is nonsingular.
178 *
179  IF( upper ) THEN
180 *
181 * Upper triangular storage: examine D from bottom to top
182 *
183  DO 10 info = n, 1, -1
184  IF( ipiv( info ).GT.0 .AND. a( info, info ).EQ.zero )
185  $ RETURN
186  10 CONTINUE
187  ELSE
188 *
189 * Lower triangular storage: examine D from top to bottom.
190 *
191  DO 20 info = 1, n
192  IF( ipiv( info ).GT.0 .AND. a( info, info ).EQ.zero )
193  $ RETURN
194  20 CONTINUE
195  END IF
196  info = 0
197 *
198  IF( upper ) THEN
199 *
200 * Compute inv(A) from the factorization A = U*D*U**T.
201 *
202 * K is the main loop index, increasing from 1 to N in steps of
203 * 1 or 2, depending on the size of the diagonal blocks.
204 *
205  k = 1
206  30 CONTINUE
207 *
208 * If K > N, exit from loop.
209 *
210  IF( k.GT.n )
211  $ GO TO 40
212 *
213  IF( ipiv( k ).GT.0 ) THEN
214 *
215 * 1 x 1 diagonal block
216 *
217 * Invert the diagonal block.
218 *
219  a( k, k ) = one / a( k, k )
220 *
221 * Compute column K of the inverse.
222 *
223  IF( k.GT.1 ) THEN
224  CALL zcopy( k-1, a( 1, k ), 1, work, 1 )
225  CALL zsymv( uplo, k-1, -one, a, lda, work, 1, zero,
226  $ a( 1, k ), 1 )
227  a( k, k ) = a( k, k ) - zdotu( k-1, work, 1, a( 1, k ),
228  $ 1 )
229  END IF
230  kstep = 1
231  ELSE
232 *
233 * 2 x 2 diagonal block
234 *
235 * Invert the diagonal block.
236 *
237  t = a( k, k+1 )
238  ak = a( k, k ) / t
239  akp1 = a( k+1, k+1 ) / t
240  akkp1 = a( k, k+1 ) / t
241  d = t*( ak*akp1-one )
242  a( k, k ) = akp1 / d
243  a( k+1, k+1 ) = ak / d
244  a( k, k+1 ) = -akkp1 / d
245 *
246 * Compute columns K and K+1 of the inverse.
247 *
248  IF( k.GT.1 ) THEN
249  CALL zcopy( k-1, a( 1, k ), 1, work, 1 )
250  CALL zsymv( uplo, k-1, -one, a, lda, work, 1, zero,
251  $ a( 1, k ), 1 )
252  a( k, k ) = a( k, k ) - zdotu( k-1, work, 1, a( 1, k ),
253  $ 1 )
254  a( k, k+1 ) = a( k, k+1 ) -
255  $ zdotu( k-1, a( 1, k ), 1, a( 1, k+1 ), 1 )
256  CALL zcopy( k-1, a( 1, k+1 ), 1, work, 1 )
257  CALL zsymv( uplo, k-1, -one, a, lda, work, 1, zero,
258  $ a( 1, k+1 ), 1 )
259  a( k+1, k+1 ) = a( k+1, k+1 ) -
260  $ zdotu( k-1, work, 1, a( 1, k+1 ), 1 )
261  END IF
262  kstep = 2
263  END IF
264 *
265  kp = abs( ipiv( k ) )
266  IF( kp.NE.k ) THEN
267 *
268 * Interchange rows and columns K and KP in the leading
269 * submatrix A(1:k+1,1:k+1)
270 *
271  CALL zswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
272  CALL zswap( k-kp-1, a( kp+1, k ), 1, a( kp, kp+1 ), lda )
273  temp = a( k, k )
274  a( k, k ) = a( kp, kp )
275  a( kp, kp ) = temp
276  IF( kstep.EQ.2 ) THEN
277  temp = a( k, k+1 )
278  a( k, k+1 ) = a( kp, k+1 )
279  a( kp, k+1 ) = temp
280  END IF
281  END IF
282 *
283  k = k + kstep
284  GO TO 30
285  40 CONTINUE
286 *
287  ELSE
288 *
289 * Compute inv(A) from the factorization A = L*D*L**T.
290 *
291 * K is the main loop index, increasing from 1 to N in steps of
292 * 1 or 2, depending on the size of the diagonal blocks.
293 *
294  k = n
295  50 CONTINUE
296 *
297 * If K < 1, exit from loop.
298 *
299  IF( k.LT.1 )
300  $ GO TO 60
301 *
302  IF( ipiv( k ).GT.0 ) THEN
303 *
304 * 1 x 1 diagonal block
305 *
306 * Invert the diagonal block.
307 *
308  a( k, k ) = one / a( k, k )
309 *
310 * Compute column K of the inverse.
311 *
312  IF( k.LT.n ) THEN
313  CALL zcopy( n-k, a( k+1, k ), 1, work, 1 )
314  CALL zsymv( uplo, n-k, -one, a( k+1, k+1 ), lda, work, 1,
315  $ zero, a( k+1, k ), 1 )
316  a( k, k ) = a( k, k ) - zdotu( n-k, work, 1, a( k+1, k ),
317  $ 1 )
318  END IF
319  kstep = 1
320  ELSE
321 *
322 * 2 x 2 diagonal block
323 *
324 * Invert the diagonal block.
325 *
326  t = a( k, k-1 )
327  ak = a( k-1, k-1 ) / t
328  akp1 = a( k, k ) / t
329  akkp1 = a( k, k-1 ) / t
330  d = t*( ak*akp1-one )
331  a( k-1, k-1 ) = akp1 / d
332  a( k, k ) = ak / d
333  a( k, k-1 ) = -akkp1 / d
334 *
335 * Compute columns K-1 and K of the inverse.
336 *
337  IF( k.LT.n ) THEN
338  CALL zcopy( n-k, a( k+1, k ), 1, work, 1 )
339  CALL zsymv( uplo, n-k, -one, a( k+1, k+1 ), lda, work, 1,
340  $ zero, a( k+1, k ), 1 )
341  a( k, k ) = a( k, k ) - zdotu( n-k, work, 1, a( k+1, k ),
342  $ 1 )
343  a( k, k-1 ) = a( k, k-1 ) -
344  $ zdotu( n-k, a( k+1, k ), 1, a( k+1, k-1 ),
345  $ 1 )
346  CALL zcopy( n-k, a( k+1, k-1 ), 1, work, 1 )
347  CALL zsymv( uplo, n-k, -one, a( k+1, k+1 ), lda, work, 1,
348  $ zero, a( k+1, k-1 ), 1 )
349  a( k-1, k-1 ) = a( k-1, k-1 ) -
350  $ zdotu( n-k, work, 1, a( k+1, k-1 ), 1 )
351  END IF
352  kstep = 2
353  END IF
354 *
355  kp = abs( ipiv( k ) )
356  IF( kp.NE.k ) THEN
357 *
358 * Interchange rows and columns K and KP in the trailing
359 * submatrix A(k-1:n,k-1:n)
360 *
361  IF( kp.LT.n )
362  $ CALL zswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ), 1 )
363  CALL zswap( kp-k-1, a( k+1, k ), 1, a( kp, k+1 ), lda )
364  temp = a( k, k )
365  a( k, k ) = a( kp, kp )
366  a( kp, kp ) = temp
367  IF( kstep.EQ.2 ) THEN
368  temp = a( k, k-1 )
369  a( k, k-1 ) = a( kp, k-1 )
370  a( kp, k-1 ) = temp
371  END IF
372  END IF
373 *
374  k = k - kstep
375  GO TO 50
376  60 CONTINUE
377  END IF
378 *
379  RETURN
380 *
381 * End of ZSYTRI
382 *
zcopy
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:52
zswap
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
Definition: zswap.f:52
zdotu
complex *16 function zdotu(N, ZX, INCX, ZY, INCY)
ZDOTU
Definition: zdotu.f:54
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
zsymv
subroutine zsymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZSYMV computes a matrix-vector product for a complex symmetric matrix.
Definition: zsymv.f:159
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: