LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cpot05 ( character  UPLO,
integer  N,
integer  NRHS,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( ldb, * )  B,
integer  LDB,
complex, dimension( ldx, * )  X,
integer  LDX,
complex, dimension( ldxact, * )  XACT,
integer  LDXACT,
real, dimension( * )  FERR,
real, dimension( * )  BERR,
real, dimension( * )  RESLTS 
)

CPOT05

Purpose: 
 CPOT05 tests the error bounds from iterative refinement for the
 computed solution to a system of equations A*X = B, where A is a
 Hermitian n by n matrix.

 RESLTS(1) = test of the error bound
           = norm(X - XACT) / ( norm(X) * FERR )

 A large value is returned if this ratio is not less than one.

 RESLTS(2) = residual from the iterative refinement routine
           = the maximum of BERR / ( (n+1)*EPS + (*) ), where
             (*) = (n+1)*UNFL / (min_i (abs(A)*abs(X) +abs(b))_i )
Parameters
[in]UPLO
          UPLO is CHARACTER*1
          Specifies whether the upper or lower triangular part of the
          Hermitian matrix A is stored.
          = 'U':  Upper triangular
          = 'L':  Lower triangular
[in]N
          N is INTEGER
          The number of rows of the matrices X, B, and XACT, and the
          order of the matrix A.  N >= 0.
[in]NRHS
          NRHS is INTEGER
          The number of columns of the matrices X, B, and XACT.
          NRHS >= 0.
[in]A
          A is COMPLEX array, dimension (LDA,N)
          The Hermitian matrix A.  If UPLO = 'U', the leading n by n
          upper triangular part of A contains the upper triangular part
          of the matrix A, and the strictly lower triangular part of A
          is not referenced.  If UPLO = 'L', the leading n by n lower
          triangular part of A contains the lower triangular part of
          the matrix A, and the strictly upper triangular part of A is
          not referenced.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,N).
[in]B
          B is COMPLEX array, dimension (LDB,NRHS)
          The right hand side vectors for the system of linear
          equations.
[in]LDB
          LDB is INTEGER
          The leading dimension of the array B.  LDB >= max(1,N).
[in]X
          X is COMPLEX array, dimension (LDX,NRHS)
          The computed solution vectors.  Each vector is stored as a
          column of the matrix X.
[in]LDX
          LDX is INTEGER
          The leading dimension of the array X.  LDX >= max(1,N).
[in]XACT
          XACT is COMPLEX array, dimension (LDX,NRHS)
          The exact solution vectors.  Each vector is stored as a
          column of the matrix XACT.
[in]LDXACT
          LDXACT is INTEGER
          The leading dimension of the array XACT.  LDXACT >= max(1,N).
[in]FERR
          FERR is REAL array, dimension (NRHS)
          The estimated forward error bounds for each solution vector
          X.  If XTRUE is the true solution, FERR bounds the magnitude
          of the largest entry in (X - XTRUE) divided by the magnitude
          of the largest entry in X.
[in]BERR
          BERR is REAL array, dimension (NRHS)
          The componentwise relative backward error of each solution
          vector (i.e., the smallest relative change in any entry of A
          or B that makes X an exact solution).
[out]RESLTS
          RESLTS is REAL array, dimension (2)
          The maximum over the NRHS solution vectors of the ratios:
          RESLTS(1) = norm(X - XACT) / ( norm(X) * FERR )
          RESLTS(2) = BERR / ( (n+1)*EPS + (*) )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 167 of file cpot05.f.

