LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches
cpbt02.f
Go to the documentation of this file.
1*> \brief \b CPBT02
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 CPBT02( UPLO, N, KD, NRHS, A, LDA, X, LDX, B, LDB,
12* RWORK, RESID )
13*
14* .. Scalar Arguments ..
15* CHARACTER UPLO
16* INTEGER KD, LDA, LDB, LDX, N, NRHS
17* REAL RESID
18* ..
19* .. Array Arguments ..
20* REAL RWORK( * )
21* COMPLEX A( LDA, * ), B( LDB, * ), X( LDX, * )
22* ..
23*
24*
25*> \par Purpose:
26* =============
27*>
28*> \verbatim
29*>
30*> CPBT02 computes the residual for a solution of a Hermitian banded
31*> system of equations A*x = b:
32*> RESID = norm( B - A*X ) / ( norm(A) * norm(X) * EPS)
33*> where EPS is the machine precision.
34*> \endverbatim
35*
36* Arguments:
37* ==========
38*
39*> \param[in] UPLO
40*> \verbatim
41*> UPLO is CHARACTER*1
42*> Specifies whether the upper or lower triangular part of the
43*> Hermitian matrix A is stored:
44*> = 'U': Upper triangular
45*> = 'L': Lower triangular
46*> \endverbatim
47*>
48*> \param[in] N
49*> \verbatim
50*> N is INTEGER
51*> The number of rows and columns of the matrix A. N >= 0.
52*> \endverbatim
53*>
54*> \param[in] KD
55*> \verbatim
56*> KD is INTEGER
57*> The number of super-diagonals of the matrix A if UPLO = 'U',
58*> or the number of sub-diagonals if UPLO = 'L'. KD >= 0.
59*> \endverbatim
60*>
61*> \param[in] NRHS
62*> \verbatim
63*> NRHS is INTEGER
64*> The number of right hand sides. NRHS >= 0.
65*> \endverbatim
66*>
67*> \param[in] A
68*> \verbatim
69*> A is COMPLEX array, dimension (LDA,N)
70*> The original Hermitian band matrix A. If UPLO = 'U', the
71*> upper triangular part of A is stored as a band matrix; if
72*> UPLO = 'L', the lower triangular part of A is stored. The
73*> columns of the appropriate triangle are stored in the columns
74*> of A and the diagonals of the triangle are stored in the rows
75*> of A. See CPBTRF for further details.
76*> \endverbatim
77*>
78*> \param[in] LDA
79*> \verbatim
80*> LDA is INTEGER.
81*> The leading dimension of the array A. LDA >= max(1,KD+1).
82*> \endverbatim
83*>
84*> \param[in] X
85*> \verbatim
86*> X is COMPLEX array, dimension (LDX,NRHS)
87*> The computed solution vectors for the system of linear
88*> equations.
89*> \endverbatim
90*>
91*> \param[in] LDX
92*> \verbatim
93*> LDX is INTEGER
94*> The leading dimension of the array X. LDX >= max(1,N).
95*> \endverbatim
96*>
97*> \param[in,out] B
98*> \verbatim
99*> B is COMPLEX array, dimension (LDB,NRHS)
100*> On entry, the right hand side vectors for the system of
101*> linear equations.
102*> On exit, B is overwritten with the difference B - A*X.
103*> \endverbatim
104*>
105*> \param[in] LDB
106*> \verbatim
107*> LDB is INTEGER
108*> The leading dimension of the array B. LDB >= max(1,N).
109*> \endverbatim
110*>
111*> \param[out] RWORK
112*> \verbatim
113*> RWORK is REAL array, dimension (N)
114*> \endverbatim
115*>
116*> \param[out] RESID
117*> \verbatim
118*> RESID is REAL
119*> The maximum over the number of right hand sides of
120*> norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
121*> \endverbatim
122*
123* Authors:
124* ========
125*
126*> \author Univ. of Tennessee
127*> \author Univ. of California Berkeley
128*> \author Univ. of Colorado Denver
129*> \author NAG Ltd.
130*
131*> \ingroup complex_lin
132*
133* =====================================================================
134 SUBROUTINE cpbt02( UPLO, N, KD, NRHS, A, LDA, X, LDX, B, LDB,
135 \$ RWORK, RESID )
136*
137* -- LAPACK test routine --
138* -- LAPACK is a software package provided by Univ. of Tennessee, --
139* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
140*
141* .. Scalar Arguments ..
142 CHARACTER UPLO
143 INTEGER KD, LDA, LDB, LDX, N, NRHS
144 REAL RESID
145* ..
146* .. Array Arguments ..
147 REAL RWORK( * )
148 COMPLEX A( LDA, * ), B( LDB, * ), X( LDX, * )
149* ..
150*
151* =====================================================================
152*
153* .. Parameters ..
154 REAL ZERO, ONE
155 parameter( zero = 0.0e+0, one = 1.0e+0 )
156 COMPLEX CONE
157 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
158* ..
159* .. Local Scalars ..
160 INTEGER J
161 REAL ANORM, BNORM, EPS, XNORM
162* ..
163* .. External Functions ..
164 REAL CLANHB, SCASUM, SLAMCH
165 EXTERNAL clanhb, scasum, slamch
166* ..
167* .. External Subroutines ..
168 EXTERNAL chbmv
169* ..
170* .. Intrinsic Functions ..
171 INTRINSIC max
172* ..
173* .. Executable Statements ..
174*
175* Quick exit if N = 0 or NRHS = 0.
176*
177 IF( n.LE.0 .OR. nrhs.LE.0 ) THEN
178 resid = zero
179 RETURN
180 END IF
181*
182* Exit with RESID = 1/EPS if ANORM = 0.
183*
184 eps = slamch( 'Epsilon' )
185 anorm = clanhb( '1', uplo, n, kd, a, lda, rwork )
186 IF( anorm.LE.zero ) THEN
187 resid = one / eps
188 RETURN
189 END IF
190*
191* Compute B - A*X
192*
193 DO 10 j = 1, nrhs
194 CALL chbmv( uplo, n, kd, -cone, a, lda, x( 1, j ), 1, cone,
195 \$ b( 1, j ), 1 )
196 10 CONTINUE
197*
198* Compute the maximum over the number of right hand sides of
199* norm( B - A*X ) / ( norm(A) * norm(X) * EPS )
200*
201 resid = zero
202 DO 20 j = 1, nrhs
203 bnorm = scasum( n, b( 1, j ), 1 )
204 xnorm = scasum( n, x( 1, j ), 1 )
205 IF( xnorm.LE.zero ) THEN
206 resid = one / eps
207 ELSE
208 resid = max( resid, ( ( bnorm/anorm )/xnorm )/eps )
209 END IF
210 20 CONTINUE
211*
212 RETURN
213*
214* End of CPBT02
215*
216 END
subroutine cpbt02(uplo, n, kd, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
CPBT02
Definition cpbt02.f:136
subroutine chbmv(uplo, n, k, alpha, a, lda, x, incx, beta, y, incy)
CHBMV
Definition chbmv.f:187