LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
chpr2.f
Go to the documentation of this file.
1*> \brief \b CHPR2
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 CHPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP)
12*
13* .. Scalar Arguments ..
14* COMPLEX ALPHA
15* INTEGER INCX,INCY,N
16* CHARACTER UPLO
17* ..
18* .. Array Arguments ..
19* COMPLEX AP(*),X(*),Y(*)
20* ..
21*
22*
23*> \par Purpose:
24* =============
25*>
26*> \verbatim
27*>
28*> CHPR2 performs the hermitian rank 2 operation
29*>
30*> A := alpha*x*y**H + conjg( alpha )*y*x**H + A,
31*>
32*> where alpha is a scalar, x and y are n element vectors and A is an
33*> n by n hermitian matrix, supplied in packed form.
34*> \endverbatim
35*
36* Arguments:
37* ==========
38*
39*> \param[in] UPLO
40*> \verbatim
41*> UPLO is CHARACTER*1
42*> On entry, UPLO specifies whether the upper or lower
43*> triangular part of the matrix A is supplied in the packed
44*> array AP as follows:
45*>
46*> UPLO = 'U' or 'u' The upper triangular part of A is
47*> supplied in AP.
48*>
49*> UPLO = 'L' or 'l' The lower triangular part of A is
50*> supplied in AP.
51*> \endverbatim
52*>
53*> \param[in] N
54*> \verbatim
55*> N is INTEGER
56*> On entry, N specifies the order of the matrix A.
57*> N must be at least zero.
58*> \endverbatim
59*>
60*> \param[in] ALPHA
61*> \verbatim
62*> ALPHA is COMPLEX
63*> On entry, ALPHA specifies the scalar alpha.
64*> \endverbatim
65*>
66*> \param[in] X
67*> \verbatim
68*> X is COMPLEX array, dimension at least
69*> ( 1 + ( n - 1 )*abs( INCX ) ).
70*> Before entry, the incremented array X must contain the n
71*> element vector x.
72*> \endverbatim
73*>
74*> \param[in] INCX
75*> \verbatim
76*> INCX is INTEGER
77*> On entry, INCX specifies the increment for the elements of
78*> X. INCX must not be zero.
79*> \endverbatim
80*>
81*> \param[in] Y
82*> \verbatim
83*> Y is COMPLEX array, dimension at least
84*> ( 1 + ( n - 1 )*abs( INCY ) ).
85*> Before entry, the incremented array Y must contain the n
86*> element vector y.
87*> \endverbatim
88*>
89*> \param[in] INCY
90*> \verbatim
91*> INCY is INTEGER
92*> On entry, INCY specifies the increment for the elements of
93*> Y. INCY must not be zero.
94*> \endverbatim
95*>
96*> \param[in,out] AP
97*> \verbatim
98*> AP is COMPLEX array, dimension at least
99*> ( ( n*( n + 1 ) )/2 ).
100*> Before entry with UPLO = 'U' or 'u', the array AP must
101*> contain the upper triangular part of the hermitian matrix
102*> packed sequentially, column by column, so that AP( 1 )
103*> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
104*> and a( 2, 2 ) respectively, and so on. On exit, the array
105*> AP is overwritten by the upper triangular part of the
106*> updated matrix.
107*> Before entry with UPLO = 'L' or 'l', the array AP must
108*> contain the lower triangular part of the hermitian matrix
109*> packed sequentially, column by column, so that AP( 1 )
110*> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
111*> and a( 3, 1 ) respectively, and so on. On exit, the array
112*> AP is overwritten by the lower triangular part of the
113*> updated matrix.
114*> Note that the imaginary parts of the diagonal elements need
115*> not be set, they are assumed to be zero, and on exit they
116*> are set to zero.
117*> \endverbatim
118*
119* Authors:
120* ========
121*
122*> \author Univ. of Tennessee
123*> \author Univ. of California Berkeley
124*> \author Univ. of Colorado Denver
125*> \author NAG Ltd.
126*
127*> \ingroup hpr2
128*
129*> \par Further Details:
130* =====================
131*>
132*> \verbatim
133*>
134*> Level 2 Blas routine.
135*>
136*> -- Written on 22-October-1986.
137*> Jack Dongarra, Argonne National Lab.
138*> Jeremy Du Croz, Nag Central Office.
139*> Sven Hammarling, Nag Central Office.
140*> Richard Hanson, Sandia National Labs.
141*> \endverbatim
142*>
143* =====================================================================
144 SUBROUTINE chpr2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP)
145*
146* -- Reference BLAS level2 routine --
147* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
148* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
149*
150* .. Scalar Arguments ..
151 COMPLEX ALPHA
152 INTEGER INCX,INCY,N
153 CHARACTER UPLO
154* ..
155* .. Array Arguments ..
156 COMPLEX AP(*),X(*),Y(*)
157* ..
158*
159* =====================================================================
160*
161* .. Parameters ..
162 COMPLEX ZERO
163 parameter(zero= (0.0e+0,0.0e+0))
164* ..
165* .. Local Scalars ..
166 COMPLEX TEMP1,TEMP2
167 INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
168* ..
169* .. External Functions ..
170 LOGICAL LSAME
171 EXTERNAL lsame
172* ..
173* .. External Subroutines ..
174 EXTERNAL xerbla
175* ..
176* .. Intrinsic Functions ..
177 INTRINSIC conjg,real
178* ..
179*
180* Test the input parameters.
181*
182 info = 0
183 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
184 info = 1
185 ELSE IF (n.LT.0) THEN
186 info = 2
187 ELSE IF (incx.EQ.0) THEN
188 info = 5
189 ELSE IF (incy.EQ.0) THEN
190 info = 7
191 END IF
192 IF (info.NE.0) THEN
193 CALL xerbla('CHPR2 ',info)
194 RETURN
195 END IF
196*
197* Quick return if possible.
198*
199 IF ((n.EQ.0) .OR. (alpha.EQ.zero)) RETURN
200*
201* Set up the start points in X and Y if the increments are not both
202* unity.
203*
204 IF ((incx.NE.1) .OR. (incy.NE.1)) THEN
205 IF (incx.GT.0) THEN
206 kx = 1
207 ELSE
208 kx = 1 - (n-1)*incx
209 END IF
210 IF (incy.GT.0) THEN
211 ky = 1
212 ELSE
213 ky = 1 - (n-1)*incy
214 END IF
215 jx = kx
216 jy = ky
217 END IF
218*
219* Start the operations. In this version the elements of the array AP
220* are accessed sequentially with one pass through AP.
221*
222 kk = 1
223 IF (lsame(uplo,'U')) THEN
224*
225* Form A when upper triangle is stored in AP.
226*
227 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
228 DO 20 j = 1,n
229 IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
230 temp1 = alpha*conjg(y(j))
231 temp2 = conjg(alpha*x(j))
232 k = kk
233 DO 10 i = 1,j - 1
234 ap(k) = ap(k) + x(i)*temp1 + y(i)*temp2
235 k = k + 1
236 10 CONTINUE
237 ap(kk+j-1) = real(ap(kk+j-1)) +
238 + real(x(j)*temp1+y(j)*temp2)
239 ELSE
240 ap(kk+j-1) = real(ap(kk+j-1))
241 END IF
242 kk = kk + j
243 20 CONTINUE
244 ELSE
245 DO 40 j = 1,n
246 IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
247 temp1 = alpha*conjg(y(jy))
248 temp2 = conjg(alpha*x(jx))
249 ix = kx
250 iy = ky
251 DO 30 k = kk,kk + j - 2
252 ap(k) = ap(k) + x(ix)*temp1 + y(iy)*temp2
253 ix = ix + incx
254 iy = iy + incy
255 30 CONTINUE
256 ap(kk+j-1) = real(ap(kk+j-1)) +
257 + real(x(jx)*temp1+y(jy)*temp2)
258 ELSE
259 ap(kk+j-1) = real(ap(kk+j-1))
260 END IF
261 jx = jx + incx
262 jy = jy + incy
263 kk = kk + j
264 40 CONTINUE
265 END IF
266 ELSE
267*
268* Form A when lower triangle is stored in AP.
269*
270 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
271 DO 60 j = 1,n
272 IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
273 temp1 = alpha*conjg(y(j))
274 temp2 = conjg(alpha*x(j))
275 ap(kk) = real(ap(kk)) +
276 + real(x(j)*temp1+y(j)*temp2)
277 k = kk + 1
278 DO 50 i = j + 1,n
279 ap(k) = ap(k) + x(i)*temp1 + y(i)*temp2
280 k = k + 1
281 50 CONTINUE
282 ELSE
283 ap(kk) = real(ap(kk))
284 END IF
285 kk = kk + n - j + 1
286 60 CONTINUE
287 ELSE
288 DO 80 j = 1,n
289 IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
290 temp1 = alpha*conjg(y(jy))
291 temp2 = conjg(alpha*x(jx))
292 ap(kk) = real(ap(kk)) +
293 + real(x(jx)*temp1+y(jy)*temp2)
294 ix = jx
295 iy = jy
296 DO 70 k = kk + 1,kk + n - j
297 ix = ix + incx
298 iy = iy + incy
299 ap(k) = ap(k) + x(ix)*temp1 + y(iy)*temp2
300 70 CONTINUE
301 ELSE
302 ap(kk) = real(ap(kk))
303 END IF
304 jx = jx + incx
305 jy = jy + incy
306 kk = kk + n - j + 1
307 80 CONTINUE
308 END IF
309 END IF
310*
311 RETURN
312*
313* End of CHPR2
314*
315 END
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
chpr2
subroutine chpr2(uplo, n, alpha, x, incx, y, incy, ap)
CHPR2
Definition chpr2.f:145