LAPACK 3.3.0
|
00001 SUBROUTINE SGBT02( TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, 00002 $ LDB, 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 KL, KU, LDA, LDB, LDX, M, N, NRHS 00011 REAL RESID 00012 * .. 00013 * .. Array Arguments .. 00014 REAL A( LDA, * ), B( LDB, * ), X( LDX, * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * SGBT02 computes the residual for a solution of a banded system of 00021 * equations A*x = b or A'*x = b: 00022 * RESID = norm( B - A*X ) / ( norm(A) * norm(X) * EPS). 00023 * where EPS is the machine precision. 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * TRANS (input) CHARACTER*1 00029 * Specifies the form of the system of equations: 00030 * = 'N': A *x = b 00031 * = 'T': A'*x = b, where A' is the transpose of A 00032 * = 'C': A'*x = b, where A' is the transpose of A 00033 * 00034 * M (input) INTEGER 00035 * The number of rows of the matrix A. M >= 0. 00036 * 00037 * N (input) INTEGER 00038 * The number of columns of the matrix A. N >= 0. 00039 * 00040 * KL (input) INTEGER 00041 * The number of subdiagonals within the band of A. KL >= 0. 00042 * 00043 * KU (input) INTEGER 00044 * The number of superdiagonals within the band of A. KU >= 0. 00045 * 00046 * NRHS (input) INTEGER 00047 * The number of columns of B. NRHS >= 0. 00048 * 00049 * A (input) REAL array, dimension (LDA,N) 00050 * The original matrix A in band storage, stored in rows 1 to 00051 * KL+KU+1. 00052 * 00053 * LDA (input) INTEGER 00054 * The leading dimension of the array A. LDA >= max(1,KL+KU+1). 00055 * 00056 * X (input) REAL array, dimension (LDX,NRHS) 00057 * The computed solution vectors for the system of linear 00058 * equations. 00059 * 00060 * LDX (input) INTEGER 00061 * The leading dimension of the array X. If TRANS = 'N', 00062 * LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,M). 00063 * 00064 * B (input/output) REAL array, dimension (LDB,NRHS) 00065 * On entry, the right hand side vectors for the system of 00066 * linear equations. 00067 * On exit, B is overwritten with the difference B - A*X. 00068 * 00069 * LDB (input) INTEGER 00070 * The leading dimension of the array B. IF TRANS = 'N', 00071 * LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N). 00072 * 00073 * RESID (output) REAL 00074 * The maximum over the number of right hand sides of 00075 * norm(B - A*X) / ( norm(A) * norm(X) * EPS ). 00076 * 00077 * ===================================================================== 00078 * 00079 * .. Parameters .. 00080 REAL ZERO, ONE 00081 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 00082 * .. 00083 * .. Local Scalars .. 00084 INTEGER I1, I2, J, KD, N1 00085 REAL ANORM, BNORM, EPS, XNORM 00086 * .. 00087 * .. External Functions .. 00088 LOGICAL LSAME 00089 REAL SASUM, SLAMCH 00090 EXTERNAL LSAME, SASUM, SLAMCH 00091 * .. 00092 * .. External Subroutines .. 00093 EXTERNAL SGBMV 00094 * .. 00095 * .. Intrinsic Functions .. 00096 INTRINSIC MAX, MIN 00097 * .. 00098 * .. Executable Statements .. 00099 * 00100 * Quick return if N = 0 pr NRHS = 0 00101 * 00102 IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.LE.0 ) THEN 00103 RESID = ZERO 00104 RETURN 00105 END IF 00106 * 00107 * Exit with RESID = 1/EPS if ANORM = 0. 00108 * 00109 EPS = SLAMCH( 'Epsilon' ) 00110 KD = KU + 1 00111 ANORM = ZERO 00112 DO 10 J = 1, N 00113 I1 = MAX( KD+1-J, 1 ) 00114 I2 = MIN( KD+M-J, KL+KD ) 00115 ANORM = MAX( ANORM, SASUM( I2-I1+1, A( I1, J ), 1 ) ) 00116 10 CONTINUE 00117 IF( ANORM.LE.ZERO ) THEN 00118 RESID = ONE / EPS 00119 RETURN 00120 END IF 00121 * 00122 IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN 00123 N1 = N 00124 ELSE 00125 N1 = M 00126 END IF 00127 * 00128 * Compute B - A*X (or B - A'*X ) 00129 * 00130 DO 20 J = 1, NRHS 00131 CALL SGBMV( TRANS, M, N, KL, KU, -ONE, A, LDA, X( 1, J ), 1, 00132 $ ONE, B( 1, J ), 1 ) 00133 20 CONTINUE 00134 * 00135 * Compute the maximum over the number of right hand sides of 00136 * norm(B - A*X) / ( norm(A) * norm(X) * EPS ). 00137 * 00138 RESID = ZERO 00139 DO 30 J = 1, NRHS 00140 BNORM = SASUM( N1, B( 1, J ), 1 ) 00141 XNORM = SASUM( N1, X( 1, J ), 1 ) 00142 IF( XNORM.LE.ZERO ) THEN 00143 RESID = ONE / EPS 00144 ELSE 00145 RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS ) 00146 END IF 00147 30 CONTINUE 00148 * 00149 RETURN 00150 * 00151 * End of SGBT02 00152 * 00153 END