LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
ctbt03.f
Go to the documentation of this file.
1*> \brief \b CTBT03
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 CTBT03( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB,
12* SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK,
13* RESID )
14*
15* .. Scalar Arguments ..
16* CHARACTER DIAG, TRANS, UPLO
17* INTEGER KD, LDAB, LDB, LDX, N, NRHS
18* REAL RESID, SCALE, TSCAL
19* ..
20* .. Array Arguments ..
21* REAL CNORM( * )
22* COMPLEX AB( LDAB, * ), B( LDB, * ), WORK( * ),
23* $ X( LDX, * )
24* ..
25*
26*
27*> \par Purpose:
28* =============
29*>
30*> \verbatim
31*>
32*> CTBT03 computes the residual for the solution to a scaled triangular
33*> system of equations A*x = s*b, A**T *x = s*b, or A**H *x = s*b
34*> when A is a triangular band matrix. Here A**T denotes the transpose
35*> of A, A**H denotes the conjugate transpose of A, s is a scalar, and
36*> x and b are N by NRHS matrices. The test ratio is the maximum over
37*> the number of right hand sides of
38*> norm(s*b - op(A)*x) / ( norm(op(A)) * norm(x) * EPS ),
39*> where op(A) denotes A, A**T, or A**H, and EPS is the machine epsilon.
40*> \endverbatim
41*
42* Arguments:
43* ==========
44*
45*> \param[in] UPLO
46*> \verbatim
47*> UPLO is CHARACTER*1
48*> Specifies whether the matrix A is upper or lower triangular.
49*> = 'U': Upper triangular
50*> = 'L': Lower triangular
51*> \endverbatim
52*>
53*> \param[in] TRANS
54*> \verbatim
55*> TRANS is CHARACTER*1
56*> Specifies the operation applied to A.
57*> = 'N': A *x = s*b (No transpose)
58*> = 'T': A**T *x = s*b (Transpose)
59*> = 'C': A**H *x = s*b (Conjugate transpose)
60*> \endverbatim
61*>
62*> \param[in] DIAG
63*> \verbatim
64*> DIAG is CHARACTER*1
65*> Specifies whether or not the matrix A is unit triangular.
66*> = 'N': Non-unit triangular
67*> = 'U': Unit triangular
68*> \endverbatim
69*>
70*> \param[in] N
71*> \verbatim
72*> N is INTEGER
73*> The order of the matrix A. N >= 0.
74*> \endverbatim
75*>
76*> \param[in] KD
77*> \verbatim
78*> KD is INTEGER
79*> The number of superdiagonals or subdiagonals of the
80*> triangular band matrix A. KD >= 0.
81*> \endverbatim
82*>
83*> \param[in] NRHS
84*> \verbatim
85*> NRHS is INTEGER
86*> The number of right hand sides, i.e., the number of columns
87*> of the matrices X and B. NRHS >= 0.
88*> \endverbatim
89*>
90*> \param[in] AB
91*> \verbatim
92*> AB is COMPLEX array, dimension (LDAB,N)
93*> The upper or lower triangular band matrix A, stored in the
94*> first kd+1 rows of the array. The j-th column of A is stored
95*> in the j-th column of the array AB as follows:
96*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
97*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
98*> \endverbatim
99*>
100*> \param[in] LDAB
101*> \verbatim
102*> LDAB is INTEGER
103*> The leading dimension of the array AB. LDAB >= KD+1.
104*> \endverbatim
105*>
106*> \param[in] SCALE
107*> \verbatim
108*> SCALE is REAL
109*> The scaling factor s used in solving the triangular system.
110*> \endverbatim
111*>
112*> \param[in] CNORM
113*> \verbatim
114*> CNORM is REAL array, dimension (N)
115*> The 1-norms of the columns of A, not counting the diagonal.
116*> \endverbatim
117*>
118*> \param[in] TSCAL
119*> \verbatim
120*> TSCAL is REAL
121*> The scaling factor used in computing the 1-norms in CNORM.
122*> CNORM actually contains the column norms of TSCAL*A.
123*> \endverbatim
124*>
125*> \param[in] X
126*> \verbatim
127*> X is COMPLEX array, dimension (LDX,NRHS)
128*> The computed solution vectors for the system of linear
129*> equations.
130*> \endverbatim
131*>
132*> \param[in] LDX
133*> \verbatim
134*> LDX is INTEGER
135*> The leading dimension of the array X. LDX >= max(1,N).
136*> \endverbatim
137*>
138*> \param[in] B
139*> \verbatim
140*> B is COMPLEX array, dimension (LDB,NRHS)
141*> The right hand side vectors for the system of linear
142*> equations.
143*> \endverbatim
144*>
145*> \param[in] LDB
146*> \verbatim
147*> LDB is INTEGER
148*> The leading dimension of the array B. LDB >= max(1,N).
149*> \endverbatim
150*>
151*> \param[out] WORK
152*> \verbatim
153*> WORK is COMPLEX array, dimension (N)
154*> \endverbatim
155*>
156*> \param[out] RESID
157*> \verbatim
158*> RESID is REAL
159*> The maximum over the number of right hand sides of
160*> norm(op(A)*x - s*b) / ( norm(op(A)) * norm(x) * EPS ).
161*> \endverbatim
162*
163* Authors:
164* ========
165*
166*> \author Univ. of Tennessee
167*> \author Univ. of California Berkeley
168*> \author Univ. of Colorado Denver
169*> \author NAG Ltd.
170*
171*> \ingroup complex_lin
172*
173* =====================================================================
174 SUBROUTINE ctbt03( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB,
175 $ SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK,
176 $ RESID )
177*
178* -- LAPACK test routine --
179* -- LAPACK is a software package provided by Univ. of Tennessee, --
180* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
181*
182* .. Scalar Arguments ..
183 CHARACTER DIAG, TRANS, UPLO
184 INTEGER KD, LDAB, LDB, LDX, N, NRHS
185 REAL RESID, SCALE, TSCAL
186* ..
187* .. Array Arguments ..
188 REAL CNORM( * )
189 COMPLEX AB( LDAB, * ), B( LDB, * ), WORK( * ),
190 $ x( ldx, * )
191* ..
192*
193* =====================================================================
194*
195*
196* .. Parameters ..
197 REAL ONE, ZERO
198 PARAMETER ( ONE = 1.0e+0, zero = 0.0e+0 )
199* ..
200* .. Local Scalars ..
201 INTEGER IX, J
202 REAL EPS, ERR, SMLNUM, TNORM, XNORM, XSCAL
203* ..
204* .. External Functions ..
205 LOGICAL LSAME
206 INTEGER ICAMAX
207 REAL SLAMCH
208 EXTERNAL lsame, icamax, slamch
209* ..
210* .. External Subroutines ..
211 EXTERNAL caxpy, ccopy, csscal, ctbmv
212* ..
213* .. Intrinsic Functions ..
214 INTRINSIC abs, cmplx, max, real
215* ..
216* .. Executable Statements ..
217*
218* Quick exit if N = 0
219*
220 IF( n.LE.0 .OR. nrhs.LE.0 ) THEN
221 resid = zero
222 RETURN
223 END IF
224 eps = slamch( 'Epsilon' )
225 smlnum = slamch( 'Safe minimum' )
226*
227* Compute the norm of the triangular matrix A using the column
228* norms already computed by CLATBS.
229*
230 tnorm = zero
231 IF( lsame( diag, 'N' ) ) THEN
232 IF( lsame( uplo, 'U' ) ) THEN
233 DO 10 j = 1, n
234 tnorm = max( tnorm, tscal*abs( ab( kd+1, j ) )+
235 $ cnorm( j ) )
236 10 CONTINUE
237 ELSE
238 DO 20 j = 1, n
239 tnorm = max( tnorm, tscal*abs( ab( 1, j ) )+cnorm( j ) )
240 20 CONTINUE
241 END IF
242 ELSE
243 DO 30 j = 1, n
244 tnorm = max( tnorm, tscal+cnorm( j ) )
245 30 CONTINUE
246 END IF
247*
248* Compute the maximum over the number of right hand sides of
249* norm(op(A)*x - s*b) / ( norm(op(A)) * norm(x) * EPS ).
250*
251 resid = zero
252 DO 40 j = 1, nrhs
253 CALL ccopy( n, x( 1, j ), 1, work, 1 )
254 ix = icamax( n, work, 1 )
255 xnorm = max( one, abs( x( ix, j ) ) )
256 xscal = ( one / xnorm ) / real( kd+1 )
257 CALL csscal( n, xscal, work, 1 )
258 CALL ctbmv( uplo, trans, diag, n, kd, ab, ldab, work, 1 )
259 CALL caxpy( n, cmplx( -scale*xscal ), b( 1, j ), 1, work, 1 )
260 ix = icamax( n, work, 1 )
261 err = tscal*abs( work( ix ) )
262 ix = icamax( n, x( 1, j ), 1 )
263 xnorm = abs( x( ix, j ) )
264 IF( err*smlnum.LE.xnorm ) THEN
265 IF( xnorm.GT.zero )
266 $ err = err / xnorm
267 ELSE
268 IF( err.GT.zero )
269 $ err = one / eps
270 END IF
271 IF( err*smlnum.LE.tnorm ) THEN
272 IF( tnorm.GT.zero )
273 $ err = err / tnorm
274 ELSE
275 IF( err.GT.zero )
276 $ err = one / eps
277 END IF
278 resid = max( resid, err )
279 40 CONTINUE
280*
281 RETURN
282*
283* End of CTBT03
284*
285 END
subroutine ctbt03(uplo, trans, diag, n, kd, nrhs, ab, ldab, scale, cnorm, tscal, x, ldx, b, ldb, work, resid)
CTBT03
Definition ctbt03.f:177
subroutine caxpy(n, ca, cx, incx, cy, incy)
CAXPY
Definition caxpy.f:88
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
Definition ccopy.f:81
subroutine csscal(n, sa, cx, incx)
CSSCAL
Definition csscal.f:78
subroutine ctbmv(uplo, trans, diag, n, k, a, lda, x, incx)
CTBMV
Definition ctbmv.f:186