LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
dget07.f
Go to the documentation of this file.
1 *> \brief \b DGET07
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 DGET07( 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 * DOUBLE PRECISION A( LDA, * ), B( LDB, * ), BERR( * ), FERR( * ),
21 * $ RESLTS( * ), X( LDX, * ), XACT( LDXACT, * )
22 * ..
23 *
24 *
25 *> \par Purpose:
26 * =============
27 *>
28 *> \verbatim
29 *>
30 *> DGET07 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 double_lin
161 *
162 * =====================================================================
163  SUBROUTINE dget07( 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  DOUBLE PRECISION A( LDA, * ), B( LDB, * ), BERR( * ), FERR( * ),
177  $ reslts( * ), x( ldx, * ), xact( ldxact, * )
178 * ..
179 *
180 * =====================================================================
181 *
182 * .. Parameters ..
183  DOUBLE PRECISION ZERO, ONE
184  parameter( zero = 0.0d+0, one = 1.0d+0 )
185 * ..
186 * .. Local Scalars ..
187  LOGICAL NOTRAN
188  INTEGER I, IMAX, J, K
189  DOUBLE PRECISION AXBI, DIFF, EPS, ERRBND, OVFL, TMP, UNFL, XNORM
190 * ..
191 * .. External Functions ..
192  LOGICAL LSAME
193  INTEGER IDAMAX
194  DOUBLE PRECISION DLAMCH
195  EXTERNAL lsame, idamax, dlamch
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 = dlamch( 'Epsilon' )
211  unfl = dlamch( '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 = idamax( 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 DGET07
281 *
282  END
subroutine dget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
DGET07
Definition: dget07.f:165