LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zspr.f
Go to the documentation of this file.
1 *> \brief \b ZSPR performs the symmetrical rank-1 update of 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 ZSPR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zspr.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zspr.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zspr.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE ZSPR( UPLO, N, ALPHA, X, INCX, AP )
22 *
23 * .. Scalar Arguments ..
24 * CHARACTER UPLO
25 * INTEGER INCX, N
26 * COMPLEX*16 ALPHA
27 * ..
28 * .. Array Arguments ..
29 * COMPLEX*16 AP( * ), X( * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> ZSPR performs the symmetric rank 1 operation
39 *>
40 *> A := alpha*x*x**H + A,
41 *>
42 *> where alpha is a complex scalar, x is an n element vector and A is an
43 *> 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] X
81 *> \verbatim
82 *> X is COMPLEX*16 array, dimension at least
83 *> ( 1 + ( N - 1 )*abs( INCX ) ).
84 *> Before entry, the incremented array X must contain the N-
85 *> element vector x.
86 *> Unchanged on exit.
87 *> \endverbatim
88 *>
89 *> \param[in] INCX
90 *> \verbatim
91 *> INCX is INTEGER
92 *> On entry, INCX specifies the increment for the elements of
93 *> X. INCX must not be zero.
94 *> Unchanged on exit.
95 *> \endverbatim
96 *>
97 *> \param[in,out] AP
98 *> \verbatim
99 *> AP is COMPLEX*16 array, dimension at least
100 *> ( ( N*( N + 1 ) )/2 ).
101 *> Before entry, with UPLO = 'U' or 'u', the array AP must
102 *> contain the upper triangular part of the symmetric matrix
103 *> packed sequentially, column by column, so that AP( 1 )
104 *> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
105 *> and a( 2, 2 ) respectively, and so on. On exit, the array
106 *> AP is overwritten by the upper triangular part of the
107 *> updated matrix.
108 *> Before entry, with UPLO = 'L' or 'l', the array AP must
109 *> contain the lower triangular part of the symmetric matrix
110 *> packed sequentially, column by column, so that AP( 1 )
111 *> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
112 *> and a( 3, 1 ) respectively, and so on. On exit, the array
113 *> AP is overwritten by the lower triangular part of the
114 *> updated matrix.
115 *> Note that the imaginary parts of the diagonal elements need
116 *> not be set, they are assumed to be zero, and on exit they
117 *> are set to zero.
118 *> \endverbatim
119 *
120 * Authors:
121 * ========
122 *
123 *> \author Univ. of Tennessee
124 *> \author Univ. of California Berkeley
125 *> \author Univ. of Colorado Denver
126 *> \author NAG Ltd.
127 *
128 *> \date September 2012
129 *
130 *> \ingroup complex16OTHERauxiliary
131 *
132 * =====================================================================
133  SUBROUTINE zspr( UPLO, N, ALPHA, X, INCX, AP )
134 *
135 * -- LAPACK auxiliary routine (version 3.4.2) --
136 * -- LAPACK is a software package provided by Univ. of Tennessee, --
137 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
138 * September 2012
139 *
140 * .. Scalar Arguments ..
141  CHARACTER uplo
142  INTEGER incx, n
143  COMPLEX*16 alpha
144 * ..
145 * .. Array Arguments ..
146  COMPLEX*16 ap( * ), x( * )
147 * ..
148 *
149 * =====================================================================
150 *
151 * .. Parameters ..
152  COMPLEX*16 zero
153  parameter( zero = ( 0.0d+0, 0.0d+0 ) )
154 * ..
155 * .. Local Scalars ..
156  INTEGER i, info, ix, j, jx, k, kk, kx
157  COMPLEX*16 temp
158 * ..
159 * .. External Functions ..
160  LOGICAL lsame
161  EXTERNAL lsame
162 * ..
163 * .. External Subroutines ..
164  EXTERNAL xerbla
165 * ..
166 * .. Executable Statements ..
167 *
168 * Test the input parameters.
169 *
170  info = 0
171  IF( .NOT.lsame( uplo, 'U' ) .AND. .NOT.lsame( uplo, 'L' ) ) THEN
172  info = 1
173  ELSE IF( n.LT.0 ) THEN
174  info = 2
175  ELSE IF( incx.EQ.0 ) THEN
176  info = 5
177  END IF
178  IF( info.NE.0 ) THEN
179  CALL xerbla( 'ZSPR ', info )
180  return
181  END IF
182 *
183 * Quick return if possible.
184 *
185  IF( ( n.EQ.0 ) .OR. ( alpha.EQ.zero ) )
186  $ return
187 *
188 * Set the start point in X if the increment is not unity.
189 *
190  IF( incx.LE.0 ) THEN
191  kx = 1 - ( n-1 )*incx
192  ELSE IF( incx.NE.1 ) THEN
193  kx = 1
194  END IF
195 *
196 * Start the operations. In this version the elements of the array AP
197 * are accessed sequentially with one pass through AP.
198 *
199  kk = 1
200  IF( lsame( uplo, 'U' ) ) THEN
201 *
202 * Form A when upper triangle is stored in AP.
203 *
204  IF( incx.EQ.1 ) THEN
205  DO 20 j = 1, n
206  IF( x( j ).NE.zero ) THEN
207  temp = alpha*x( j )
208  k = kk
209  DO 10 i = 1, j - 1
210  ap( k ) = ap( k ) + x( i )*temp
211  k = k + 1
212  10 continue
213  ap( kk+j-1 ) = ap( kk+j-1 ) + x( j )*temp
214  ELSE
215  ap( kk+j-1 ) = ap( kk+j-1 )
216  END IF
217  kk = kk + j
218  20 continue
219  ELSE
220  jx = kx
221  DO 40 j = 1, n
222  IF( x( jx ).NE.zero ) THEN
223  temp = alpha*x( jx )
224  ix = kx
225  DO 30 k = kk, kk + j - 2
226  ap( k ) = ap( k ) + x( ix )*temp
227  ix = ix + incx
228  30 continue
229  ap( kk+j-1 ) = ap( kk+j-1 ) + x( jx )*temp
230  ELSE
231  ap( kk+j-1 ) = ap( kk+j-1 )
232  END IF
233  jx = jx + incx
234  kk = kk + j
235  40 continue
236  END IF
237  ELSE
238 *
239 * Form A when lower triangle is stored in AP.
240 *
241  IF( incx.EQ.1 ) THEN
242  DO 60 j = 1, n
243  IF( x( j ).NE.zero ) THEN
244  temp = alpha*x( j )
245  ap( kk ) = ap( kk ) + temp*x( j )
246  k = kk + 1
247  DO 50 i = j + 1, n
248  ap( k ) = ap( k ) + x( i )*temp
249  k = k + 1
250  50 continue
251  ELSE
252  ap( kk ) = ap( kk )
253  END IF
254  kk = kk + n - j + 1
255  60 continue
256  ELSE
257  jx = kx
258  DO 80 j = 1, n
259  IF( x( jx ).NE.zero ) THEN
260  temp = alpha*x( jx )
261  ap( kk ) = ap( kk ) + temp*x( jx )
262  ix = jx
263  DO 70 k = kk + 1, kk + n - j
264  ix = ix + incx
265  ap( k ) = ap( k ) + x( ix )*temp
266  70 continue
267  ELSE
268  ap( kk ) = ap( kk )
269  END IF
270  jx = jx + incx
271  kk = kk + n - j + 1
272  80 continue
273  END IF
274  END IF
275 *
276  return
277 *
278 * End of ZSPR
279 *
280  END