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