zla_gercond_c()

double precision function zla_gercond_c	(	character	TRANS,
		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_GERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general matrices.

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

Purpose:

    ZLA_GERCOND_C computes the infinity norm condition number of
    op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector.

Parameters

[in]	TRANS	TRANS is CHARACTER*1 Specifies the form of the system of equations: = 'N': A * X = B (No transpose) = 'T': A**T * X = B (Transpose) = 'C': A**H * X = B (Conjugate Transpose = Transpose)
[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 factors L and U from the factorization A = P*L*U as computed by ZGETRF.
[in]	LDAF	LDAF is INTEGER The leading dimension of the array AF. LDAF >= max(1,N).
[in]	IPIV	IPIV is INTEGER array, dimension (N) The pivot indices from the factorization A = P*L*U as computed by ZGETRF; row i of the matrix was interchanged with row IPIV(i).
[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.
[out]	WORK	WORK is COMPLEX*16 array, dimension (2*N). Workspace.
[out]	RWORK	RWORK is DOUBLE PRECISION array, dimension (N). Workspace.

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Date

December 2016

Definition at line 145 of file zla_gercond_c.f.

*
*  -- LAPACK computational routine (version 3.7.0) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     December 2016
*
*     .. Scalar Arguments ..
      CHARACTER          TRANS
      LOGICAL            CAPPLY
      INTEGER            N, LDA, LDAF, INFO
*     ..
*     .. Array Arguments ..
      INTEGER            IPIV( * )
      COMPLEX*16         A( LDA, * ), AF( LDAF, * ), WORK( * )
      DOUBLE PRECISION   C( * ), RWORK( * )
*     ..
*
*  =====================================================================
*
*     .. Local Scalars ..
      LOGICAL            NOTRANS
      INTEGER            KASE, I, J
      DOUBLE PRECISION   AINVNM, ANORM, TMP
      COMPLEX*16         ZDUM
*     ..
*     .. Local Arrays ..
      INTEGER            ISAVE( 3 )
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           lsame
*     ..
*     .. External Subroutines ..
      EXTERNAL           zlacn2, zgetrs, xerbla
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, max, real, dimag
*     ..
*     .. Statement Functions ..
      DOUBLE PRECISION   CABS1
*     ..
*     .. Statement Function Definitions ..
      cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
*     ..
*     .. Executable Statements ..
      zla_gercond_c = 0.0d+0
*
      info = 0
      notrans = lsame( trans, 'N' )
      IF ( .NOT. notrans .AND. .NOT. lsame( trans, 'T' ) .AND. .NOT.
     $     lsame( trans, 'C' ) ) 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_GERCOND_C', -info )
         RETURN
      END IF
*
*     Compute norm of op(A)*op2(C).
*
      anorm = 0.0d+0
      IF ( notrans ) THEN
         DO i = 1, n
            tmp = 0.0d+0
            IF ( capply ) THEN
               DO j = 1, n
                  tmp = tmp + cabs1( a( i, j ) ) / c( j )
               END DO
            ELSE
               DO j = 1, n
                  tmp = tmp + cabs1( a( i, j ) )
               END DO
            END IF
            rwork( i ) = tmp
            anorm = max( anorm, tmp )
         END DO
      ELSE
         DO i = 1, n
            tmp = 0.0d+0
            IF ( capply ) THEN
               DO j = 1, n
                  tmp = tmp + cabs1( a( j, i ) ) / c( j )
               END DO
            ELSE
               DO j = 1, n
                  tmp = tmp + cabs1( a( j, i ) )
               END DO
            END IF
            rwork( i ) = tmp
            anorm = max( anorm, tmp )
         END DO
      END IF
*
*     Quick return if possible.
*
      IF( n.EQ.0 ) THEN
         zla_gercond_c = 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 (notrans) THEN
               CALL zgetrs( 'No transpose', n, 1, af, ldaf, ipiv,
     $            work, n, info )
            ELSE
               CALL zgetrs( 'Conjugate transpose', n, 1, af, ldaf, ipiv,
     $            work, n, info )
            ENDIF
*
*           Multiply by inv(C).
*
            IF ( capply ) THEN
               DO i = 1, n
                  work( i ) = work( i ) * c( i )
               END DO
            END IF
         ELSE
*
*           Multiply by inv(C**H).
*
            IF ( capply ) THEN
               DO i = 1, n
                  work( i ) = work( i ) * c( i )
               END DO
            END IF
*
            IF ( notrans ) THEN
               CALL zgetrs( 'Conjugate transpose', n, 1, af, ldaf, ipiv,
     $            work, n, info )
            ELSE
               CALL zgetrs( 'No transpose', 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_gercond_c = 1.0d+0 / ainvnm
*
      RETURN
*

Here is the call graph for this function:

Here is the caller graph for this function: