LAPACK  3.11.0
LAPACK: Linear Algebra PACKage
dsyr2.f
1 *> \brief \b DSYR2
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 DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
12 *
13 * .. Scalar Arguments ..
14 * DOUBLE PRECISION ALPHA
15 * INTEGER INCX,INCY,LDA,N
16 * CHARACTER UPLO
17 * ..
18 * .. Array Arguments ..
19 * DOUBLE PRECISION A(LDA,*),X(*),Y(*)
20 * ..
21 *
22 *
23 *> \par Purpose:
24 * =============
25 *>
26 *> \verbatim
27 *>
28 *> DSYR2 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 DOUBLE PRECISION.
63 *> On entry, ALPHA specifies the scalar alpha.
64 *> \endverbatim
65 *>
66 *> \param[in] X
67 *> \verbatim
68 *> X is DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 her2
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 dsyr2(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  DOUBLE PRECISION ALPHA
154  INTEGER INCX,INCY,LDA,N
155  CHARACTER UPLO
156 * ..
157 * .. Array Arguments ..
158  DOUBLE PRECISION A(lda,*),X(*),Y(*)
159 * ..
160 *
161 * =====================================================================
162 *
163 * .. Parameters ..
164  DOUBLE PRECISION ZERO
165  parameter(zero=0.0d+0)
166 * ..
167 * .. Local Scalars ..
168  DOUBLE PRECISION 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('DSYR2 ',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 DSYR2
294 *
295  END
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
dsyr2
subroutine dsyr2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
DSYR2
Definition: dsyr2.f:147