LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
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