LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
slaptm.f
Go to the documentation of this file.
1*> \brief \b SLAPTM
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE SLAPTM( N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB )
12*
13* .. Scalar Arguments ..
14* INTEGER LDB, LDX, N, NRHS
15* REAL ALPHA, BETA
16* ..
17* .. Array Arguments ..
18* REAL B( LDB, * ), D( * ), E( * ), X( LDX, * )
19* ..
20*
21*
22*> \par Purpose:
23* =============
24*>
25*> \verbatim
26*>
27*> SLAPTM multiplies an N by NRHS matrix X by a symmetric tridiagonal
28*> matrix A and stores the result in a matrix B. The operation has the
29*> form
30*>
31*> B := alpha * A * X + beta * B
32*>
33*> where alpha may be either 1. or -1. and beta may be 0., 1., or -1.
34*> \endverbatim
35*
36* Arguments:
37* ==========
38*
39*> \param[in] N
40*> \verbatim
41*> N is INTEGER
42*> The order of the matrix A. N >= 0.
43*> \endverbatim
44*>
45*> \param[in] NRHS
46*> \verbatim
47*> NRHS is INTEGER
48*> The number of right hand sides, i.e., the number of columns
49*> of the matrices X and B.
50*> \endverbatim
51*>
52*> \param[in] ALPHA
53*> \verbatim
54*> ALPHA is REAL
55*> The scalar alpha. ALPHA must be 1. or -1.; otherwise,
56*> it is assumed to be 0.
57*> \endverbatim
58*>
59*> \param[in] D
60*> \verbatim
61*> D is REAL array, dimension (N)
62*> The n diagonal elements of the tridiagonal matrix A.
63*> \endverbatim
64*>
65*> \param[in] E
66*> \verbatim
67*> E is REAL array, dimension (N-1)
68*> The (n-1) subdiagonal or superdiagonal elements of A.
69*> \endverbatim
70*>
71*> \param[in] X
72*> \verbatim
73*> X is REAL array, dimension (LDX,NRHS)
74*> The N by NRHS matrix X.
75*> \endverbatim
76*>
77*> \param[in] LDX
78*> \verbatim
79*> LDX is INTEGER
80*> The leading dimension of the array X. LDX >= max(N,1).
81*> \endverbatim
82*>
83*> \param[in] BETA
84*> \verbatim
85*> BETA is REAL
86*> The scalar beta. BETA must be 0., 1., or -1.; otherwise,
87*> it is assumed to be 1.
88*> \endverbatim
89*>
90*> \param[in,out] B
91*> \verbatim
92*> B is REAL array, dimension (LDB,NRHS)
93*> On entry, the N by NRHS matrix B.
94*> On exit, B is overwritten by the matrix expression
95*> B := alpha * A * X + beta * B.
96*> \endverbatim
97*>
98*> \param[in] LDB
99*> \verbatim
100*> LDB is INTEGER
101*> The leading dimension of the array B. LDB >= max(N,1).
102*> \endverbatim
103*
104* Authors:
105* ========
106*
107*> \author Univ. of Tennessee
108*> \author Univ. of California Berkeley
109*> \author Univ. of Colorado Denver
110*> \author NAG Ltd.
111*
112*> \ingroup single_lin
113*
114* =====================================================================
115 SUBROUTINE slaptm( N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB )
116*
117* -- LAPACK test routine --
118* -- LAPACK is a software package provided by Univ. of Tennessee, --
119* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
120*
121* .. Scalar Arguments ..
122 INTEGER LDB, LDX, N, NRHS
123 REAL ALPHA, BETA
124* ..
125* .. Array Arguments ..
126 REAL B( LDB, * ), D( * ), E( * ), X( LDX, * )
127* ..
128*
129* =====================================================================
130*
131* .. Parameters ..
132 REAL ONE, ZERO
133 parameter( one = 1.0e+0, zero = 0.0e+0 )
134* ..
135* .. Local Scalars ..
136 INTEGER I, J
137* ..
138* .. Executable Statements ..
139*
140 IF( n.EQ.0 )
141 $ RETURN
142*
143* Multiply B by BETA if BETA.NE.1.
144*
145 IF( beta.EQ.zero ) THEN
146 DO 20 j = 1, nrhs
147 DO 10 i = 1, n
148 b( i, j ) = zero
149 10 CONTINUE
150 20 CONTINUE
151 ELSE IF( beta.EQ.-one ) THEN
152 DO 40 j = 1, nrhs
153 DO 30 i = 1, n
154 b( i, j ) = -b( i, j )
155 30 CONTINUE
156 40 CONTINUE
157 END IF
158*
159 IF( alpha.EQ.one ) THEN
160*
161* Compute B := B + A*X
162*
163 DO 60 j = 1, nrhs
164 IF( n.EQ.1 ) THEN
165 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j )
166 ELSE
167 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j ) +
168 $ e( 1 )*x( 2, j )
169 b( n, j ) = b( n, j ) + e( n-1 )*x( n-1, j ) +
170 $ d( n )*x( n, j )
171 DO 50 i = 2, n - 1
172 b( i, j ) = b( i, j ) + e( i-1 )*x( i-1, j ) +
173 $ d( i )*x( i, j ) + e( i )*x( i+1, j )
174 50 CONTINUE
175 END IF
176 60 CONTINUE
177 ELSE IF( alpha.EQ.-one ) THEN
178*
179* Compute B := B - A*X
180*
181 DO 80 j = 1, nrhs
182 IF( n.EQ.1 ) THEN
183 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j )
184 ELSE
185 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j ) -
186 $ e( 1 )*x( 2, j )
187 b( n, j ) = b( n, j ) - e( n-1 )*x( n-1, j ) -
188 $ d( n )*x( n, j )
189 DO 70 i = 2, n - 1
190 b( i, j ) = b( i, j ) - e( i-1 )*x( i-1, j ) -
191 $ d( i )*x( i, j ) - e( i )*x( i+1, j )
192 70 CONTINUE
193 END IF
194 80 CONTINUE
195 END IF
196 RETURN
197*
198* End of SLAPTM
199*
200 END
subroutine slaptm(n, nrhs, alpha, d, e, x, ldx, beta, b, ldb)
SLAPTM
Definition slaptm.f:116