001:       REAL FUNCTION CLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, LDAF, WORK )
002: *
003: *     -- LAPACK routine (version 3.2.1)                                 --
004: *     -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
005: *     -- Jason Riedy of Univ. of California Berkeley.                 --
006: *     -- April 2009                                                   --
007: *
008: *     -- LAPACK is a software package provided by Univ. of Tennessee, --
009: *     -- Univ. of California Berkeley and NAG Ltd.                    --
010: *
011:       IMPLICIT NONE
012: *     ..
013: *     .. Scalar Arguments ..
014:       CHARACTER*1        UPLO
015:       INTEGER            NCOLS, LDA, LDAF
016: *     ..
017: *     .. Array Arguments ..
018:       COMPLEX            A( LDA, * ), AF( LDAF, * )
019:       REAL               WORK( * )
020: *     ..
021: *
022: *  Purpose
023: *  =======
024: * 
025: *  CLA_PORPVGRW computes the reciprocal pivot growth factor
026: *  norm(A)/norm(U). The "max absolute element" norm is used. If this is
027: *  much less than 1, the stability of the LU factorization of the
028: *  (equilibrated) matrix A could be poor. This also means that the
029: *  solution X, estimated condition numbers, and error bounds could be
030: *  unreliable.
031: *
032: *  Arguments
033: *  =========
034: *
035: *     UPLO    (input) CHARACTER*1
036: *       = 'U':  Upper triangle of A is stored;
037: *       = 'L':  Lower triangle of A is stored.
038: *
039: *     NCOLS   (input) INTEGER
040: *     The number of columns of the matrix A. NCOLS >= 0.
041: *
042: *     A       (input) COMPLEX array, dimension (LDA,N)
043: *     On entry, the N-by-N matrix A.
044: *
045: *     LDA     (input) INTEGER
046: *     The leading dimension of the array A.  LDA >= max(1,N).
047: *
048: *     AF      (input) COMPLEX array, dimension (LDAF,N)
049: *     The triangular factor U or L from the Cholesky factorization
050: *     A = U**T*U or A = L*L**T, as computed by CPOTRF.
051: *
052: *     LDAF    (input) INTEGER
053: *     The leading dimension of the array AF.  LDAF >= max(1,N).
054: *
055: *     WORK    (input) COMPLEX array, dimension (2*N)
056: *
057: *  =====================================================================
058: *
059: *     .. Local Scalars ..
060:       INTEGER            I, J
061:       REAL               AMAX, UMAX, RPVGRW
062:       LOGICAL            UPPER
063:       COMPLEX            ZDUM
064: *     ..
065: *     .. External Functions ..
066:       EXTERNAL           LSAME, CLASET
067:       LOGICAL            LSAME
068: *     ..
069: *     .. Intrinsic Functions ..
070:       INTRINSIC          ABS, MAX, MIN, REAL, AIMAG
071: *     ..
072: *     .. Statement Functions ..
073:       REAL               CABS1
074: *     ..
075: *     .. Statement Function Definitions ..
076:       CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
077: *     ..
078: *     .. Executable Statements ..
079:       UPPER = LSAME( 'Upper', UPLO )
080: *
081: *     SPOTRF will have factored only the NCOLSxNCOLS leading minor, so
082: *     we restrict the growth search to that minor and use only the first
083: *     2*NCOLS workspace entries.
084: *
085:       RPVGRW = 1.0
086:       DO I = 1, 2*NCOLS
087:          WORK( I ) = 0.0
088:       END DO
089: *
090: *     Find the max magnitude entry of each column.
091: *
092:       IF ( UPPER ) THEN
093:          DO J = 1, NCOLS
094:             DO I = 1, J
095:                WORK( NCOLS+J ) =
096:      $              MAX( CABS1( A( I, J ) ), WORK( NCOLS+J ) )
097:             END DO
098:          END DO
099:       ELSE
100:          DO J = 1, NCOLS
101:             DO I = J, NCOLS
102:                WORK( NCOLS+J ) =
103:      $              MAX( CABS1( A( I, J ) ), WORK( NCOLS+J ) )
104:             END DO
105:          END DO
106:       END IF
107: *
108: *     Now find the max magnitude entry of each column of the factor in
109: *     AF.  No pivoting, so no permutations.
110: *
111:       IF ( LSAME( 'Upper', UPLO ) ) THEN
112:          DO J = 1, NCOLS
113:             DO I = 1, J
114:                WORK( J ) = MAX( CABS1( AF( I, J ) ), WORK( J ) )
115:             END DO
116:          END DO
117:       ELSE
118:          DO J = 1, NCOLS
119:             DO I = J, NCOLS
120:                WORK( J ) = MAX( CABS1( AF( I, J ) ), WORK( J ) )
121:             END DO
122:          END DO
123:       END IF
124: *
125: *     Compute the *inverse* of the max element growth factor.  Dividing
126: *     by zero would imply the largest entry of the factor's column is
127: *     zero.  Than can happen when either the column of A is zero or
128: *     massive pivots made the factor underflow to zero.  Neither counts
129: *     as growth in itself, so simply ignore terms with zero
130: *     denominators.
131: *
132:       IF ( LSAME( 'Upper', UPLO ) ) THEN
133:          DO I = 1, NCOLS
134:             UMAX = WORK( I )
135:             AMAX = WORK( NCOLS+I )
136:             IF ( UMAX /= 0.0 ) THEN
137:                RPVGRW = MIN( AMAX / UMAX, RPVGRW )
138:             END IF
139:          END DO
140:       ELSE
141:          DO I = 1, NCOLS
142:             UMAX = WORK( I )
143:             AMAX = WORK( NCOLS+I )
144:             IF ( UMAX /= 0.0 ) THEN
145:                RPVGRW = MIN( AMAX / UMAX, RPVGRW )
146:             END IF
147:          END DO
148:       END IF
149: 
150:       CLA_PORPVGRW = RPVGRW
151:       END FUNCTION
152: