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