LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
double precision function zla_syrcond_c ( character  UPLO,
integer  N,
complex*16, dimension( lda, * )  A,
integer  LDA,
complex*16, dimension( ldaf, * )  AF,
integer  LDAF,
integer, dimension( * )  IPIV,
double precision, dimension( * )  C,
logical  CAPPLY,
integer  INFO,
complex*16, dimension( * )  WORK,
double precision, dimension( * )  RWORK 
)

ZLA_SYRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for symmetric indefinite matrices.

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

Purpose: 
    ZLA_SYRCOND_C Computes the infinity norm condition number of
    op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
       = 'U':  Upper triangle of A is stored;
       = 'L':  Lower triangle of A is stored.
[in]N
          N is INTEGER
     The number of linear equations, i.e., the order of the
     matrix A.  N >= 0.
[in]A
          A is COMPLEX*16 array, dimension (LDA,N)
     On entry, the N-by-N matrix A
[in]LDA
          LDA is INTEGER
     The leading dimension of the array A.  LDA >= max(1,N).
[in]AF
          AF is COMPLEX*16 array, dimension (LDAF,N)
     The block diagonal matrix D and the multipliers used to
     obtain the factor U or L as computed by ZSYTRF.
[in]LDAF
          LDAF is INTEGER
     The leading dimension of the array AF.  LDAF >= 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.
[in]C
          C is DOUBLE PRECISION array, dimension (N)
     The vector C in the formula op(A) * inv(diag(C)).
[in]CAPPLY
          CAPPLY is LOGICAL
     If .TRUE. then access the vector C in the formula above.
[out]INFO
          INFO is INTEGER
       = 0:  Successful exit.
     i > 0:  The ith argument is invalid.
[in]WORK
          WORK is COMPLEX*16 array, dimension (2*N).
     Workspace.
[in]RWORK
          RWORK is DOUBLE PRECISION array, dimension (N).
     Workspace.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012

Definition at line 142 of file zla_syrcond_c.f.

142 *
143 * -- LAPACK computational routine (version 3.4.2) --
144 * -- LAPACK is a software package provided by Univ. of Tennessee, --
145 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
146 * September 2012
147 *
148 * .. Scalar Arguments ..
149  CHARACTER uplo
150  LOGICAL capply
151  INTEGER n, lda, ldaf, info
152 * ..
153 * .. Array Arguments ..
154  INTEGER ipiv( * )
155  COMPLEX*16 a( lda, * ), af( ldaf, * ), work( * )
156  DOUBLE PRECISION c( * ), rwork( * )
157 * ..
158 *
159 * =====================================================================
160 *
161 * .. Local Scalars ..
162  INTEGER kase
163  DOUBLE PRECISION ainvnm, anorm, tmp
164  INTEGER i, j
165  LOGICAL up, upper
166  COMPLEX*16 zdum
167 * ..
168 * .. Local Arrays ..
169  INTEGER isave( 3 )
170 * ..
171 * .. External Functions ..
172  LOGICAL lsame
173  EXTERNAL lsame
174 * ..
175 * .. External Subroutines ..
176  EXTERNAL zlacn2, zsytrs, xerbla
177 * ..
178 * .. Intrinsic Functions ..
179  INTRINSIC abs, max
180 * ..
181 * .. Statement Functions ..
182  DOUBLE PRECISION cabs1
183 * ..
184 * .. Statement Function Definitions ..
185  cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
186 * ..
187 * .. Executable Statements ..
188 *
189  zla_syrcond_c = 0.0d+0
190 *
191  info = 0
192  upper = lsame( uplo, 'U' )
193  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
194  info = -1
195  ELSE IF( n.LT.0 ) THEN
196  info = -2
197  ELSE IF( lda.LT.max( 1, n ) ) THEN
198  info = -4
199  ELSE IF( ldaf.LT.max( 1, n ) ) THEN
200  info = -6
201  END IF
202  IF( info.NE.0 ) THEN
203  CALL xerbla( 'ZLA_SYRCOND_C', -info )
204  RETURN
205  END IF
206  up = .false.
207  IF ( lsame( uplo, 'U' ) ) up = .true.
208 *
209 * Compute norm of op(A)*op2(C).
210 *
211  anorm = 0.0d+0
212  IF ( up ) THEN
213  DO i = 1, n
214  tmp = 0.0d+0
215  IF ( capply ) THEN
216  DO j = 1, i
217  tmp = tmp + cabs1( a( j, i ) ) / c( j )
218  END DO
219  DO j = i+1, n
220  tmp = tmp + cabs1( a( i, j ) ) / c( j )
221  END DO
222  ELSE
223  DO j = 1, i
224  tmp = tmp + cabs1( a( j, i ) )
225  END DO
226  DO j = i+1, n
227  tmp = tmp + cabs1( a( i, j ) )
228  END DO
229  END IF
230  rwork( i ) = tmp
231  anorm = max( anorm, tmp )
232  END DO
233  ELSE
234  DO i = 1, n
235  tmp = 0.0d+0
236  IF ( capply ) THEN
237  DO j = 1, i
238  tmp = tmp + cabs1( a( i, j ) ) / c( j )
239  END DO
240  DO j = i+1, n
241  tmp = tmp + cabs1( a( j, i ) ) / c( j )
242  END DO
243  ELSE
244  DO j = 1, i
245  tmp = tmp + cabs1( a( i, j ) )
246  END DO
247  DO j = i+1, n
248  tmp = tmp + cabs1( a( j, i ) )
249  END DO
250  END IF
251  rwork( i ) = tmp
252  anorm = max( anorm, tmp )
253  END DO
254  END IF
255 *
256 * Quick return if possible.
257 *
258  IF( n.EQ.0 ) THEN
259  zla_syrcond_c = 1.0d+0
260  RETURN
261  ELSE IF( anorm .EQ. 0.0d+0 ) THEN
262  RETURN
263  END IF
264 *
265 * Estimate the norm of inv(op(A)).
266 *
267  ainvnm = 0.0d+0
268 *
269  kase = 0
270  10 CONTINUE
271  CALL zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
272  IF( kase.NE.0 ) THEN
273  IF( kase.EQ.2 ) THEN
274 *
275 * Multiply by R.
276 *
277  DO i = 1, n
278  work( i ) = work( i ) * rwork( i )
279  END DO
280 *
281  IF ( up ) THEN
282  CALL zsytrs( 'U', n, 1, af, ldaf, ipiv,
283  $ work, n, info )
284  ELSE
285  CALL zsytrs( 'L', n, 1, af, ldaf, ipiv,
286  $ work, n, info )
287  ENDIF
288 *
289 * Multiply by inv(C).
290 *
291  IF ( capply ) THEN
292  DO i = 1, n
293  work( i ) = work( i ) * c( i )
294  END DO
295  END IF
296  ELSE
297 *
298 * Multiply by inv(C**T).
299 *
300  IF ( capply ) THEN
301  DO i = 1, n
302  work( i ) = work( i ) * c( i )
303  END DO
304  END IF
305 *
306  IF ( up ) THEN
307  CALL zsytrs( 'U', n, 1, af, ldaf, ipiv,
308  $ work, n, info )
309  ELSE
310  CALL zsytrs( 'L', n, 1, af, ldaf, ipiv,
311  $ work, n, info )
312  END IF
313 *
314 * Multiply by R.
315 *
316  DO i = 1, n
317  work( i ) = work( i ) * rwork( i )
318  END DO
319  END IF
320  GO TO 10
321  END IF
322 *
323 * Compute the estimate of the reciprocal condition number.
324 *
325  IF( ainvnm .NE. 0.0d+0 )
326  $ zla_syrcond_c = 1.0d+0 / ainvnm
327 *
328  RETURN
329 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
zla_syrcond_c
double precision function zla_syrcond_c(UPLO, N, A, LDA, AF, LDAF, IPIV, C, CAPPLY, INFO, WORK, RWORK)
ZLA_SYRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for symmetric indefin...
Definition: zla_syrcond_c.f:142
zlacn2
subroutine zlacn2(N, V, X, EST, KASE, ISAVE)
ZLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
Definition: zlacn2.f:135
zsytrs
subroutine zsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZSYTRS
Definition: zsytrs.f:122
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: