LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
dgtts2.f
Go to the documentation of this file.
1 *> \brief \b DGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf.
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download DGTTS2 + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgtts2.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgtts2.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgtts2.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE DGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER ITRANS, LDB, N, NRHS
25 * ..
26 * .. Array Arguments ..
27 * INTEGER IPIV( * )
28 * DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> DGTTS2 solves one of the systems of equations
38 *> A*X = B or A**T*X = B,
39 *> with a tridiagonal matrix A using the LU factorization computed
40 *> by DGTTRF.
41 *> \endverbatim
42 *
43 * Arguments:
44 * ==========
45 *
46 *> \param[in] ITRANS
47 *> \verbatim
48 *> ITRANS is INTEGER
49 *> Specifies the form of the system of equations.
50 *> = 0: A * X = B (No transpose)
51 *> = 1: A**T* X = B (Transpose)
52 *> = 2: A**T* X = B (Conjugate transpose = Transpose)
53 *> \endverbatim
54 *>
55 *> \param[in] N
56 *> \verbatim
57 *> N is INTEGER
58 *> The order of the matrix A.
59 *> \endverbatim
60 *>
61 *> \param[in] NRHS
62 *> \verbatim
63 *> NRHS is INTEGER
64 *> The number of right hand sides, i.e., the number of columns
65 *> of the matrix B. NRHS >= 0.
66 *> \endverbatim
67 *>
68 *> \param[in] DL
69 *> \verbatim
70 *> DL is DOUBLE PRECISION array, dimension (N-1)
71 *> The (n-1) multipliers that define the matrix L from the
72 *> LU factorization of A.
73 *> \endverbatim
74 *>
75 *> \param[in] D
76 *> \verbatim
77 *> D is DOUBLE PRECISION array, dimension (N)
78 *> The n diagonal elements of the upper triangular matrix U from
79 *> the LU factorization of A.
80 *> \endverbatim
81 *>
82 *> \param[in] DU
83 *> \verbatim
84 *> DU is DOUBLE PRECISION array, dimension (N-1)
85 *> The (n-1) elements of the first super-diagonal of U.
86 *> \endverbatim
87 *>
88 *> \param[in] DU2
89 *> \verbatim
90 *> DU2 is DOUBLE PRECISION array, dimension (N-2)
91 *> The (n-2) elements of the second super-diagonal of U.
92 *> \endverbatim
93 *>
94 *> \param[in] IPIV
95 *> \verbatim
96 *> IPIV is INTEGER array, dimension (N)
97 *> The pivot indices; for 1 <= i <= n, row i of the matrix was
98 *> interchanged with row IPIV(i). IPIV(i) will always be either
99 *> i or i+1; IPIV(i) = i indicates a row interchange was not
100 *> required.
101 *> \endverbatim
102 *>
103 *> \param[in,out] B
104 *> \verbatim
105 *> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
106 *> On entry, the matrix of right hand side vectors B.
107 *> On exit, B is overwritten by the solution vectors X.
108 *> \endverbatim
109 *>
110 *> \param[in] LDB
111 *> \verbatim
112 *> LDB is INTEGER
113 *> The leading dimension of the array B. LDB >= max(1,N).
114 *> \endverbatim
115 *
116 * Authors:
117 * ========
118 *
119 *> \author Univ. of Tennessee
120 *> \author Univ. of California Berkeley
121 *> \author Univ. of Colorado Denver
122 *> \author NAG Ltd.
123 *
124 *> \ingroup doubleGTcomputational
125 *
126 * =====================================================================
127  SUBROUTINE dgtts2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
128 *
129 * -- LAPACK computational routine --
130 * -- LAPACK is a software package provided by Univ. of Tennessee, --
131 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
132 *
133 * .. Scalar Arguments ..
134  INTEGER ITRANS, LDB, N, NRHS
135 * ..
136 * .. Array Arguments ..
137  INTEGER IPIV( * )
138  DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
139 * ..
140 *
141 * =====================================================================
142 *
143 * .. Local Scalars ..
144  INTEGER I, IP, J
145  DOUBLE PRECISION TEMP
146 * ..
147 * .. Executable Statements ..
148 *
149 * Quick return if possible
150 *
151  IF( n.EQ.0 .OR. nrhs.EQ.0 )
152  $ RETURN
153 *
154  IF( itrans.EQ.0 ) THEN
155 *
156 * Solve A*X = B using the LU factorization of A,
157 * overwriting each right hand side vector with its solution.
158 *
159  IF( nrhs.LE.1 ) THEN
160  j = 1
161  10 CONTINUE
162 *
163 * Solve L*x = b.
164 *
165  DO 20 i = 1, n - 1
166  ip = ipiv( i )
167  temp = b( i+1-ip+i, j ) - dl( i )*b( ip, j )
168  b( i, j ) = b( ip, j )
169  b( i+1, j ) = temp
170  20 CONTINUE
171 *
172 * Solve U*x = b.
173 *
174  b( n, j ) = b( n, j ) / d( n )
175  IF( n.GT.1 )
176  $ b( n-1, j ) = ( b( n-1, j )-du( n-1 )*b( n, j ) ) /
177  $ d( n-1 )
178  DO 30 i = n - 2, 1, -1
179  b( i, j ) = ( b( i, j )-du( i )*b( i+1, j )-du2( i )*
180  $ b( i+2, j ) ) / d( i )
181  30 CONTINUE
182  IF( j.LT.nrhs ) THEN
183  j = j + 1
184  GO TO 10
185  END IF
186  ELSE
187  DO 60 j = 1, nrhs
188 *
189 * Solve L*x = b.
190 *
191  DO 40 i = 1, n - 1
192  IF( ipiv( i ).EQ.i ) THEN
193  b( i+1, j ) = b( i+1, j ) - dl( i )*b( i, j )
194  ELSE
195  temp = b( i, j )
196  b( i, j ) = b( i+1, j )
197  b( i+1, j ) = temp - dl( i )*b( i, j )
198  END IF
199  40 CONTINUE
200 *
201 * Solve U*x = b.
202 *
203  b( n, j ) = b( n, j ) / d( n )
204  IF( n.GT.1 )
205  $ b( n-1, j ) = ( b( n-1, j )-du( n-1 )*b( n, j ) ) /
206  $ d( n-1 )
207  DO 50 i = n - 2, 1, -1
208  b( i, j ) = ( b( i, j )-du( i )*b( i+1, j )-du2( i )*
209  $ b( i+2, j ) ) / d( i )
210  50 CONTINUE
211  60 CONTINUE
212  END IF
213  ELSE
214 *
215 * Solve A**T * X = B.
216 *
217  IF( nrhs.LE.1 ) THEN
218 *
219 * Solve U**T*x = b.
220 *
221  j = 1
222  70 CONTINUE
223  b( 1, j ) = b( 1, j ) / d( 1 )
224  IF( n.GT.1 )
225  $ b( 2, j ) = ( b( 2, j )-du( 1 )*b( 1, j ) ) / d( 2 )
226  DO 80 i = 3, n
227  b( i, j ) = ( b( i, j )-du( i-1 )*b( i-1, j )-du2( i-2 )*
228  $ b( i-2, j ) ) / d( i )
229  80 CONTINUE
230 *
231 * Solve L**T*x = b.
232 *
233  DO 90 i = n - 1, 1, -1
234  ip = ipiv( i )
235  temp = b( i, j ) - dl( i )*b( i+1, j )
236  b( i, j ) = b( ip, j )
237  b( ip, j ) = temp
238  90 CONTINUE
239  IF( j.LT.nrhs ) THEN
240  j = j + 1
241  GO TO 70
242  END IF
243 *
244  ELSE
245  DO 120 j = 1, nrhs
246 *
247 * Solve U**T*x = b.
248 *
249  b( 1, j ) = b( 1, j ) / d( 1 )
250  IF( n.GT.1 )
251  $ b( 2, j ) = ( b( 2, j )-du( 1 )*b( 1, j ) ) / d( 2 )
252  DO 100 i = 3, n
253  b( i, j ) = ( b( i, j )-du( i-1 )*b( i-1, j )-
254  $ du2( i-2 )*b( i-2, j ) ) / d( i )
255  100 CONTINUE
256  DO 110 i = n - 1, 1, -1
257  IF( ipiv( i ).EQ.i ) THEN
258  b( i, j ) = b( i, j ) - dl( i )*b( i+1, j )
259  ELSE
260  temp = b( i+1, j )
261  b( i+1, j ) = b( i, j ) - dl( i )*temp
262  b( i, j ) = temp
263  END IF
264  110 CONTINUE
265  120 CONTINUE
266  END IF
267  END IF
268 *
269 * End of DGTTS2
270 *
271  END
subroutine dgtts2(ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB)
DGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization compu...
Definition: dgtts2.f:128