File:  [local] / rpl / lapack / lapack / zla_porpvgrw.f
Revision 1.4: download - view: text, annotated - select for diffs - revision graph
Tue Dec 21 13:53:48 2010 UTC (13 years, 4 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_3, rpl-4_1_2, rpl-4_1_1, rpl-4_1_0, rpl-4_0_24, rpl-4_0_22, rpl-4_0_21, rpl-4_0_20, rpl-4_0, HEAD
Mise à jour de lapack vers la version 3.3.0.

    1:       DOUBLE PRECISION FUNCTION ZLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, 
    2:      $                                        LDAF, WORK )
    3: *
    4: *     -- LAPACK routine (version 3.2.2)                                 --
    5: *     -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
    6: *     -- Jason Riedy of Univ. of California Berkeley.                 --
    7: *     -- June 2010                                                    --
    8: *
    9: *     -- LAPACK is a software package provided by Univ. of Tennessee, --
   10: *     -- Univ. of California Berkeley and NAG Ltd.                    --
   11: *
   12:       IMPLICIT NONE
   13: *     ..
   14: *     .. Scalar Arguments ..
   15:       CHARACTER*1        UPLO
   16:       INTEGER            NCOLS, LDA, LDAF
   17: *     ..
   18: *     .. Array Arguments ..
   19:       COMPLEX*16         A( LDA, * ), AF( LDAF, * )
   20:       DOUBLE PRECISION   WORK( * )
   21: *     ..
   22: *
   23: *  Purpose
   24: *  =======
   25:    26: *  ZLA_PORPVGRW computes the reciprocal pivot growth factor
   27: *  norm(A)/norm(U). The "max absolute element" norm is used. If this is
   28: *  much less than 1, the stability of the LU factorization of the
   29: *  (equilibrated) matrix A could be poor. This also means that the
   30: *  solution X, estimated condition numbers, and error bounds could be
   31: *  unreliable.
   32: *
   33: *  Arguments
   34: *  =========
   35: *
   36: *     UPLO    (input) CHARACTER*1
   37: *       = 'U':  Upper triangle of A is stored;
   38: *       = 'L':  Lower triangle of A is stored.
   39: *
   40: *     NCOLS   (input) INTEGER
   41: *     The number of columns of the matrix A. NCOLS >= 0.
   42: *
   43: *     A       (input) COMPLEX*16 array, dimension (LDA,N)
   44: *     On entry, the N-by-N matrix A.
   45: *
   46: *     LDA     (input) INTEGER
   47: *     The leading dimension of the array A.  LDA >= max(1,N).
   48: *
   49: *     AF      (input) COMPLEX*16 array, dimension (LDAF,N)
   50: *     The triangular factor U or L from the Cholesky factorization
   51: *     A = U**T*U or A = L*L**T, as computed by ZPOTRF.
   52: *
   53: *     LDAF    (input) INTEGER
   54: *     The leading dimension of the array AF.  LDAF >= max(1,N).
   55: *
   56: *     WORK    (input) COMPLEX*16 array, dimension (2*N)
   57: *
   58: *  =====================================================================
   59: *
   60: *     .. Local Scalars ..
   61:       INTEGER            I, J
   62:       DOUBLE PRECISION   AMAX, UMAX, RPVGRW
   63:       LOGICAL            UPPER
   64:       COMPLEX*16         ZDUM
   65: *     ..
   66: *     .. External Functions ..
   67:       EXTERNAL           LSAME, ZLASET
   68:       LOGICAL            LSAME
   69: *     ..
   70: *     .. Intrinsic Functions ..
   71:       INTRINSIC          ABS, MAX, MIN, REAL, DIMAG
   72: *     ..
   73: *     .. Statement Functions ..
   74:       DOUBLE PRECISION   CABS1
   75: *     ..
   76: *     .. Statement Function Definitions ..
   77:       CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
   78: *     ..
   79: *     .. Executable Statements ..
   80:       UPPER = LSAME( 'Upper', UPLO )
   81: *
   82: *     DPOTRF will have factored only the NCOLSxNCOLS leading minor, so
   83: *     we restrict the growth search to that minor and use only the first
   84: *     2*NCOLS workspace entries.
   85: *
   86:       RPVGRW = 1.0D+0
   87:       DO I = 1, 2*NCOLS
   88:          WORK( I ) = 0.0D+0
   89:       END DO
   90: *
   91: *     Find the max magnitude entry of each column.
   92: *
   93:       IF ( UPPER ) THEN
   94:          DO J = 1, NCOLS
   95:             DO I = 1, J
   96:                WORK( NCOLS+J ) =
   97:      $              MAX( CABS1( A( I, J ) ), WORK( NCOLS+J ) )
   98:             END DO
   99:          END DO
  100:       ELSE
  101:          DO J = 1, NCOLS
  102:             DO I = J, NCOLS
  103:                WORK( NCOLS+J ) =
  104:      $              MAX( CABS1( A( I, J ) ), WORK( NCOLS+J ) )
  105:             END DO
  106:          END DO
  107:       END IF
  108: *
  109: *     Now find the max magnitude entry of each column of the factor in
  110: *     AF.  No pivoting, so no permutations.
  111: *
  112:       IF ( LSAME( 'Upper', UPLO ) ) THEN
  113:          DO J = 1, NCOLS
  114:             DO I = 1, J
  115:                WORK( J ) = MAX( CABS1( AF( I, J ) ), WORK( J ) )
  116:             END DO
  117:          END DO
  118:       ELSE
  119:          DO J = 1, NCOLS
  120:             DO I = J, NCOLS
  121:                WORK( J ) = MAX( CABS1( AF( I, J ) ), WORK( J ) )
  122:             END DO
  123:          END DO
  124:       END IF
  125: *
  126: *     Compute the *inverse* of the max element growth factor.  Dividing
  127: *     by zero would imply the largest entry of the factor's column is
  128: *     zero.  Than can happen when either the column of A is zero or
  129: *     massive pivots made the factor underflow to zero.  Neither counts
  130: *     as growth in itself, so simply ignore terms with zero
  131: *     denominators.
  132: *
  133:       IF ( LSAME( 'Upper', UPLO ) ) THEN
  134:          DO I = 1, NCOLS
  135:             UMAX = WORK( I )
  136:             AMAX = WORK( NCOLS+I )
  137:             IF ( UMAX /= 0.0D+0 ) THEN
  138:                RPVGRW = MIN( AMAX / UMAX, RPVGRW )
  139:             END IF
  140:          END DO
  141:       ELSE
  142:          DO I = 1, NCOLS
  143:             UMAX = WORK( I )
  144:             AMAX = WORK( NCOLS+I )
  145:             IF ( UMAX /= 0.0D+0 ) THEN
  146:                RPVGRW = MIN( AMAX / UMAX, RPVGRW )
  147:             END IF
  148:          END DO
  149:       END IF
  150: 
  151:       ZLA_PORPVGRW = RPVGRW
  152:       END

CVSweb interface <joel.bertrand@systella.fr>