LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ sgtsv()

subroutine sgtsv ( integer  N,
integer  NRHS,
real, dimension( * )  DL,
real, dimension( * )  D,
real, dimension( * )  DU,
real, dimension( ldb, * )  B,
integer  LDB,
integer  INFO 
)

SGTSV computes the solution to system of linear equations A * X = B for GT matrices

Download SGTSV + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 SGTSV  solves the equation

    A*X = B,

 where A is an n by n tridiagonal matrix, by Gaussian elimination with
 partial pivoting.

 Note that the equation  A**T*X = B  may be solved by interchanging the
 order of the arguments DU and DL.
Parameters
[in]N
          N is INTEGER
          The order of the matrix A.  N >= 0.
[in]NRHS
          NRHS is INTEGER
          The number of right hand sides, i.e., the number of columns
          of the matrix B.  NRHS >= 0.
[in,out]DL
          DL is REAL array, dimension (N-1)
          On entry, DL must contain the (n-1) sub-diagonal elements of
          A.

          On exit, DL is overwritten by the (n-2) elements of the
          second super-diagonal of the upper triangular matrix U from
          the LU factorization of A, in DL(1), ..., DL(n-2).
[in,out]D
          D is REAL array, dimension (N)
          On entry, D must contain the diagonal elements of A.

          On exit, D is overwritten by the n diagonal elements of U.
[in,out]DU
          DU is REAL array, dimension (N-1)
          On entry, DU must contain the (n-1) super-diagonal elements
          of A.

          On exit, DU is overwritten by the (n-1) elements of the first
          super-diagonal of U.
[in,out]B
          B is REAL array, dimension (LDB,NRHS)
          On entry, the N by NRHS matrix of right hand side matrix B.
          On exit, if INFO = 0, the N by NRHS solution matrix X.
[in]LDB
          LDB is INTEGER
          The leading dimension of the array B.  LDB >= max(1,N).
[out]INFO
          INFO is INTEGER
          = 0: successful exit
          < 0: if INFO = -i, the i-th argument had an illegal value
          > 0: if INFO = i, U(i,i) is exactly zero, and the solution
               has not been computed.  The factorization has not been
               completed unless i = N.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 126 of file sgtsv.f.

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*
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
Here is the call graph for this function:
Here is the caller graph for this function: