01:       DOUBLE PRECISION FUNCTION ZLA_RPVGRW( N, NCOLS, A, LDA, AF, LDAF )
02: *
03: *     -- LAPACK routine (version 3.2.1)                                 --
04: *     -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
05: *     -- Jason Riedy of Univ. of California Berkeley.                 --
06: *     -- April 2009                                                   --
07: *
08: *     -- LAPACK is a software package provided by Univ. of Tennessee, --
09: *     -- Univ. of California Berkeley and NAG Ltd.                    --
10: *
11:       IMPLICIT NONE
12: *     ..
13: *     .. Scalar Arguments ..
14:       INTEGER            N, NCOLS, LDA, LDAF
15: *     ..
16: *     .. Array Arguments ..
17:       COMPLEX*16         A( LDA, * ), AF( LDAF, * )
18: *     ..
19: *
20: *  Purpose
21: *  =======
22: * 
23: *  ZLA_RPVGRW computes the reciprocal pivot growth factor
24: *  norm(A)/norm(U). The "max absolute element" norm is used. If this is
25: *  much less than 1, the stability of the LU factorization of the
26: *  (equilibrated) matrix A could be poor. This also means that the
27: *  solution X, estimated condition numbers, and error bounds could be
28: *  unreliable.
29: *
30: *  Arguments
31: *  =========
32: *
33: *     N       (input) INTEGER
34: *     The number of linear equations, i.e., the order of the
35: *     matrix A.  N >= 0.
36: *
37: *     NCOLS   (input) INTEGER
38: *     The number of columns of the matrix A. NCOLS >= 0.
39: *
40: *     A       (input) DOUBLE PRECISION array, dimension (LDA,N)
41: *     On entry, the N-by-N matrix A.
42: *
43: *     LDA     (input) INTEGER
44: *     The leading dimension of the array A.  LDA >= max(1,N).
45: *
46: *     AF      (input) DOUBLE PRECISION array, dimension (LDAF,N)
47: *     The factors L and U from the factorization
48: *     A = P*L*U as computed by ZGETRF.
49: *
50: *     LDAF    (input) INTEGER
51: *     The leading dimension of the array AF.  LDAF >= max(1,N).
52: *
53: *  =====================================================================
54: *
55: *     .. Local Scalars ..
56:       INTEGER            I, J
57:       DOUBLE PRECISION   AMAX, UMAX, RPVGRW
58:       COMPLEX*16         ZDUM
59: *     ..
60: *     .. Intrinsic Functions ..
61:       INTRINSIC          MAX, MIN, ABS, REAL, DIMAG
62: *     ..
63: *     .. Statement Functions ..
64:       DOUBLE PRECISION   CABS1
65: *     ..
66: *     .. Statement Function Definitions ..
67:       CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
68: *     ..
69: *     .. Executable Statements ..
70: *
71:       RPVGRW = 1.0D+0
72: 
73:       DO J = 1, NCOLS
74:          AMAX = 0.0D+0
75:          UMAX = 0.0D+0
76:          DO I = 1, N
77:             AMAX = MAX( CABS1( A( I, J ) ), AMAX )
78:          END DO
79:          DO I = 1, J
80:             UMAX = MAX( CABS1( AF( I, J ) ), UMAX )
81:          END DO
82:          IF ( UMAX /= 0.0D+0 ) THEN
83:             RPVGRW = MIN( AMAX / UMAX, RPVGRW )
84:          END IF
85:       END DO
86:       ZLA_RPVGRW = RPVGRW
87:       END FUNCTION
88: