1
SUBROUTINE DSYR ( UPLO, N, ALPHA, X, INCX, A, LDA )
3
* =========== DOCUMENTATION ===========
5
* Online html documentation available at
6
* http://www.netlib.org/lapack/explore-html/
11
* SUBROUTINE DSYR(UPLO,N,ALPHA,X,INCX,A,LDA)
13
* .. Scalar Arguments ..
14
* DOUBLE PRECISION ALPHA
18
* .. Array Arguments ..
19
* DOUBLE PRECISION A(LDA,*),X(*)
28
*> DSYR performs the symmetric rank 1 operation
30
*> A := alpha*x*x**T + A,
32
*> where alpha is a real scalar, x is an n element vector and A is an
33
*> n by n symmetric matrix.
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
46
*> UPLO = 'U' or 'u' Only the upper triangular part of A
47
*> is to be referenced.
49
*> UPLO = 'L' or 'l' Only the lower triangular part of A
50
*> is to be referenced.
56
*> On entry, N specifies the order of the matrix A.
57
*> N must be at least zero.
62
*> ALPHA is DOUBLE PRECISION.
63
*> On entry, ALPHA specifies the scalar alpha.
68
*> X is DOUBLE PRECISION array of dimension at least
69
*> ( 1 + ( n - 1 )*abs( INCX ) ).
70
*> Before entry, the incremented array X must contain the n
77
*> On entry, INCX specifies the increment for the elements of
78
*> X. INCX must not be zero.
83
*> A is DOUBLE PRECISION 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.
101
*> On entry, LDA specifies the first dimension of A as declared
102
*> in the calling (sub) program. LDA must be at least
109
*> \author Univ. of Tennessee
110
*> \author Univ. of California Berkeley
111
*> \author Univ. of Colorado Denver
114
*> \date November 2011
116
*> \ingroup double_blas_level2
118
*> \par Further Details:
119
* =====================
123
*> Level 2 Blas routine.
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.
132
* =====================================================================
133
SUBROUTINE DSYR(UPLO,N,ALPHA,X,INCX,A,LDA)
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..--
2
140
* .. Scalar Arguments ..
3
C $Id: dsyr.f 19695 2010-10-29 16:51:02Z d3y133 $
141
DOUBLE PRECISION ALPHA
7
145
* .. Array Arguments ..
8
DOUBLE PRECISION A( LDA, * ), X( * )
146
DOUBLE PRECISION A(LDA,*),X(*)
14
* DSYR performs the symmetric rank 1 operation
16
* A := alpha*x*x' + A,
18
* where alpha is a real scalar, x is an n element vector and A is an
19
* n by n symmetric matrix.
25
* On entry, UPLO specifies whether the upper or lower
26
* triangular part of the array A is to be referenced as
29
* UPLO = 'U' or 'u' Only the upper triangular part of A
30
* is to be referenced.
32
* UPLO = 'L' or 'l' Only the lower triangular part of A
33
* is to be referenced.
38
* On entry, N specifies the order of the matrix A.
39
* N must be at least zero.
42
* ALPHA - DOUBLE PRECISION.
43
* On entry, ALPHA specifies the scalar alpha.
46
* X - DOUBLE PRECISION array of dimension at least
47
* ( 1 + ( n - 1 )*abs( INCX ) ).
48
* Before entry, the incremented array X must contain the n
53
* On entry, INCX specifies the increment for the elements of
54
* X. INCX must not be zero.
57
* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
58
* Before entry with UPLO = 'U' or 'u', the leading n by n
59
* upper triangular part of the array A must contain the upper
60
* triangular part of the symmetric matrix and the strictly
61
* lower triangular part of A is not referenced. On exit, the
62
* upper triangular part of the array A is overwritten by the
63
* upper triangular part of the updated matrix.
64
* Before entry with UPLO = 'L' or 'l', the leading n by n
65
* lower triangular part of the array A must contain the lower
66
* triangular part of the symmetric matrix and the strictly
67
* upper triangular part of A is not referenced. On exit, the
68
* lower triangular part of the array A is overwritten by the
69
* lower triangular part of the updated matrix.
72
* On entry, LDA specifies the first dimension of A as declared
73
* in the calling (sub) program. LDA must be at least
78
* Level 2 Blas routine.
80
* -- Written on 22-October-1986.
81
* Jack Dongarra, Argonne National Lab.
82
* Jeremy Du Croz, Nag Central Office.
83
* Sven Hammarling, Nag Central Office.
84
* Richard Hanson, Sandia National Labs.
149
* =====================================================================
87
151
* .. Parameters ..
89
PARAMETER ( ZERO = 0.0D+0 )
152
DOUBLE PRECISION ZERO
153
PARAMETER (ZERO=0.0D+0)
90
155
* .. Local Scalars ..
92
INTEGER I, INFO, IX, J, JX, KX
156
DOUBLE PRECISION TEMP
157
INTEGER I,INFO,IX,J,JX,KX
93
159
* .. External Functions ..
96
163
* .. External Subroutines ..
98
166
* .. Intrinsic Functions ..
101
* .. Executable Statements ..
103
170
* Test the input parameters.
106
IF ( .NOT.LSAME( UPLO, 'U' ).AND.
107
$ .NOT.LSAME( UPLO, 'L' ) )THEN
109
ELSE IF( N.LT.0 )THEN
111
ELSE IF( INCX.EQ.0 )THEN
113
ELSE IF( LDA.LT.MAX( 1, N ) )THEN
173
IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
175
ELSE IF (N.LT.0) THEN
177
ELSE IF (INCX.EQ.0) THEN
179
ELSE IF (LDA.LT.MAX(1,N)) THEN
117
CALL XERBLA( 'DSYR ', INFO )
183
CALL XERBLA('DSYR ',INFO)
121
187
* Quick return if possible.
123
IF( ( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
189
IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
126
191
* Set the start point in X if the increment is not unity.
129
KX = 1 - ( N - 1 )*INCX
130
ELSE IF( INCX.NE.1 )THEN
195
ELSE IF (INCX.NE.1) THEN
134
199
* Start the operations. In this version the elements of A are
135
200
* accessed sequentially with one pass through the triangular part
138
IF( LSAME( UPLO, 'U' ) )THEN
203
IF (LSAME(UPLO,'U')) THEN
140
205
* Form A when A is stored in upper triangle.
144
IF( X( J ).NE.ZERO )THEN
147
A( I, J ) = A( I, J ) + X( I )*TEMP
154
IF( X( JX ).NE.ZERO )THEN
158
A( I, J ) = A( I, J ) + X( IX )*TEMP
209
IF (X(J).NE.ZERO) THEN
212
A(I,J) = A(I,J) + X(I)*TEMP
219
IF (X(JX).NE.ZERO) THEN
223
A(I,J) = A(I,J) + X(IX)*TEMP
167
232
* Form A when A is stored in lower triangle.
171
IF( X( J ).NE.ZERO )THEN
174
A( I, J ) = A( I, J ) + X( I )*TEMP
181
IF( X( JX ).NE.ZERO )THEN
185
A( I, J ) = A( I, J ) + X( IX )*TEMP
236
IF (X(J).NE.ZERO) THEN
239
A(I,J) = A(I,J) + X(I)*TEMP
246
IF (X(JX).NE.ZERO) THEN
250
A(I,J) = A(I,J) + X(IX)*TEMP