d7/d93/zla__gercond__c_8f_source.html

 *> \brief \b ZLA_GERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general matrices.
 *
 *  =========== DOCUMENTATION ===========
 *
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
 *> \htmlonly
 *> Download ZLA_GERCOND_C + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_gercond_c.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_gercond_c.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_gercond_c.f">
 *> [TXT]</a>
 *> \endhtmlonly
 *
 *  Definition:
 *  ===========
 *
 *       DOUBLE PRECISION FUNCTION ZLA_GERCOND_C( TRANS, N, A, LDA, AF,
 *                                                LDAF, IPIV, C, CAPPLY,
 *                                                INFO, WORK, RWORK )
 *
 *       .. 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( * )
 *       ..
 *
 *
 *> \par Purpose:
 *  =============
 *>
 *> \verbatim
 *>
 *>    ZLA_GERCOND_C computes the infinity norm condition number of
 *>    op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector.
 *> \endverbatim
 *
 *  Arguments:
 *  ==========
 *
 *> \param[in] TRANS
 *> \verbatim
 *>          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)
 *> \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 factors L and U from the factorization
 *>     A = P*L*U as computed by ZGETRF.
 *> \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)
 *>     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).
 *> \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_gercond
 *
 *  =====================================================================
       DOUBLE PRECISION FUNCTION zla_gercond_c( TRANS, 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          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
 *
 *     End of ZLA_GERCOND_C
 *
       END
zla_gercond_c
double precision function zla_gercond_c(TRANS, N, A, LDA, AF, LDAF, IPIV, C, CAPPLY, INFO, WORK, RWORK)
ZLA_GERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general matrices...
Definition: zla_gercond_c.f:143

xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60

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

zgetrs
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
Definition: zgetrs.f:121