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
1.7.2