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

◆ zgtts2()

subroutine zgtts2 ( integer itrans,
integer n,
integer nrhs,
complex*16, dimension( * ) dl,
complex*16, dimension( * ) d,
complex*16, dimension( * ) du,
complex*16, dimension( * ) du2,
integer, dimension( * ) ipiv,
complex*16, dimension( ldb, * ) b,
integer ldb )

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

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

Purpose:
!>
!> ZGTTS2 solves one of the systems of equations
!>    A * X = B,  A**T * X = B,  or  A**H * X = B,
!> with a tridiagonal matrix A using the LU factorization computed
!> by ZGTTRF.
!>
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**H * X = B  (Conjugate 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 COMPLEX*16 array, dimension (N-1)
!>          The (n-1) multipliers that define the matrix L from the
!>          LU factorization of A.
!>
[in]D
!>          D is COMPLEX*16 array, dimension (N)
!>          The n diagonal elements of the upper triangular matrix U from
!>          the LU factorization of A.
!>
[in]DU
!>          DU is COMPLEX*16 array, dimension (N-1)
!>          The (n-1) elements of the first super-diagonal of U.
!>
[in]DU2
!>          DU2 is COMPLEX*16 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 COMPLEX*16 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).
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 125 of file zgtts2.f.

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 COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
138* ..
139*
140* =====================================================================
141*
142* .. Local Scalars ..
143 INTEGER I, J
144 COMPLEX*16 TEMP
145* ..
146* .. Intrinsic Functions ..
147 INTRINSIC dconjg
148* ..
149* .. Executable Statements ..
150*
151* Quick return if possible
152*
153 IF( n.EQ.0 .OR. nrhs.EQ.0 )
154 $ RETURN
155*
156 IF( itrans.EQ.0 ) THEN
157*
158* Solve A*X = B using the LU factorization of A,
159* overwriting each right hand side vector with its solution.
160*
161 IF( nrhs.LE.1 ) THEN
162 j = 1
163 10 CONTINUE
164*
165* Solve L*x = b.
166*
167 DO 20 i = 1, n - 1
168 IF( ipiv( i ).EQ.i ) THEN
169 b( i+1, j ) = b( i+1, j ) - dl( i )*b( i, j )
170 ELSE
171 temp = b( i, j )
172 b( i, j ) = b( i+1, j )
173 b( i+1, j ) = temp - dl( i )*b( i, j )
174 END IF
175 20 CONTINUE
176*
177* Solve U*x = b.
178*
179 b( n, j ) = b( n, j ) / d( n )
180 IF( n.GT.1 )
181 $ b( n-1, j ) = ( b( n-1, j )-du( n-1 )*b( n, j ) ) /
182 $ d( n-1 )
183 DO 30 i = n - 2, 1, -1
184 b( i, j ) = ( b( i, j )-du( i )*b( i+1, j )-du2( i )*
185 $ b( i+2, j ) ) / d( i )
186 30 CONTINUE
187 IF( j.LT.nrhs ) THEN
188 j = j + 1
189 GO TO 10
190 END IF
191 ELSE
192 DO 60 j = 1, nrhs
193*
194* Solve L*x = b.
195*
196 DO 40 i = 1, n - 1
197 IF( ipiv( i ).EQ.i ) THEN
198 b( i+1, j ) = b( i+1, j ) - dl( i )*b( i, j )
199 ELSE
200 temp = b( i, j )
201 b( i, j ) = b( i+1, j )
202 b( i+1, j ) = temp - dl( i )*b( i, j )
203 END IF
204 40 CONTINUE
205*
206* Solve U*x = b.
207*
208 b( n, j ) = b( n, j ) / d( n )
209 IF( n.GT.1 )
210 $ b( n-1, j ) = ( b( n-1, j )-du( n-1 )*b( n, j ) ) /
211 $ d( n-1 )
212 DO 50 i = n - 2, 1, -1
213 b( i, j ) = ( b( i, j )-du( i )*b( i+1, j )-du2( i )*
214 $ b( i+2, j ) ) / d( i )
215 50 CONTINUE
216 60 CONTINUE
217 END IF
218 ELSE IF( itrans.EQ.1 ) THEN
219*
220* Solve A**T * X = B.
221*
222 IF( nrhs.LE.1 ) THEN
223 j = 1
224 70 CONTINUE
225*
226* Solve U**T * x = b.
227*
228 b( 1, j ) = b( 1, j ) / d( 1 )
229 IF( n.GT.1 )
230 $ b( 2, j ) = ( b( 2, j )-du( 1 )*b( 1, j ) ) / d( 2 )
231 DO 80 i = 3, n
232 b( i, j ) = ( b( i, j )-du( i-1 )*b( i-1, j )-du2( i-2 )*
233 $ b( i-2, j ) ) / d( i )
234 80 CONTINUE
235*
236* Solve L**T * x = b.
237*
238 DO 90 i = n - 1, 1, -1
239 IF( ipiv( i ).EQ.i ) THEN
240 b( i, j ) = b( i, j ) - dl( i )*b( i+1, j )
241 ELSE
242 temp = b( i+1, j )
243 b( i+1, j ) = b( i, j ) - dl( i )*temp
244 b( i, j ) = temp
245 END IF
246 90 CONTINUE
247 IF( j.LT.nrhs ) THEN
248 j = j + 1
249 GO TO 70
250 END IF
251 ELSE
252 DO 120 j = 1, nrhs
253*
254* Solve U**T * x = b.
255*
256 b( 1, j ) = b( 1, j ) / d( 1 )
257 IF( n.GT.1 )
258 $ b( 2, j ) = ( b( 2, j )-du( 1 )*b( 1, j ) ) / d( 2 )
259 DO 100 i = 3, n
260 b( i, j ) = ( b( i, j )-du( i-1 )*b( i-1, j )-
261 $ du2( i-2 )*b( i-2, j ) ) / d( i )
262 100 CONTINUE
263*
264* Solve L**T * x = b.
265*
266 DO 110 i = n - 1, 1, -1
267 IF( ipiv( i ).EQ.i ) THEN
268 b( i, j ) = b( i, j ) - dl( i )*b( i+1, j )
269 ELSE
270 temp = b( i+1, j )
271 b( i+1, j ) = b( i, j ) - dl( i )*temp
272 b( i, j ) = temp
273 END IF
274 110 CONTINUE
275 120 CONTINUE
276 END IF
277 ELSE
278*
279* Solve A**H * X = B.
280*
281 IF( nrhs.LE.1 ) THEN
282 j = 1
283 130 CONTINUE
284*
285* Solve U**H * x = b.
286*
287 b( 1, j ) = b( 1, j ) / dconjg( d( 1 ) )
288 IF( n.GT.1 )
289 $ b( 2, j ) = ( b( 2, j )-dconjg( du( 1 ) )*b( 1, j ) ) /
290 $ dconjg( d( 2 ) )
291 DO 140 i = 3, n
292 b( i, j ) = ( b( i, j )-dconjg( du( i-1 ) )*b( i-1, j )-
293 $ dconjg( du2( i-2 ) )*b( i-2, j ) ) /
294 $ dconjg( d( i ) )
295 140 CONTINUE
296*
297* Solve L**H * x = b.
298*
299 DO 150 i = n - 1, 1, -1
300 IF( ipiv( i ).EQ.i ) THEN
301 b( i, j ) = b( i, j ) - dconjg( dl( i ) )*b( i+1, j )
302 ELSE
303 temp = b( i+1, j )
304 b( i+1, j ) = b( i, j ) - dconjg( dl( i ) )*temp
305 b( i, j ) = temp
306 END IF
307 150 CONTINUE
308 IF( j.LT.nrhs ) THEN
309 j = j + 1
310 GO TO 130
311 END IF
312 ELSE
313 DO 180 j = 1, nrhs
314*
315* Solve U**H * x = b.
316*
317 b( 1, j ) = b( 1, j ) / dconjg( d( 1 ) )
318 IF( n.GT.1 )
319 $ b( 2, j ) = ( b( 2, j )-dconjg( du( 1 ) )*b( 1, j ) )
320 $ / dconjg( d( 2 ) )
321 DO 160 i = 3, n
322 b( i, j ) = ( b( i, j )-dconjg( du( i-1 ) )*
323 $ b( i-1, j )-dconjg( du2( i-2 ) )*
324 $ b( i-2, j ) ) / dconjg( d( i ) )
325 160 CONTINUE
326*
327* Solve L**H * x = b.
328*
329 DO 170 i = n - 1, 1, -1
330 IF( ipiv( i ).EQ.i ) THEN
331 b( i, j ) = b( i, j ) - dconjg( dl( i ) )*
332 $ b( i+1, j )
333 ELSE
334 temp = b( i+1, j )
335 b( i+1, j ) = b( i, j ) - dconjg( dl( i ) )*temp
336 b( i, j ) = temp
337 END IF
338 170 CONTINUE
339 180 CONTINUE
340 END IF
341 END IF
342*
343* End of ZGTTS2
344*
Here is the caller graph for this function: