LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cpbt05()

subroutine cpbt05 ( character  UPLO,
integer  N,
integer  KD,
integer  NRHS,
complex, dimension( ldab, * )  AB,
integer  LDAB,
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 
)

CPBT05

Purpose:
 CPBT05 tests the error bounds from iterative refinement for the
 computed solution to a system of equations A*X = B, where A is a
 Hermitian band 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 / ( NZ*EPS + (*) ), where
             (*) = NZ*UNFL / (min_i (abs(A)*abs(X) +abs(b))_i )
             and NZ = max. number of nonzeros in any row of A, plus 1
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]KD
          KD is INTEGER
          The number of super-diagonals of the matrix A if UPLO = 'U',
          or the number of sub-diagonals if UPLO = 'L'.  KD >= 0.
[in]NRHS
          NRHS is INTEGER
          The number of columns of the matrices X, B, and XACT.
          NRHS >= 0.
[in]AB
          AB is COMPLEX array, dimension (LDAB,N)
          The upper or lower triangle of the Hermitian band matrix A,
          stored in the first KD+1 rows of the array.  The j-th column
          of A is stored in the j-th column of the array AB as follows:
          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
[in]LDAB
          LDAB is INTEGER
          The leading dimension of the array AB.  LDAB >= KD+1.
[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 / ( NZ*EPS + (*) )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 169 of file cpbt05.f.

171 *
172 * -- LAPACK test routine --
173 * -- LAPACK is a software package provided by Univ. of Tennessee, --
174 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
175 *
176 * .. Scalar Arguments ..
177  CHARACTER UPLO
178  INTEGER KD, LDAB, LDB, LDX, LDXACT, N, NRHS
179 * ..
180 * .. Array Arguments ..
181  REAL BERR( * ), FERR( * ), RESLTS( * )
182  COMPLEX AB( LDAB, * ), B( LDB, * ), X( LDX, * ),
183  $ XACT( LDXACT, * )
184 * ..
185 *
186 * =====================================================================
187 *
188 * .. Parameters ..
189  REAL ZERO, ONE
190  parameter( zero = 0.0e+0, one = 1.0e+0 )
191 * ..
192 * .. Local Scalars ..
193  LOGICAL UPPER
194  INTEGER I, IMAX, J, K, NZ
195  REAL AXBI, DIFF, EPS, ERRBND, OVFL, TMP, UNFL, XNORM
196  COMPLEX ZDUM
197 * ..
198 * .. External Functions ..
199  LOGICAL LSAME
200  INTEGER ICAMAX
201  REAL SLAMCH
202  EXTERNAL lsame, icamax, slamch
203 * ..
204 * .. Intrinsic Functions ..
205  INTRINSIC abs, aimag, max, min, real
206 * ..
207 * .. Statement Functions ..
208  REAL CABS1
209 * ..
210 * .. Statement Function definitions ..
211  cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
212 * ..
213 * .. Executable Statements ..
214 *
215 * Quick exit if N = 0 or NRHS = 0.
216 *
217  IF( n.LE.0 .OR. nrhs.LE.0 ) THEN
218  reslts( 1 ) = zero
219  reslts( 2 ) = zero
220  RETURN
221  END IF
222 *
223  eps = slamch( 'Epsilon' )
224  unfl = slamch( 'Safe minimum' )
225  ovfl = one / unfl
226  upper = lsame( uplo, 'U' )
227  nz = 2*max( kd, n-1 ) + 1
228 *
229 * Test 1: Compute the maximum of
230 * norm(X - XACT) / ( norm(X) * FERR )
231 * over all the vectors X and XACT using the infinity-norm.
232 *
233  errbnd = zero
234  DO 30 j = 1, nrhs
235  imax = icamax( n, x( 1, j ), 1 )
236  xnorm = max( cabs1( x( imax, j ) ), unfl )
237  diff = zero
238  DO 10 i = 1, n
239  diff = max( diff, cabs1( x( i, j )-xact( i, j ) ) )
240  10 CONTINUE
241 *
242  IF( xnorm.GT.one ) THEN
243  GO TO 20
244  ELSE IF( diff.LE.ovfl*xnorm ) THEN
245  GO TO 20
246  ELSE
247  errbnd = one / eps
248  GO TO 30
249  END IF
250 *
251  20 CONTINUE
252  IF( diff / xnorm.LE.ferr( j ) ) THEN
253  errbnd = max( errbnd, ( diff / xnorm ) / ferr( j ) )
254  ELSE
255  errbnd = one / eps
256  END IF
257  30 CONTINUE
258  reslts( 1 ) = errbnd
259 *
260 * Test 2: Compute the maximum of BERR / ( NZ*EPS + (*) ), where
261 * (*) = NZ*UNFL / (min_i (abs(A)*abs(X) +abs(b))_i )
262 *
263  DO 90 k = 1, nrhs
264  DO 80 i = 1, n
265  tmp = cabs1( b( i, k ) )
266  IF( upper ) THEN
267  DO 40 j = max( i-kd, 1 ), i - 1
268  tmp = tmp + cabs1( ab( kd+1-i+j, i ) )*
269  $ cabs1( x( j, k ) )
270  40 CONTINUE
271  tmp = tmp + abs( real( ab( kd+1, i ) ) )*
272  $ cabs1( x( i, k ) )
273  DO 50 j = i + 1, min( i+kd, n )
274  tmp = tmp + cabs1( ab( kd+1+i-j, j ) )*
275  $ cabs1( x( j, k ) )
276  50 CONTINUE
277  ELSE
278  DO 60 j = max( i-kd, 1 ), i - 1
279  tmp = tmp + cabs1( ab( 1+i-j, j ) )*cabs1( x( j, k ) )
280  60 CONTINUE
281  tmp = tmp + abs( real( ab( 1, i ) ) )*cabs1( x( i, k ) )
282  DO 70 j = i + 1, min( i+kd, n )
283  tmp = tmp + cabs1( ab( 1+j-i, i ) )*cabs1( x( j, k ) )
284  70 CONTINUE
285  END IF
286  IF( i.EQ.1 ) THEN
287  axbi = tmp
288  ELSE
289  axbi = min( axbi, tmp )
290  END IF
291  80 CONTINUE
292  tmp = berr( k ) / ( nz*eps+nz*unfl / max( axbi, nz*unfl ) )
293  IF( k.EQ.1 ) THEN
294  reslts( 2 ) = tmp
295  ELSE
296  reslts( 2 ) = max( reslts( 2 ), tmp )
297  END IF
298  90 CONTINUE
299 *
300  RETURN
301 *
302 * End of CPBT05
303 *
integer function icamax(N, CX, INCX)
ICAMAX
Definition: icamax.f:71
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the caller graph for this function: