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