LAPACK
3.5.0
LAPACK: Linear Algebra PACKage
Main Page
Data Types List
Files
File List
File Members
All
Classes
Files
Functions
Variables
Typedefs
Macros
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 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,out] A
82
*> \verbatim
83
*> A is REAL array of 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
*> \date November 2011
115
*
116
*> \ingroup single_blas_level2
117
*
118
*> \par Further Details:
119
* =====================
120
*>
121
*> \verbatim
122
*>
123
*> Level 2 Blas routine.
124
*>
125
*> -- Written on 22-October-1986.
126
*> Jack Dongarra, Argonne National Lab.
127
*> Jeremy Du Croz, Nag Central Office.
128
*> Sven Hammarling, Nag Central Office.
129
*> Richard Hanson, Sandia National Labs.
130
*> \endverbatim
131
*>
132
* =====================================================================
133
SUBROUTINE
ssyr
(UPLO,N,ALPHA,X,INCX,A,LDA)
134
*
135
* -- Reference BLAS level2 routine (version 3.4.0) --
136
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
137
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
138
* November 2011
139
*
140
* .. Scalar Arguments ..
141
REAL
alpha
142
INTEGER
incx,lda,n
143
CHARACTER
uplo
144
* ..
145
* .. Array Arguments ..
146
REAL
a(lda,*),x(*)
147
* ..
148
*
149
* =====================================================================
150
*
151
* .. Parameters ..
152
REAL
zero
153
parameter(zero=0.0e+0)
154
* ..
155
* .. Local Scalars ..
156
REAL
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
max
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
(
'SSYR '
,info)
184
RETURN
185
END IF
186
*
187
* Quick return if possible.
188
*
189
IF
((n.EQ.0) .OR. (alpha.EQ.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*x(
j
)
211
DO
10 i = 1,
j
212
a(i,
j
) = a(i,
j
) + x(i)*temp
213
10
CONTINUE
214
END IF
215
20
CONTINUE
216
ELSE
217
jx = kx
218
DO
40
j
= 1,n
219
IF
(x(jx).NE.zero)
THEN
220
temp = alpha*x(jx)
221
ix = kx
222
DO
30 i = 1,
j
223
a(i,
j
) = a(i,
j
) + x(ix)*temp
224
ix = ix + incx
225
30
CONTINUE
226
END IF
227
jx = jx + incx
228
40
CONTINUE
229
END IF
230
ELSE
231
*
232
* Form A when A is stored in lower triangle.
233
*
234
IF
(incx.EQ.1)
THEN
235
DO
60
j
= 1,n
236
IF
(x(
j
).NE.zero)
THEN
237
temp = alpha*x(
j
)
238
DO
50 i =
j
,n
239
a(i,
j
) = a(i,
j
) + x(i)*temp
240
50
CONTINUE
241
END IF
242
60
CONTINUE
243
ELSE
244
jx = kx
245
DO
80
j
= 1,n
246
IF
(x(jx).NE.zero)
THEN
247
temp = alpha*x(jx)
248
ix = jx
249
DO
70 i =
j
,n
250
a(i,
j
) = a(i,
j
) + x(ix)*temp
251
ix = ix + incx
252
70
CONTINUE
253
END IF
254
jx = jx + incx
255
80
CONTINUE
256
END IF
257
END IF
258
*
259
RETURN
260
*
261
* End of SSYR .
262
*
263
END
blas
SRC
ssyr.f
Generated on Mon Dec 30 2013 16:09:10 for LAPACK by
1.8.1.2