LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
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 *> \date November 2011
125 *
126 *> \ingroup complex_lin
127 *
128 * =====================================================================
129  SUBROUTINE claptm( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B,
130  $ ldb )
131 *
132 * -- LAPACK test routine (version 3.4.0) --
133 * -- LAPACK is a software package provided by Univ. of Tennessee, --
134 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
135 * November 2011
136 *
137 * .. Scalar Arguments ..
138  CHARACTER uplo
139  INTEGER ldb, ldx, n, nrhs
140  REAL alpha, beta
141 * ..
142 * .. Array Arguments ..
143  REAL d( * )
144  COMPLEX b( ldb, * ), e( * ), x( ldx, * )
145 * ..
146 *
147 * =====================================================================
148 *
149 * .. Parameters ..
150  REAL one, zero
151  parameter( one = 1.0e+0, zero = 0.0e+0 )
152 * ..
153 * .. Local Scalars ..
154  INTEGER i, j
155 * ..
156 * .. External Functions ..
157  LOGICAL lsame
158  EXTERNAL lsame
159 * ..
160 * .. Intrinsic Functions ..
161  INTRINSIC conjg
162 * ..
163 * .. Executable Statements ..
164 *
165  IF( n.EQ.0 )
166  $ return
167 *
168  IF( beta.EQ.zero ) THEN
169  DO 20 j = 1, nrhs
170  DO 10 i = 1, n
171  b( i, j ) = zero
172  10 continue
173  20 continue
174  ELSE IF( beta.EQ.-one ) THEN
175  DO 40 j = 1, nrhs
176  DO 30 i = 1, n
177  b( i, j ) = -b( i, j )
178  30 continue
179  40 continue
180  END IF
181 *
182  IF( alpha.EQ.one ) THEN
183  IF( lsame( uplo, 'U' ) ) THEN
184 *
185 * Compute B := B + A*X, where E is the superdiagonal of A.
186 *
187  DO 60 j = 1, nrhs
188  IF( n.EQ.1 ) THEN
189  b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j )
190  ELSE
191  b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j ) +
192  $ e( 1 )*x( 2, j )
193  b( n, j ) = b( n, j ) + conjg( e( n-1 ) )*
194  $ x( n-1, j ) + d( n )*x( n, j )
195  DO 50 i = 2, n - 1
196  b( i, j ) = b( i, j ) + conjg( e( i-1 ) )*
197  $ x( i-1, j ) + d( i )*x( i, j ) +
198  $ e( i )*x( i+1, j )
199  50 continue
200  END IF
201  60 continue
202  ELSE
203 *
204 * Compute B := B + A*X, where E is the subdiagonal of A.
205 *
206  DO 80 j = 1, nrhs
207  IF( n.EQ.1 ) THEN
208  b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j )
209  ELSE
210  b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j ) +
211  $ conjg( e( 1 ) )*x( 2, j )
212  b( n, j ) = b( n, j ) + e( n-1 )*x( n-1, j ) +
213  $ d( n )*x( n, j )
214  DO 70 i = 2, n - 1
215  b( i, j ) = b( i, j ) + e( i-1 )*x( i-1, j ) +
216  $ d( i )*x( i, j ) +
217  $ conjg( e( i ) )*x( i+1, j )
218  70 continue
219  END IF
220  80 continue
221  END IF
222  ELSE IF( alpha.EQ.-one ) THEN
223  IF( lsame( uplo, 'U' ) ) THEN
224 *
225 * Compute B := B - A*X, where E is the superdiagonal of A.
226 *
227  DO 100 j = 1, nrhs
228  IF( n.EQ.1 ) THEN
229  b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j )
230  ELSE
231  b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j ) -
232  $ e( 1 )*x( 2, j )
233  b( n, j ) = b( n, j ) - conjg( e( n-1 ) )*
234  $ x( n-1, j ) - d( n )*x( n, j )
235  DO 90 i = 2, n - 1
236  b( i, j ) = b( i, j ) - conjg( e( i-1 ) )*
237  $ x( i-1, j ) - d( i )*x( i, j ) -
238  $ e( i )*x( i+1, j )
239  90 continue
240  END IF
241  100 continue
242  ELSE
243 *
244 * Compute B := B - A*X, where E is the subdiagonal of A.
245 *
246  DO 120 j = 1, nrhs
247  IF( n.EQ.1 ) THEN
248  b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j )
249  ELSE
250  b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j ) -
251  $ conjg( e( 1 ) )*x( 2, j )
252  b( n, j ) = b( n, j ) - e( n-1 )*x( n-1, j ) -
253  $ d( n )*x( n, j )
254  DO 110 i = 2, n - 1
255  b( i, j ) = b( i, j ) - e( i-1 )*x( i-1, j ) -
256  $ d( i )*x( i, j ) -
257  $ conjg( e( i ) )*x( i+1, j )
258  110 continue
259  END IF
260  120 continue
261  END IF
262  END IF
263  return
264 *
265 * End of CLAPTM
266 *
267  END