![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DGBTRS 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download DGBTRS + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgbtrs.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgbtrs.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgbtrs.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, 00022 * INFO ) 00023 * 00024 * .. Scalar Arguments .. 00025 * CHARACTER TRANS 00026 * INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS 00027 * .. 00028 * .. Array Arguments .. 00029 * INTEGER IPIV( * ) 00030 * DOUBLE PRECISION AB( LDAB, * ), B( LDB, * ) 00031 * .. 00032 * 00033 * 00034 *> \par Purpose: 00035 * ============= 00036 *> 00037 *> \verbatim 00038 *> 00039 *> DGBTRS solves a system of linear equations 00040 *> A * X = B or A**T * X = B 00041 *> with a general band matrix A using the LU factorization computed 00042 *> by DGBTRF. 00043 *> \endverbatim 00044 * 00045 * Arguments: 00046 * ========== 00047 * 00048 *> \param[in] TRANS 00049 *> \verbatim 00050 *> TRANS is CHARACTER*1 00051 *> Specifies the form of the system of equations. 00052 *> = 'N': A * X = B (No transpose) 00053 *> = 'T': A**T* X = B (Transpose) 00054 *> = 'C': A**T* X = B (Conjugate transpose = Transpose) 00055 *> \endverbatim 00056 *> 00057 *> \param[in] N 00058 *> \verbatim 00059 *> N is INTEGER 00060 *> The order of the matrix A. N >= 0. 00061 *> \endverbatim 00062 *> 00063 *> \param[in] KL 00064 *> \verbatim 00065 *> KL is INTEGER 00066 *> The number of subdiagonals within the band of A. KL >= 0. 00067 *> \endverbatim 00068 *> 00069 *> \param[in] KU 00070 *> \verbatim 00071 *> KU is INTEGER 00072 *> The number of superdiagonals within the band of A. KU >= 0. 00073 *> \endverbatim 00074 *> 00075 *> \param[in] NRHS 00076 *> \verbatim 00077 *> NRHS is INTEGER 00078 *> The number of right hand sides, i.e., the number of columns 00079 *> of the matrix B. NRHS >= 0. 00080 *> \endverbatim 00081 *> 00082 *> \param[in] AB 00083 *> \verbatim 00084 *> AB is DOUBLE PRECISION array, dimension (LDAB,N) 00085 *> Details of the LU factorization of the band matrix A, as 00086 *> computed by DGBTRF. U is stored as an upper triangular band 00087 *> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and 00088 *> the multipliers used during the factorization are stored in 00089 *> rows KL+KU+2 to 2*KL+KU+1. 00090 *> \endverbatim 00091 *> 00092 *> \param[in] LDAB 00093 *> \verbatim 00094 *> LDAB is INTEGER 00095 *> The leading dimension of the array AB. LDAB >= 2*KL+KU+1. 00096 *> \endverbatim 00097 *> 00098 *> \param[in] IPIV 00099 *> \verbatim 00100 *> IPIV is INTEGER array, dimension (N) 00101 *> The pivot indices; for 1 <= i <= N, row i of the matrix was 00102 *> interchanged with row IPIV(i). 00103 *> \endverbatim 00104 *> 00105 *> \param[in,out] B 00106 *> \verbatim 00107 *> B is DOUBLE PRECISION array, dimension (LDB,NRHS) 00108 *> On entry, the right hand side matrix B. 00109 *> On exit, the solution matrix X. 00110 *> \endverbatim 00111 *> 00112 *> \param[in] LDB 00113 *> \verbatim 00114 *> LDB is INTEGER 00115 *> The leading dimension of the array B. LDB >= max(1,N). 00116 *> \endverbatim 00117 *> 00118 *> \param[out] INFO 00119 *> \verbatim 00120 *> INFO is INTEGER 00121 *> = 0: successful exit 00122 *> < 0: if INFO = -i, the i-th argument had an illegal value 00123 *> \endverbatim 00124 * 00125 * Authors: 00126 * ======== 00127 * 00128 *> \author Univ. of Tennessee 00129 *> \author Univ. of California Berkeley 00130 *> \author Univ. of Colorado Denver 00131 *> \author NAG Ltd. 00132 * 00133 *> \date November 2011 00134 * 00135 *> \ingroup doubleGBcomputational 00136 * 00137 * ===================================================================== 00138 SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, 00139 $ INFO ) 00140 * 00141 * -- LAPACK computational routine (version 3.4.0) -- 00142 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00143 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00144 * November 2011 00145 * 00146 * .. Scalar Arguments .. 00147 CHARACTER TRANS 00148 INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS 00149 * .. 00150 * .. Array Arguments .. 00151 INTEGER IPIV( * ) 00152 DOUBLE PRECISION AB( LDAB, * ), B( LDB, * ) 00153 * .. 00154 * 00155 * ===================================================================== 00156 * 00157 * .. Parameters .. 00158 DOUBLE PRECISION ONE 00159 PARAMETER ( ONE = 1.0D+0 ) 00160 * .. 00161 * .. Local Scalars .. 00162 LOGICAL LNOTI, NOTRAN 00163 INTEGER I, J, KD, L, LM 00164 * .. 00165 * .. External Functions .. 00166 LOGICAL LSAME 00167 EXTERNAL LSAME 00168 * .. 00169 * .. External Subroutines .. 00170 EXTERNAL DGEMV, DGER, DSWAP, DTBSV, XERBLA 00171 * .. 00172 * .. Intrinsic Functions .. 00173 INTRINSIC MAX, MIN 00174 * .. 00175 * .. Executable Statements .. 00176 * 00177 * Test the input parameters. 00178 * 00179 INFO = 0 00180 NOTRAN = LSAME( TRANS, 'N' ) 00181 IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. 00182 $ LSAME( TRANS, 'C' ) ) THEN 00183 INFO = -1 00184 ELSE IF( N.LT.0 ) THEN 00185 INFO = -2 00186 ELSE IF( KL.LT.0 ) THEN 00187 INFO = -3 00188 ELSE IF( KU.LT.0 ) THEN 00189 INFO = -4 00190 ELSE IF( NRHS.LT.0 ) THEN 00191 INFO = -5 00192 ELSE IF( LDAB.LT.( 2*KL+KU+1 ) ) THEN 00193 INFO = -7 00194 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00195 INFO = -10 00196 END IF 00197 IF( INFO.NE.0 ) THEN 00198 CALL XERBLA( 'DGBTRS', -INFO ) 00199 RETURN 00200 END IF 00201 * 00202 * Quick return if possible 00203 * 00204 IF( N.EQ.0 .OR. NRHS.EQ.0 ) 00205 $ RETURN 00206 * 00207 KD = KU + KL + 1 00208 LNOTI = KL.GT.0 00209 * 00210 IF( NOTRAN ) THEN 00211 * 00212 * Solve A*X = B. 00213 * 00214 * Solve L*X = B, overwriting B with X. 00215 * 00216 * L is represented as a product of permutations and unit lower 00217 * triangular matrices L = P(1) * L(1) * ... * P(n-1) * L(n-1), 00218 * where each transformation L(i) is a rank-one modification of 00219 * the identity matrix. 00220 * 00221 IF( LNOTI ) THEN 00222 DO 10 J = 1, N - 1 00223 LM = MIN( KL, N-J ) 00224 L = IPIV( J ) 00225 IF( L.NE.J ) 00226 $ CALL DSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB ) 00227 CALL DGER( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, 1 ), 00228 $ LDB, B( J+1, 1 ), LDB ) 00229 10 CONTINUE 00230 END IF 00231 * 00232 DO 20 I = 1, NRHS 00233 * 00234 * Solve U*X = B, overwriting B with X. 00235 * 00236 CALL DTBSV( 'Upper', 'No transpose', 'Non-unit', N, KL+KU, 00237 $ AB, LDAB, B( 1, I ), 1 ) 00238 20 CONTINUE 00239 * 00240 ELSE 00241 * 00242 * Solve A**T*X = B. 00243 * 00244 DO 30 I = 1, NRHS 00245 * 00246 * Solve U**T*X = B, overwriting B with X. 00247 * 00248 CALL DTBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, AB, 00249 $ LDAB, B( 1, I ), 1 ) 00250 30 CONTINUE 00251 * 00252 * Solve L**T*X = B, overwriting B with X. 00253 * 00254 IF( LNOTI ) THEN 00255 DO 40 J = N - 1, 1, -1 00256 LM = MIN( KL, N-J ) 00257 CALL DGEMV( 'Transpose', LM, NRHS, -ONE, B( J+1, 1 ), 00258 $ LDB, AB( KD+1, J ), 1, ONE, B( J, 1 ), LDB ) 00259 L = IPIV( J ) 00260 IF( L.NE.J ) 00261 $ CALL DSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB ) 00262 40 CONTINUE 00263 END IF 00264 END IF 00265 RETURN 00266 * 00267 * End of DGBTRS 00268 * 00269 END