LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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*> \ingroup hpr
129*
130* =====================================================================
131 SUBROUTINE zspr( UPLO, N, ALPHA, X, INCX, AP )
132*
133* -- LAPACK auxiliary routine --
134* -- LAPACK is a software package provided by Univ. of Tennessee, --
135* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
136*
137* .. Scalar Arguments ..
138 CHARACTER UPLO
139 INTEGER INCX, N
140 COMPLEX*16 ALPHA
141* ..
142* .. Array Arguments ..
143 COMPLEX*16 AP( * ), X( * )
144* ..
145*
146* =====================================================================
147*
148* .. Parameters ..
149 COMPLEX*16 ZERO
150 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
151* ..
152* .. Local Scalars ..
153 INTEGER I, INFO, IX, J, JX, K, KK, KX
154 COMPLEX*16 TEMP
155* ..
156* .. External Functions ..
157 LOGICAL LSAME
158 EXTERNAL lsame
159* ..
160* .. External Subroutines ..
161 EXTERNAL xerbla
162* ..
163* .. Executable Statements ..
164*
165* Test the input parameters.
166*
167 info = 0
168 IF( .NOT.lsame( uplo, 'U' ) .AND. .NOT.lsame( uplo, 'L' ) ) THEN
169 info = 1
170 ELSE IF( n.LT.0 ) THEN
171 info = 2
172 ELSE IF( incx.EQ.0 ) THEN
173 info = 5
174 END IF
175 IF( info.NE.0 ) THEN
176 CALL xerbla( 'ZSPR ', info )
177 RETURN
178 END IF
179*
180* Quick return if possible.
181*
182 IF( ( n.EQ.0 ) .OR. ( alpha.EQ.zero ) )
183 $ RETURN
184*
185* Set the start point in X if the increment is not unity.
186*
187 IF( incx.LE.0 ) THEN
188 kx = 1 - ( n-1 )*incx
189 ELSE IF( incx.NE.1 ) THEN
190 kx = 1
191 END IF
192*
193* Start the operations. In this version the elements of the array AP
194* are accessed sequentially with one pass through AP.
195*
196 kk = 1
197 IF( lsame( uplo, 'U' ) ) THEN
198*
199* Form A when upper triangle is stored in AP.
200*
201 IF( incx.EQ.1 ) THEN
202 DO 20 j = 1, n
203 IF( x( j ).NE.zero ) THEN
204 temp = alpha*x( j )
205 k = kk
206 DO 10 i = 1, j - 1
207 ap( k ) = ap( k ) + x( i )*temp
208 k = k + 1
209 10 CONTINUE
210 ap( kk+j-1 ) = ap( kk+j-1 ) + x( j )*temp
211 ELSE
212 ap( kk+j-1 ) = ap( kk+j-1 )
213 END IF
214 kk = kk + j
215 20 CONTINUE
216 ELSE
217 jx = kx
218 DO 40 j = 1, n
219 IF( x( jx ).NE.zero ) THEN
220 temp = alpha*x( jx )
221 ix = kx
222 DO 30 k = kk, kk + j - 2
223 ap( k ) = ap( k ) + x( ix )*temp
224 ix = ix + incx
225 30 CONTINUE
226 ap( kk+j-1 ) = ap( kk+j-1 ) + x( jx )*temp
227 ELSE
228 ap( kk+j-1 ) = ap( kk+j-1 )
229 END IF
230 jx = jx + incx
231 kk = kk + j
232 40 CONTINUE
233 END IF
234 ELSE
235*
236* Form A when lower triangle is stored in AP.
237*
238 IF( incx.EQ.1 ) THEN
239 DO 60 j = 1, n
240 IF( x( j ).NE.zero ) THEN
241 temp = alpha*x( j )
242 ap( kk ) = ap( kk ) + temp*x( j )
243 k = kk + 1
244 DO 50 i = j + 1, n
245 ap( k ) = ap( k ) + x( i )*temp
246 k = k + 1
247 50 CONTINUE
248 ELSE
249 ap( kk ) = ap( kk )
250 END IF
251 kk = kk + n - j + 1
252 60 CONTINUE
253 ELSE
254 jx = kx
255 DO 80 j = 1, n
256 IF( x( jx ).NE.zero ) THEN
257 temp = alpha*x( jx )
258 ap( kk ) = ap( kk ) + temp*x( jx )
259 ix = jx
260 DO 70 k = kk + 1, kk + n - j
261 ix = ix + incx
262 ap( k ) = ap( k ) + x( ix )*temp
263 70 CONTINUE
264 ELSE
265 ap( kk ) = ap( kk )
266 END IF
267 jx = jx + incx
268 kk = kk + n - j + 1
269 80 CONTINUE
270 END IF
271 END IF
272*
273 RETURN
274*
275* End of ZSPR
276*
277 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine zspr(uplo, n, alpha, x, incx, ap)
ZSPR performs the symmetrical rank-1 update of a complex symmetric packed matrix.
Definition zspr.f:132