1       SUBROUTINE CGTT05( TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX,
  2      $                   XACT, LDXACT, FERR, BERR, RESLTS )
  3 *
  4 *  -- LAPACK test routine (version 3.1) --
  5 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  6 *     November 2006
  7 *
  8 *     .. Scalar Arguments ..
  9       CHARACTER          TRANS
 10       INTEGER            LDB, LDX, LDXACT, N, NRHS
 11 *     ..
 12 *     .. Array Arguments ..
 13       REAL               BERR( * ), FERR( * ), RESLTS( * )
 14       COMPLEX            B( LDB, * ), D( * ), DL( * ), DU( * ),
 15      $                   X( LDX, * ), XACT( LDXACT, * )
 16 *     ..
 17 *
 18 *  Purpose
 19 *  =======
 20 *
 21 *  CGTT05 tests the error bounds from iterative refinement for the
 22 *  computed solution to a system of equations A*X = B, where A is a
 23 *  general tridiagonal matrix of order n and op(A) = A or A**T,
 24 *  depending on TRANS.
 25 *
 26 *  RESLTS(1) = test of the error bound
 27 *            = norm(X - XACT) / ( norm(X) * FERR )
 28 *
 29 *  A large value is returned if this ratio is not less than one.
 30 *
 31 *  RESLTS(2) = residual from the iterative refinement routine
 32 *            = the maximum of BERR / ( NZ*EPS + (*) ), where
 33 *              (*) = NZ*UNFL / (min_i (abs(op(A))*abs(X) +abs(b))_i )
 34 *              and NZ = max. number of nonzeros in any row of A, plus 1
 35 *
 36 *  Arguments
 37 *  =========
 38 *
 39 *  TRANS   (input) CHARACTER*1
 40 *          Specifies the form of the system of equations.
 41 *          = 'N':  A * X = B     (No transpose)
 42 *          = 'T':  A**T * X = B  (Transpose)
 43 *          = 'C':  A**H * X = B  (Conjugate transpose = Transpose)
 44 *
 45 *  N       (input) INTEGER
 46 *          The number of rows of the matrices X and XACT.  N >= 0.
 47 *
 48 *  NRHS    (input) INTEGER
 49 *          The number of columns of the matrices X and XACT.  NRHS >= 0.
 50 *
 51 *  DL      (input) COMPLEX array, dimension (N-1)
 52 *          The (n-1) sub-diagonal elements of A.
 53 *
 54 *  D       (input) COMPLEX array, dimension (N)
 55 *          The diagonal elements of A.
 56 *
 57 *  DU      (input) COMPLEX array, dimension (N-1)
 58 *          The (n-1) super-diagonal elements of A.
 59 *
 60 *  B       (input) COMPLEX array, dimension (LDB,NRHS)
 61 *          The right hand side vectors for the system of linear
 62 *          equations.
 63 *
 64 *  LDB     (input) INTEGER
 65 *          The leading dimension of the array B.  LDB >= max(1,N).
 66 *
 67 *  X       (input) COMPLEX array, dimension (LDX,NRHS)
 68 *          The computed solution vectors.  Each vector is stored as a
 69 *          column of the matrix X.
 70 *
 71 *  LDX     (input) INTEGER
 72 *          The leading dimension of the array X.  LDX >= max(1,N).
 73 *
 74 *  XACT    (input) COMPLEX array, dimension (LDX,NRHS)
 75 *          The exact solution vectors.  Each vector is stored as a
 76 *          column of the matrix XACT.
 77 *
 78 *  LDXACT  (input) INTEGER
 79 *          The leading dimension of the array XACT.  LDXACT >= max(1,N).
 80 *
 81 *  FERR    (input) REAL array, dimension (NRHS)
 82 *          The estimated forward error bounds for each solution vector
 83 *          X.  If XTRUE is the true solution, FERR bounds the magnitude
 84 *          of the largest entry in (X - XTRUE) divided by the magnitude
 85 *          of the largest entry in X.
 86 *
 87 *  BERR    (input) REAL array, dimension (NRHS)
 88 *          The componentwise relative backward error of each solution
 89 *          vector (i.e., the smallest relative change in any entry of A
 90 *          or B that makes X an exact solution).
 91 *
 92 *  RESLTS  (output) REAL array, dimension (2)
 93 *          The maximum over the NRHS solution vectors of the ratios:
 94 *          RESLTS(1) = norm(X - XACT) / ( norm(X) * FERR )
 95 *          RESLTS(2) = BERR / ( NZ*EPS + (*) )
 96 *
 97 *  =====================================================================
 98 *
 99 *     .. Parameters ..
