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