1*> \brief \b CLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CLA_GBRPVGRW + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cla_gbrpvgrw.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cla_gbrpvgrw.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cla_gbrpvgrw.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       REAL FUNCTION CLA_GBRPVGRW( N, KL, KU, NCOLS, AB, LDAB, AFB,
22*                                   LDAFB )
23*
24*       .. Scalar Arguments ..
25*       INTEGER            N, KL, KU, NCOLS, LDAB, LDAFB
26*       ..
27*       .. Array Arguments ..
28*       COMPLEX            AB( LDAB, * ), AFB( LDAFB, * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> CLA_GBRPVGRW computes the reciprocal pivot growth factor
38*> norm(A)/norm(U). The "max absolute element" norm is used. If this is
39*> much less than 1, the stability of the LU factorization of the
40*> (equilibrated) matrix A could be poor. This also means that the
41*> solution X, estimated condition numbers, and error bounds could be
42*> unreliable.
43*> \endverbatim
44*
45*  Arguments:
46*  ==========
47*
48*> \param[in] N
49*> \verbatim
50*>          N is INTEGER
51*>     The number of linear equations, i.e., the order of the
52*>     matrix A.  N >= 0.
53*> \endverbatim
54*>
55*> \param[in] KL
56*> \verbatim
57*>          KL is INTEGER
58*>     The number of subdiagonals within the band of A.  KL >= 0.
59*> \endverbatim
60*>
61*> \param[in] KU
62*> \verbatim
63*>          KU is INTEGER
64*>     The number of superdiagonals within the band of A.  KU >= 0.
65*> \endverbatim
66*>
67*> \param[in] NCOLS
68*> \verbatim
69*>          NCOLS is INTEGER
70*>     The number of columns of the matrix A.  NCOLS >= 0.
71*> \endverbatim
72*>
73*> \param[in] AB
74*> \verbatim
75*>          AB is COMPLEX array, dimension (LDAB,N)
76*>     On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
77*>     The j-th column of A is stored in the j-th column of the
78*>     array AB as follows:
79*>     AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
80*> \endverbatim
81*>
82*> \param[in] LDAB
83*> \verbatim
84*>          LDAB is INTEGER
85*>     The leading dimension of the array AB.  LDAB >= KL+KU+1.
86*> \endverbatim
87*>
88*> \param[in] AFB
89*> \verbatim
90*>          AFB is COMPLEX array, dimension (LDAFB,N)
91*>     Details of the LU factorization of the band matrix A, as
92*>     computed by CGBTRF.  U is stored as an upper triangular
93*>     band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
94*>     and the multipliers used during the factorization are stored
95*>     in rows KL+KU+2 to 2*KL+KU+1.
96*> \endverbatim
97*>
98*> \param[in] LDAFB
99*> \verbatim
100*>          LDAFB is INTEGER
101*>     The leading dimension of the array AFB.  LDAFB >= 2*KL+KU+1.
102*> \endverbatim
103*
104*  Authors:
105*  ========
106*
107*> \author Univ. of Tennessee
108*> \author Univ. of California Berkeley
109*> \author Univ. of Colorado Denver
110*> \author NAG Ltd.
111*
112*> \date September 2012
113*
114*> \ingroup complexGBcomputational
115*
116*  =====================================================================
117      REAL FUNCTION CLA_GBRPVGRW( N, KL, KU, NCOLS, AB, LDAB, AFB,
118     $                            LDAFB )
119*
120*  -- LAPACK computational routine (version 3.4.2) --
121*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
122*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
123*     September 2012
124*
125*     .. Scalar Arguments ..
126      INTEGER            N, KL, KU, NCOLS, LDAB, LDAFB
127*     ..
128*     .. Array Arguments ..
129      COMPLEX            AB( LDAB, * ), AFB( LDAFB, * )
130*     ..
131*
132*  =====================================================================
133*
134*     .. Local Scalars ..
135      INTEGER            I, J, KD
136      REAL               AMAX, UMAX, RPVGRW
137      COMPLEX            ZDUM
138*     ..
139*     .. Intrinsic Functions ..
140      INTRINSIC          ABS, MAX, MIN, REAL, AIMAG
141*     ..
142*     .. Statement Functions ..
143      REAL               CABS1
144*     ..
145*     .. Statement Function Definitions ..
146      CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
147*     ..
148*     .. Executable Statements ..
149*
150      RPVGRW = 1.0
151
152      KD = KU + 1
153      DO J = 1, NCOLS
154         AMAX = 0.0
155         UMAX = 0.0
156         DO I = MAX( J-KU, 1 ), MIN( J+KL, N )
157            AMAX = MAX( CABS1( AB( KD+I-J, J ) ), AMAX )
158         END DO
159         DO I = MAX( J-KU, 1 ), J
160            UMAX = MAX( CABS1( AFB( KD+I-J, J ) ), UMAX )
161         END DO
162         IF ( UMAX /= 0.0 ) THEN
163            RPVGRW = MIN( AMAX / UMAX, RPVGRW )
164         END IF
165      END DO
166      CLA_GBRPVGRW = RPVGRW
167      END
168