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

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

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