LAPACK 3.3.0

sgtt02.f

Go to the documentation of this file.
00001       SUBROUTINE SGTT02( TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB,
00002      $                   RWORK, RESID )
00003 *
00004 *  -- LAPACK test routine (version 3.1) --
00005 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       CHARACTER          TRANS
00010       INTEGER            LDB, LDX, N, NRHS
00011       REAL               RESID
00012 *     ..
00013 *     .. Array Arguments ..
00014       REAL               B( LDB, * ), D( * ), DL( * ), DU( * ),
00015      $                   RWORK( * ), X( LDX, * )
00016 *     ..
00017 *
00018 *  Purpose
00019 *  =======
00020 *
00021 *  SGTT02 computes the residual for the solution to a tridiagonal
00022 *  system of equations:
00023 *     RESID = norm(B - op(A)*X) / (norm(A) * norm(X) * EPS),
00024 *  where EPS is the machine epsilon.
00025 *
00026 *  Arguments
00027 *  =========
00028 *
00029 *  TRANS   (input) CHARACTER
00030 *          Specifies the form of the residual.
00031 *          = 'N':  B - A * X  (No transpose)
00032 *          = 'T':  B - A'* X  (Transpose)
00033 *          = 'C':  B - A'* X  (Conjugate transpose = Transpose)
00034 *
00035 *  N       (input) INTEGTER
00036 *          The order of the matrix A.  N >= 0.
00037 *
00038 *  NRHS    (input) INTEGER
00039 *          The number of right hand sides, i.e., the number of columns
00040 *          of the matrices B and X.  NRHS >= 0.
00041 *
00042 *  DL      (input) REAL array, dimension (N-1)
00043 *          The (n-1) sub-diagonal elements of A.
00044 *
00045 *  D       (input) REAL array, dimension (N)
00046 *          The diagonal elements of A.
00047 *
00048 *  DU      (input) REAL array, dimension (N-1)
00049 *          The (n-1) super-diagonal elements of A.
00050 *
00051 *  X       (input) REAL array, dimension (LDX,NRHS)
00052 *          The computed solution vectors X.
00053 *
00054 *  LDX     (input) INTEGER
00055 *          The leading dimension of the array X.  LDX >= max(1,N).
00056 *
00057 *  B       (input/output) REAL array, dimension (LDB,NRHS)
00058 *          On entry, the right hand side vectors for the system of
00059 *          linear equations.
00060 *          On exit, B is overwritten with the difference B - op(A)*X.
00061 *
00062 *  LDB     (input) INTEGER
00063 *          The leading dimension of the array B.  LDB >= max(1,N).
00064 *
00065 *  RWORK   (workspace) REAL array, dimension (N)
00066 *
00067 *  RESID   (output) REAL
00068 *          norm(B - op(A)*X) / (norm(A) * norm(X) * EPS)
00069 *
00070 *  =====================================================================
00071 *
00072 *     .. Parameters ..
00073       REAL               ONE, ZERO
00074       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00075 *     ..
00076 *     .. Local Scalars ..
00077       INTEGER            J
00078       REAL               ANORM, BNORM, EPS, XNORM
00079 *     ..
00080 *     .. External Functions ..
00081       LOGICAL            LSAME
00082       REAL               SASUM, SLAMCH, SLANGT
00083       EXTERNAL           LSAME, SASUM, SLAMCH, SLANGT
00084 *     ..
00085 *     .. External Subroutines ..
00086       EXTERNAL           SLAGTM
00087 *     ..
00088 *     .. Intrinsic Functions ..
00089       INTRINSIC          MAX
00090 *     ..
00091 *     .. Executable Statements ..
00092 *
00093 *     Quick exit if N = 0 or NRHS = 0
00094 *
00095       RESID = ZERO
00096       IF( N.LE.0 .OR. NRHS.EQ.0 )
00097      $   RETURN
00098 *
00099 *     Compute the maximum over the number of right hand sides of
00100 *        norm(B - op(A)*X) / ( norm(A) * norm(X) * EPS ).
00101 *
00102       IF( LSAME( TRANS, 'N' ) ) THEN
00103          ANORM = SLANGT( '1', N, DL, D, DU )
00104       ELSE
00105          ANORM = SLANGT( 'I', N, DL, D, DU )
00106       END IF
00107 *
00108 *     Exit with RESID = 1/EPS if ANORM = 0.
00109 *
00110       EPS = SLAMCH( 'Epsilon' )
00111       IF( ANORM.LE.ZERO ) THEN
00112          RESID = ONE / EPS
00113          RETURN
00114       END IF
00115 *
00116 *     Compute B - op(A)*X.
00117 *
00118       CALL SLAGTM( TRANS, N, NRHS, -ONE, DL, D, DU, X, LDX, ONE, B,
00119      $             LDB )
00120 *
00121       DO 10 J = 1, NRHS
00122          BNORM = SASUM( N, B( 1, J ), 1 )
00123          XNORM = SASUM( N, X( 1, J ), 1 )
00124          IF( XNORM.LE.ZERO ) THEN
00125             RESID = ONE / EPS
00126          ELSE
00127             RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS )
00128          END IF
00129    10 CONTINUE
00130 *
00131       RETURN
00132 *
00133 *     End of SGTT02
00134 *
00135       END
 All Files Functions