LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cgtt05 ( character  TRANS,
integer  N,
integer  NRHS,
complex, dimension( * )  DL,
complex, dimension( * )  D,
complex, dimension( * )  DU,
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 
)

CGTT05

Purpose: 
 CGTT05 tests the error bounds from iterative refinement for the
 computed solution to a system of equations A*X = B, where A is a
 general tridiagonal matrix of order n and op(A) = A or A**T,
 depending on TRANS.

 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(op(A))*abs(X) +abs(b))_i )
             and NZ = max. number of nonzeros in any row of A, plus 1
Parameters
[in]TRANS
          TRANS is CHARACTER*1
          Specifies the form of the system of equations.
          = 'N':  A * X = B     (No transpose)
          = 'T':  A**T * X = B  (Transpose)
          = 'C':  A**H * X = B  (Conjugate transpose = Transpose)
[in]N
          N is INTEGER
          The number of rows of the matrices X and XACT.  N >= 0.
[in]NRHS
          NRHS is INTEGER
          The number of columns of the matrices X and XACT.  NRHS >= 0.
[in]DL
          DL is COMPLEX array, dimension (N-1)
          The (n-1) sub-diagonal elements of A.
[in]D
          D is COMPLEX array, dimension (N)
          The diagonal elements of A.
[in]DU
          DU is COMPLEX array, dimension (N-1)
          The (n-1) super-diagonal elements of A.
[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.
Date
November 2011

Definition at line 167 of file cgtt05.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 trans
175  INTEGER ldb, ldx, ldxact, n, nrhs
176 * ..
177 * .. Array Arguments ..
178  REAL berr( * ), ferr( * ), reslts( * )
179  COMPLEX b( ldb, * ), d( * ), dl( * ), du( * ),
180  $ x( ldx, * ), 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 notran
191  INTEGER i, imax, j, k, nz
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  notran = lsame( trans, 'N' )
224  nz = 4
225 *
226 * Test 1: Compute the maximum of
227 * norm(X - XACT) / ( norm(X) * FERR )
228 * over all the vectors X and XACT using the infinity-norm.
229 *
230  errbnd = zero
231  DO 30 j = 1, nrhs
232  imax = icamax( n, x( 1, j ), 1 )
233  xnorm = max( cabs1( x( imax, j ) ), unfl )
234  diff = zero
235  DO 10 i = 1, n
236  diff = max( diff, cabs1( x( i, j )-xact( i, j ) ) )
237  10 CONTINUE
238 *
239  IF( xnorm.GT.one ) THEN
240  GO TO 20
241  ELSE IF( diff.LE.ovfl*xnorm ) THEN
242  GO TO 20
243  ELSE
244  errbnd = one / eps
245  GO TO 30
246  END IF
247 *
248  20 CONTINUE
249  IF( diff / xnorm.LE.ferr( j ) ) THEN
250  errbnd = max( errbnd, ( diff / xnorm ) / ferr( j ) )
251  ELSE
252  errbnd = one / eps
253  END IF
254  30 CONTINUE
255  reslts( 1 ) = errbnd
256 *
257 * Test 2: Compute the maximum of BERR / ( NZ*EPS + (*) ), where
258 * (*) = NZ*UNFL / (min_i (abs(op(A))*abs(X) +abs(b))_i )
259 *
260  DO 60 k = 1, nrhs
261  IF( notran ) THEN
262  IF( n.EQ.1 ) THEN
263  axbi = cabs1( b( 1, k ) ) +
264  $ cabs1( d( 1 ) )*cabs1( x( 1, k ) )
265  ELSE
266  axbi = cabs1( b( 1, k ) ) +
267  $ cabs1( d( 1 ) )*cabs1( x( 1, k ) ) +
268  $ cabs1( du( 1 ) )*cabs1( x( 2, k ) )
269  DO 40 i = 2, n - 1
270  tmp = cabs1( b( i, k ) ) +
271  $ cabs1( dl( i-1 ) )*cabs1( x( i-1, k ) ) +
272  $ cabs1( d( i ) )*cabs1( x( i, k ) ) +
273  $ cabs1( du( i ) )*cabs1( x( i+1, k ) )
274  axbi = min( axbi, tmp )
275  40 CONTINUE
276  tmp = cabs1( b( n, k ) ) + cabs1( dl( n-1 ) )*
277  $ cabs1( x( n-1, k ) ) + cabs1( d( n ) )*
278  $ cabs1( x( n, k ) )
279  axbi = min( axbi, tmp )
280  END IF
281  ELSE
282  IF( n.EQ.1 ) THEN
283  axbi = cabs1( b( 1, k ) ) +
284  $ cabs1( d( 1 ) )*cabs1( x( 1, k ) )
285  ELSE
286  axbi = cabs1( b( 1, k ) ) +
287  $ cabs1( d( 1 ) )*cabs1( x( 1, k ) ) +
288  $ cabs1( dl( 1 ) )*cabs1( x( 2, k ) )
289  DO 50 i = 2, n - 1
290  tmp = cabs1( b( i, k ) ) +
291  $ cabs1( du( i-1 ) )*cabs1( x( i-1, k ) ) +
292  $ cabs1( d( i ) )*cabs1( x( i, k ) ) +
293  $ cabs1( dl( i ) )*cabs1( x( i+1, k ) )
294  axbi = min( axbi, tmp )
295  50 CONTINUE
296  tmp = cabs1( b( n, k ) ) + cabs1( du( n-1 ) )*
297  $ cabs1( x( n-1, k ) ) + cabs1( d( n ) )*
298  $ cabs1( x( n, k ) )
299  axbi = min( axbi, tmp )
300  END IF
301  END IF
302  tmp = berr( k ) / ( nz*eps+nz*unfl / max( axbi, nz*unfl ) )
303  IF( k.EQ.1 ) THEN
304  reslts( 2 ) = tmp
305  ELSE
306  reslts( 2 ) = max( reslts( 2 ), tmp )
307  END IF
308  60 CONTINUE
309 *
310  RETURN
311 *
312 * End of CGTT05
313 *
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: