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