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