Return to zla_porpvgrw.f CVS log

Up to [local] / rpl / lapack / lapack

Première mise à jour de lapack et blas.

    1: *> \brief \b ZLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian positive-definite matrix.
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download ZLA_PORPVGRW + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_porpvgrw.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_porpvgrw.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_porpvgrw.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       DOUBLE PRECISION FUNCTION ZLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF,
   22: *                                               LDAF, WORK )
   23: *
   24: *       .. Scalar Arguments ..
   25: *       CHARACTER*1        UPLO
   26: *       INTEGER            NCOLS, LDA, LDAF
   27: *       ..
   28: *       .. Array Arguments ..
   29: *       COMPLEX*16         A( LDA, * ), AF( LDAF, * )
   30: *       DOUBLE PRECISION   WORK( * )
   31: *       ..
   32: *
   33: *
   34: *> \par Purpose:
   35: *  =============
   36: *>
   37: *> \verbatim
   38: *>
   39: *>
   40: *> ZLA_PORPVGRW computes the reciprocal pivot growth factor
   41: *> norm(A)/norm(U). The "max absolute element" norm is used. If this is
   42: *> much less than 1, the stability of the LU factorization of the
   43: *> (equilibrated) matrix A could be poor. This also means that the
   44: *> solution X, estimated condition numbers, and error bounds could be
   45: *> unreliable.
   46: *> \endverbatim
   47: *
   48: *  Arguments:
   49: *  ==========
   50: *
   51: *> \param[in] UPLO
   52: *> \verbatim
   53: *>          UPLO is CHARACTER*1
   54: *>       = 'U':  Upper triangle of A is stored;
   55: *>       = 'L':  Lower triangle of A is stored.
   56: *> \endverbatim
   57: *>
   58: *> \param[in] NCOLS
   59: *> \verbatim
   60: *>          NCOLS is INTEGER
   61: *>     The number of columns of the matrix A. NCOLS >= 0.
   62: *> \endverbatim
   63: *>
   64: *> \param[in] A
   65: *> \verbatim
   66: *>          A is COMPLEX*16 array, dimension (LDA,N)
   67: *>     On entry, the N-by-N matrix A.
   68: *> \endverbatim
   69: *>
   70: *> \param[in] LDA
   71: *> \verbatim
   72: *>          LDA is INTEGER
   73: *>     The leading dimension of the array A.  LDA >= max(1,N).
   74: *> \endverbatim
   75: *>
   76: *> \param[in] AF
   77: *> \verbatim
   78: *>          AF is COMPLEX*16 array, dimension (LDAF,N)
   79: *>     The triangular factor U or L from the Cholesky factorization
   80: *>     A = U**T*U or A = L*L**T, as computed by ZPOTRF.
   81: *> \endverbatim
   82: *>
   83: *> \param[in] LDAF
   84: *> \verbatim
   85: *>          LDAF is INTEGER
   86: *>     The leading dimension of the array AF.  LDAF >= max(1,N).
   87: *> \endverbatim
   88: *>
   89: *> \param[out] WORK
   90: *> \verbatim
   91: *>          WORK is DOUBLE PRECISION array, dimension (2*N)
   92: *> \endverbatim
   93: *
   94: *  Authors:
   95: *  ========
   96: *
   97: *> \author Univ. of Tennessee
   98: *> \author Univ. of California Berkeley
   99: *> \author Univ. of Colorado Denver
  100: *> \author NAG Ltd.
  101: *
  102: *> \ingroup complex16POcomputational
  103: *
  104: *  =====================================================================
  105:       DOUBLE PRECISION FUNCTION ZLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF,
  106:      $                                        LDAF, WORK )
  107: *
  108: *  -- LAPACK computational routine --
  109: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  110: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  111: *
  112: *     .. Scalar Arguments ..
  113:       CHARACTER*1        UPLO
  114:       INTEGER            NCOLS, LDA, LDAF
  115: *     ..
  116: *     .. Array Arguments ..
  117:       COMPLEX*16         A( LDA, * ), AF( LDAF, * )
  118:       DOUBLE PRECISION   WORK( * )
  119: *     ..
  120: *
  121: *  =====================================================================
  122: *
  123: *     .. Local Scalars ..
  124:       INTEGER            I, J
  125:       DOUBLE PRECISION   AMAX, UMAX, RPVGRW
  126:       LOGICAL            UPPER
  127:       COMPLEX*16         ZDUM
  128: *     ..
  129: *     .. External Functions ..
  130:       EXTERNAL           LSAME
  131:       LOGICAL            LSAME
  132: *     ..
  133: *     .. Intrinsic Functions ..
  134:       INTRINSIC          ABS, MAX, MIN, REAL, DIMAG
  135: *     ..
  136: *     .. Statement Functions ..
  137:       DOUBLE PRECISION   CABS1
  138: *     ..
  139: *     .. Statement Function Definitions ..
  140:       CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
  141: *     ..
  142: *     .. Executable Statements ..
  143:       UPPER = LSAME( 'Upper', UPLO )
  144: *
  145: *     DPOTRF will have factored only the NCOLSxNCOLS leading minor, so
  146: *     we restrict the growth search to that minor and use only the first
  147: *     2*NCOLS workspace entries.
  148: *
  149:       RPVGRW = 1.0D+0
  150:       DO I = 1, 2*NCOLS
  151:          WORK( I ) = 0.0D+0
  152:       END DO
  153: *
  154: *     Find the max magnitude entry of each column.
  155: *
  156:       IF ( UPPER ) THEN
  157:          DO J = 1, NCOLS
  158:             DO I = 1, J
  159:                WORK( NCOLS+J ) =
  160:      $              MAX( CABS1( A( I, J ) ), WORK( NCOLS+J ) )
  161:             END DO
  162:          END DO
  163:       ELSE
  164:          DO J = 1, NCOLS
  165:             DO I = J, NCOLS
  166:                WORK( NCOLS+J ) =
  167:      $              MAX( CABS1( A( I, J ) ), WORK( NCOLS+J ) )
  168:             END DO
  169:          END DO
  170:       END IF
  171: *
  172: *     Now find the max magnitude entry of each column of the factor in
  173: *     AF.  No pivoting, so no permutations.
  174: *
  175:       IF ( LSAME( 'Upper', UPLO ) ) THEN
  176:          DO J = 1, NCOLS
  177:             DO I = 1, J
  178:                WORK( J ) = MAX( CABS1( AF( I, J ) ), WORK( J ) )
  179:             END DO
  180:          END DO
  181:       ELSE
  182:          DO J = 1, NCOLS
  183:             DO I = J, NCOLS
  184:                WORK( J ) = MAX( CABS1( AF( I, J ) ), WORK( J ) )
  185:             END DO
  186:          END DO
  187:       END IF
  188: *
  189: *     Compute the *inverse* of the max element growth factor.  Dividing
  190: *     by zero would imply the largest entry of the factor's column is
  191: *     zero.  Than can happen when either the column of A is zero or
  192: *     massive pivots made the factor underflow to zero.  Neither counts
  193: *     as growth in itself, so simply ignore terms with zero
  194: *     denominators.
  195: *
  196:       IF ( LSAME( 'Upper', UPLO ) ) THEN
  197:          DO I = 1, NCOLS
  198:             UMAX = WORK( I )
  199:             AMAX = WORK( NCOLS+I )
  200:             IF ( UMAX /= 0.0D+0 ) THEN
  201:                RPVGRW = MIN( AMAX / UMAX, RPVGRW )
  202:             END IF
  203:          END DO
  204:       ELSE
  205:          DO I = 1, NCOLS
  206:             UMAX = WORK( I )
  207:             AMAX = WORK( NCOLS+I )
  208:             IF ( UMAX /= 0.0D+0 ) THEN
  209:                RPVGRW = MIN( AMAX / UMAX, RPVGRW )
  210:             END IF
  211:          END DO
  212:       END IF
  213: 
  214:       ZLA_PORPVGRW = RPVGRW
  215: *
  216: *     End of ZLA_PORPVGRW
  217: *
  218:       END