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