LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
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