LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
slagtm.f
Go to the documentation of this file.
1 *> \brief \b SLAGTM 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.
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SLAGTM + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slagtm.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slagtm.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slagtm.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
22 * B, LDB )
23 *
24 * .. Scalar Arguments ..
25 * CHARACTER TRANS
26 * INTEGER LDB, LDX, N, NRHS
27 * REAL ALPHA, BETA
28 * ..
29 * .. Array Arguments ..
30 * REAL B( LDB, * ), D( * ), DL( * ), DU( * ),
31 * $ X( LDX, * )
32 * ..
33 *
34 *
35 *> \par Purpose:
36 * =============
37 *>
38 *> \verbatim
39 *>
40 *> SLAGTM performs a matrix-vector product of the form
41 *>
42 *> B := alpha * A * X + beta * B
43 *>
44 *> where A is a tridiagonal matrix of order N, B and X are N by NRHS
45 *> matrices, and alpha and beta are real scalars, each of which may be
46 *> 0., 1., or -1.
47 *> \endverbatim
48 *
49 * Arguments:
50 * ==========
51 *
52 *> \param[in] TRANS
53 *> \verbatim
54 *> TRANS is CHARACTER*1
55 *> Specifies the operation applied to A.
56 *> = 'N': No transpose, B := alpha * A * X + beta * B
57 *> = 'T': Transpose, B := alpha * A'* X + beta * B
58 *> = 'C': Conjugate transpose = Transpose
59 *> \endverbatim
60 *>
61 *> \param[in] N
62 *> \verbatim
63 *> N is INTEGER
64 *> The order of the matrix A. N >= 0.
65 *> \endverbatim
66 *>
67 *> \param[in] NRHS
68 *> \verbatim
69 *> NRHS is INTEGER
70 *> The number of right hand sides, i.e., the number of columns
71 *> of the matrices X and B.
72 *> \endverbatim
73 *>
74 *> \param[in] ALPHA
75 *> \verbatim
76 *> ALPHA is REAL
77 *> The scalar alpha. ALPHA must be 0., 1., or -1.; otherwise,
78 *> it is assumed to be 0.
79 *> \endverbatim
80 *>
81 *> \param[in] DL
82 *> \verbatim
83 *> DL is REAL array, dimension (N-1)
84 *> The (n-1) sub-diagonal elements of T.
85 *> \endverbatim
86 *>
87 *> \param[in] D
88 *> \verbatim
89 *> D is REAL array, dimension (N)
90 *> The diagonal elements of T.
91 *> \endverbatim
92 *>
93 *> \param[in] DU
94 *> \verbatim
95 *> DU is REAL array, dimension (N-1)
96 *> The (n-1) super-diagonal elements of T.
97 *> \endverbatim
98 *>
99 *> \param[in] X
100 *> \verbatim
101 *> X is REAL array, dimension (LDX,NRHS)
102 *> The N by NRHS matrix X.
103 *> \endverbatim
104 *>
105 *> \param[in] LDX
106 *> \verbatim
107 *> LDX is INTEGER
108 *> The leading dimension of the array X. LDX >= max(N,1).
109 *> \endverbatim
110 *>
111 *> \param[in] BETA
112 *> \verbatim
113 *> BETA is REAL
114 *> The scalar beta. BETA must be 0., 1., or -1.; otherwise,
115 *> it is assumed to be 1.
116 *> \endverbatim
117 *>
118 *> \param[in,out] B
119 *> \verbatim
120 *> B is REAL array, dimension (LDB,NRHS)
121 *> On entry, the N by NRHS matrix B.
122 *> On exit, B is overwritten by the matrix expression
123 *> B := alpha * A * X + beta * B.
124 *> \endverbatim
125 *>
126 *> \param[in] LDB
127 *> \verbatim
128 *> LDB is INTEGER
129 *> The leading dimension of the array B. LDB >= max(N,1).
130 *> \endverbatim
131 *
132 * Authors:
133 * ========
134 *
135 *> \author Univ. of Tennessee
136 *> \author Univ. of California Berkeley
137 *> \author Univ. of Colorado Denver
138 *> \author NAG Ltd.
139 *
140 *> \date September 2012
141 *
142 *> \ingroup realOTHERauxiliary
143 *
144 * =====================================================================
145  SUBROUTINE slagtm( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
146  $ b, ldb )
147 *
148 * -- LAPACK auxiliary routine (version 3.4.2) --
149 * -- LAPACK is a software package provided by Univ. of Tennessee, --
150 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
151 * September 2012
152 *
153 * .. Scalar Arguments ..
154  CHARACTER TRANS
155  INTEGER LDB, LDX, N, NRHS
156  REAL ALPHA, BETA
157 * ..
158 * .. Array Arguments ..
159  REAL B( ldb, * ), D( * ), DL( * ), DU( * ),
160  $ x( ldx, * )
161 * ..
162 *
163 * =====================================================================
164 *
165 * .. Parameters ..
166  REAL ONE, ZERO
167  parameter ( one = 1.0e+0, zero = 0.0e+0 )
168 * ..
169 * .. Local Scalars ..
170  INTEGER I, J
171 * ..
172 * .. External Functions ..
173  LOGICAL LSAME
174  EXTERNAL lsame
175 * ..
176 * .. Executable Statements ..
177 *
178  IF( n.EQ.0 )
179  $ RETURN
180 *
181 * Multiply B by BETA if BETA.NE.1.
182 *
183  IF( beta.EQ.zero ) THEN
184  DO 20 j = 1, nrhs
185  DO 10 i = 1, n
186  b( i, j ) = zero
187  10 CONTINUE
188  20 CONTINUE
189  ELSE IF( beta.EQ.-one ) THEN
190  DO 40 j = 1, nrhs
191  DO 30 i = 1, n
192  b( i, j ) = -b( i, j )
193  30 CONTINUE
194  40 CONTINUE
195  END IF
196 *
197  IF( alpha.EQ.one ) THEN
198  IF( lsame( trans, 'N' ) ) THEN
199 *
200 * Compute B := B + A*X
201 *
202  DO 60 j = 1, nrhs
203  IF( n.EQ.1 ) THEN
204  b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j )
205  ELSE
206  b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j ) +
207  $ du( 1 )*x( 2, j )
208  b( n, j ) = b( n, j ) + dl( n-1 )*x( n-1, j ) +
209  $ d( n )*x( n, j )
210  DO 50 i = 2, n - 1
211  b( i, j ) = b( i, j ) + dl( i-1 )*x( i-1, j ) +
212  $ d( i )*x( i, j ) + du( i )*x( i+1, j )
213  50 CONTINUE
214  END IF
215  60 CONTINUE
216  ELSE
217 *
218 * Compute B := B + A**T*X
219 *
220  DO 80 j = 1, nrhs
221  IF( n.EQ.1 ) THEN
222  b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j )
223  ELSE
224  b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j ) +
225  $ dl( 1 )*x( 2, j )
226  b( n, j ) = b( n, j ) + du( n-1 )*x( n-1, j ) +
227  $ d( n )*x( n, j )
228  DO 70 i = 2, n - 1
229  b( i, j ) = b( i, j ) + du( i-1 )*x( i-1, j ) +
230  $ d( i )*x( i, j ) + dl( i )*x( i+1, j )
231  70 CONTINUE
232  END IF
233  80 CONTINUE
234  END IF
235  ELSE IF( alpha.EQ.-one ) THEN
236  IF( lsame( trans, 'N' ) ) THEN
237 *
238 * Compute B := B - A*X
239 *
240  DO 100 j = 1, nrhs
241  IF( n.EQ.1 ) THEN
242  b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j )
243  ELSE
244  b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j ) -
245  $ du( 1 )*x( 2, j )
246  b( n, j ) = b( n, j ) - dl( n-1 )*x( n-1, j ) -
247  $ d( n )*x( n, j )
248  DO 90 i = 2, n - 1
249  b( i, j ) = b( i, j ) - dl( i-1 )*x( i-1, j ) -
250  $ d( i )*x( i, j ) - du( i )*x( i+1, j )
251  90 CONTINUE
252  END IF
253  100 CONTINUE
254  ELSE
255 *
256 * Compute B := B - A**T*X
257 *
258  DO 120 j = 1, nrhs
259  IF( n.EQ.1 ) THEN
260  b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j )
261  ELSE
262  b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j ) -
263  $ dl( 1 )*x( 2, j )
264  b( n, j ) = b( n, j ) - du( n-1 )*x( n-1, j ) -
265  $ d( n )*x( n, j )
266  DO 110 i = 2, n - 1
267  b( i, j ) = b( i, j ) - du( i-1 )*x( i-1, j ) -
268  $ d( i )*x( i, j ) - dl( i )*x( i+1, j )
269  110 CONTINUE
270  END IF
271  120 CONTINUE
272  END IF
273  END IF
274  RETURN
275 *
276 * End of SLAGTM
277 *
278  END
slagtm
subroutine slagtm(TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, B, LDB)
SLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix...
Definition: slagtm.f:147