LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zlaptm.f
Go to the documentation of this file.
1*> \brief \b ZLAPTM
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 ZLAPTM( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B,
12* LDB )
13*
14* .. Scalar Arguments ..
15* CHARACTER UPLO
16* INTEGER LDB, LDX, N, NRHS
17* DOUBLE PRECISION ALPHA, BETA
18* ..
19* .. Array Arguments ..
20* DOUBLE PRECISION D( * )
21* COMPLEX*16 B( LDB, * ), E( * ), X( LDX, * )
22* ..
23*
24*
25*> \par Purpose:
26* =============
27*>
28*> \verbatim
29*>
30*> ZLAPTM multiplies an N by NRHS matrix X by a Hermitian tridiagonal
31*> matrix A and stores the result in a matrix B. The operation has the
32*> form
33*>
34*> B := alpha * A * X + beta * B
35*>
36*> where alpha may be either 1. or -1. and beta may be 0., 1., or -1.
37*> \endverbatim
38*
39* Arguments:
40* ==========
41*
42*> \param[in] UPLO
43*> \verbatim
44*> UPLO is CHARACTER
45*> Specifies whether the superdiagonal or the subdiagonal of the
46*> tridiagonal matrix A is stored.
47*> = 'U': Upper, E is the superdiagonal of A.
48*> = 'L': Lower, E is the subdiagonal of A.
49*> \endverbatim
50*>
51*> \param[in] N
52*> \verbatim
53*> N is INTEGER
54*> The order of the matrix A. N >= 0.
55*> \endverbatim
56*>
57*> \param[in] NRHS
58*> \verbatim
59*> NRHS is INTEGER
60*> The number of right hand sides, i.e., the number of columns
61*> of the matrices X and B.
62*> \endverbatim
63*>
64*> \param[in] ALPHA
65*> \verbatim
66*> ALPHA is DOUBLE PRECISION
67*> The scalar alpha. ALPHA must be 1. or -1.; otherwise,
68*> it is assumed to be 0.
69*> \endverbatim
70*>
71*> \param[in] D
72*> \verbatim
73*> D is DOUBLE PRECISION array, dimension (N)
74*> The n diagonal elements of the tridiagonal matrix A.
75*> \endverbatim
76*>
77*> \param[in] E
78*> \verbatim
79*> E is COMPLEX*16 array, dimension (N-1)
80*> The (n-1) subdiagonal or superdiagonal elements of A.
81*> \endverbatim
82*>
83*> \param[in] X
84*> \verbatim
85*> X is COMPLEX*16 array, dimension (LDX,NRHS)
86*> The N by NRHS matrix X.
87*> \endverbatim
88*>
89*> \param[in] LDX
90*> \verbatim
91*> LDX is INTEGER
92*> The leading dimension of the array X. LDX >= max(N,1).
93*> \endverbatim
94*>
95*> \param[in] BETA
96*> \verbatim
97*> BETA is DOUBLE PRECISION
98*> The scalar beta. BETA must be 0., 1., or -1.; otherwise,
99*> it is assumed to be 1.
100*> \endverbatim
101*>
102*> \param[in,out] B
103*> \verbatim
104*> B is COMPLEX*16 array, dimension (LDB,NRHS)
105*> On entry, the N by NRHS matrix B.
106*> On exit, B is overwritten by the matrix expression
107*> B := alpha * A * X + beta * B.
108*> \endverbatim
109*>
110*> \param[in] LDB
111*> \verbatim
112*> LDB is INTEGER
113*> The leading dimension of the array B. LDB >= max(N,1).
114*> \endverbatim
115*
116* Authors:
117* ========
118*
119*> \author Univ. of Tennessee
120*> \author Univ. of California Berkeley
121*> \author Univ. of Colorado Denver
122*> \author NAG Ltd.
123*
124*> \ingroup complex16_lin
125*
126* =====================================================================
127 SUBROUTINE zlaptm( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B,
128 $ LDB )
129*
130* -- LAPACK test routine --
131* -- LAPACK is a software package provided by Univ. of Tennessee, --
132* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
133*
134* .. Scalar Arguments ..
135 CHARACTER UPLO
136 INTEGER LDB, LDX, N, NRHS
137 DOUBLE PRECISION ALPHA, BETA
138* ..
139* .. Array Arguments ..
140 DOUBLE PRECISION D( * )
141 COMPLEX*16 B( LDB, * ), E( * ), X( LDX, * )
142* ..
143*
144* =====================================================================
145*
146* .. Parameters ..
147 DOUBLE PRECISION ONE, ZERO
148 parameter( one = 1.0d+0, zero = 0.0d+0 )
149* ..
150* .. Local Scalars ..
151 INTEGER I, J
152* ..
153* .. External Functions ..
154 LOGICAL LSAME
155 EXTERNAL lsame
156* ..
157* .. Intrinsic Functions ..
158 INTRINSIC dconjg
159* ..
160* .. Executable Statements ..
161*
162 IF( n.EQ.0 )
163 $ RETURN
164*
165 IF( beta.EQ.zero ) THEN
166 DO 20 j = 1, nrhs
167 DO 10 i = 1, n
168 b( i, j ) = zero
169 10 CONTINUE
170 20 CONTINUE
171 ELSE IF( beta.EQ.-one ) THEN
172 DO 40 j = 1, nrhs
173 DO 30 i = 1, n
174 b( i, j ) = -b( i, j )
175 30 CONTINUE
176 40 CONTINUE
177 END IF
178*
179 IF( alpha.EQ.one ) THEN
180 IF( lsame( uplo, 'U' ) ) THEN
181*
182* Compute B := B + A*X, where E is the superdiagonal of A.
183*
184 DO 60 j = 1, nrhs
185 IF( n.EQ.1 ) THEN
186 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j )
187 ELSE
188 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j ) +
189 $ e( 1 )*x( 2, j )
190 b( n, j ) = b( n, j ) + dconjg( e( n-1 ) )*
191 $ x( n-1, j ) + d( n )*x( n, j )
192 DO 50 i = 2, n - 1
193 b( i, j ) = b( i, j ) + dconjg( e( i-1 ) )*
194 $ x( i-1, j ) + d( i )*x( i, j ) +
195 $ e( i )*x( i+1, j )
196 50 CONTINUE
197 END IF
198 60 CONTINUE
199 ELSE
200*
201* Compute B := B + A*X, where E is the subdiagonal of A.
202*
203 DO 80 j = 1, nrhs
204 IF( n.EQ.1 ) THEN
205 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j )
206 ELSE
207 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j ) +
208 $ dconjg( e( 1 ) )*x( 2, j )
209 b( n, j ) = b( n, j ) + e( n-1 )*x( n-1, j ) +
210 $ d( n )*x( n, j )
211 DO 70 i = 2, n - 1
212 b( i, j ) = b( i, j ) + e( i-1 )*x( i-1, j ) +
213 $ d( i )*x( i, j ) +
214 $ dconjg( e( i ) )*x( i+1, j )
215 70 CONTINUE
216 END IF
217 80 CONTINUE
218 END IF
219 ELSE IF( alpha.EQ.-one ) THEN
220 IF( lsame( uplo, 'U' ) ) THEN
221*
222* Compute B := B - A*X, where E is the superdiagonal of A.
223*
224 DO 100 j = 1, nrhs
225 IF( n.EQ.1 ) THEN
226 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j )
227 ELSE
228 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j ) -
229 $ e( 1 )*x( 2, j )
230 b( n, j ) = b( n, j ) - dconjg( e( n-1 ) )*
231 $ x( n-1, j ) - d( n )*x( n, j )
232 DO 90 i = 2, n - 1
233 b( i, j ) = b( i, j ) - dconjg( e( i-1 ) )*
234 $ x( i-1, j ) - d( i )*x( i, j ) -
235 $ e( i )*x( i+1, j )
236 90 CONTINUE
237 END IF
238 100 CONTINUE
239 ELSE
240*
241* Compute B := B - A*X, where E is the subdiagonal of A.
242*
243 DO 120 j = 1, nrhs
244 IF( n.EQ.1 ) THEN
245 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j )
246 ELSE
247 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j ) -
248 $ dconjg( e( 1 ) )*x( 2, j )
249 b( n, j ) = b( n, j ) - e( n-1 )*x( n-1, j ) -
250 $ d( n )*x( n, j )
251 DO 110 i = 2, n - 1
252 b( i, j ) = b( i, j ) - e( i-1 )*x( i-1, j ) -
253 $ d( i )*x( i, j ) -
254 $ dconjg( e( i ) )*x( i+1, j )
255 110 CONTINUE
256 END IF
257 120 CONTINUE
258 END IF
259 END IF
260 RETURN
261*
262* End of ZLAPTM
263*
264 END
zlaptm
subroutine zlaptm(uplo, n, nrhs, alpha, d, e, x, ldx, beta, b, ldb)
ZLAPTM
Definition zlaptm.f:129