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

◆ clagtm()

subroutine clagtm ( character trans,
integer n,
integer nrhs,
real alpha,
complex, dimension( * ) dl,
complex, dimension( * ) d,
complex, dimension( * ) du,
complex, dimension( ldx, * ) x,
integer ldx,
real beta,
complex, dimension( ldb, * ) b,
integer ldb )

CLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1.

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

Purpose:
!>
!> CLAGTM performs a matrix-matrix product of the form
!>
!>    B := alpha * A * X + beta * B
!>
!> where A is a tridiagonal matrix of order N, B and X are N by NRHS
!> matrices, and alpha and beta are real scalars, each of which may be
!> 0., 1., or -1.
!> 
Parameters
[in]TRANS
!>          TRANS is CHARACTER*1
!>          Specifies the operation applied to A.
!>          = 'N':  No transpose, B := alpha * A * X + beta * B
!>          = 'T':  Transpose,    B := alpha * A**T * X + beta * B
!>          = 'C':  Conjugate transpose, B := alpha * A**H * X + beta * B
!> 
[in]N
!>          N is INTEGER
!>          The order of the matrix A.  N >= 0.
!> 
[in]NRHS
!>          NRHS is INTEGER
!>          The number of right hand sides, i.e., the number of columns
!>          of the matrices X and B.
!> 
[in]ALPHA
!>          ALPHA is REAL
!>          The scalar alpha.  ALPHA must be 0., 1., or -1.; otherwise,
!>          it is assumed to be 0.
!> 
[in]DL
!>          DL is COMPLEX array, dimension (N-1)
!>          The (n-1) sub-diagonal elements of T.
!> 
[in]D
!>          D is COMPLEX array, dimension (N)
!>          The diagonal elements of T.
!> 
[in]DU
!>          DU is COMPLEX array, dimension (N-1)
!>          The (n-1) super-diagonal elements of T.
!> 
[in]X
!>          X is COMPLEX array, dimension (LDX,NRHS)
!>          The N by NRHS matrix X.
!> 
[in]LDX
!>          LDX is INTEGER
!>          The leading dimension of the array X.  LDX >= max(N,1).
!> 
[in]BETA
!>          BETA is REAL
!>          The scalar beta.  BETA must be 0., 1., or -1.; otherwise,
!>          it is assumed to be 1.
!> 
[in,out]B
!>          B is COMPLEX array, dimension (LDB,NRHS)
!>          On entry, the N by NRHS matrix B.
!>          On exit, B is overwritten by the matrix expression
!>          B := alpha * A * X + beta * B.
!> 
[in]LDB
!>          LDB is INTEGER
!>          The leading dimension of the array B.  LDB >= max(N,1).
!> 
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 141 of file clagtm.f.

144*
145* -- LAPACK auxiliary routine --
146* -- LAPACK is a software package provided by Univ. of Tennessee, --
147* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
148*
149* .. Scalar Arguments ..
150 CHARACTER TRANS
151 INTEGER LDB, LDX, N, NRHS
152 REAL ALPHA, BETA
153* ..
154* .. Array Arguments ..
155 COMPLEX B( LDB, * ), D( * ), DL( * ), DU( * ),
156 $ X( LDX, * )
157* ..
158*
159* =====================================================================
160*
161* .. Parameters ..
162 REAL ONE, ZERO
163 parameter( one = 1.0e+0, zero = 0.0e+0 )
164* ..
165* .. Local Scalars ..
166 INTEGER I, J
167* ..
168* .. External Functions ..
169 LOGICAL LSAME
170 EXTERNAL lsame
171* ..
172* .. Intrinsic Functions ..
173 INTRINSIC conjg
174* ..
175* .. Executable Statements ..
176*
177 IF( n.EQ.0 )
178 $ RETURN
179*
180* Multiply B by BETA if BETA.NE.1.
181*
182 IF( beta.EQ.zero ) THEN
183 DO 20 j = 1, nrhs
184 DO 10 i = 1, n
185 b( i, j ) = zero
186 10 CONTINUE
187 20 CONTINUE
188 ELSE IF( beta.EQ.-one ) THEN
189 DO 40 j = 1, nrhs
190 DO 30 i = 1, n
191 b( i, j ) = -b( i, j )
192 30 CONTINUE
193 40 CONTINUE
194 END IF
195*
196 IF( alpha.EQ.one ) THEN
197 IF( lsame( trans, 'N' ) ) THEN
198*
199* Compute B := B + A*X
200*
201 DO 60 j = 1, nrhs
202 IF( n.EQ.1 ) THEN
203 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j )
204 ELSE
205 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j ) +
206 $ du( 1 )*x( 2, j )
207 b( n, j ) = b( n, j ) + dl( n-1 )*x( n-1, j ) +
208 $ d( n )*x( n, j )
209 DO 50 i = 2, n - 1
210 b( i, j ) = b( i, j ) + dl( i-1 )*x( i-1, j ) +
211 $ d( i )*x( i, j ) + du( i )*x( i+1, j )
212 50 CONTINUE
213 END IF
214 60 CONTINUE
215 ELSE IF( lsame( trans, 'T' ) ) THEN
216*
217* Compute B := B + A**T * X
218*
219 DO 80 j = 1, nrhs
220 IF( n.EQ.1 ) THEN
221 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j )
222 ELSE
223 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j ) +
224 $ dl( 1 )*x( 2, j )
225 b( n, j ) = b( n, j ) + du( n-1 )*x( n-1, j ) +
226 $ d( n )*x( n, j )
227 DO 70 i = 2, n - 1
228 b( i, j ) = b( i, j ) + du( i-1 )*x( i-1, j ) +
229 $ d( i )*x( i, j ) + dl( i )*x( i+1, j )
230 70 CONTINUE
231 END IF
232 80 CONTINUE
233 ELSE IF( lsame( trans, 'C' ) ) THEN
234*
235* Compute B := B + A**H * X
236*
237 DO 100 j = 1, nrhs
238 IF( n.EQ.1 ) THEN
239 b( 1, j ) = b( 1, j ) + conjg( d( 1 ) )*x( 1, j )
240 ELSE
241 b( 1, j ) = b( 1, j ) + conjg( d( 1 ) )*x( 1, j ) +
242 $ conjg( dl( 1 ) )*x( 2, j )
243 b( n, j ) = b( n, j ) + conjg( du( n-1 ) )*
244 $ x( n-1, j ) + conjg( d( n ) )*x( n, j )
245 DO 90 i = 2, n - 1
246 b( i, j ) = b( i, j ) + conjg( du( i-1 ) )*
247 $ x( i-1, j ) + conjg( d( i ) )*
248 $ x( i, j ) + conjg( dl( i ) )*
249 $ x( i+1, j )
250 90 CONTINUE
251 END IF
252 100 CONTINUE
253 END IF
254 ELSE IF( alpha.EQ.-one ) THEN
255 IF( lsame( trans, 'N' ) ) THEN
256*
257* Compute B := B - A*X
258*
259 DO 120 j = 1, nrhs
260 IF( n.EQ.1 ) THEN
261 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j )
262 ELSE
263 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j ) -
264 $ du( 1 )*x( 2, j )
265 b( n, j ) = b( n, j ) - dl( n-1 )*x( n-1, j ) -
266 $ d( n )*x( n, j )
267 DO 110 i = 2, n - 1
268 b( i, j ) = b( i, j ) - dl( i-1 )*x( i-1, j ) -
269 $ d( i )*x( i, j ) - du( i )*x( i+1, j )
270 110 CONTINUE
271 END IF
272 120 CONTINUE
273 ELSE IF( lsame( trans, 'T' ) ) THEN
274*
275* Compute B := B - A**T*X
276*
277 DO 140 j = 1, nrhs
278 IF( n.EQ.1 ) THEN
279 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j )
280 ELSE
281 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j ) -
282 $ dl( 1 )*x( 2, j )
283 b( n, j ) = b( n, j ) - du( n-1 )*x( n-1, j ) -
284 $ d( n )*x( n, j )
285 DO 130 i = 2, n - 1
286 b( i, j ) = b( i, j ) - du( i-1 )*x( i-1, j ) -
287 $ d( i )*x( i, j ) - dl( i )*x( i+1, j )
288 130 CONTINUE
289 END IF
290 140 CONTINUE
291 ELSE IF( lsame( trans, 'C' ) ) THEN
292*
293* Compute B := B - A**H*X
294*
295 DO 160 j = 1, nrhs
296 IF( n.EQ.1 ) THEN
297 b( 1, j ) = b( 1, j ) - conjg( d( 1 ) )*x( 1, j )
298 ELSE
299 b( 1, j ) = b( 1, j ) - conjg( d( 1 ) )*x( 1, j ) -
300 $ conjg( dl( 1 ) )*x( 2, j )
301 b( n, j ) = b( n, j ) - conjg( du( n-1 ) )*
302 $ x( n-1, j ) - conjg( d( n ) )*x( n, j )
303 DO 150 i = 2, n - 1
304 b( i, j ) = b( i, j ) - conjg( du( i-1 ) )*
305 $ x( i-1, j ) - conjg( d( i ) )*
306 $ x( i, j ) - conjg( dl( i ) )*
307 $ x( i+1, j )
308 150 CONTINUE
309 END IF
310 160 CONTINUE
311 END IF
312 END IF
313 RETURN
314*
315* End of CLAGTM
316*
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the caller graph for this function: