LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
real function cla_hercond_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_HERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian indefinite matrices.

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

Purpose: 
    CLA_HERCOND_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 CHETRF.
[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 CHETRF.
[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_hercond_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, i, j
161  REAL ainvnm, anorm, tmp
162  LOGICAL up, upper
163  COMPLEX zdum
164 * ..
165 * .. Local Arrays ..
166  INTEGER isave( 3 )
167 * ..
168 * .. External Functions ..
169  LOGICAL lsame
170  EXTERNAL lsame
171 * ..
172 * .. External Subroutines ..
173  EXTERNAL clacn2, chetrs, xerbla
174 * ..
175 * .. Intrinsic Functions ..
176  INTRINSIC abs, max
177 * ..
178 * .. Statement Functions ..
179  REAL cabs1
180 * ..
181 * .. Statement Function Definitions ..
182  cabs1( zdum ) = abs( REAL( ZDUM ) ) + abs( aimag( zdum ) )
183 * ..
184 * .. Executable Statements ..
185 *
186  cla_hercond_c = 0.0e+0
187 *
188  info = 0
189  upper = lsame( uplo, 'U' )
190  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
191  info = -1
192  ELSE IF( n.LT.0 ) THEN
193  info = -2
194  ELSE IF( lda.LT.max( 1, n ) ) THEN
195  info = -4
196  ELSE IF( ldaf.LT.max( 1, n ) ) THEN
197  info = -6
198  END IF
199  IF( info.NE.0 ) THEN
200  CALL xerbla( 'CLA_HERCOND_C', -info )
201  RETURN
202  END IF
203  up = .false.
204  IF ( lsame( uplo, 'U' ) ) up = .true.
205 *
206 * Compute norm of op(A)*op2(C).
207 *
208  anorm = 0.0e+0
209  IF ( up ) THEN
210  DO i = 1, n
211  tmp = 0.0e+0
212  IF ( capply ) THEN
213  DO j = 1, i
214  tmp = tmp + cabs1( a( j, i ) ) / c( j )
215  END DO
216  DO j = i+1, n
217  tmp = tmp + cabs1( a( i, j ) ) / c( j )
218  END DO
219  ELSE
220  DO j = 1, i
221  tmp = tmp + cabs1( a( j, i ) )
222  END DO
223  DO j = i+1, n
224  tmp = tmp + cabs1( a( i, j ) )
225  END DO
226  END IF
227  rwork( i ) = tmp
228  anorm = max( anorm, tmp )
229  END DO
230  ELSE
231  DO i = 1, n
232  tmp = 0.0e+0
233  IF ( capply ) THEN
234  DO j = 1, i
235  tmp = tmp + cabs1( a( i, j ) ) / c( j )
236  END DO
237  DO j = i+1, n
238  tmp = tmp + cabs1( a( j, i ) ) / c( j )
239  END DO
240  ELSE
241  DO j = 1, i
242  tmp = tmp + cabs1( a( i, j ) )
243  END DO
244  DO j = i+1, n
245  tmp = tmp + cabs1( a( j, i ) )
246  END DO
247  END IF
248  rwork( i ) = tmp
249  anorm = max( anorm, tmp )
250  END DO
251  END IF
252 *
253 * Quick return if possible.
254 *
255  IF( n.EQ.0 ) THEN
256  cla_hercond_c = 1.0e+0
257  RETURN
258  ELSE IF( anorm .EQ. 0.0e+0 ) THEN
259  RETURN
260  END IF
261 *
262 * Estimate the norm of inv(op(A)).
263 *
264  ainvnm = 0.0e+0
265 *
266  kase = 0
267  10 CONTINUE
268  CALL clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
269  IF( kase.NE.0 ) THEN
270  IF( kase.EQ.2 ) THEN
271 *
272 * Multiply by R.
273 *
274  DO i = 1, n
275  work( i ) = work( i ) * rwork( i )
276  END DO
277 *
278  IF ( up ) THEN
279  CALL chetrs( 'U', n, 1, af, ldaf, ipiv,
280  $ work, n, info )
281  ELSE
282  CALL chetrs( 'L', n, 1, af, ldaf, ipiv,
283  $ work, n, info )
284  ENDIF
285 *
286 * Multiply by inv(C).
287 *
288  IF ( capply ) THEN
289  DO i = 1, n
290  work( i ) = work( i ) * c( i )
291  END DO
292  END IF
293  ELSE
294 *
295 * Multiply by inv(C**H).
296 *
297  IF ( capply ) THEN
298  DO i = 1, n
299  work( i ) = work( i ) * c( i )
300  END DO
301  END IF
302 *
303  IF ( up ) THEN
304  CALL chetrs( 'U', n, 1, af, ldaf, ipiv,
305  $ work, n, info )
306  ELSE
307  CALL chetrs( 'L', n, 1, af, ldaf, ipiv,
308  $ work, n, info )
309  END IF
310 *
311 * Multiply by R.
312 *
313  DO i = 1, n
314  work( i ) = work( i ) * rwork( i )
315  END DO
316  END IF
317  GO TO 10
318  END IF
319 *
320 * Compute the estimate of the reciprocal condition number.
321 *
322  IF( ainvnm .NE. 0.0e+0 )
323  $ cla_hercond_c = 1.0e+0 / ainvnm
324 *
325  RETURN
326 *
cla_hercond_c
real function cla_hercond_c(UPLO, N, A, LDA, AF, LDAF, IPIV, C, CAPPLY, INFO, WORK, RWORK)
CLA_HERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian indefin...
Definition: cla_hercond_c.f:140
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
chetrs
subroutine chetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS
Definition: chetrs.f:122
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: