LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ 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 *
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: