d1/d42/zla__hercond__c_8f_source.html

 *> \brief \b ZLA_HERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian indefinite matrices.
 *
 *  =========== DOCUMENTATION ===========
 *
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
 *> \htmlonly
 *> Download ZLA_HERCOND_C + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_hercond_c.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_hercond_c.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_hercond_c.f">
 *> [TXT]</a>
 *> \endhtmlonly
 *
 *  Definition:
 *  ===========
 *
 *       DOUBLE PRECISION FUNCTION ZLA_HERCOND_C( UPLO, N, A, LDA, AF,
 *                                                LDAF, IPIV, C, CAPPLY,
 *                                                INFO, WORK, RWORK )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
 *       LOGICAL            CAPPLY
 *       INTEGER            N, LDA, LDAF, INFO
 *       ..
 *       .. Array Arguments ..
 *       INTEGER            IPIV( * )
 *       COMPLEX*16         A( LDA, * ), AF( LDAF, * ), WORK( * )
 *       DOUBLE PRECISION   C ( * ), RWORK( * )
 *       ..
 *
 *
 *> \par Purpose:
 *  =============
 *>
 *> \verbatim
 *>
 *>    ZLA_HERCOND_C computes the infinity norm condition number of
 *>    op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector.
 *> \endverbatim
 *
 *  Arguments:
 *  ==========
 *
 *> \param[in] UPLO
 *> \verbatim
 *>          UPLO is CHARACTER*1
 *>       = 'U':  Upper triangle of A is stored;
 *>       = 'L':  Lower triangle of A is stored.
 *> \endverbatim
 *>
 *> \param[in] N
 *> \verbatim
 *>          N is INTEGER
 *>     The number of linear equations, i.e., the order of the
 *>     matrix A.  N >= 0.
 *> \endverbatim
 *>
 *> \param[in] A
 *> \verbatim
 *>          A is COMPLEX*16 array, dimension (LDA,N)
 *>     On entry, the N-by-N matrix A
 *> \endverbatim
 *>
 *> \param[in] LDA
 *> \verbatim
 *>          LDA is INTEGER
 *>     The leading dimension of the array A.  LDA >= max(1,N).
 *> \endverbatim
 *>
 *> \param[in] AF
 *> \verbatim
 *>          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.
 *> \endverbatim
 *>
 *> \param[in] LDAF
 *> \verbatim
 *>          LDAF is INTEGER
 *>     The leading dimension of the array AF.  LDAF >= max(1,N).
 *> \endverbatim
 *>
 *> \param[in] IPIV
 *> \verbatim
 *>          IPIV is INTEGER array, dimension (N)
 *>     Details of the interchanges and the block structure of D
 *>     as determined by CHETRF.
 *> \endverbatim
 *>
 *> \param[in] C
 *> \verbatim
 *>          C is DOUBLE PRECISION array, dimension (N)
 *>     The vector C in the formula op(A) * inv(diag(C)).
 *> \endverbatim
 *>
 *> \param[in] CAPPLY
 *> \verbatim
 *>          CAPPLY is LOGICAL
 *>     If .TRUE. then access the vector C in the formula above.
 *> \endverbatim
 *>
 *> \param[out] INFO
 *> \verbatim
 *>          INFO is INTEGER
 *>       = 0:  Successful exit.
 *>     i > 0:  The ith argument is invalid.
 *> \endverbatim
 *>
 *> \param[out] WORK
 *> \verbatim
 *>          WORK is COMPLEX*16 array, dimension (2*N).
 *>     Workspace.
 *> \endverbatim
 *>
 *> \param[out] RWORK
 *> \verbatim
 *>          RWORK is DOUBLE PRECISION array, dimension (N).
 *>     Workspace.
 *> \endverbatim
 *
 *  Authors:
 *  ========
 *
 *> \author Univ. of Tennessee
 *> \author Univ. of California Berkeley
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
 *> \ingroup la_hercond
 *
 *  =====================================================================
       DOUBLE PRECISION FUNCTION zla_hercond_c( UPLO, N, A, LDA, AF,
      $                                         LDAF, IPIV, C, CAPPLY,
      $                                         INFO, WORK, RWORK )
 *
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *
 *     .. Scalar Arguments ..
       CHARACTER          UPLO
       LOGICAL            CAPPLY
       INTEGER            N, LDA, LDAF, INFO
 *     ..
 *     .. Array Arguments ..
       INTEGER            IPIV( * )
       COMPLEX*16         A( lda, * ), AF( ldaf, * ), WORK( * )
       DOUBLE PRECISION   C ( * ), 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_c = 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_C', -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
             IF ( capply ) THEN
                DO j = 1, i
                   tmp = tmp + cabs1( a( j, i ) ) / c( j )
                END DO
                DO j = i+1, n
                   tmp = tmp + cabs1( a( i, j ) ) / c( j )
                END DO
             ELSE
                DO j = 1, i
                   tmp = tmp + cabs1( a( j, i ) )
                END DO
                DO j = i+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, i
                   tmp = tmp + cabs1( a( i, j ) ) / c( j )
                END DO
                DO j = i+1, n
                   tmp = tmp + cabs1( a( j, i ) ) / c( j )
                END DO
             ELSE
                DO j = 1, i
                   tmp = tmp + cabs1( a( i, j ) )
                END DO
                DO j = i+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_hercond_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 ( 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(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 ( 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_c = 1.0d+0 / ainvnm
 *
       RETURN
 *
 *     End of ZLA_HERCOND_C
 *
       END
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60

zhetrs
subroutine zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS
Definition: zhetrs.f:120

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:133

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:140