LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
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 of 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 of 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 of 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 *> \date November 2011
133 *
134 *> \ingroup complex_blas_level2
135 *
136 *> \par Further Details:
137 * =====================
138 *>
139 *> \verbatim
140 *>
141 *> Level 2 Blas routine.
142 *>
143 *> -- Written on 22-October-1986.
144 *> Jack Dongarra, Argonne National Lab.
145 *> Jeremy Du Croz, Nag Central Office.
146 *> Sven Hammarling, Nag Central Office.
147 *> Richard Hanson, Sandia National Labs.
148 *> \endverbatim
149 *>
150 * =====================================================================
151  SUBROUTINE cher2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
152 *
153 * -- Reference BLAS level2 routine (version 3.4.0) --
154 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
155 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
156 * November 2011
157 *
158 * .. Scalar Arguments ..
159  COMPLEX alpha
160  INTEGER incx,incy,lda,n
161  CHARACTER uplo
162 * ..
163 * .. Array Arguments ..
164  COMPLEX a(lda,*),x(*),y(*)
165 * ..
166 *
167 * =====================================================================
168 *
169 * .. Parameters ..
170  COMPLEX zero
171  parameter(zero= (0.0e+0,0.0e+0))
172 * ..
173 * .. Local Scalars ..
174  COMPLEX temp1,temp2
175  INTEGER i,info,ix,iy,j,jx,jy,kx,ky
176 * ..
177 * .. External Functions ..
178  LOGICAL lsame
179  EXTERNAL lsame
180 * ..
181 * .. External Subroutines ..
182  EXTERNAL xerbla
183 * ..
184 * .. Intrinsic Functions ..
185  INTRINSIC conjg,max,real
186 * ..
187 *
188 * Test the input parameters.
189 *
190  info = 0
191  IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
192  info = 1
193  ELSE IF (n.LT.0) THEN
194  info = 2
195  ELSE IF (incx.EQ.0) THEN
196  info = 5
197  ELSE IF (incy.EQ.0) THEN
198  info = 7
199  ELSE IF (lda.LT.max(1,n)) THEN
200  info = 9
201  END IF
202  IF (info.NE.0) THEN
203  CALL xerbla('CHER2 ',info)
204  RETURN
205  END IF
206 *
207 * Quick return if possible.
208 *
209  IF ((n.EQ.0) .OR. (alpha.EQ.zero)) RETURN
210 *
211 * Set up the start points in X and Y if the increments are not both
212 * unity.
213 *
214  IF ((incx.NE.1) .OR. (incy.NE.1)) THEN
215  IF (incx.GT.0) THEN
216  kx = 1
217  ELSE
218  kx = 1 - (n-1)*incx
219  END IF
220  IF (incy.GT.0) THEN
221  ky = 1
222  ELSE
223  ky = 1 - (n-1)*incy
224  END IF
225  jx = kx
226  jy = ky
227  END IF
228 *
229 * Start the operations. In this version the elements of A are
230 * accessed sequentially with one pass through the triangular part
231 * of A.
232 *
233  IF (lsame(uplo,'U')) THEN
234 *
235 * Form A when A is stored in the upper triangle.
236 *
237  IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
238  DO 20 j = 1,n
239  IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
240  temp1 = alpha*conjg(y(j))
241  temp2 = conjg(alpha*x(j))
242  DO 10 i = 1,j - 1
243  a(i,j) = a(i,j) + x(i)*temp1 + y(i)*temp2
244  10 CONTINUE
245  a(j,j) = REAL(A(J,J)) +
246  + REAL(x(j)*temp1+y(j)*temp2)
247  ELSE
248  a(j,j) = REAL(a(j,j))
249  END IF
250  20 CONTINUE
251  ELSE
252  DO 40 j = 1,n
253  IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
254  temp1 = alpha*conjg(y(jy))
255  temp2 = conjg(alpha*x(jx))
256  ix = kx
257  iy = ky
258  DO 30 i = 1,j - 1
259  a(i,j) = a(i,j) + x(ix)*temp1 + y(iy)*temp2
260  ix = ix + incx
261  iy = iy + incy
262  30 CONTINUE
263  a(j,j) = REAL(A(J,J)) +
264  + REAL(x(jx)*temp1+y(jy)*temp2)
265  ELSE
266  a(j,j) = REAL(a(j,j))
267  END IF
268  jx = jx + incx
269  jy = jy + incy
270  40 CONTINUE
271  END IF
272  ELSE
273 *
274 * Form A when A is stored in the lower triangle.
275 *
276  IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
277  DO 60 j = 1,n
278  IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
279  temp1 = alpha*conjg(y(j))
280  temp2 = conjg(alpha*x(j))
281  a(j,j) = REAL(A(J,J)) +
282  + REAL(x(j)*temp1+y(j)*temp2)
283  DO 50 i = j + 1,n
284  a(i,j) = a(i,j) + x(i)*temp1 + y(i)*temp2
285  50 CONTINUE
286  ELSE
287  a(j,j) = REAL(a(j,j))
288  END IF
289  60 CONTINUE
290  ELSE
291  DO 80 j = 1,n
292  IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
293  temp1 = alpha*conjg(y(jy))
294  temp2 = conjg(alpha*x(jx))
295  a(j,j) = REAL(A(J,J)) +
296  + REAL(x(jx)*temp1+y(jy)*temp2)
297  ix = jx
298  iy = jy
299  DO 70 i = j + 1,n
300  ix = ix + incx
301  iy = iy + incy
302  a(i,j) = a(i,j) + x(ix)*temp1 + y(iy)*temp2
303  70 CONTINUE
304  ELSE
305  a(j,j) = REAL(a(j,j))
306  END IF
307  jx = jx + incx
308  jy = jy + incy
309  80 CONTINUE
310  END IF
311  END IF
312 *
313  RETURN
314 *
315 * End of CHER2 .
316 *
317  END