LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cgtt05.f
Go to the documentation of this file.
1*> \brief \b CGTT05
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 CGTT05( TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX,
12* XACT, LDXACT, FERR, BERR, RESLTS )
13*
14* .. Scalar Arguments ..
15* CHARACTER TRANS
16* INTEGER LDB, LDX, LDXACT, N, NRHS
17* ..
18* .. Array Arguments ..
19* REAL BERR( * ), FERR( * ), RESLTS( * )
20* COMPLEX B( LDB, * ), D( * ), DL( * ), DU( * ),
21* $ X( LDX, * ), XACT( LDXACT, * )
22* ..
23*
24*
25*> \par Purpose:
26* =============
27*>
28*> \verbatim
29*>
30*> CGTT05 tests the error bounds from iterative refinement for the
31*> computed solution to a system of equations A*X = B, where A is a
32*> general tridiagonal matrix of order n and op(A) = A or A**T,
33*> depending on TRANS.
34*>
35*> RESLTS(1) = test of the error bound
36*> = norm(X - XACT) / ( norm(X) * FERR )
37*>
38*> A large value is returned if this ratio is not less than one.
39*>
40*> RESLTS(2) = residual from the iterative refinement routine
41*> = the maximum of BERR / ( NZ*EPS + (*) ), where
42*> (*) = NZ*UNFL / (min_i (abs(op(A))*abs(X) +abs(b))_i )
43*> and NZ = max. number of nonzeros in any row of A, plus 1
44*> \endverbatim
45*
46* Arguments:
47* ==========
48*
49*> \param[in] TRANS
50*> \verbatim
51*> TRANS is CHARACTER*1
52*> Specifies the form of the system of equations.
53*> = 'N': A * X = B (No transpose)
54*> = 'T': A**T * X = B (Transpose)
55*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
56*> \endverbatim
57*>
58*> \param[in] N
59*> \verbatim
60*> N is INTEGER
61*> The number of rows of the matrices X and XACT. N >= 0.
62*> \endverbatim
63*>
64*> \param[in] NRHS
65*> \verbatim
66*> NRHS is INTEGER
67*> The number of columns of the matrices X and XACT. NRHS >= 0.
68*> \endverbatim
69*>
70*> \param[in] DL
71*> \verbatim
72*> DL is COMPLEX array, dimension (N-1)
73*> The (n-1) sub-diagonal elements of A.
74*> \endverbatim
75*>
76*> \param[in] D
77*> \verbatim
78*> D is COMPLEX array, dimension (N)
79*> The diagonal elements of A.
80*> \endverbatim
81*>
82*> \param[in] DU
83*> \verbatim
84*> DU is COMPLEX array, dimension (N-1)
85*> The (n-1) super-diagonal elements of A.
86*> \endverbatim
87*>
88*> \param[in] B
89*> \verbatim
90*> B is COMPLEX array, dimension (LDB,NRHS)
91*> The right hand side vectors for the system of linear
92*> equations.
93*> \endverbatim
94*>
95*> \param[in] LDB
96*> \verbatim
97*> LDB is INTEGER
98*> The leading dimension of the array B. LDB >= max(1,N).
99*> \endverbatim
100*>
101*> \param[in] X
102*> \verbatim
103*> X is COMPLEX array, dimension (LDX,NRHS)
104*> The computed solution vectors. Each vector is stored as a
105*> column of the matrix X.
106*> \endverbatim
107*>
108*> \param[in] LDX
109*> \verbatim
110*> LDX is INTEGER
111*> The leading dimension of the array X. LDX >= max(1,N).
112*> \endverbatim
113*>
114*> \param[in] XACT
115*> \verbatim
116*> XACT is COMPLEX array, dimension (LDX,NRHS)
117*> The exact solution vectors. Each vector is stored as a
118*> column of the matrix XACT.
119*> \endverbatim
120*>
121*> \param[in] LDXACT
122*> \verbatim
123*> LDXACT is INTEGER
124*> The leading dimension of the array XACT. LDXACT >= max(1,N).
125*> \endverbatim
126*>
127*> \param[in] FERR
128*> \verbatim
129*> FERR is REAL array, dimension (NRHS)
130*> The estimated forward error bounds for each solution vector
131*> X. If XTRUE is the true solution, FERR bounds the magnitude
132*> of the largest entry in (X - XTRUE) divided by the magnitude
133*> of the largest entry in X.
134*> \endverbatim
135*>
136*> \param[in] BERR
137*> \verbatim
138*> BERR is REAL array, dimension (NRHS)
139*> The componentwise relative backward error of each solution
140*> vector (i.e., the smallest relative change in any entry of A
141*> or B that makes X an exact solution).
142*> \endverbatim
143*>
144*> \param[out] RESLTS
145*> \verbatim
146*> RESLTS is REAL array, dimension (2)
147*> The maximum over the NRHS solution vectors of the ratios:
148*> RESLTS(1) = norm(X - XACT) / ( norm(X) * FERR )
149*> RESLTS(2) = BERR / ( NZ*EPS + (*) )
150*> \endverbatim
151*
152* Authors:
153* ========
154*
155*> \author Univ. of Tennessee
156*> \author Univ. of California Berkeley
157*> \author Univ. of Colorado Denver
158*> \author NAG Ltd.
159*
160*> \ingroup complex_lin
161*
162* =====================================================================
163 SUBROUTINE cgtt05( TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX,
164 $ XACT, LDXACT, FERR, BERR, RESLTS )
165*
166* -- LAPACK test routine --
167* -- LAPACK is a software package provided by Univ. of Tennessee, --
168* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
169*
170* .. Scalar Arguments ..
171 CHARACTER TRANS
172 INTEGER LDB, LDX, LDXACT, N, NRHS
173* ..
174* .. Array Arguments ..
175 REAL BERR( * ), FERR( * ), RESLTS( * )
176 COMPLEX B( LDB, * ), D( * ), DL( * ), DU( * ),
177 $ x( ldx, * ), xact( ldxact, * )
178* ..
179*
180* =====================================================================
181*
182* .. Parameters ..
183 REAL ZERO, ONE
184 parameter( zero = 0.0e+0, one = 1.0e+0 )
185* ..
186* .. Local Scalars ..
187 LOGICAL NOTRAN
188 INTEGER I, IMAX, J, K, NZ
189 REAL AXBI, DIFF, EPS, ERRBND, OVFL, TMP, UNFL, XNORM
190 COMPLEX ZDUM
191* ..
192* .. External Functions ..
193 LOGICAL LSAME
194 INTEGER ICAMAX
195 REAL SLAMCH
196 EXTERNAL lsame, icamax, slamch
197* ..
198* .. Intrinsic Functions ..
199 INTRINSIC abs, aimag, max, min, real
200* ..
201* .. Statement Functions ..
202 REAL CABS1
203* ..
204* .. Statement Function definitions ..
205 cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
206* ..
207* .. Executable Statements ..
208*
209* Quick exit if N = 0 or NRHS = 0.
210*
211 IF( n.LE.0 .OR. nrhs.LE.0 ) THEN
212 reslts( 1 ) = zero
213 reslts( 2 ) = zero
214 RETURN
215 END IF
216*
217 eps = slamch( 'Epsilon' )
218 unfl = slamch( 'Safe minimum' )
219 ovfl = one / unfl
220 notran = lsame( trans, 'N' )
221 nz = 4
222*
223* Test 1: Compute the maximum of
224* norm(X - XACT) / ( norm(X) * FERR )
225* over all the vectors X and XACT using the infinity-norm.
226*
227 errbnd = zero
228 DO 30 j = 1, nrhs
229 imax = icamax( n, x( 1, j ), 1 )
230 xnorm = max( cabs1( x( imax, j ) ), unfl )
231 diff = zero
232 DO 10 i = 1, n
233 diff = max( diff, cabs1( x( i, j )-xact( i, j ) ) )
234 10 CONTINUE
235*
236 IF( xnorm.GT.one ) THEN
237 GO TO 20
238 ELSE IF( diff.LE.ovfl*xnorm ) THEN
239 GO TO 20
240 ELSE
241 errbnd = one / eps
242 GO TO 30
243 END IF
244*
245 20 CONTINUE
246 IF( diff / xnorm.LE.ferr( j ) ) THEN
247 errbnd = max( errbnd, ( diff / xnorm ) / ferr( j ) )
248 ELSE
249 errbnd = one / eps
250 END IF
251 30 CONTINUE
252 reslts( 1 ) = errbnd
253*
254* Test 2: Compute the maximum of BERR / ( NZ*EPS + (*) ), where
255* (*) = NZ*UNFL / (min_i (abs(op(A))*abs(X) +abs(b))_i )
256*
257 DO 60 k = 1, nrhs
258 IF( notran ) THEN
259 IF( n.EQ.1 ) THEN
260 axbi = cabs1( b( 1, k ) ) +
261 $ cabs1( d( 1 ) )*cabs1( x( 1, k ) )
262 ELSE
263 axbi = cabs1( b( 1, k ) ) +
264 $ cabs1( d( 1 ) )*cabs1( x( 1, k ) ) +
265 $ cabs1( du( 1 ) )*cabs1( x( 2, k ) )
266 DO 40 i = 2, n - 1
267 tmp = cabs1( b( i, k ) ) +
268 $ cabs1( dl( i-1 ) )*cabs1( x( i-1, k ) ) +
269 $ cabs1( d( i ) )*cabs1( x( i, k ) ) +
270 $ cabs1( du( i ) )*cabs1( x( i+1, k ) )
271 axbi = min( axbi, tmp )
272 40 CONTINUE
273 tmp = cabs1( b( n, k ) ) + cabs1( dl( n-1 ) )*
274 $ cabs1( x( n-1, k ) ) + cabs1( d( n ) )*
275 $ cabs1( x( n, k ) )
276 axbi = min( axbi, tmp )
277 END IF
278 ELSE
279 IF( n.EQ.1 ) THEN
280 axbi = cabs1( b( 1, k ) ) +
281 $ cabs1( d( 1 ) )*cabs1( x( 1, k ) )
282 ELSE
283 axbi = cabs1( b( 1, k ) ) +
284 $ cabs1( d( 1 ) )*cabs1( x( 1, k ) ) +
285 $ cabs1( dl( 1 ) )*cabs1( x( 2, k ) )
286 DO 50 i = 2, n - 1
287 tmp = cabs1( b( i, k ) ) +
288 $ cabs1( du( i-1 ) )*cabs1( x( i-1, k ) ) +
289 $ cabs1( d( i ) )*cabs1( x( i, k ) ) +
290 $ cabs1( dl( i ) )*cabs1( x( i+1, k ) )
291 axbi = min( axbi, tmp )
292 50 CONTINUE
293 tmp = cabs1( b( n, k ) ) + cabs1( du( n-1 ) )*
294 $ cabs1( x( n-1, k ) ) + cabs1( d( n ) )*
295 $ cabs1( x( n, k ) )
296 axbi = min( axbi, tmp )
297 END IF
298 END IF
299 tmp = berr( k ) / ( nz*eps+nz*unfl / max( axbi, nz*unfl ) )
300 IF( k.EQ.1 ) THEN
301 reslts( 2 ) = tmp
302 ELSE
303 reslts( 2 ) = max( reslts( 2 ), tmp )
304 END IF
305 60 CONTINUE
306*
307 RETURN
308*
309* End of CGTT05
310*
311 END
subroutine cgtt05(trans, n, nrhs, dl, d, du, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
CGTT05
Definition cgtt05.f:165