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