 LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 subroutine dgtts2 ( integer ITRANS, integer N, integer NRHS, double precision, dimension( * ) DL, double precision, dimension( * ) D, double precision, dimension( * ) DU, double precision, dimension( * ) DU2, integer, dimension( * ) IPIV, double precision, dimension( ldb, * ) B, integer LDB )

DGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf.

Purpose:
DGTTS2 solves one of the systems of equations
A*X = B  or  A**T*X = B,
with a tridiagonal matrix A using the LU factorization computed
by DGTTRF.
Parameters
 [in] ITRANS ITRANS is INTEGER Specifies the form of the system of equations. = 0: A * X = B (No transpose) = 1: A**T* X = B (Transpose) = 2: A**T* X = B (Conjugate transpose = Transpose) [in] N N is INTEGER The order of the matrix A. [in] NRHS NRHS is INTEGER The number of right hand sides, i.e., the number of columns of the matrix B. NRHS >= 0. [in] DL DL is DOUBLE PRECISION array, dimension (N-1) The (n-1) multipliers that define the matrix L from the LU factorization of A. [in] D D is DOUBLE PRECISION array, dimension (N) The n diagonal elements of the upper triangular matrix U from the LU factorization of A. [in] DU DU is DOUBLE PRECISION array, dimension (N-1) The (n-1) elements of the first super-diagonal of U. [in] DU2 DU2 is DOUBLE PRECISION array, dimension (N-2) The (n-2) elements of the second super-diagonal of U. [in] IPIV IPIV is INTEGER array, dimension (N) The pivot indices; for 1 <= i <= n, row i of the matrix was interchanged with row IPIV(i). IPIV(i) will always be either i or i+1; IPIV(i) = i indicates a row interchange was not required. [in,out] B B is DOUBLE PRECISION array, dimension (LDB,NRHS) On entry, the matrix of right hand side vectors B. On exit, B is overwritten by the solution vectors X. [in] LDB LDB is INTEGER The leading dimension of the array B. LDB >= max(1,N).
Date
September 2012

Definition at line 130 of file dgtts2.f.

130 *
131 * -- LAPACK computational routine (version 3.4.2) --
132 * -- LAPACK is a software package provided by Univ. of Tennessee, --
133 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
134 * September 2012
135 *
136 * .. Scalar Arguments ..
137  INTEGER itrans, ldb, n, nrhs
138 * ..
139 * .. Array Arguments ..
140  INTEGER ipiv( * )
141  DOUBLE PRECISION b( ldb, * ), d( * ), dl( * ), du( * ), du2( * )
142 * ..
143 *
144 * =====================================================================
145 *
146 * .. Local Scalars ..
147  INTEGER i, ip, j
148  DOUBLE PRECISION temp
149 * ..
150 * .. Executable Statements ..
151 *
152 * Quick return if possible
153 *
154  IF( n.EQ.0 .OR. nrhs.EQ.0 )
155  \$ RETURN
156 *
157  IF( itrans.EQ.0 ) THEN
158 *
159 * Solve A*X = B using the LU factorization of A,
160 * overwriting each right hand side vector with its solution.
161 *
162  IF( nrhs.LE.1 ) THEN
163  j = 1
164  10 CONTINUE
165 *
166 * Solve L*x = b.
167 *
168  DO 20 i = 1, n - 1
169  ip = ipiv( i )
170  temp = b( i+1-ip+i, j ) - dl( i )*b( ip, j )
171  b( i, j ) = b( ip, j )
172  b( i+1, j ) = temp
173  20 CONTINUE
174 *
175 * Solve U*x = b.
176 *
177  b( n, j ) = b( n, j ) / d( n )
178  IF( n.GT.1 )
179  \$ b( n-1, j ) = ( b( n-1, j )-du( n-1 )*b( n, j ) ) /
180  \$ d( n-1 )
181  DO 30 i = n - 2, 1, -1
182  b( i, j ) = ( b( i, j )-du( i )*b( i+1, j )-du2( i )*
183  \$ b( i+2, j ) ) / d( i )
184  30 CONTINUE
185  IF( j.LT.nrhs ) THEN
186  j = j + 1
187  GO TO 10
188  END IF
189  ELSE
190  DO 60 j = 1, nrhs
191 *
192 * Solve L*x = b.
193 *
194  DO 40 i = 1, n - 1
195  IF( ipiv( i ).EQ.i ) THEN
196  b( i+1, j ) = b( i+1, j ) - dl( i )*b( i, j )
197  ELSE
198  temp = b( i, j )
199  b( i, j ) = b( i+1, j )
200  b( i+1, j ) = temp - dl( i )*b( i, j )
201  END IF
202  40 CONTINUE
203 *
204 * Solve U*x = b.
205 *
206  b( n, j ) = b( n, j ) / d( n )
207  IF( n.GT.1 )
208  \$ b( n-1, j ) = ( b( n-1, j )-du( n-1 )*b( n, j ) ) /
209  \$ d( n-1 )
210  DO 50 i = n - 2, 1, -1
211  b( i, j ) = ( b( i, j )-du( i )*b( i+1, j )-du2( i )*
212  \$ b( i+2, j ) ) / d( i )
213  50 CONTINUE
214  60 CONTINUE
215  END IF
216  ELSE
217 *
218 * Solve A**T * X = B.
219 *
220  IF( nrhs.LE.1 ) THEN
221 *
222 * Solve U**T*x = b.
223 *
224  j = 1
225  70 CONTINUE
226  b( 1, j ) = b( 1, j ) / d( 1 )
227  IF( n.GT.1 )
228  \$ b( 2, j ) = ( b( 2, j )-du( 1 )*b( 1, j ) ) / d( 2 )
229  DO 80 i = 3, n
230  b( i, j ) = ( b( i, j )-du( i-1 )*b( i-1, j )-du2( i-2 )*
231  \$ b( i-2, j ) ) / d( i )
232  80 CONTINUE
233 *
234 * Solve L**T*x = b.
235 *
236  DO 90 i = n - 1, 1, -1
237  ip = ipiv( i )
238  temp = b( i, j ) - dl( i )*b( i+1, j )
239  b( i, j ) = b( ip, j )
240  b( ip, j ) = temp
241  90 CONTINUE
242  IF( j.LT.nrhs ) THEN
243  j = j + 1
244  GO TO 70
245  END IF
246 *
247  ELSE
248  DO 120 j = 1, nrhs
249 *
250 * Solve U**T*x = b.
251 *
252  b( 1, j ) = b( 1, j ) / d( 1 )
253  IF( n.GT.1 )
254  \$ b( 2, j ) = ( b( 2, j )-du( 1 )*b( 1, j ) ) / d( 2 )
255  DO 100 i = 3, n
256  b( i, j ) = ( b( i, j )-du( i-1 )*b( i-1, j )-
257  \$ du2( i-2 )*b( i-2, j ) ) / d( i )
258  100 CONTINUE
259  DO 110 i = n - 1, 1, -1
260  IF( ipiv( i ).EQ.i ) THEN
261  b( i, j ) = b( i, j ) - dl( i )*b( i+1, j )
262  ELSE
263  temp = b( i+1, j )
264  b( i+1, j ) = b( i, j ) - dl( i )*temp
265  b( i, j ) = temp
266  END IF
267  110 CONTINUE
268  120 CONTINUE
269  END IF
270  END IF
271 *
272 * End of DGTTS2
273 *

Here is the caller graph for this function: