LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
stbt02.f
Go to the documentation of this file.
00001 *> \brief \b STBT02
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE STBT02( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, X,
00012 *                          LDX, B, LDB, WORK, RESID )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       CHARACTER          DIAG, TRANS, UPLO
00016 *       INTEGER            KD, LDAB, LDB, LDX, N, NRHS
00017 *       REAL               RESID
00018 *       ..
00019 *       .. Array Arguments ..
00020 *       REAL               AB( LDAB, * ), B( LDB, * ), WORK( * ),
00021 *      $                   X( LDX, * )
00022 *       ..
00023 *  
00024 *
00025 *> \par Purpose:
00026 *  =============
00027 *>
00028 *> \verbatim
00029 *>
00030 *> STBT02 computes the residual for the computed solution to a
00031 *> triangular system of linear equations  A*x = b  or  A' *x = b when
00032 *> A is a triangular band matrix.  Here A' is the transpose of A and
00033 *> x and b are N by NRHS matrices.  The test ratio is the maximum over
00034 *> the number of right hand sides of
00035 *>    norm(b - op(A)*x) / ( norm(op(A)) * norm(x) * EPS ),
00036 *> where op(A) denotes A or A' and EPS is the machine epsilon.
00037 *> \endverbatim
00038 *
00039 *  Arguments:
00040 *  ==========
00041 *
00042 *> \param[in] UPLO
00043 *> \verbatim
00044 *>          UPLO is CHARACTER*1
00045 *>          Specifies whether the matrix A is upper or lower triangular.
00046 *>          = 'U':  Upper triangular
00047 *>          = 'L':  Lower triangular
00048 *> \endverbatim
00049 *>
00050 *> \param[in] TRANS
00051 *> \verbatim
00052 *>          TRANS is CHARACTER*1
00053 *>          Specifies the operation applied to A.
00054 *>          = 'N':  A *x = b  (No transpose)
00055 *>          = 'T':  A'*x = b  (Transpose)
00056 *>          = 'C':  A'*x = b  (Conjugate transpose = Transpose)
00057 *> \endverbatim
00058 *>
00059 *> \param[in] DIAG
00060 *> \verbatim
00061 *>          DIAG is CHARACTER*1
00062 *>          Specifies whether or not the matrix A is unit triangular.
00063 *>          = 'N':  Non-unit triangular
00064 *>          = 'U':  Unit triangular
00065 *> \endverbatim
00066 *>
00067 *> \param[in] N
00068 *> \verbatim
00069 *>          N is INTEGER
00070 *>          The order of the matrix A.  N >= 0.
00071 *> \endverbatim
00072 *>
00073 *> \param[in] KD
00074 *> \verbatim
00075 *>          KD is INTEGER
00076 *>          The number of superdiagonals or subdiagonals of the
00077 *>          triangular band matrix A.  KD >= 0.
00078 *> \endverbatim
00079 *>
00080 *> \param[in] NRHS
00081 *> \verbatim
00082 *>          NRHS is INTEGER
00083 *>          The number of right hand sides, i.e., the number of columns
00084 *>          of the matrices X and B.  NRHS >= 0.
00085 *> \endverbatim
00086 *>
00087 *> \param[in] AB
00088 *> \verbatim
00089 *>          AB is REAL array, dimension (LDAB,N)
00090 *>          The upper or lower triangular band matrix A, stored in the
00091 *>          first kd+1 rows of the array. The j-th column of A is stored
00092 *>          in the j-th column of the array AB as follows:
00093 *>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
00094 *>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
00095 *> \endverbatim
00096 *>
00097 *> \param[in] LDAB
00098 *> \verbatim
00099 *>          LDAB is INTEGER
00100 *>          The leading dimension of the array AB.  LDAB >= KD+1.
00101 *> \endverbatim
00102 *>
00103 *> \param[in] X
00104 *> \verbatim
00105 *>          X is REAL array, dimension (LDX,NRHS)
00106 *>          The computed solution vectors for the system of linear
00107 *>          equations.
00108 *> \endverbatim
00109 *>
00110 *> \param[in] LDX
00111 *> \verbatim
00112 *>          LDX is INTEGER
00113 *>          The leading dimension of the array X.  LDX >= max(1,N).
00114 *> \endverbatim
00115 *>
00116 *> \param[in] B
00117 *> \verbatim
00118 *>          B is REAL array, dimension (LDB,NRHS)
00119 *>          The right hand side vectors for the system of linear
00120 *>          equations.
00121 *> \endverbatim
00122 *>
00123 *> \param[in] LDB
00124 *> \verbatim
00125 *>          LDB is INTEGER
00126 *>          The leading dimension of the array B.  LDB >= max(1,N).
00127 *> \endverbatim
00128 *>
00129 *> \param[out] WORK
00130 *> \verbatim
00131 *>          WORK is REAL array, dimension (N)
00132 *> \endverbatim
00133 *>
00134 *> \param[out] RESID
00135 *> \verbatim
00136 *>          RESID is REAL
00137 *>          The maximum over the number of right hand sides of
00138 *>          norm(op(A)*x - b) / ( norm(op(A)) * norm(x) * EPS ).
00139 *> \endverbatim
00140 *
00141 *  Authors:
00142 *  ========
00143 *
00144 *> \author Univ. of Tennessee 
00145 *> \author Univ. of California Berkeley 
00146 *> \author Univ. of Colorado Denver 
00147 *> \author NAG Ltd. 
00148 *
00149 *> \date November 2011
00150 *
00151 *> \ingroup single_lin
00152 *
00153 *  =====================================================================
00154       SUBROUTINE STBT02( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, X,
00155      $                   LDX, B, LDB, WORK, RESID )
00156 *
00157 *  -- LAPACK test routine (version 3.4.0) --
00158 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00159 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00160 *     November 2011
00161 *
00162 *     .. Scalar Arguments ..
00163       CHARACTER          DIAG, TRANS, UPLO
00164       INTEGER            KD, LDAB, LDB, LDX, N, NRHS
00165       REAL               RESID
00166 *     ..
00167 *     .. Array Arguments ..
00168       REAL               AB( LDAB, * ), B( LDB, * ), WORK( * ),
00169      $                   X( LDX, * )
00170 *     ..
00171 *
00172 *  =====================================================================
00173 *
00174 *     .. Parameters ..
00175       REAL               ZERO, ONE
00176       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
00177 *     ..
00178 *     .. Local Scalars ..
00179       INTEGER            J
00180       REAL               ANORM, BNORM, EPS, XNORM
00181 *     ..
00182 *     .. External Functions ..
00183       LOGICAL            LSAME
00184       REAL               SASUM, SLAMCH, SLANTB
00185       EXTERNAL           LSAME, SASUM, SLAMCH, SLANTB
00186 *     ..
00187 *     .. External Subroutines ..
00188       EXTERNAL           SAXPY, SCOPY, STBMV
00189 *     ..
00190 *     .. Intrinsic Functions ..
00191       INTRINSIC          MAX
00192 *     ..
00193 *     .. Executable Statements ..
00194 *
00195 *     Quick exit if N = 0 or NRHS = 0
00196 *
00197       IF( N.LE.0 .OR. NRHS.LE.0 ) THEN
00198          RESID = ZERO
00199          RETURN
00200       END IF
00201 *
00202 *     Compute the 1-norm of A or A'.
00203 *
00204       IF( LSAME( TRANS, 'N' ) ) THEN
00205          ANORM = SLANTB( '1', UPLO, DIAG, N, KD, AB, LDAB, WORK )
00206       ELSE
00207          ANORM = SLANTB( 'I', UPLO, DIAG, N, KD, AB, LDAB, WORK )
00208       END IF
00209 *
00210 *     Exit with RESID = 1/EPS if ANORM = 0.
00211 *
00212       EPS = SLAMCH( 'Epsilon' )
00213       IF( ANORM.LE.ZERO ) THEN
00214          RESID = ONE / EPS
00215          RETURN
00216       END IF
00217 *
00218 *     Compute the maximum over the number of right hand sides of
00219 *        norm(op(A)*x - b) / ( norm(op(A)) * norm(x) * EPS ).
00220 *
00221       RESID = ZERO
00222       DO 10 J = 1, NRHS
00223          CALL SCOPY( N, X( 1, J ), 1, WORK, 1 )
00224          CALL STBMV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, WORK, 1 )
00225          CALL SAXPY( N, -ONE, B( 1, J ), 1, WORK, 1 )
00226          BNORM = SASUM( N, WORK, 1 )
00227          XNORM = SASUM( N, X( 1, J ), 1 )
00228          IF( XNORM.LE.ZERO ) THEN
00229             RESID = ONE / EPS
00230          ELSE
00231             RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS )
00232          END IF
00233    10 CONTINUE
00234 *
00235       RETURN
00236 *
00237 *     End of STBT02
00238 *
00239       END
 All Files Functions