LAPACK 3.12.0
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 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: