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