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