LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
csymv.f
Go to the documentation of this file.
1*> \brief \b CSYMV computes a matrix-vector product for a complex symmetric matrix.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CSYMV + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csymv.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csymv.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csymv.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY )
22*
23* .. Scalar Arguments ..
24* CHARACTER UPLO
25* INTEGER INCX, INCY, LDA, N
26* COMPLEX ALPHA, BETA
27* ..
28* .. Array Arguments ..
29* COMPLEX A( LDA, * ), X( * ), Y( * )
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*> \verbatim
37*>
38*> CSYMV performs the matrix-vector operation
39*>
40*> y := alpha*A*x + beta*y,
41*>
42*> where alpha and beta are scalars, x and y are n element vectors and
43*> A is an n by n symmetric matrix.
44*> \endverbatim
45*
46* Arguments:
47* ==========
48*
49*> \param[in] UPLO
50*> \verbatim
51*> UPLO is CHARACTER*1
52*> On entry, UPLO specifies whether the upper or lower
53*> triangular part of the array A is to be referenced as
54*> follows:
55*>
56*> UPLO = 'U' or 'u' Only the upper triangular part of A
57*> is to be referenced.
58*>
59*> UPLO = 'L' or 'l' Only the lower triangular part of A
60*> is to be referenced.
61*>
62*> Unchanged on exit.
63*> \endverbatim
64*>
65*> \param[in] N
66*> \verbatim
67*> N is INTEGER
68*> On entry, N specifies the order of the matrix A.
69*> N must be at least zero.
70*> Unchanged on exit.
71*> \endverbatim
72*>
73*> \param[in] ALPHA
74*> \verbatim
75*> ALPHA is COMPLEX
76*> On entry, ALPHA specifies the scalar alpha.
77*> Unchanged on exit.
78*> \endverbatim
79*>
80*> \param[in] A
81*> \verbatim
82*> A is COMPLEX array, dimension ( LDA, N )
83*> Before entry, with UPLO = 'U' or 'u', the leading n by n
84*> upper triangular part of the array A must contain the upper
85*> triangular part of the symmetric matrix and the strictly
86*> lower triangular part of A is not referenced.
87*> Before entry, with UPLO = 'L' or 'l', the leading n by n
88*> lower triangular part of the array A must contain the lower
89*> triangular part of the symmetric matrix and the strictly
90*> upper triangular part of A is not referenced.
91*> Unchanged on exit.
92*> \endverbatim
93*>
94*> \param[in] LDA
95*> \verbatim
96*> LDA is INTEGER
97*> On entry, LDA specifies the first dimension of A as declared
98*> in the calling (sub) program. LDA must be at least
99*> max( 1, N ).
100*> Unchanged on exit.
101*> \endverbatim
102*>
103*> \param[in] X
104*> \verbatim
105*> X is COMPLEX array, dimension at least
106*> ( 1 + ( N - 1 )*abs( INCX ) ).
107*> Before entry, the incremented array X must contain the N-
108*> element vector x.
109*> Unchanged on exit.
110*> \endverbatim
111*>
112*> \param[in] INCX
113*> \verbatim
114*> INCX is INTEGER
115*> On entry, INCX specifies the increment for the elements of
116*> X. INCX must not be zero.
117*> Unchanged on exit.
118*> \endverbatim
119*>
120*> \param[in] BETA
121*> \verbatim
122*> BETA is COMPLEX
123*> On entry, BETA specifies the scalar beta. When BETA is
124*> supplied as zero then Y need not be set on input.
125*> Unchanged on exit.
126*> \endverbatim
127*>
128*> \param[in,out] Y
129*> \verbatim
130*> Y is COMPLEX array, dimension at least
131*> ( 1 + ( N - 1 )*abs( INCY ) ).
132*> Before entry, the incremented array Y must contain the n
133*> element vector y. On exit, Y is overwritten by the updated
134*> vector y.
135*> \endverbatim
136*>
137*> \param[in] INCY
138*> \verbatim
139*> INCY is INTEGER
140*> On entry, INCY specifies the increment for the elements of
141*> Y. INCY must not be zero.
142*> Unchanged on exit.
143*> \endverbatim
144*
145* Authors:
146* ========
147*
148*> \author Univ. of Tennessee
149*> \author Univ. of California Berkeley
150*> \author Univ. of Colorado Denver
151*> \author NAG Ltd.
152*
153*> \ingroup hemv
154*
155* =====================================================================
156 SUBROUTINE csymv( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY )
157*
158* -- LAPACK auxiliary routine --
159* -- LAPACK is a software package provided by Univ. of Tennessee, --
160* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
161*
162* .. Scalar Arguments ..
163 CHARACTER UPLO
164 INTEGER INCX, INCY, LDA, N
165 COMPLEX ALPHA, BETA
166* ..
167* .. Array Arguments ..
168 COMPLEX A( LDA, * ), X( * ), Y( * )
169* ..
170*
171* =====================================================================
172*
173* .. Parameters ..
174 COMPLEX ONE
175 parameter( one = ( 1.0e+0, 0.0e+0 ) )
176 COMPLEX ZERO
177 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
178* ..
179* .. Local Scalars ..
180 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
181 COMPLEX TEMP1, TEMP2
182* ..
183* .. External Functions ..
184 LOGICAL LSAME
185 EXTERNAL lsame
186* ..
187* .. External Subroutines ..
188 EXTERNAL xerbla
189* ..
190* .. Intrinsic Functions ..
191 INTRINSIC max
192* ..
193* .. Executable Statements ..
194*
195* Test the input parameters.
196*
197 info = 0
198 IF( .NOT.lsame( uplo, 'U' ) .AND. .NOT.lsame( uplo, 'L' ) ) THEN
199 info = 1
200 ELSE IF( n.LT.0 ) THEN
201 info = 2
202 ELSE IF( lda.LT.max( 1, n ) ) THEN
203 info = 5
204 ELSE IF( incx.EQ.0 ) THEN
205 info = 7
206 ELSE IF( incy.EQ.0 ) THEN
207 info = 10
208 END IF
209 IF( info.NE.0 ) THEN
210 CALL xerbla( 'CSYMV ', info )
211 RETURN
212 END IF
213*
214* Quick return if possible.
215*
216 IF( ( n.EQ.0 ) .OR. ( ( alpha.EQ.zero ) .AND. ( beta.EQ.one ) ) )
217 $ RETURN
218*
219* Set up the start points in X and Y.
220*
221 IF( incx.GT.0 ) THEN
222 kx = 1
223 ELSE
224 kx = 1 - ( n-1 )*incx
225 END IF
226 IF( incy.GT.0 ) THEN
227 ky = 1
228 ELSE
229 ky = 1 - ( n-1 )*incy
230 END IF
231*
232* Start the operations. In this version the elements of A are
233* accessed sequentially with one pass through the triangular part
234* of A.
235*
236* First form y := beta*y.
237*
238 IF( beta.NE.one ) THEN
239 IF( incy.EQ.1 ) THEN
240 IF( beta.EQ.zero ) THEN
241 DO 10 i = 1, n
242 y( i ) = zero
243 10 CONTINUE
244 ELSE
245 DO 20 i = 1, n
246 y( i ) = beta*y( i )
247 20 CONTINUE
248 END IF
249 ELSE
250 iy = ky
251 IF( beta.EQ.zero ) THEN
252 DO 30 i = 1, n
253 y( iy ) = zero
254 iy = iy + incy
255 30 CONTINUE
256 ELSE
257 DO 40 i = 1, n
258 y( iy ) = beta*y( iy )
259 iy = iy + incy
260 40 CONTINUE
261 END IF
262 END IF
263 END IF
264 IF( alpha.EQ.zero )
265 $ RETURN
266 IF( lsame( uplo, 'U' ) ) THEN
267*
268* Form y when A is stored in upper triangle.
269*
270 IF( ( incx.EQ.1 ) .AND. ( incy.EQ.1 ) ) THEN
271 DO 60 j = 1, n
272 temp1 = alpha*x( j )
273 temp2 = zero
274 DO 50 i = 1, j - 1
275 y( i ) = y( i ) + temp1*a( i, j )
276 temp2 = temp2 + a( i, j )*x( i )
277 50 CONTINUE
278 y( j ) = y( j ) + temp1*a( j, j ) + alpha*temp2
279 60 CONTINUE
280 ELSE
281 jx = kx
282 jy = ky
283 DO 80 j = 1, n
284 temp1 = alpha*x( jx )
285 temp2 = zero
286 ix = kx
287 iy = ky
288 DO 70 i = 1, j - 1
289 y( iy ) = y( iy ) + temp1*a( i, j )
290 temp2 = temp2 + a( i, j )*x( ix )
291 ix = ix + incx
292 iy = iy + incy
293 70 CONTINUE
294 y( jy ) = y( jy ) + temp1*a( j, j ) + alpha*temp2
295 jx = jx + incx
296 jy = jy + incy
297 80 CONTINUE
298 END IF
299 ELSE
300*
301* Form y when A is stored in lower triangle.
302*
303 IF( ( incx.EQ.1 ) .AND. ( incy.EQ.1 ) ) THEN
304 DO 100 j = 1, n
305 temp1 = alpha*x( j )
306 temp2 = zero
307 y( j ) = y( j ) + temp1*a( j, j )
308 DO 90 i = j + 1, n
309 y( i ) = y( i ) + temp1*a( i, j )
310 temp2 = temp2 + a( i, j )*x( i )
311 90 CONTINUE
312 y( j ) = y( j ) + alpha*temp2
313 100 CONTINUE
314 ELSE
315 jx = kx
316 jy = ky
317 DO 120 j = 1, n
318 temp1 = alpha*x( jx )
319 temp2 = zero
320 y( jy ) = y( jy ) + temp1*a( j, j )
321 ix = jx
322 iy = jy
323 DO 110 i = j + 1, n
324 ix = ix + incx
325 iy = iy + incy
326 y( iy ) = y( iy ) + temp1*a( i, j )
327 temp2 = temp2 + a( i, j )*x( ix )
328 110 CONTINUE
329 y( jy ) = y( jy ) + alpha*temp2
330 jx = jx + incx
331 jy = jy + incy
332 120 CONTINUE
333 END IF
334 END IF
335*
336 RETURN
337*
338* End of CSYMV
339*
340 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine csymv(uplo, n, alpha, a, lda, x, incx, beta, y, incy)
CSYMV computes a matrix-vector product for a complex symmetric matrix.
Definition csymv.f:157