LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ cgtt05()

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.

Definition at line 163 of file cgtt05.f.

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