LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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.
Date
September 2012

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

Here is the caller graph for this function: