d7/dce/dla__gercond_8f_source.html

 *> \brief \b DLA_GERCOND estimates the Skeel condition number for a general matrix.
 *
 *  =========== DOCUMENTATION ===========
 *
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
 *> \htmlonly
 *> Download DLA_GERCOND + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_gercond.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_gercond.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_gercond.f">
 *> [TXT]</a>
 *> \endhtmlonly
 *
 *  Definition:
 *  ===========
 *
 *       DOUBLE PRECISION FUNCTION DLA_GERCOND( TRANS, N, A, LDA, AF,
 *                                              LDAF, IPIV, CMODE, C,
 *                                              INFO, WORK, IWORK )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          TRANS
 *       INTEGER            N, LDA, LDAF, INFO, CMODE
 *       ..
 *       .. Array Arguments ..
 *       INTEGER            IPIV( * ), IWORK( * )
 *       DOUBLE PRECISION   A( LDA, * ), AF( LDAF, * ), WORK( * ),
 *      $                   C( * )
 *       ..
 *
 *
 *> \par Purpose:
 *  =============
 *>
 *> \verbatim
 *>
 *>    DLA_GERCOND estimates the Skeel condition number of op(A) * op2(C)
 *>    where op2 is determined by CMODE as follows
 *>    CMODE =  1    op2(C) = C
 *>    CMODE =  0    op2(C) = I
 *>    CMODE = -1    op2(C) = inv(C)
 *>    The Skeel condition number cond(A) = norminf( |inv(A)||A| )
 *>    is computed by computing scaling factors R such that
 *>    diag(R)*A*op2(C) is row equilibrated and computing the standard
 *>    infinity-norm condition number.
 *> \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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (LDAF,N)
 *>     The factors L and U from the factorization
 *>     A = P*L*U as computed by DGETRF.
 *> \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 DGETRF; row i of the matrix was interchanged
 *>     with row IPIV(i).
 *> \endverbatim
 *>
 *> \param[in] CMODE
 *> \verbatim
 *>          CMODE is INTEGER
 *>     Determines op2(C) in the formula op(A) * op2(C) as follows:
 *>     CMODE =  1    op2(C) = C
 *>     CMODE =  0    op2(C) = I
 *>     CMODE = -1    op2(C) = inv(C)
 *> \endverbatim
 *>
 *> \param[in] C
 *> \verbatim
 *>          C is DOUBLE PRECISION array, dimension (N)
 *>     The vector C in the formula op(A) * op2(C).
 *> \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 DOUBLE PRECISION array, dimension (3*N).
 *>     Workspace.
 *> \endverbatim
 *>
 *> \param[out] IWORK
 *> \verbatim
 *>          IWORK is INTEGER 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 dla_gercond( TRANS, N, A, LDA, AF,
      $                                       LDAF, IPIV, CMODE, C,
      $                                       INFO, WORK, IWORK )
 *
 *  -- 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
       INTEGER            N, LDA, LDAF, INFO, CMODE
 *     ..
 *     .. Array Arguments ..
       INTEGER            IPIV( * ), IWORK( * )
       DOUBLE PRECISION   A( lda, * ), AF( ldaf, * ), WORK( * ),
      $                   c( * )
 *     ..
 *
 *  =====================================================================
 *
 *     .. Local Scalars ..
       LOGICAL            NOTRANS
       INTEGER            KASE, I, J
       DOUBLE PRECISION   AINVNM, TMP
 *     ..
 *     .. Local Arrays ..
       INTEGER            ISAVE( 3 )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       EXTERNAL           lsame
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           dlacn2, dgetrs, xerbla
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          abs, max
 *     ..
 *     .. Executable Statements ..
 *
       dla_gercond = 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( 'DLA_GERCOND', -info )
          RETURN
       END IF
       IF( n.EQ.0 ) THEN
          dla_gercond = 1.0d+0
          RETURN
       END IF
 *
 *     Compute the equilibration matrix R such that
 *     inv(R)*A*C has unit 1-norm.
 *
       IF (notrans) THEN
          DO i = 1, n
             tmp = 0.0d+0
             IF ( cmode .EQ. 1 ) THEN
                DO j = 1, n
                   tmp = tmp + abs( a( i, j ) * c( j ) )
                END DO
             ELSE IF ( cmode .EQ. 0 ) THEN
                DO j = 1, n
                   tmp = tmp + abs( a( i, j ) )
                END DO
             ELSE
                DO j = 1, n
                   tmp = tmp + abs( a( i, j ) / c( j ) )
                END DO
             END IF
             work( 2*n+i ) = tmp
          END DO
       ELSE
          DO i = 1, n
             tmp = 0.0d+0
             IF ( cmode .EQ. 1 ) THEN
                DO j = 1, n
                   tmp = tmp + abs( a( j, i ) * c( j ) )
                END DO
             ELSE IF ( cmode .EQ. 0 ) THEN
                DO j = 1, n
                   tmp = tmp + abs( a( j, i ) )
                END DO
             ELSE
                DO j = 1, n
                   tmp = tmp + abs( a( j, i ) / c( j ) )
                END DO
             END IF
             work( 2*n+i ) = tmp
          END DO
       END IF
 *
 *     Estimate the norm of inv(op(A)).
 *
       ainvnm = 0.0d+0

       kase = 0
    10 CONTINUE
       CALL dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
       IF( kase.NE.0 ) THEN
          IF( kase.EQ.2 ) THEN
 *
 *           Multiply by R.
 *
             DO i = 1, n
                work(i) = work(i) * work(2*n+i)
             END DO

             IF (notrans) THEN
                CALL dgetrs( 'No transpose', n, 1, af, ldaf, ipiv,
      $            work, n, info )
             ELSE
                CALL dgetrs( 'Transpose', n, 1, af, ldaf, ipiv,
      $            work, n, info )
             END IF
 *
 *           Multiply by inv(C).
 *
             IF ( cmode .EQ. 1 ) THEN
                DO i = 1, n
                   work( i ) = work( i ) / c( i )
                END DO
             ELSE IF ( cmode .EQ. -1 ) THEN
                DO i = 1, n
                   work( i ) = work( i ) * c( i )
                END DO
             END IF
          ELSE
 *
 *           Multiply by inv(C**T).
 *
             IF ( cmode .EQ. 1 ) THEN
                DO i = 1, n
                   work( i ) = work( i ) / c( i )
                END DO
             ELSE IF ( cmode .EQ. -1 ) THEN
                DO i = 1, n
                   work( i ) = work( i ) * c( i )
                END DO
             END IF

             IF (notrans) THEN
                CALL dgetrs( 'Transpose', n, 1, af, ldaf, ipiv,
      $            work, n, info )
             ELSE
                CALL dgetrs( 'No transpose', n, 1, af, ldaf, ipiv,
      $            work, n, info )
             END IF
 *
 *           Multiply by R.
 *
             DO i = 1, n
                work( i ) = work( i ) * work( 2*n+i )
             END DO
          END IF
          GO TO 10
       END IF
 *
 *     Compute the estimate of the reciprocal condition number.
 *
       IF( ainvnm .NE. 0.0d+0 )
      $   dla_gercond = ( 1.0d+0 / ainvnm )
 *
       RETURN
 *
 *     End of DLA_GERCOND
 *
       END
dgetrs
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
Definition: dgetrs.f:121

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

dla_gercond
double precision function dla_gercond(TRANS, N, A, LDA, AF, LDAF, IPIV, CMODE, C, INFO, WORK, IWORK)
DLA_GERCOND estimates the Skeel condition number for a general matrix.
Definition: dla_gercond.f:152

dlacn2
subroutine dlacn2(N, V, X, ISGN, EST, KASE, ISAVE)
DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
Definition: dlacn2.f:136