167 *
168 * -- LAPACK test routine (version 3.4.0) --
169 * -- LAPACK is a software package provided by Univ. of Tennessee, --
170 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
171 * November 2011
172 *
173 * .. Scalar Arguments ..
174  CHARACTER uplo
175  INTEGER lda, ldb, ldx, ldxact, n, nrhs
176 * ..
177 * .. Array Arguments ..
178  REAL berr( * ), ferr( * ), reslts( * )
179  COMPLEX a( lda, * ), b( ldb, * ), x( ldx, * ),
180  $ xact( ldxact, * )
181 * ..
182 *
183 * =====================================================================
184 *
185 * .. Parameters ..
186  REAL zero, one
187  parameter ( zero = 0.0e+0, one = 1.0e+0 )
188 * ..
189 * .. Local Scalars ..
190  LOGICAL upper
191  INTEGER i, imax, j, k
192  REAL axbi, diff, eps, errbnd, ovfl, tmp, unfl, xnorm
193  COMPLEX zdum
194 * ..
195 * .. External Functions ..
196  LOGICAL lsame
197  INTEGER icamax
198  REAL slamch
199  EXTERNAL lsame, icamax, slamch
200 * ..
201 * .. Intrinsic Functions ..
202  INTRINSIC abs, aimag, max, min, real
203 * ..
204 * .. Statement Functions ..
205  REAL cabs1
206 * ..
207 * .. Statement Function definitions ..
208  cabs1( zdum ) = abs( REAL( ZDUM ) ) + abs( aimag( zdum ) )
209 * ..
210 * .. Executable Statements ..
211 *
212 * Quick exit if N = 0 or NRHS = 0.
213 *
214  IF( n.LE.0 .OR. nrhs.LE.0 ) THEN
215  reslts( 1 ) = zero
216  reslts( 2 ) = zero
217  RETURN
218  END IF
219 *
220  eps = slamch( 'Epsilon' )
221  unfl = slamch( 'Safe minimum' )
222  ovfl = one / unfl
223  upper = lsame( uplo, 'U' )
224 *
225 * Test 1: Compute the maximum of
226 * norm(X - XACT) / ( norm(X) * FERR )
227 * over all the vectors X and XACT using the infinity-norm.
228 *
229  errbnd = zero
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  reslts( 1 ) = errbnd
255 *
256 * Test 2: Compute the maximum of BERR / ( (n+1)*EPS + (*) ), where
257 * (*) = (n+1)*UNFL / (min_i (abs(A)*abs(X) +abs(b))_i )
258 *
259  DO 90 k = 1, nrhs
260  DO 80 i = 1, n
261  tmp = cabs1( b( i, k ) )
262  IF( upper ) THEN
263  DO 40 j = 1, i - 1
264  tmp = tmp + cabs1( a( j, i ) )*cabs1( x( j, k ) )
265  40 CONTINUE
266  tmp = tmp + abs( REAL( A( I, I ) ) )*cabs1( x( i, k ) )
267  DO 50 j = i + 1, n
268  tmp = tmp + cabs1( a( i, j ) )*cabs1( x( j, k ) )
269  50 CONTINUE
270  ELSE
271  DO 60 j = 1, i - 1
272  tmp = tmp + cabs1( a( i, j ) )*cabs1( x( j, k ) )
273  60 CONTINUE
274  tmp = tmp + abs( REAL( A( I, I ) ) )*cabs1( x( i, k ) )
275  DO 70 j = i + 1, n
276  tmp = tmp + cabs1( a( j, i ) )*cabs1( x( j, k ) )
277  70 CONTINUE
278  END IF
279  IF( i.EQ.1 ) THEN
280  axbi = tmp
281  ELSE
282  axbi = min( axbi, tmp )
283  END IF
284  80 CONTINUE
285  tmp = berr( k ) / ( ( n+1 )*eps+( n+1 )*unfl /
286  $ max( axbi, ( n+1 )*unfl ) )
287  IF( k.EQ.1 ) THEN
288  reslts( 2 ) = tmp
289  ELSE
290  reslts( 2 ) = max( reslts( 2 ), tmp )
291  END IF
292  90 CONTINUE
293 *
294  RETURN
295 *
296 * End of CPOT05
297 *
icamax
integer function icamax(N, CX, INCX)
ICAMAX
Definition: icamax.f:53
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the caller graph for this function: