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

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

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

Purpose: 
    CLA_SYRCOND_C Computes the infinity norm condition number of
    op(A) * inv(diag(C)) where C is a REAL 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 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 array, dimension (LDAF,N)
     The block diagonal matrix D and the multipliers used to
     obtain the factor U or L as computed by CSYTRF.
[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 CSYTRF.
[in]C
          C is REAL 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 array, dimension (2*N).
     Workspace.
[in]RWORK
          RWORK is REAL array, dimension (N).
     Workspace.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012

Definition at line 140 of file cla_syrcond_c.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: