LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ 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 127 of file zgtts2.f.

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