1
SUBROUTINE SSYMV ( UPLO, N, ALPHA, A, LDA, X, INCX,
4
* $Id: ssymv.f 19695 2010-10-29 16:51:02Z d3y133 $
3
* =========== DOCUMENTATION ===========
5
* Online html documentation available at
6
* http://www.netlib.org/lapack/explore-html/
11
* SUBROUTINE SSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
13
* .. Scalar Arguments ..
15
* INTEGER INCX,INCY,LDA,N
18
* .. Array Arguments ..
19
* REAL A(LDA,*),X(*),Y(*)
28
*> SSYMV performs the matrix-vector operation
30
*> y := alpha*A*x + beta*y,
32
*> where alpha and beta are scalars, x and y are n element vectors and
33
*> A is an 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.
63
*> On entry, ALPHA specifies the scalar alpha.
68
*> A is REAL array of DIMENSION ( LDA, n ).
69
*> Before entry with UPLO = 'U' or 'u', the leading n by n
70
*> upper triangular part of the array A must contain the upper
71
*> triangular part of the symmetric matrix and the strictly
72
*> lower triangular part of A is not referenced.
73
*> Before entry with UPLO = 'L' or 'l', the leading n by n
74
*> lower triangular part of the array A must contain the lower
75
*> triangular part of the symmetric matrix and the strictly
76
*> upper triangular part of A is not referenced.
82
*> On entry, LDA specifies the first dimension of A as declared
83
*> in the calling (sub) program. LDA must be at least
89
*> X is REAL array of dimension at least
90
*> ( 1 + ( n - 1 )*abs( INCX ) ).
91
*> Before entry, the incremented array X must contain the n
98
*> On entry, INCX specifies the increment for the elements of
99
*> X. INCX must not be zero.
105
*> On entry, BETA specifies the scalar beta. When BETA is
106
*> supplied as zero then Y need not be set on input.
111
*> Y is REAL array of dimension at least
112
*> ( 1 + ( n - 1 )*abs( INCY ) ).
113
*> Before entry, the incremented array Y must contain the n
114
*> element vector y. On exit, Y is overwritten by the updated
121
*> On entry, INCY specifies the increment for the elements of
122
*> Y. INCY must not be zero.
128
*> \author Univ. of Tennessee
129
*> \author Univ. of California Berkeley
130
*> \author Univ. of Colorado Denver
133
*> \date November 2011
135
*> \ingroup single_blas_level2
137
*> \par Further Details:
138
* =====================
142
*> Level 2 Blas routine.
143
*> The vector and matrix arguments are not referenced when N = 0, or M = 0
145
*> -- Written on 22-October-1986.
146
*> Jack Dongarra, Argonne National Lab.
147
*> Jeremy Du Croz, Nag Central Office.
148
*> Sven Hammarling, Nag Central Office.
149
*> Richard Hanson, Sandia National Labs.
152
* =====================================================================
153
SUBROUTINE SSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
155
* -- Reference BLAS level2 routine (version 3.4.0) --
156
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
157
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6
160
* .. Scalar Arguments ..
8
INTEGER INCX, INCY, LDA, N
162
INTEGER INCX,INCY,LDA,N
10
165
* .. Array Arguments ..
11
REAL A( LDA, * ), X( * ), Y( * )
166
REAL A(LDA,*),X(*),Y(*)
17
* SSYMV performs the matrix-vector operation
19
* y := alpha*A*x + beta*y,
21
* where alpha and beta are scalars, x and y are n element vectors and
22
* A is an n by n symmetric matrix.
28
* On entry, UPLO specifies whether the upper or lower
29
* triangular part of the array A is to be referenced as
32
* UPLO = 'U' or 'u' Only the upper triangular part of A
33
* is to be referenced.
35
* UPLO = 'L' or 'l' Only the lower triangular part of A
36
* is to be referenced.
41
* On entry, N specifies the order of the matrix A.
42
* N must be at least zero.
46
* On entry, ALPHA specifies the scalar alpha.
49
* A - REAL array of DIMENSION ( LDA, n ).
50
* Before entry with UPLO = 'U' or 'u', the leading n by n
51
* upper triangular part of the array A must contain the upper
52
* triangular part of the symmetric matrix and the strictly
53
* lower triangular part of A is not referenced.
54
* Before entry with UPLO = 'L' or 'l', the leading n by n
55
* lower triangular part of the array A must contain the lower
56
* triangular part of the symmetric matrix and the strictly
57
* upper triangular part of A is not referenced.
61
* On entry, LDA specifies the first dimension of A as declared
62
* in the calling (sub) program. LDA must be at least
66
* X - REAL array of dimension at least
67
* ( 1 + ( n - 1 )*abs( INCX ) ).
68
* Before entry, the incremented array X must contain the n
73
* On entry, INCX specifies the increment for the elements of
74
* X. INCX must not be zero.
78
* On entry, BETA specifies the scalar beta. When BETA is
79
* supplied as zero then Y need not be set on input.
82
* Y - REAL array of dimension at least
83
* ( 1 + ( n - 1 )*abs( INCY ) ).
84
* Before entry, the incremented array Y must contain the n
85
* element vector y. On exit, Y is overwritten by the updated
89
* On entry, INCY specifies the increment for the elements of
90
* Y. INCY must not be zero.
94
* Level 2 Blas routine.
96
* -- Written on 22-October-1986.
97
* Jack Dongarra, Argonne National Lab.
98
* Jeremy Du Croz, Nag Central Office.
99
* Sven Hammarling, Nag Central Office.
100
* Richard Hanson, Sandia National Labs.
169
* =====================================================================
103
171
* .. Parameters ..
105
PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
173
PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
106
175
* .. Local Scalars ..
108
INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
177
INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
109
179
* .. External Functions ..
112
183
* .. External Subroutines ..
114
186
* .. Intrinsic Functions ..
117
* .. Executable Statements ..
119
190
* Test the input parameters.
122
IF ( .NOT.LSAME( UPLO, 'U' ).AND.
123
$ .NOT.LSAME( UPLO, 'L' ) )THEN
125
ELSE IF( N.LT.0 )THEN
127
ELSE IF( LDA.LT.MAX( 1, N ) )THEN
129
ELSE IF( INCX.EQ.0 )THEN
131
ELSE IF( INCY.EQ.0 )THEN
193
IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
195
ELSE IF (N.LT.0) THEN
197
ELSE IF (LDA.LT.MAX(1,N)) THEN
199
ELSE IF (INCX.EQ.0) THEN
201
ELSE IF (INCY.EQ.0) THEN
135
CALL XERBLA( 'SSYMV ', INFO )
205
CALL XERBLA('SSYMV ',INFO)
139
209
* Quick return if possible.
141
IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
211
IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
144
213
* Set up the start points in X and Y.
149
KX = 1 - ( N - 1 )*INCX
154
KY = 1 - ( N - 1 )*INCY
157
226
* Start the operations. In this version the elements of A are
161
230
* First form y := beta*y.
163
IF( BETA.NE.ONE )THEN
165
IF( BETA.EQ.ZERO )THEN
176
IF( BETA.EQ.ZERO )THEN
183
Y( IY ) = BETA*Y( IY )
232
IF (BETA.NE.ONE) THEN
234
IF (BETA.EQ.ZERO) THEN
245
IF (BETA.EQ.ZERO) THEN
191
IF( LSAME( UPLO, 'U' ) )THEN
258
IF (ALPHA.EQ.ZERO) RETURN
259
IF (LSAME(UPLO,'U')) THEN
193
261
* Form y when A is stored in upper triangle.
195
IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
200
Y( I ) = Y( I ) + TEMP1*A( I, J )
201
TEMP2 = TEMP2 + A( I, J )*X( I )
203
Y( J ) = Y( J ) + TEMP1*A( J, J ) + ALPHA*TEMP2
209
TEMP1 = ALPHA*X( JX )
214
Y( IY ) = Y( IY ) + TEMP1*A( I, J )
215
TEMP2 = TEMP2 + A( I, J )*X( IX )
219
Y( JY ) = Y( JY ) + TEMP1*A( J, J ) + ALPHA*TEMP2
263
IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
268
Y(I) = Y(I) + TEMP1*A(I,J)
269
TEMP2 = TEMP2 + A(I,J)*X(I)
271
Y(J) = Y(J) + TEMP1*A(J,J) + ALPHA*TEMP2
282
Y(IY) = Y(IY) + TEMP1*A(I,J)
283
TEMP2 = TEMP2 + A(I,J)*X(IX)
287
Y(JY) = Y(JY) + TEMP1*A(J,J) + ALPHA*TEMP2
226
294
* Form y when A is stored in lower triangle.
228
IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
232
Y( J ) = Y( J ) + TEMP1*A( J, J )
234
Y( I ) = Y( I ) + TEMP1*A( I, J )
235
TEMP2 = TEMP2 + A( I, J )*X( I )
237
Y( J ) = Y( J ) + ALPHA*TEMP2
243
TEMP1 = ALPHA*X( JX )
245
Y( JY ) = Y( JY ) + TEMP1*A( J, J )
251
Y( IY ) = Y( IY ) + TEMP1*A( I, J )
252
TEMP2 = TEMP2 + A( I, J )*X( IX )
254
Y( JY ) = Y( JY ) + ALPHA*TEMP2
296
IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
300
Y(J) = Y(J) + TEMP1*A(J,J)
302
Y(I) = Y(I) + TEMP1*A(I,J)
303
TEMP2 = TEMP2 + A(I,J)*X(I)
305
Y(J) = Y(J) + ALPHA*TEMP2
313
Y(JY) = Y(JY) + TEMP1*A(J,J)
319
Y(IY) = Y(IY) + TEMP1*A(I,J)
320
TEMP2 = TEMP2 + A(I,J)*X(IX)
322
Y(JY) = Y(JY) + ALPHA*TEMP2