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