LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sgbtrs.f
Go to the documentation of this file.
1*> \brief \b SGBTRS
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SGBTRS + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgbtrs.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgbtrs.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgbtrs.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE SGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
22* INFO )
23*
24* .. Scalar Arguments ..
25* CHARACTER TRANS
26* INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
27* ..
28* .. Array Arguments ..
29* INTEGER IPIV( * )
30* REAL AB( LDAB, * ), B( LDB, * )
31* ..
32*
33*
34*> \par Purpose:
35* =============
36*>
37*> \verbatim
38*>
39*> SGBTRS solves a system of linear equations
40*> A * X = B or A**T * X = B
41*> with a general band matrix A using the LU factorization computed
42*> by SGBTRF.
43*> \endverbatim
44*
45* Arguments:
46* ==========
47*
48*> \param[in] TRANS
49*> \verbatim
50*> TRANS is CHARACTER*1
51*> Specifies the form of the system of equations.
52*> = 'N': A * X = B (No transpose)
53*> = 'T': A**T* X = B (Transpose)
54*> = 'C': A**T* X = B (Conjugate transpose = Transpose)
55*> \endverbatim
56*>
57*> \param[in] N
58*> \verbatim
59*> N is INTEGER
60*> The order of the matrix A. N >= 0.
61*> \endverbatim
62*>
63*> \param[in] KL
64*> \verbatim
65*> KL is INTEGER
66*> The number of subdiagonals within the band of A. KL >= 0.
67*> \endverbatim
68*>
69*> \param[in] KU
70*> \verbatim
71*> KU is INTEGER
72*> The number of superdiagonals within the band of A. KU >= 0.
73*> \endverbatim
74*>
75*> \param[in] NRHS
76*> \verbatim
77*> NRHS is INTEGER
78*> The number of right hand sides, i.e., the number of columns
79*> of the matrix B. NRHS >= 0.
80*> \endverbatim
81*>
82*> \param[in] AB
83*> \verbatim
84*> AB is REAL array, dimension (LDAB,N)
85*> Details of the LU factorization of the band matrix A, as
86*> computed by SGBTRF. U is stored as an upper triangular band
87*> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
88*> the multipliers used during the factorization are stored in
89*> rows KL+KU+2 to 2*KL+KU+1.
90*> \endverbatim
91*>
92*> \param[in] LDAB
93*> \verbatim
94*> LDAB is INTEGER
95*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
96*> \endverbatim
97*>
98*> \param[in] IPIV
99*> \verbatim
100*> IPIV is INTEGER array, dimension (N)
101*> The pivot indices; for 1 <= i <= N, row i of the matrix was
102*> interchanged with row IPIV(i).
103*> \endverbatim
104*>
105*> \param[in,out] B
106*> \verbatim
107*> B is REAL array, dimension (LDB,NRHS)
108*> On entry, the right hand side matrix B.
109*> On exit, the solution matrix X.
110*> \endverbatim
111*>
112*> \param[in] LDB
113*> \verbatim
114*> LDB is INTEGER
115*> The leading dimension of the array B. LDB >= max(1,N).
116*> \endverbatim
117*>
118*> \param[out] INFO
119*> \verbatim
120*> INFO is INTEGER
121*> = 0: successful exit
122*> < 0: if INFO = -i, the i-th argument had an illegal value
123*> \endverbatim
124*
125* Authors:
126* ========
127*
128*> \author Univ. of Tennessee
129*> \author Univ. of California Berkeley
130*> \author Univ. of Colorado Denver
131*> \author NAG Ltd.
132*
133*> \ingroup gbtrs
134*
135* =====================================================================
136 SUBROUTINE sgbtrs( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
137 $ INFO )
138*
139* -- LAPACK computational routine --
140* -- LAPACK is a software package provided by Univ. of Tennessee, --
141* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
142*
143* .. Scalar Arguments ..
144 CHARACTER TRANS
145 INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
146* ..
147* .. Array Arguments ..
148 INTEGER IPIV( * )
149 REAL AB( LDAB, * ), B( LDB, * )
150* ..
151*
152* =====================================================================
153*
154* .. Parameters ..
155 REAL ONE
156 parameter( one = 1.0e+0 )
157* ..
158* .. Local Scalars ..
159 LOGICAL LNOTI, NOTRAN
160 INTEGER I, J, KD, L, LM
161* ..
162* .. External Functions ..
163 LOGICAL LSAME
164 EXTERNAL lsame
165* ..
166* .. External Subroutines ..
167 EXTERNAL sgemv, sger, sswap, stbsv, xerbla
168* ..
169* .. Intrinsic Functions ..
170 INTRINSIC max, min
171* ..
172* .. Executable Statements ..
173*
174* Test the input parameters.
175*
176 info = 0
177 notran = lsame( trans, 'N' )
178 IF( .NOT.notran .AND. .NOT.lsame( trans, 'T' ) .AND. .NOT.
179 $ lsame( trans, 'C' ) ) THEN
180 info = -1
181 ELSE IF( n.LT.0 ) THEN
182 info = -2
183 ELSE IF( kl.LT.0 ) THEN
184 info = -3
185 ELSE IF( ku.LT.0 ) THEN
186 info = -4
187 ELSE IF( nrhs.LT.0 ) THEN
188 info = -5
189 ELSE IF( ldab.LT.( 2*kl+ku+1 ) ) THEN
190 info = -7
191 ELSE IF( ldb.LT.max( 1, n ) ) THEN
192 info = -10
193 END IF
194 IF( info.NE.0 ) THEN
195 CALL xerbla( 'SGBTRS', -info )
196 RETURN
197 END IF
198*
199* Quick return if possible
200*
201 IF( n.EQ.0 .OR. nrhs.EQ.0 )
202 $ RETURN
203*
204 kd = ku + kl + 1
205 lnoti = kl.GT.0
206*
207 IF( notran ) THEN
208*
209* Solve A*X = B.
210*
211* Solve L*X = B, overwriting B with X.
212*
213* L is represented as a product of permutations and unit lower
214* triangular matrices L = P(1) * L(1) * ... * P(n-1) * L(n-1),
215* where each transformation L(i) is a rank-one modification of
216* the identity matrix.
217*
218 IF( lnoti ) THEN
219 DO 10 j = 1, n - 1
220 lm = min( kl, n-j )
221 l = ipiv( j )
222 IF( l.NE.j )
223 $ CALL sswap( nrhs, b( l, 1 ), ldb, b( j, 1 ), ldb )
224 CALL sger( lm, nrhs, -one, ab( kd+1, j ), 1, b( j, 1 ),
225 $ ldb, b( j+1, 1 ), ldb )
226 10 CONTINUE
227 END IF
228*
229 DO 20 i = 1, nrhs
230*
231* Solve U*X = B, overwriting B with X.
232*
233 CALL stbsv( 'Upper', 'No transpose', 'Non-unit', n, kl+ku,
234 $ ab, ldab, b( 1, i ), 1 )
235 20 CONTINUE
236*
237 ELSE
238*
239* Solve A**T*X = B.
240*
241 DO 30 i = 1, nrhs
242*
243* Solve U**T*X = B, overwriting B with X.
244*
245 CALL stbsv( 'Upper', 'Transpose', 'Non-unit', n, kl+ku, ab,
246 $ ldab, b( 1, i ), 1 )
247 30 CONTINUE
248*
249* Solve L**T*X = B, overwriting B with X.
250*
251 IF( lnoti ) THEN
252 DO 40 j = n - 1, 1, -1
253 lm = min( kl, n-j )
254 CALL sgemv( 'Transpose', lm, nrhs, -one, b( j+1, 1 ),
255 $ ldb, ab( kd+1, j ), 1, one, b( j, 1 ), ldb )
256 l = ipiv( j )
257 IF( l.NE.j )
258 $ CALL sswap( nrhs, b( l, 1 ), ldb, b( j, 1 ), ldb )
259 40 CONTINUE
260 END IF
261 END IF
262 RETURN
263*
264* End of SGBTRS
265*
266 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine sgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
SGBTRS
Definition sgbtrs.f:138
subroutine sgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
SGEMV
Definition sgemv.f:158
subroutine sger(m, n, alpha, x, incx, y, incy, a, lda)
SGER
Definition sger.f:130
subroutine sswap(n, sx, incx, sy, incy)
SSWAP
Definition sswap.f:82
subroutine stbsv(uplo, trans, diag, n, k, a, lda, x, incx)
STBSV
Definition stbsv.f:189