00001 SUBROUTINE SPBT02( UPLO, N, KD, NRHS, A, LDA, 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 UPLO 00010 INTEGER KD, LDA, LDB, LDX, N, NRHS 00011 REAL RESID 00012 * .. 00013 * .. Array Arguments .. 00014 REAL A( LDA, * ), B( LDB, * ), RWORK( * ), 00015 $ X( LDX, * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * SPBT02 computes the residual for a solution of a symmetric banded 00022 * system of equations A*x = b: 00023 * RESID = norm( B - A*X ) / ( norm(A) * norm(X) * EPS) 00024 * where EPS is the machine precision. 00025 * 00026 * Arguments 00027 * ========= 00028 * 00029 * UPLO (input) CHARACTER*1 00030 * Specifies whether the upper or lower triangular part of the 00031 * symmetric matrix A is stored: 00032 * = 'U': Upper triangular 00033 * = 'L': Lower triangular 00034 * 00035 * N (input) INTEGER 00036 * The number of rows and columns of the matrix A. N >= 0. 00037 * 00038 * KD (input) INTEGER 00039 * The number of super-diagonals of the matrix A if UPLO = 'U', 00040 * or the number of sub-diagonals if UPLO = 'L'. KD >= 0. 00041 * 00042 * A (input) REAL array, dimension (LDA,N) 00043 * The original symmetric band matrix A. If UPLO = 'U', the 00044 * upper triangular part of A is stored as a band matrix; if 00045 * UPLO = 'L', the lower triangular part of A is stored. The 00046 * columns of the appropriate triangle are stored in the columns 00047 * of A and the diagonals of the triangle are stored in the rows 00048 * of A. See SPBTRF for further details. 00049 * 00050 * LDA (input) INTEGER. 00051 * The leading dimension of the array A. LDA >= max(1,KD+1). 00052 * 00053 * X (input) REAL array, dimension (LDX,NRHS) 00054 * The computed solution vectors for the system of linear 00055 * equations. 00056 * 00057 * LDX (input) INTEGER 00058 * The leading dimension of the array X. LDX >= max(1,N). 00059 * 00060 * B (input/output) REAL array, dimension (LDB,NRHS) 00061 * On entry, the right hand side vectors for the system of 00062 * linear equations. 00063 * On exit, B is overwritten with the difference B - A*X. 00064 * 00065 * LDB (input) INTEGER 00066 * The leading dimension of the array B. LDB >= max(1,N). 00067 * 00068 * RWORK (workspace) REAL array, dimension (N) 00069 * 00070 * RESID (output) REAL 00071 * The maximum over the number of right hand sides of 00072 * norm(B - A*X) / ( norm(A) * norm(X) * EPS ). 00073 * 00074 * ===================================================================== 00075 * 00076 * .. Parameters .. 00077 REAL ZERO, ONE 00078 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 00079 * .. 00080 * .. Local Scalars .. 00081 INTEGER J 00082 REAL ANORM, BNORM, EPS, XNORM 00083 * .. 00084 * .. External Functions .. 00085 REAL SASUM, SLAMCH, SLANSB 00086 EXTERNAL SASUM, SLAMCH, SLANSB 00087 * .. 00088 * .. External Subroutines .. 00089 EXTERNAL SSBMV 00090 * .. 00091 * .. Intrinsic Functions .. 00092 INTRINSIC MAX 00093 * .. 00094 * .. Executable Statements .. 00095 * 00096 * Quick exit if N = 0 or NRHS = 0. 00097 * 00098 IF( N.LE.0 .OR. NRHS.LE.0 ) THEN 00099 RESID = ZERO 00100 RETURN 00101 END IF 00102 * 00103 * Exit with RESID = 1/EPS if ANORM = 0. 00104 * 00105 EPS = SLAMCH( 'Epsilon' ) 00106 ANORM = SLANSB( '1', UPLO, N, KD, A, LDA, RWORK ) 00107 IF( ANORM.LE.ZERO ) THEN 00108 RESID = ONE / EPS 00109 RETURN 00110 END IF 00111 * 00112 * Compute B - A*X 00113 * 00114 DO 10 J = 1, NRHS 00115 CALL SSBMV( UPLO, N, KD, -ONE, A, LDA, X( 1, J ), 1, ONE, 00116 $ B( 1, J ), 1 ) 00117 10 CONTINUE 00118 * 00119 * Compute the maximum over the number of right hand sides of 00120 * norm( B - A*X ) / ( norm(A) * norm(X) * EPS ) 00121 * 00122 RESID = ZERO 00123 DO 20 J = 1, NRHS 00124 BNORM = SASUM( N, B( 1, J ), 1 ) 00125 XNORM = SASUM( N, X( 1, J ), 1 ) 00126 IF( XNORM.LE.ZERO ) THEN 00127 RESID = ONE / EPS 00128 ELSE 00129 RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS ) 00130 END IF 00131 20 CONTINUE 00132 * 00133 RETURN 00134 * 00135 * End of SPBT02 00136 * 00137 END
1.7.2