1       SUBROUTINE SGTT02( TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB,
  2      $                   RWORK, RESID )
  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, N, NRHS
 11       REAL               RESID
 12 *     ..
 13 *     .. Array Arguments ..
 14       REAL               B( LDB, * ), D( * ), DL( * ), DU( * ),
 15      $                   RWORK( * ), X( LDX, * )
 16 *     ..
 17 *
 18 *  Purpose
 19 *  =======
 20 *
 21 *  SGTT02 computes the residual for the solution to a tridiagonal
 22 *  system of equations:
 23 *     RESID = norm(B - op(A)*X) / (norm(A) * norm(X) * EPS),
 24 *  where EPS is the machine epsilon.
 25 *
 26 *  Arguments
 27 *  =========
 28 *
 29 *  TRANS   (input) CHARACTER
 30 *          Specifies the form of the residual.
 31 *          = 'N':  B - A * X  (No transpose)
 32 *          = 'T':  B - A'* X  (Transpose)
 33 *          = 'C':  B - A'* X  (Conjugate transpose = Transpose)
 34 *
 35 *  N       (input) INTEGTER
 36 *          The order of the matrix A.  N >= 0.
 37 *
 38 *  NRHS    (input) INTEGER
 39 *          The number of right hand sides, i.e., the number of columns
 40 *          of the matrices B and X.  NRHS >= 0.
 41 *
 42 *  DL      (input) REAL array, dimension (N-1)
 43 *          The (n-1) sub-diagonal elements of A.
 44 *
 45 *  D       (input) REAL array, dimension (N)
 46 *          The diagonal elements of A.
 47 *
 48 *  DU      (input) REAL array, dimension (N-1)
 49 *          The (n-1) super-diagonal elements of A.
 50 *
 51 *  X       (input) REAL array, dimension (LDX,NRHS)
 52 *          The computed solution vectors X.
 53 *
 54 *  LDX     (input) INTEGER
 55 *          The leading dimension of the array X.  LDX >= max(1,N).
 56 *
 57 *  B       (input/output) REAL array, dimension (LDB,NRHS)
 58 *          On entry, the right hand side vectors for the system of
 59 *          linear equations.
 60 *          On exit, B is overwritten with the difference B - op(A)*X.
 61 *
 62 *  LDB     (input) INTEGER
 63 *          The leading dimension of the array B.  LDB >= max(1,N).
 64 *
 65 *  RWORK   (workspace) REAL array, dimension (N)
 66 *
 67 *  RESID   (output) REAL
 68 *          norm(B - op(A)*X) / (norm(A) * norm(X) * EPS)
 69 *
 70 *  =====================================================================
 71 *
 72 *     .. Parameters ..
 73       REAL               ONE, ZERO
 74       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
 75 *     ..
 76 *     .. Local Scalars ..
 77       INTEGER            J
 78       REAL               ANORM, BNORM, EPS, XNORM
 79 *     ..
 80 *     .. External Functions ..
 81       LOGICAL            LSAME
 82       REAL               SASUM, SLAMCH, SLANGT
 83       EXTERNAL           LSAME, SASUM, SLAMCH, SLANGT
 84 *     ..
 85 *     .. External Subroutines ..
 86       EXTERNAL           SLAGTM
 87 *     ..
 88 *     .. Intrinsic Functions ..
 89       INTRINSIC          MAX
 90 *     ..
 91 *     .. Executable Statements ..
 92 *
 93 *     Quick exit if N = 0 or NRHS = 0
 94 *
 95       RESID = ZERO
 96       IF( N.LE.0 .OR. NRHS.EQ.0 )
 97      $   RETURN
 98 *
 99 *     Compute the maximum over the number of right hand sides of
100 *        norm(B - op(A)*X) / ( norm(A) * norm(X) * EPS ).
101 *
102       IF( LSAME( TRANS, 'N' ) ) THEN
103          ANORM = SLANGT( '1', N, DL, D, DU )
104       ELSE
105          ANORM = SLANGT( 'I', N, DL, D, DU )
106       END IF
107 *
108 *     Exit with RESID = 1/EPS if ANORM = 0.
109 *
110       EPS = SLAMCH( 'Epsilon' )
111       IF( ANORM.LE.ZERO ) THEN
112          RESID = ONE / EPS
113          RETURN
114       END IF
115 *
116 *     Compute B - op(A)*X.
117 *
118       CALL SLAGTM( TRANS, N, NRHS, -ONE, DL, D, DU, X, LDX, ONE, B,
119      $             LDB )
120 *
121       DO 10 J = 1, NRHS
122          BNORM = SASUM( N, B( 1, J ), 1 )
123          XNORM = SASUM( N, X( 1, J ), 1 )
124          IF( XNORM.LE.ZERO ) THEN
125             RESID = ONE / EPS
126          ELSE
127             RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS )
128          END IF
129    10 CONTINUE
130 *
131       RETURN
132 *
133 *     End of SGTT02
134 *
135       END