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