1*> \brief \b CGBT02
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE CGBT02( TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B,
12*                          LDB, RESID )
13*
14*       .. Scalar Arguments ..
15*       CHARACTER          TRANS
16*       INTEGER            KL, KU, LDA, LDB, LDX, M, N, NRHS
17*       REAL               RESID
18*       ..
19*       .. Array Arguments ..
20*       COMPLEX            A( LDA, * ), B( LDB, * ), X( LDX, * )
21*       ..
22*
23*
24*> \par Purpose:
25*  =============
26*>
27*> \verbatim
28*>
29*> CGBT02 computes the residual for a solution of a banded system of
30*> equations  A*x = b  or  A'*x = b:
31*>    RESID = norm( B - A*X ) / ( norm(A) * norm(X) * EPS).
32*> where EPS is the machine precision.
33*> \endverbatim
34*
35*  Arguments:
36*  ==========
37*
38*> \param[in] TRANS
39*> \verbatim
40*>          TRANS is CHARACTER*1
41*>          Specifies the form of the system of equations:
42*>          = 'N':  A *x = b
43*>          = 'T':  A'*x = b, where A' is the transpose of A
44*>          = 'C':  A'*x = b, where A' is the transpose of A
45*> \endverbatim
46*>
47*> \param[in] M
48*> \verbatim
49*>          M is INTEGER
50*>          The number of rows of the matrix A.  M >= 0.
51*> \endverbatim
52*>
53*> \param[in] N
54*> \verbatim
55*>          N is INTEGER
56*>          The number of columns of the matrix A.  N >= 0.
57*> \endverbatim
58*>
59*> \param[in] KL
60*> \verbatim
61*>          KL is INTEGER
62*>          The number of subdiagonals within the band of A.  KL >= 0.
63*> \endverbatim
64*>
65*> \param[in] KU
66*> \verbatim
67*>          KU is INTEGER
68*>          The number of superdiagonals within the band of A.  KU >= 0.
69*> \endverbatim
70*>
71*> \param[in] NRHS
72*> \verbatim
73*>          NRHS is INTEGER
74*>          The number of columns of B.  NRHS >= 0.
75*> \endverbatim
76*>
77*> \param[in] A
78*> \verbatim
79*>          A is COMPLEX array, dimension (LDA,N)
80*>          The original matrix A in band storage, stored in rows 1 to
81*>          KL+KU+1.
82*> \endverbatim
83*>
84*> \param[in] LDA
85*> \verbatim
86*>          LDA is INTEGER
87*>          The leading dimension of the array A.  LDA >= max(1,KL+KU+1).
88*> \endverbatim
89*>
90*> \param[in] X
91*> \verbatim
92*>          X is COMPLEX array, dimension (LDX,NRHS)
93*>          The computed solution vectors for the system of linear
94*>          equations.
95*> \endverbatim
96*>
97*> \param[in] LDX
98*> \verbatim
99*>          LDX is INTEGER
100*>          The leading dimension of the array X.  If TRANS = 'N',
101*>          LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,M).
102*> \endverbatim
103*>
104*> \param[in,out] B
105*> \verbatim
106*>          B is COMPLEX array, dimension (LDB,NRHS)
107*>          On entry, the right hand side vectors for the system of
108*>          linear equations.
109*>          On exit, B is overwritten with the difference B - A*X.
110*> \endverbatim
111*>
112*> \param[in] LDB
113*> \verbatim
114*>          LDB is INTEGER
115*>          The leading dimension of the array B.  IF TRANS = 'N',
116*>          LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N).
117*> \endverbatim
118*>
119*> \param[out] RESID
120*> \verbatim
121*>          RESID is REAL
122*>          The maximum over the number of right hand sides of
123*>          norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
124*> \endverbatim
125*
126*  Authors:
127*  ========
128*
129*> \author Univ. of Tennessee
130*> \author Univ. of California Berkeley
131*> \author Univ. of Colorado Denver
132*> \author NAG Ltd.
133*
134*> \date November 2011
135*
136*> \ingroup complex_lin
137*
138*  =====================================================================
139      SUBROUTINE CGBT02( TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B,
140     $                   LDB, RESID )
141*
142*  -- LAPACK test routine (version 3.4.0) --
143*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
144*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
145*     November 2011
146*
147*     .. Scalar Arguments ..
148      CHARACTER          TRANS
149      INTEGER            KL, KU, LDA, LDB, LDX, M, N, NRHS
150      REAL               RESID
151*     ..
152*     .. Array Arguments ..
153      COMPLEX            A( LDA, * ), B( LDB, * ), X( LDX, * )
154*     ..
155*
156*  =====================================================================
157*
158*     .. Parameters ..
159      REAL               ZERO, ONE
160      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
161      COMPLEX            CONE
162      PARAMETER          ( CONE = ( 1.0E+0, 0.0E+0 ) )
163*     ..
164*     .. Local Scalars ..
165      INTEGER            I1, I2, J, KD, N1
166      REAL               ANORM, BNORM, EPS, XNORM
167*     ..
168*     .. External Functions ..
169      LOGICAL            LSAME
170      REAL               SCASUM, SLAMCH
171      EXTERNAL           LSAME, SCASUM, SLAMCH
172*     ..
173*     .. External Subroutines ..
174      EXTERNAL           CGBMV
175*     ..
176*     .. Intrinsic Functions ..
177      INTRINSIC          MAX, MIN
178*     ..
179*     .. Executable Statements ..
180*
181*     Quick return if N = 0 pr NRHS = 0
182*
183      IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.LE.0 ) THEN
184         RESID = ZERO
185         RETURN
186      END IF
187*
188*     Exit with RESID = 1/EPS if ANORM = 0.
189*
190      EPS = SLAMCH( 'Epsilon' )
191      KD = KU + 1
192      ANORM = ZERO
193      DO 10 J = 1, N
194         I1 = MAX( KD+1-J, 1 )
195         I2 = MIN( KD+M-J, KL+KD )
196         ANORM = MAX( ANORM, SCASUM( I2-I1+1, A( I1, J ), 1 ) )
197   10 CONTINUE
198      IF( ANORM.LE.ZERO ) THEN
199         RESID = ONE / EPS
200         RETURN
201      END IF
202*
203      IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN
204         N1 = N
205      ELSE
206         N1 = M
207      END IF
208*
209*     Compute  B - A*X (or  B - A'*X )
210*
211      DO 20 J = 1, NRHS
212         CALL CGBMV( TRANS, M, N, KL, KU, -CONE, A, LDA, X( 1, J ), 1,
213     $               CONE, B( 1, J ), 1 )
214   20 CONTINUE
215*
216*     Compute the maximum over the number of right hand sides of
217*        norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
218*
219      RESID = ZERO
220      DO 30 J = 1, NRHS
221         BNORM = SCASUM( N1, B( 1, J ), 1 )
222         XNORM = SCASUM( N1, X( 1, J ), 1 )
223         IF( XNORM.LE.ZERO ) THEN
224            RESID = ONE / EPS
225         ELSE
226            RESID = MAX( RESID, ( ( BNORM/ANORM )/XNORM )/EPS )
227         END IF
228   30 CONTINUE
229*
230      RETURN
231*
232*     End of CGBT02
233*
234      END
235