01:       REAL FUNCTION SLA_GBRPVGRW( N, KL, KU, NCOLS, AB, LDAB, AFB,
02:      $                            LDAFB )
03: *
04: *     -- LAPACK routine (version 3.2.1)                                 --
05: *     -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
06: *     -- Jason Riedy of Univ. of California Berkeley.                 --
07: *     -- April 2009                                                   --
08: *
09: *     -- LAPACK is a software package provided by Univ. of Tennessee, --
10: *     -- Univ. of California Berkeley and NAG Ltd.                    --
11: *
12:       IMPLICIT NONE
13: *     ..
14: *     .. Scalar Arguments ..
15:       INTEGER            N, KL, KU, NCOLS, LDAB, LDAFB
16: *     ..
17: *     .. Array Arguments ..
18:       REAL               AB( LDAB, * ), AFB( LDAFB, * )
19: *     ..
20: *
21: *  Purpose
22: *  =======
23: *
24: *  SLA_GBRPVGRW computes the reciprocal pivot growth factor
25: *  norm(A)/norm(U). The "max absolute element" norm is used. If this is
26: *  much less than 1, the stability of the LU factorization of the
27: *  (equilibrated) matrix A could be poor. This also means that the
28: *  solution X, estimated condition numbers, and error bounds could be
29: *  unreliable.
30: *
31: *  Arguments
32: *  =========
33: *
34: *     N       (input) INTEGER
35: *     The number of linear equations, i.e., the order of the
36: *     matrix A.  N >= 0.
37: *
38: *     KL      (input) INTEGER
39: *     The number of subdiagonals within the band of A.  KL >= 0.
40: *
41: *     KU      (input) INTEGER
42: *     The number of superdiagonals within the band of A.  KU >= 0.
43: *
44: *     NCOLS   (input) INTEGER
45: *     The number of columns of the matrix A.  NCOLS >= 0.
46: *
47: *     AB      (input) REAL array, dimension (LDAB,N)
48: *     On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
49: *     The j-th column of A is stored in the j-th column of the
50: *     array AB as follows:
51: *     AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
52: *
53: *     LDAB    (input) INTEGER
54: *     The leading dimension of the array AB.  LDAB >= KL+KU+1.
55: *
56: *     AFB     (input) REAL array, dimension (LDAFB,N)
57: *     Details of the LU factorization of the band matrix A, as
58: *     computed by SGBTRF.  U is stored as an upper triangular
59: *     band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
60: *     and the multipliers used during the factorization are stored
61: *     in rows KL+KU+2 to 2*KL+KU+1.
62: *
63: *     LDAFB   (input) INTEGER
64: *     The leading dimension of the array AFB.  LDAFB >= 2*KL+KU+1.
65: *
66: *  =====================================================================
67: *
68: *     .. Local Scalars ..
69:       INTEGER            I, J, KD
70:       REAL               AMAX, UMAX, RPVGRW
71: *     ..
72: *     .. Intrinsic Functions ..
73:       INTRINSIC          ABS, MAX, MIN
74: *     ..
75: *     .. Executable Statements ..
76: *
77:       RPVGRW = 1.0
78: 
79:       KD = KU + 1
80:       DO J = 1, NCOLS
81:          AMAX = 0.0
82:          UMAX = 0.0
83:          DO I = MAX( J-KU, 1 ), MIN( J+KL, N )
84:             AMAX = MAX( ABS( AB( KD+I-J, J)), AMAX )
85:          END DO
86:          DO I = MAX( J-KU, 1 ), J
87:             UMAX = MAX( ABS( AFB( KD+I-J, J ) ), UMAX )
88:          END DO
89:          IF ( UMAX /= 0.0 ) THEN
90:             RPVGRW = MIN( AMAX / UMAX, RPVGRW )
91:          END IF
92:       END DO
93:       SLA_GBRPVGRW = RPVGRW
94:       END FUNCTION
95: