001:       REAL FUNCTION SLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, LDAF, WORK )
002: *
003: *     -- LAPACK routine (version 3.2)                                 --
004: *     -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
005: *     -- Jason Riedy of Univ. of California Berkeley.                 --
006: *     -- November 2008                                                --
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: *     .. Local Scalars ..
021:       INTEGER            I, J
022:       REAL               AMAX, UMAX, RPVGRW
023:       LOGICAL            UPPER
024: *     ..
025: *     .. Intrinsic Functions ..
026:       INTRINSIC          ABS, MAX, MIN
027: *     ..
028: *     .. External Functions ..
029:       EXTERNAL           LSAME, SLASET
030:       LOGICAL            LSAME
031: *     ..
032: *     .. Executable Statements ..
033: *
034:       UPPER = LSAME( 'Upper', UPLO )
035: *
036: *     SPOTRF will have factored only the NCOLSxNCOLS leading minor, so
037: *     we restrict the growth search to that minor and use only the first
038: *     2*NCOLS workspace entries.
039: *
040:       RPVGRW = 1.0
041:       DO I = 1, 2*NCOLS
042:          WORK( I ) = 0.0
043:       END DO
044: *
045: *     Find the max magnitude entry of each column.
046: *
047:       IF ( UPPER ) THEN
048:          DO J = 1, NCOLS
049:             DO I = 1, J
050:                WORK( NCOLS+J ) =
051:      $              MAX( ABS( A( I, J ) ), WORK( NCOLS+J ) )
052:             END DO
053:          END DO
054:       ELSE
055:          DO J = 1, NCOLS
056:             DO I = J, NCOLS
057:                WORK( NCOLS+J ) =
058:      $              MAX( ABS( A( I, J ) ), WORK( NCOLS+J ) )
059:             END DO
060:          END DO
061:       END IF
062: *
063: *     Now find the max magnitude entry of each column of the factor in
064: *     AF.  No pivoting, so no permutations.
065: *
066:       IF ( LSAME( 'Upper', UPLO ) ) THEN
067:          DO J = 1, NCOLS
068:             DO I = 1, J
069:                WORK( J ) = MAX( ABS( AF( I, J ) ), WORK( J ) )
070:             END DO
071:          END DO
072:       ELSE
073:          DO J = 1, NCOLS
074:             DO I = J, NCOLS
075:                WORK( J ) = MAX( ABS( AF( I, J ) ), WORK( J ) )
076:             END DO
077:          END DO
078:       END IF
079: *
080: *     Compute the *inverse* of the max element growth factor.  Dividing
081: *     by zero would imply the largest entry of the factor's column is
082: *     zero.  Than can happen when either the column of A is zero or
083: *     massive pivots made the factor underflow to zero.  Neither counts
084: *     as growth in itself, so simply ignore terms with zero
085: *     denominators.
086: *
087:       IF ( LSAME( 'Upper', UPLO ) ) THEN
088:          DO I = 1, NCOLS
089:             UMAX = WORK( I )
090:             AMAX = WORK( NCOLS+I )
091:             IF ( UMAX /= 0.0 ) THEN
092:                RPVGRW = MIN( AMAX / UMAX, RPVGRW )
093:             END IF
094:          END DO
095:       ELSE
096:          DO I = 1, NCOLS
097:             UMAX = WORK( I )
098:             AMAX = WORK( NCOLS+I )
099:             IF ( UMAX /= 0.0 ) THEN
100:                RPVGRW = MIN( AMAX / UMAX, RPVGRW )
101:             END IF
102:          END DO
103:       END IF
104: 
105:       SLA_PORPVGRW = RPVGRW
106:       END FUNCTION
107: