LAPACK  3.4.2 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 *> \date November 2011
162 *
163 *> \ingroup complex_lin
164 *
165 * =====================================================================
166  SUBROUTINE cget07( TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT,
167  \$ ldxact, ferr, chkferr, berr, reslts )
168 *
169 * -- LAPACK test routine (version 3.4.0) --
170 * -- LAPACK is a software package provided by Univ. of Tennessee, --
171 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
172 * November 2011
173 *
174 * .. Scalar Arguments ..
175  CHARACTER trans
176  LOGICAL chkferr
177  INTEGER lda, ldb, ldx, ldxact, n, nrhs
178 * ..
179 * .. Array Arguments ..
180  REAL berr( * ), ferr( * ), reslts( * )
181  COMPLEX a( lda, * ), b( ldb, * ), x( ldx, * ),
182  \$ xact( ldxact, * )
183 * ..
184 *
185 * =====================================================================
186 *
187 * .. Parameters ..
188  REAL zero, one
189  parameter( zero = 0.0e+0, one = 1.0e+0 )
190 * ..
191 * .. Local Scalars ..
192  LOGICAL notran
193  INTEGER i, imax, j, k
194  REAL axbi, diff, eps, errbnd, ovfl, tmp, unfl, xnorm
195  COMPLEX zdum
196 * ..
197 * .. External Functions ..
198  LOGICAL lsame
199  INTEGER icamax
200  REAL slamch
201  EXTERNAL lsame, icamax, slamch
202 * ..
203 * .. Intrinsic Functions ..
204  INTRINSIC abs, aimag, max, min, real
205 * ..
206 * .. Statement Functions ..
207  REAL cabs1
208 * ..
209 * .. Statement Function definitions ..
210  cabs1( zdum ) = abs( REAL( ZDUM ) ) + abs( aimag( zdum ) )
211 * ..
212 * .. Executable Statements ..
213 *
214 * Quick exit if N = 0 or NRHS = 0.
215 *
216  IF( n.LE.0 .OR. nrhs.LE.0 ) THEN
217  reslts( 1 ) = zero
218  reslts( 2 ) = zero
219  return
220  END IF
221 *
222  eps = slamch( 'Epsilon' )
223  unfl = slamch( 'Safe minimum' )
224  ovfl = one / unfl
225  notran = lsame( trans, 'N' )
226 *
227 * Test 1: Compute the maximum of
228 * norm(X - XACT) / ( norm(X) * FERR )
229 * over all the vectors X and XACT using the infinity-norm.
230 *
231  errbnd = zero
232  IF( chkferr ) THEN
233  DO 30 j = 1, nrhs
234  imax = icamax( n, x( 1, j ), 1 )
235  xnorm = max( cabs1( x( imax, j ) ), unfl )
236  diff = zero
237  DO 10 i = 1, n
238  diff = max( diff, cabs1( x( i, j )-xact( i, j ) ) )
239  10 continue
240 *
241  IF( xnorm.GT.one ) THEN
242  go to 20
243  ELSE IF( diff.LE.ovfl*xnorm ) THEN
244  go to 20
245  ELSE
246  errbnd = one / eps
247  go to 30
248  END IF
249 *
250  20 continue
251  IF( diff / xnorm.LE.ferr( j ) ) THEN
252  errbnd = max( errbnd, ( diff / xnorm ) / ferr( j ) )
253  ELSE
254  errbnd = one / eps
255  END IF
256  30 continue
257  END IF
258  reslts( 1 ) = errbnd
259 *
260 * Test 2: Compute the maximum of BERR / ( (n+1)*EPS + (*) ), where
261 * (*) = (n+1)*UNFL / (min_i (abs(op(A))*abs(X) +abs(b))_i )
262 *
263  DO 70 k = 1, nrhs
264  DO 60 i = 1, n
265  tmp = cabs1( b( i, k ) )
266  IF( notran ) THEN
267  DO 40 j = 1, n
268  tmp = tmp + cabs1( a( i, j ) )*cabs1( x( j, k ) )
269  40 continue
270  ELSE
271  DO 50 j = 1, n
272  tmp = tmp + cabs1( a( j, i ) )*cabs1( x( j, k ) )
273  50 continue
274  END IF
275  IF( i.EQ.1 ) THEN
276  axbi = tmp
277  ELSE
278  axbi = min( axbi, tmp )
279  END IF
280  60 continue
281  tmp = berr( k ) / ( ( n+1 )*eps+( n+1 )*unfl /
282  \$ max( axbi, ( n+1 )*unfl ) )
283  IF( k.EQ.1 ) THEN
284  reslts( 2 ) = tmp
285  ELSE
286  reslts( 2 ) = max( reslts( 2 ), tmp )
287  END IF
288  70 continue
289 *
290  return
291 *
292 * End of CGET07
293 *
294  END