LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sgtsv.f
Go to the documentation of this file.
1*> \brief <b> SGTSV computes the solution to system of linear equations A * X = B for GT matrices </b>
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SGTSV + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgtsv.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgtsv.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgtsv.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE SGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
22*
23* .. Scalar Arguments ..
24* INTEGER INFO, LDB, N, NRHS
25* ..
26* .. Array Arguments ..
27* REAL B( LDB, * ), D( * ), DL( * ), DU( * )
28* ..
29*
30*
31*> \par Purpose:
32* =============
33*>
34*> \verbatim
35*>
36*> SGTSV solves the equation
37*>
38*> A*X = B,
39*>
40*> where A is an n by n tridiagonal matrix, by Gaussian elimination with
41*> partial pivoting.
42*>
43*> Note that the equation A**T*X = B may be solved by interchanging the
44*> order of the arguments DU and DL.
45*> \endverbatim
46*
47* Arguments:
48* ==========
49*
50*> \param[in] N
51*> \verbatim
52*> N is INTEGER
53*> The order of the matrix A. N >= 0.
54*> \endverbatim
55*>
56*> \param[in] NRHS
57*> \verbatim
58*> NRHS is INTEGER
59*> The number of right hand sides, i.e., the number of columns
60*> of the matrix B. NRHS >= 0.
61*> \endverbatim
62*>
63*> \param[in,out] DL
64*> \verbatim
65*> DL is REAL array, dimension (N-1)
66*> On entry, DL must contain the (n-1) sub-diagonal elements of
67*> A.
68*>
69*> On exit, DL is overwritten by the (n-2) elements of the
70*> second super-diagonal of the upper triangular matrix U from
71*> the LU factorization of A, in DL(1), ..., DL(n-2).
72*> \endverbatim
73*>
74*> \param[in,out] D
75*> \verbatim
76*> D is REAL array, dimension (N)
77*> On entry, D must contain the diagonal elements of A.
78*>
79*> On exit, D is overwritten by the n diagonal elements of U.
80*> \endverbatim
81*>
82*> \param[in,out] DU
83*> \verbatim
84*> DU is REAL array, dimension (N-1)
85*> On entry, DU must contain the (n-1) super-diagonal elements
86*> of A.
87*>
88*> On exit, DU is overwritten by the (n-1) elements of the first
89*> super-diagonal of U.
90*> \endverbatim
91*>
92*> \param[in,out] B
93*> \verbatim
94*> B is REAL array, dimension (LDB,NRHS)
95*> On entry, the N by NRHS matrix of right hand side matrix B.
96*> On exit, if INFO = 0, the N by NRHS solution matrix X.
97*> \endverbatim
98*>
99*> \param[in] LDB
100*> \verbatim
101*> LDB is INTEGER
102*> The leading dimension of the array B. LDB >= max(1,N).
103*> \endverbatim
104*>
105*> \param[out] INFO
106*> \verbatim
107*> INFO is INTEGER
108*> = 0: successful exit
109*> < 0: if INFO = -i, the i-th argument had an illegal value
110*> > 0: if INFO = i, U(i,i) is exactly zero, and the solution
111*> has not been computed. The factorization has not been
112*> completed unless i = N.
113*> \endverbatim
114*
115* Authors:
116* ========
117*
118*> \author Univ. of Tennessee
119*> \author Univ. of California Berkeley
120*> \author Univ. of Colorado Denver
121*> \author NAG Ltd.
122*
123*> \ingroup gtsv
124*
125* =====================================================================
126 SUBROUTINE sgtsv( N, NRHS, DL, D, DU, B, LDB, INFO )
127*
128* -- LAPACK driver routine --
129* -- LAPACK is a software package provided by Univ. of Tennessee, --
130* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
131*
132* .. Scalar Arguments ..
133 INTEGER INFO, LDB, N, NRHS
134* ..
135* .. Array Arguments ..
136 REAL B( LDB, * ), D( * ), DL( * ), DU( * )
137* ..
138*
139* =====================================================================
140*
141* .. Parameters ..
142 REAL ZERO
143 parameter( zero = 0.0e+0 )
144* ..
145* .. Local Scalars ..
146 INTEGER I, J
147 REAL FACT, TEMP
148* ..
149* .. Intrinsic Functions ..
150 INTRINSIC abs, max
151* ..
152* .. External Subroutines ..
153 EXTERNAL xerbla
154* ..
155* .. Executable Statements ..
156*
157 info = 0
158 IF( n.LT.0 ) THEN
159 info = -1
160 ELSE IF( nrhs.LT.0 ) THEN
161 info = -2
162 ELSE IF( ldb.LT.max( 1, n ) ) THEN
163 info = -7
164 END IF
165 IF( info.NE.0 ) THEN
166 CALL xerbla( 'SGTSV ', -info )
167 RETURN
168 END IF
169*
170 IF( n.EQ.0 )
171 $ RETURN
172*
173 IF( nrhs.EQ.1 ) THEN
174 DO 10 i = 1, n - 2
175 IF( abs( d( i ) ).GE.abs( dl( i ) ) ) THEN
176*
177* No row interchange required
178*
179 IF( d( i ).NE.zero ) THEN
180 fact = dl( i ) / d( i )
181 d( i+1 ) = d( i+1 ) - fact*du( i )
182 b( i+1, 1 ) = b( i+1, 1 ) - fact*b( i, 1 )
183 ELSE
184 info = i
185 RETURN
186 END IF
187 dl( i ) = zero
188 ELSE
189*
190* Interchange rows I and I+1
191*
192 fact = d( i ) / dl( i )
193 d( i ) = dl( i )
194 temp = d( i+1 )
195 d( i+1 ) = du( i ) - fact*temp
196 dl( i ) = du( i+1 )
197 du( i+1 ) = -fact*dl( i )
198 du( i ) = temp
199 temp = b( i, 1 )
200 b( i, 1 ) = b( i+1, 1 )
201 b( i+1, 1 ) = temp - fact*b( i+1, 1 )
202 END IF
203 10 CONTINUE
204 IF( n.GT.1 ) THEN
205 i = n - 1
206 IF( abs( d( i ) ).GE.abs( dl( i ) ) ) THEN
207 IF( d( i ).NE.zero ) THEN
208 fact = dl( i ) / d( i )
209 d( i+1 ) = d( i+1 ) - fact*du( i )
210 b( i+1, 1 ) = b( i+1, 1 ) - fact*b( i, 1 )
211 ELSE
212 info = i
213 RETURN
214 END IF
215 ELSE
216 fact = d( i ) / dl( i )
217 d( i ) = dl( i )
218 temp = d( i+1 )
219 d( i+1 ) = du( i ) - fact*temp
220 du( i ) = temp
221 temp = b( i, 1 )
222 b( i, 1 ) = b( i+1, 1 )
223 b( i+1, 1 ) = temp - fact*b( i+1, 1 )
224 END IF
225 END IF
226 IF( d( n ).EQ.zero ) THEN
227 info = n
228 RETURN
229 END IF
230 ELSE
231 DO 40 i = 1, n - 2
232 IF( abs( d( i ) ).GE.abs( dl( i ) ) ) THEN
233*
234* No row interchange required
235*
236 IF( d( i ).NE.zero ) THEN
237 fact = dl( i ) / d( i )
238 d( i+1 ) = d( i+1 ) - fact*du( i )
239 DO 20 j = 1, nrhs
240 b( i+1, j ) = b( i+1, j ) - fact*b( i, j )
241 20 CONTINUE
242 ELSE
243 info = i
244 RETURN
245 END IF
246 dl( i ) = zero
247 ELSE
248*
249* Interchange rows I and I+1
250*
251 fact = d( i ) / dl( i )
252 d( i ) = dl( i )
253 temp = d( i+1 )
254 d( i+1 ) = du( i ) - fact*temp
255 dl( i ) = du( i+1 )
256 du( i+1 ) = -fact*dl( i )
257 du( i ) = temp
258 DO 30 j = 1, nrhs
259 temp = b( i, j )
260 b( i, j ) = b( i+1, j )
261 b( i+1, j ) = temp - fact*b( i+1, j )
262 30 CONTINUE
263 END IF
264 40 CONTINUE
265 IF( n.GT.1 ) THEN
266 i = n - 1
267 IF( abs( d( i ) ).GE.abs( dl( i ) ) ) THEN
268 IF( d( i ).NE.zero ) THEN
269 fact = dl( i ) / d( i )
270 d( i+1 ) = d( i+1 ) - fact*du( i )
271 DO 50 j = 1, nrhs
272 b( i+1, j ) = b( i+1, j ) - fact*b( i, j )
273 50 CONTINUE
274 ELSE
275 info = i
276 RETURN
277 END IF
278 ELSE
279 fact = d( i ) / dl( i )
280 d( i ) = dl( i )
281 temp = d( i+1 )
282 d( i+1 ) = du( i ) - fact*temp
283 du( i ) = temp
284 DO 60 j = 1, nrhs
285 temp = b( i, j )
286 b( i, j ) = b( i+1, j )
287 b( i+1, j ) = temp - fact*b( i+1, j )
288 60 CONTINUE
289 END IF
290 END IF
291 IF( d( n ).EQ.zero ) THEN
292 info = n
293 RETURN
294 END IF
295 END IF
296*
297* Back solve with the matrix U from the factorization.
298*
299 IF( nrhs.LE.2 ) THEN
300 j = 1
301 70 CONTINUE
302 b( n, j ) = b( n, j ) / d( n )
303 IF( n.GT.1 )
304 $ b( n-1, j ) = ( b( n-1, j )-du( n-1 )*b( n, j ) ) / d( n-1 )
305 DO 80 i = n - 2, 1, -1
306 b( i, j ) = ( b( i, j )-du( i )*b( i+1, j )-dl( i )*
307 $ b( i+2, j ) ) / d( i )
308 80 CONTINUE
309 IF( j.LT.nrhs ) THEN
310 j = j + 1
311 GO TO 70
312 END IF
313 ELSE
314 DO 100 j = 1, nrhs
315 b( n, j ) = b( n, j ) / d( n )
316 IF( n.GT.1 )
317 $ b( n-1, j ) = ( b( n-1, j )-du( n-1 )*b( n, j ) ) /
318 $ d( n-1 )
319 DO 90 i = n - 2, 1, -1
320 b( i, j ) = ( b( i, j )-du( i )*b( i+1, j )-dl( i )*
321 $ b( i+2, j ) ) / d( i )
322 90 CONTINUE
323 100 CONTINUE
324 END IF
325*
326 RETURN
327*
328* End of SGTSV
329*
330 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine sgtsv(n, nrhs, dl, d, du, b, ldb, info)
SGTSV computes the solution to system of linear equations A * X = B for GT matrices
Definition sgtsv.f:127