100       REAL               ZERO, ONE
101       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
102 *     ..
103 *     .. Local Scalars ..
104       LOGICAL            NOTRAN
105       INTEGER            I, IMAX, J, K, NZ
106       REAL               AXBI, DIFF, EPS, ERRBND, OVFL, TMP, UNFL, XNORM
107       COMPLEX            ZDUM
108 *     ..
109 *     .. External Functions ..
110       LOGICAL            LSAME
111       INTEGER            ICAMAX
112       REAL               SLAMCH
113       EXTERNAL           LSAME, ICAMAX, SLAMCH
114 *     ..
115 *     .. Intrinsic Functions ..
116       INTRINSIC          ABSAIMAGMAXMIN, REAL
117 *     ..
118 *     .. Statement Functions ..
119       REAL               CABS1
120 *     ..
121 *     .. Statement Function definitions ..
122       CABS1( ZDUM ) = ABSREAL( ZDUM ) ) + ABSAIMAG( ZDUM ) )
123 *     ..
124 *     .. Executable Statements ..
125 *
126 *     Quick exit if N = 0 or NRHS = 0.
127 *
128       IF( N.LE.0 .OR. NRHS.LE.0 ) THEN
129          RESLTS( 1 ) = ZERO
130          RESLTS( 2 ) = ZERO
131          RETURN
132       END IF
133 *
134       EPS = SLAMCH( 'Epsilon' )
135       UNFL = SLAMCH( 'Safe minimum' )
136       OVFL = ONE / UNFL
137       NOTRAN = LSAME( TRANS, 'N' )
138       NZ = 4
139 *
140 *     Test 1:  Compute the maximum of
141 *        norm(X - XACT) / ( norm(X) * FERR )
142 *     over all the vectors X and XACT using the infinity-norm.
143 *
144       ERRBND = ZERO
145       DO 30 J = 1, NRHS
146          IMAX = ICAMAX( N, X( 1, J ), 1 )
147          XNORM = MAX( CABS1( X( IMAX, J ) ), UNFL )
148          DIFF = ZERO
149          DO 10 I = 1, N
150             DIFF = MAX( DIFF, CABS1( X( I, J )-XACT( I, J ) ) )
151    10    CONTINUE
152 *
153          IF( XNORM.GT.ONE ) THEN
154             GO TO 20
155          ELSE IF( DIFF.LE.OVFL*XNORM ) THEN
156             GO TO 20
157          ELSE
158             ERRBND = ONE / EPS
159             GO TO 30
160          END IF
161 *
162    20    CONTINUE
163          IF( DIFF / XNORM.LE.FERR( J ) ) THEN
164             ERRBND = MAX( ERRBND, ( DIFF / XNORM ) / FERR( J ) )
165          ELSE
166             ERRBND = ONE / EPS
167          END IF
168    30 CONTINUE
169       RESLTS( 1 ) = ERRBND
170 *
171 *     Test 2:  Compute the maximum of BERR / ( NZ*EPS + (*) ), where
172 *     (*) = NZ*UNFL / (min_i (abs(op(A))*abs(X) +abs(b))_i )
173 *
174       DO 60 K = 1, NRHS
175          IF( NOTRAN ) THEN
176             IF( N.EQ.1 ) THEN
177                AXBI = CABS1( B( 1, K ) ) +
178      $                CABS1( D( 1 ) )*CABS1( X( 1, K ) )
179             ELSE
180                AXBI = CABS1( B( 1, K ) ) +
181      $                CABS1( D( 1 ) )*CABS1( X( 1, K ) ) +
182      $                CABS1( DU( 1 ) )*CABS1( X( 2, K ) )
183                DO 40 I = 2, N - 1
184                   TMP = CABS1( B( I, K ) ) +
185      $                  CABS1( DL( I-1 ) )*CABS1( X( I-1, K ) ) +
186      $                  CABS1( D( I ) )*CABS1( X( I, K ) ) +
187      $                  CABS1( DU( I ) )*CABS1( X( I+1, K ) )
188                   AXBI = MIN( AXBI, TMP )
189    40          CONTINUE
190                TMP = CABS1( B( N, K ) ) + CABS1( DL( N-1 ) )*
191      $               CABS1( X( N-1, K ) ) + CABS1( D( N ) )*
192      $               CABS1( X( N, K ) )
193                AXBI = MIN( AXBI, TMP )
194             END IF
195          ELSE
196             IF( N.EQ.1 ) THEN
197                AXBI = CABS1( B( 1, K ) ) +
198      $                CABS1( D( 1 ) )*CABS1( X( 1, K ) )
199             ELSE
200                AXBI = CABS1( B( 1, K ) ) +
201      $                CABS1( D( 1 ) )*CABS1( X( 1, K ) ) +
202      $                CABS1( DL( 1 ) )*CABS1( X( 2, K ) )
203                DO 50 I = 2, N - 1
204                   TMP = CABS1( B( I, K ) ) +
205      $                  CABS1( DU( I-1 ) )*CABS1( X( I-1, K ) ) +
206      $                  CABS1( D( I ) )*CABS1( X( I, K ) ) +
207      $                  CABS1( DL( I ) )*CABS1( X( I+1, K ) )
208                   AXBI = MIN( AXBI, TMP )
209    50          CONTINUE
210                TMP = CABS1( B( N, K ) ) + CABS1( DU( N-1 ) )*
211      $               CABS1( X( N-1, K ) ) + CABS1( D( N ) )*
212      $               CABS1( X( N, K ) )
213                AXBI = MIN( AXBI, TMP )
214             END IF
215          END IF
216          TMP = BERR( K ) / ( NZ*EPS+NZ*UNFL / MAX( AXBI, NZ*UNFL ) )
217          IF( K.EQ.1 ) THEN
218             RESLTS( 2 ) = TMP
219          ELSE
220             RESLTS( 2 ) = MAX( RESLTS( 2 ), TMP )
221          END IF
222    60 CONTINUE
223 *
224       RETURN
225 *
226 *     End of CGTT05
227 *
228       END