LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sget07.f
Go to the documentation of this file.
1*> \brief \b SGET07
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 SGET07( 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 A( LDA, * ), B( LDB, * ), BERR( * ), FERR( * ),
21* $ RESLTS( * ), X( LDX, * ), XACT( LDXACT, * )
22* ..
23*
24*
25*> \par Purpose:
26* =============
27*>
28*> \verbatim
29*>
30*> SGET07 tests the error bounds from iterative refinement for the
31*> computed solution to a system of equations op(A)*X = B, where A is a
32*> general n by n matrix and op(A) = A or A**T, depending on TRANS.
33*>
34*> RESLTS(1) = test of the error bound
35*> = norm(X - XACT) / ( norm(X) * FERR )
36*>
37*> A large value is returned if this ratio is not less than one.
38*>
39*> RESLTS(2) = residual from the iterative refinement routine
40*> = the maximum of BERR / ( (n+1)*EPS + (*) ), where
41*> (*) = (n+1)*UNFL / (min_i (abs(op(A))*abs(X) +abs(b))_i )
42*> \endverbatim
43*
44* Arguments:
45* ==========
46*
47*> \param[in] TRANS
48*> \verbatim
49*> TRANS is CHARACTER*1
50*> Specifies the form of the system of equations.
51*> = 'N': A * X = B (No transpose)
52*> = 'T': A**T * X = B (Transpose)
53*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
54*> \endverbatim
55*>
56*> \param[in] N
57*> \verbatim
58*> N is INTEGER
59*> The number of rows of the matrices X and XACT. N >= 0.
60*> \endverbatim
61*>
62*> \param[in] NRHS
63*> \verbatim
64*> NRHS is INTEGER
65*> The number of columns of the matrices X and XACT. NRHS >= 0.
66*> \endverbatim
67*>
68*> \param[in] A
69*> \verbatim
70*> A is REAL array, dimension (LDA,N)
71*> The original n by n matrix A.
72*> \endverbatim
73*>
74*> \param[in] LDA
75*> \verbatim
76*> LDA is INTEGER
77*> The leading dimension of the array A. LDA >= max(1,N).
78*> \endverbatim
79*>
80*> \param[in] B
81*> \verbatim
82*> B is REAL array, dimension (LDB,NRHS)
83*> The right hand side vectors for the system of linear
84*> equations.
85*> \endverbatim
86*>
87*> \param[in] LDB
88*> \verbatim
89*> LDB is INTEGER
90*> The leading dimension of the array B. LDB >= max(1,N).
91*> \endverbatim
92*>
93*> \param[in] X
94*> \verbatim
95*> X is REAL array, dimension (LDX,NRHS)
96*> The computed solution vectors. Each vector is stored as a
97*> column of the matrix X.
98*> \endverbatim
99*>
100*> \param[in] LDX
101*> \verbatim
102*> LDX is INTEGER
103*> The leading dimension of the array X. LDX >= max(1,N).
104*> \endverbatim
105*>
106*> \param[in] XACT
107*> \verbatim
108*> XACT is REAL array, dimension (LDX,NRHS)
109*> The exact solution vectors. Each vector is stored as a
110*> column of the matrix XACT.
111*> \endverbatim
112*>
113*> \param[in] LDXACT
114*> \verbatim
115*> LDXACT is INTEGER
116*> The leading dimension of the array XACT. LDXACT >= max(1,N).
117*> \endverbatim
118*>
119*> \param[in] FERR
120*> \verbatim
121*> FERR is REAL array, dimension (NRHS)
122*> The estimated forward error bounds for each solution vector
123*> X. If XTRUE is the true solution, FERR bounds the magnitude
124*> of the largest entry in (X - XTRUE) divided by the magnitude
125*> of the largest entry in X.
126*> \endverbatim
127*>
128*> \param[in] CHKFERR
129*> \verbatim
130*> CHKFERR is LOGICAL
131*> Set to .TRUE. to check FERR, .FALSE. not to check FERR.
132*> When the test system is ill-conditioned, the "true"
133*> solution in XACT may be incorrect.
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 / ( (n+1)*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 single_lin
161*
162* =====================================================================
163 SUBROUTINE sget07( TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT,
164 $ LDXACT, FERR, CHKFERR, 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 LOGICAL CHKFERR
173 INTEGER LDA, LDB, LDX, LDXACT, N, NRHS
174* ..
175* .. Array Arguments ..
176 REAL A( LDA, * ), B( LDB, * ), BERR( * ), FERR( * ),
177 $ reslts( * ), 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
189 REAL AXBI, DIFF, EPS, ERRBND, OVFL, TMP, UNFL, XNORM
190* ..
191* .. External Functions ..
192 LOGICAL LSAME
193 INTEGER ISAMAX
194 REAL SLAMCH
195 EXTERNAL lsame, isamax, slamch
196* ..
197* .. Intrinsic Functions ..
198 INTRINSIC abs, max, min
199* ..
200* .. Executable Statements ..
201*
202* Quick exit if N = 0 or NRHS = 0.
203*
204 IF( n.LE.0 .OR. nrhs.LE.0 ) THEN
205 reslts( 1 ) = zero
206 reslts( 2 ) = zero
207 RETURN
208 END IF
209*
210 eps = slamch( 'Epsilon' )
211 unfl = slamch( 'Safe minimum' )
212 ovfl = one / unfl
213 notran = lsame( trans, 'N' )
214*
215* Test 1: Compute the maximum of
216* norm(X - XACT) / ( norm(X) * FERR )
217* over all the vectors X and XACT using the infinity-norm.
218*
219 errbnd = zero
220 IF( chkferr ) THEN
221 DO 30 j = 1, nrhs
222 imax = isamax( n, x( 1, j ), 1 )
223 xnorm = max( abs( x( imax, j ) ), unfl )
224 diff = zero
225 DO 10 i = 1, n
226 diff = max( diff, abs( x( i, j )-xact( i, j ) ) )
227 10 CONTINUE
228*
229 IF( xnorm.GT.one ) THEN
230 GO TO 20
231 ELSE IF( diff.LE.ovfl*xnorm ) THEN
232 GO TO 20
233 ELSE
234 errbnd = one / eps
235 GO TO 30
236 END IF
237*
238 20 CONTINUE
239 IF( diff / xnorm.LE.ferr( j ) ) THEN
240 errbnd = max( errbnd, ( diff / xnorm ) / ferr( j ) )
241 ELSE
242 errbnd = one / eps
243 END IF
244 30 CONTINUE
245 END IF
246 reslts( 1 ) = errbnd
247*
248* Test 2: Compute the maximum of BERR / ( (n+1)*EPS + (*) ), where
249* (*) = (n+1)*UNFL / (min_i (abs(op(A))*abs(X) +abs(b))_i )
250*
251 DO 70 k = 1, nrhs
252 DO 60 i = 1, n
253 tmp = abs( b( i, k ) )
254 IF( notran ) THEN
255 DO 40 j = 1, n
256 tmp = tmp + abs( a( i, j ) )*abs( x( j, k ) )
257 40 CONTINUE
258 ELSE
259 DO 50 j = 1, n
260 tmp = tmp + abs( a( j, i ) )*abs( x( j, k ) )
261 50 CONTINUE
262 END IF
263 IF( i.EQ.1 ) THEN
264 axbi = tmp
265 ELSE
266 axbi = min( axbi, tmp )
267 END IF
268 60 CONTINUE
269 tmp = berr( k ) / ( ( n+1 )*eps+( n+1 )*unfl /
270 $ max( axbi, ( n+1 )*unfl ) )
271 IF( k.EQ.1 ) THEN
272 reslts( 2 ) = tmp
273 ELSE
274 reslts( 2 ) = max( reslts( 2 ), tmp )
275 END IF
276 70 CONTINUE
277*
278 RETURN
279*
280* End of SGET07
281*
282 END
subroutine sget07(trans, n, nrhs, a, lda, b, ldb, x, ldx, xact, ldxact, ferr, chkferr, berr, reslts)
SGET07
Definition sget07.f:165