double precision function zla_hercond_x	(	character	UPLO,
		integer	N,
		complex*16, dimension( lda, * )	A,
		integer	LDA,
		complex*16, dimension( ldaf, * )	AF,
		integer	LDAF,
		integer, dimension( * )	IPIV,
		complex*16, dimension( * )	X,
		integer	INFO,
		complex*16, dimension( * )	WORK,
		double precision, dimension( * )	RWORK
	)

ZLA_HERCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian indefinite matrices.

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

Purpose:

    ZLA_HERCOND_X computes the infinity norm condition number of
    op(A) * diag(X) where X is a COMPLEX*16 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]	X	X is COMPLEX*16 array, dimension (N) The vector X in the formula op(A) * diag(X).
[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 135 of file zla_hercond_x.f.

*
*  -- LAPACK computational routine (version 3.4.2) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     September 2012
*
*     .. Scalar Arguments ..
      CHARACTER          uplo
      INTEGER            n, lda, ldaf, info
*     ..
*     .. Array Arguments ..
      INTEGER            ipiv( * )
      COMPLEX*16         a( lda, * ), af( ldaf, * ), work( * ), x( * )
      DOUBLE PRECISION   rwork( * )
*     ..
*
*  =====================================================================
*
*     .. Local Scalars ..
      INTEGER            kase, i, j
      DOUBLE PRECISION   ainvnm, anorm, tmp
      LOGICAL            up, upper
      COMPLEX*16         zdum
*     ..
*     .. Local Arrays ..
      INTEGER            isave( 3 )
*     ..
*     .. External Functions ..
      LOGICAL            lsame
      EXTERNAL           lsame
*     ..
*     .. External Subroutines ..
      EXTERNAL           zlacn2, zhetrs, xerbla
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, max
*     ..
*     .. Statement Functions ..
      DOUBLE PRECISION cabs1
*     ..
*     .. Statement Function Definitions ..
      cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
*     ..
*     .. Executable Statements ..
*
      zla_hercond_x = 0.0d+0
*
      info = 0
      upper = lsame( uplo, 'U' )
      IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
         info = -1
      ELSE IF ( n.LT.0 ) THEN
         info = -2
      ELSE IF( lda.LT.max( 1, n ) ) THEN
         info = -4
      ELSE IF( ldaf.LT.max( 1, n ) ) THEN
         info = -6
      END IF
      IF( info.NE.0 ) THEN
         CALL xerbla( 'ZLA_HERCOND_X', -info )
         RETURN
      END IF
      up = .false.
      IF ( lsame( uplo, 'U' ) ) up = .true.
*
*     Compute norm of op(A)*op2(C).
*
      anorm = 0.0d+0
      IF ( up ) THEN
         DO i = 1, n
            tmp = 0.0d+0
            DO j = 1, i
               tmp = tmp + cabs1( a( j, i ) * x( j ) )
            END DO
            DO j = i+1, n
               tmp = tmp + cabs1( a( i, j ) * x( j ) )
            END DO
            rwork( i ) = tmp
            anorm = max( anorm, tmp )
         END DO
      ELSE
         DO i = 1, n
            tmp = 0.0d+0
            DO j = 1, i
               tmp = tmp + cabs1( a( i, j ) * x( j ) )
            END DO
            DO j = i+1, n
               tmp = tmp + cabs1( a( j, i ) * x( j ) )
            END DO
            rwork( i ) = tmp
            anorm = max( anorm, tmp )
         END DO
      END IF
*
*     Quick return if possible.
*
      IF( n.EQ.0 ) THEN
         zla_hercond_x = 1.0d+0
         RETURN
      ELSE IF( anorm .EQ. 0.0d+0 ) THEN
         RETURN
      END IF
*
*     Estimate the norm of inv(op(A)).
*
      ainvnm = 0.0d+0
*
      kase = 0
   10 CONTINUE
      CALL zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
      IF( kase.NE.0 ) THEN
         IF( kase.EQ.2 ) THEN
*
*           Multiply by R.
*
            DO i = 1, n
               work( i ) = work( i ) * rwork( i )
            END DO
*
            IF ( up ) THEN
               CALL zhetrs( 'U', n, 1, af, ldaf, ipiv,
     $            work, n, info )
            ELSE
               CALL zhetrs( 'L', n, 1, af, ldaf, ipiv,
     $            work, n, info )
            ENDIF
*
*           Multiply by inv(X).
*
            DO i = 1, n
               work( i ) = work( i ) / x( i )
            END DO
         ELSE
*
*           Multiply by inv(X**H).
*
            DO i = 1, n
               work( i ) = work( i ) / x( i )
            END DO
*
            IF ( up ) THEN
               CALL zhetrs( 'U', n, 1, af, ldaf, ipiv,
     $            work, n, info )
            ELSE
               CALL zhetrs( 'L', n, 1, af, ldaf, ipiv,
     $            work, n, info )
            END IF
*
*           Multiply by R.
*
            DO i = 1, n
               work( i ) = work( i ) * rwork( i )
            END DO
         END IF
         GO TO 10
      END IF
*
*     Compute the estimate of the reciprocal condition number.
*
      IF( ainvnm .NE. 0.0d+0 )
     $   zla_hercond_x = 1.0d+0 / ainvnm
*
      RETURN
*

Here is the call graph for this function:

Here is the caller graph for this function: