![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b STBTRS 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download STBTRS + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stbtrs.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stbtrs.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stbtrs.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE STBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, 00022 * LDB, INFO ) 00023 * 00024 * .. Scalar Arguments .. 00025 * CHARACTER DIAG, TRANS, UPLO 00026 * INTEGER INFO, KD, LDAB, LDB, N, NRHS 00027 * .. 00028 * .. Array Arguments .. 00029 * REAL AB( LDAB, * ), B( LDB, * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> STBTRS solves a triangular system of the form 00039 *> 00040 *> A * X = B or A**T * X = B, 00041 *> 00042 *> where A is a triangular band matrix of order N, and B is an 00043 *> N-by NRHS matrix. A check is made to verify that A is nonsingular. 00044 *> \endverbatim 00045 * 00046 * Arguments: 00047 * ========== 00048 * 00049 *> \param[in] UPLO 00050 *> \verbatim 00051 *> UPLO is CHARACTER*1 00052 *> = 'U': A is upper triangular; 00053 *> = 'L': A is lower triangular. 00054 *> \endverbatim 00055 *> 00056 *> \param[in] TRANS 00057 *> \verbatim 00058 *> TRANS is CHARACTER*1 00059 *> Specifies the form the system of equations: 00060 *> = 'N': A * X = B (No transpose) 00061 *> = 'T': A**T * X = B (Transpose) 00062 *> = 'C': A**H * X = B (Conjugate transpose = Transpose) 00063 *> \endverbatim 00064 *> 00065 *> \param[in] DIAG 00066 *> \verbatim 00067 *> DIAG is CHARACTER*1 00068 *> = 'N': A is non-unit triangular; 00069 *> = 'U': A is unit triangular. 00070 *> \endverbatim 00071 *> 00072 *> \param[in] N 00073 *> \verbatim 00074 *> N is INTEGER 00075 *> The order of the matrix A. N >= 0. 00076 *> \endverbatim 00077 *> 00078 *> \param[in] KD 00079 *> \verbatim 00080 *> KD is INTEGER 00081 *> The number of superdiagonals or subdiagonals of the 00082 *> triangular band matrix A. KD >= 0. 00083 *> \endverbatim 00084 *> 00085 *> \param[in] NRHS 00086 *> \verbatim 00087 *> NRHS is INTEGER 00088 *> The number of right hand sides, i.e., the number of columns 00089 *> of the matrix B. NRHS >= 0. 00090 *> \endverbatim 00091 *> 00092 *> \param[in] AB 00093 *> \verbatim 00094 *> AB is REAL array, dimension (LDAB,N) 00095 *> The upper or lower triangular band matrix A, stored in the 00096 *> first kd+1 rows of AB. The j-th column of A is stored 00097 *> in the j-th column of the array AB as follows: 00098 *> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j; 00099 *> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd). 00100 *> If DIAG = 'U', the diagonal elements of A are not referenced 00101 *> and are assumed to be 1. 00102 *> \endverbatim 00103 *> 00104 *> \param[in] LDAB 00105 *> \verbatim 00106 *> LDAB is INTEGER 00107 *> The leading dimension of the array AB. LDAB >= KD+1. 00108 *> \endverbatim 00109 *> 00110 *> \param[in,out] B 00111 *> \verbatim 00112 *> B is REAL array, dimension (LDB,NRHS) 00113 *> On entry, the right hand side matrix B. 00114 *> On exit, if INFO = 0, the solution matrix X. 00115 *> \endverbatim 00116 *> 00117 *> \param[in] LDB 00118 *> \verbatim 00119 *> LDB is INTEGER 00120 *> The leading dimension of the array B. LDB >= max(1,N). 00121 *> \endverbatim 00122 *> 00123 *> \param[out] INFO 00124 *> \verbatim 00125 *> INFO is INTEGER 00126 *> = 0: successful exit 00127 *> < 0: if INFO = -i, the i-th argument had an illegal value 00128 *> > 0: if INFO = i, the i-th diagonal element of A is zero, 00129 *> indicating that the matrix is singular and the 00130 *> solutions X have not been computed. 00131 *> \endverbatim 00132 * 00133 * Authors: 00134 * ======== 00135 * 00136 *> \author Univ. of Tennessee 00137 *> \author Univ. of California Berkeley 00138 *> \author Univ. of Colorado Denver 00139 *> \author NAG Ltd. 00140 * 00141 *> \date November 2011 00142 * 00143 *> \ingroup realOTHERcomputational 00144 * 00145 * ===================================================================== 00146 SUBROUTINE STBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, 00147 $ LDB, INFO ) 00148 * 00149 * -- LAPACK computational routine (version 3.4.0) -- 00150 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00151 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00152 * November 2011 00153 * 00154 * .. Scalar Arguments .. 00155 CHARACTER DIAG, TRANS, UPLO 00156 INTEGER INFO, KD, LDAB, LDB, N, NRHS 00157 * .. 00158 * .. Array Arguments .. 00159 REAL AB( LDAB, * ), B( LDB, * ) 00160 * .. 00161 * 00162 * ===================================================================== 00163 * 00164 * .. Parameters .. 00165 REAL ZERO 00166 PARAMETER ( ZERO = 0.0E+0 ) 00167 * .. 00168 * .. Local Scalars .. 00169 LOGICAL NOUNIT, UPPER 00170 INTEGER J 00171 * .. 00172 * .. External Functions .. 00173 LOGICAL LSAME 00174 EXTERNAL LSAME 00175 * .. 00176 * .. External Subroutines .. 00177 EXTERNAL STBSV, XERBLA 00178 * .. 00179 * .. Intrinsic Functions .. 00180 INTRINSIC MAX 00181 * .. 00182 * .. Executable Statements .. 00183 * 00184 * Test the input parameters. 00185 * 00186 INFO = 0 00187 NOUNIT = LSAME( DIAG, 'N' ) 00188 UPPER = LSAME( UPLO, 'U' ) 00189 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00190 INFO = -1 00191 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. 00192 $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN 00193 INFO = -2 00194 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN 00195 INFO = -3 00196 ELSE IF( N.LT.0 ) THEN 00197 INFO = -4 00198 ELSE IF( KD.LT.0 ) THEN 00199 INFO = -5 00200 ELSE IF( NRHS.LT.0 ) THEN 00201 INFO = -6 00202 ELSE IF( LDAB.LT.KD+1 ) THEN 00203 INFO = -8 00204 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00205 INFO = -10 00206 END IF 00207 IF( INFO.NE.0 ) THEN 00208 CALL XERBLA( 'STBTRS', -INFO ) 00209 RETURN 00210 END IF 00211 * 00212 * Quick return if possible 00213 * 00214 IF( N.EQ.0 ) 00215 $ RETURN 00216 * 00217 * Check for singularity. 00218 * 00219 IF( NOUNIT ) THEN 00220 IF( UPPER ) THEN 00221 DO 10 INFO = 1, N 00222 IF( AB( KD+1, INFO ).EQ.ZERO ) 00223 $ RETURN 00224 10 CONTINUE 00225 ELSE 00226 DO 20 INFO = 1, N 00227 IF( AB( 1, INFO ).EQ.ZERO ) 00228 $ RETURN 00229 20 CONTINUE 00230 END IF 00231 END IF 00232 INFO = 0 00233 * 00234 * Solve A * X = B or A**T * X = B. 00235 * 00236 DO 30 J = 1, NRHS 00237 CALL STBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, B( 1, J ), 1 ) 00238 30 CONTINUE 00239 * 00240 RETURN 00241 * 00242 * End of STBTRS 00243 * 00244 END