LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
claptm.f
Go to the documentation of this file.
1 *> \brief \b CLAPTM
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 CLAPTM( 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 * REAL ALPHA, BETA
18 * ..
19 * .. Array Arguments ..
20 * REAL D( * )
21 * COMPLEX B( LDB, * ), E( * ), X( LDX, * )
22 * ..
23 *
24 *
25 *> \par Purpose:
26 * =============
27 *>
28 *> \verbatim
29 *>
30 *> CLAPTM 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 REAL
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 REAL 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 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 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 REAL
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 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 complex_lin
125 *
126 * =====================================================================
127  SUBROUTINE claptm( 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  REAL ALPHA, BETA
138 * ..
139 * .. Array Arguments ..
140  REAL D( * )
141  COMPLEX B( LDB, * ), E( * ), X( LDX, * )
142 * ..
143 *
144 * =====================================================================
145 *
146 * .. Parameters ..
147  REAL ONE, ZERO
148  parameter( one = 1.0e+0, zero = 0.0e+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 conjg
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 ) + conjg( 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 ) + conjg( 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  $ conjg( 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  $ conjg( 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 ) - conjg( 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 ) - conjg( 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  $ conjg( 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  $ conjg( 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 CLAPTM
263 *
264  END
subroutine claptm(UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
CLAPTM
Definition: claptm.f:129