3 /* Subroutine */ int ssymv_(char *uplo, integer *n, real *alpha, real *a,
4 integer *lda, real *x, integer *incx, real *beta, real *y, integer *
7 /* System generated locals */
8 integer a_dim1, a_offset, i__1, i__2;
11 integer i__, j, ix, iy, jx, jy, kx, ky, info;
13 extern logical lsame_(char *, char *);
14 extern /* Subroutine */ int xerbla_(char *, integer *);
16 /* .. Scalar Arguments .. */
18 /* .. Array Arguments .. */
24 /* SSYMV performs the matrix-vector operation */
26 /* y := alpha*A*x + beta*y, */
28 /* where alpha and beta are scalars, x and y are n element vectors and */
29 /* A is an n by n symmetric matrix. */
34 /* UPLO - CHARACTER*1. */
35 /* On entry, UPLO specifies whether the upper or lower */
36 /* triangular part of the array A is to be referenced as */
39 /* UPLO = 'U' or 'u' Only the upper triangular part of A */
40 /* is to be referenced. */
42 /* UPLO = 'L' or 'l' Only the lower triangular part of A */
43 /* is to be referenced. */
45 /* Unchanged on exit. */
48 /* On entry, N specifies the order of the matrix A. */
49 /* N must be at least zero. */
50 /* Unchanged on exit. */
53 /* On entry, ALPHA specifies the scalar alpha. */
54 /* Unchanged on exit. */
56 /* A - REAL array of DIMENSION ( LDA, n ). */
57 /* Before entry with UPLO = 'U' or 'u', the leading n by n */
58 /* upper triangular part of the array A must contain the upper */
59 /* triangular part of the symmetric matrix and the strictly */
60 /* lower triangular part of A is not referenced. */
61 /* Before entry with UPLO = 'L' or 'l', the leading n by n */
62 /* lower triangular part of the array A must contain the lower */
63 /* triangular part of the symmetric matrix and the strictly */
64 /* upper triangular part of A is not referenced. */
65 /* Unchanged on exit. */
68 /* On entry, LDA specifies the first dimension of A as declared */
69 /* in the calling (sub) program. LDA must be at least */
71 /* Unchanged on exit. */
73 /* X - REAL array of dimension at least */
74 /* ( 1 + ( n - 1 )*abs( INCX ) ). */
75 /* Before entry, the incremented array X must contain the n */
76 /* element vector x. */
77 /* Unchanged on exit. */
80 /* On entry, INCX specifies the increment for the elements of */
81 /* X. INCX must not be zero. */
82 /* Unchanged on exit. */
85 /* On entry, BETA specifies the scalar beta. When BETA is */
86 /* supplied as zero then Y need not be set on input. */
87 /* Unchanged on exit. */
89 /* Y - REAL array of dimension at least */
90 /* ( 1 + ( n - 1 )*abs( INCY ) ). */
91 /* Before entry, the incremented array Y must contain the n */
92 /* element vector y. On exit, Y is overwritten by the updated */
96 /* On entry, INCY specifies the increment for the elements of */
97 /* Y. INCY must not be zero. */
98 /* Unchanged on exit. */
101 /* Level 2 Blas routine. */
103 /* -- Written on 22-October-1986. */
104 /* Jack Dongarra, Argonne National Lab. */
105 /* Jeremy Du Croz, Nag Central Office. */
106 /* Sven Hammarling, Nag Central Office. */
107 /* Richard Hanson, Sandia National Labs. */
110 /* .. Parameters .. */
112 /* .. Local Scalars .. */
114 /* .. External Functions .. */
116 /* .. External Subroutines .. */
118 /* .. Intrinsic Functions .. */
121 /* Test the input parameters. */
123 /* Parameter adjustments */
125 a_offset = 1 + a_dim1;
132 if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
136 } else if (*lda < max(1,*n)) {
138 } else if (*incx == 0) {
140 } else if (*incy == 0) {
144 xerbla_("SSYMV ", &info);
148 /* Quick return if possible. */
150 if (*n == 0 || *alpha == 0.f && *beta == 1.f) {
154 /* Set up the start points in X and Y. */
159 kx = 1 - (*n - 1) * *incx;
164 ky = 1 - (*n - 1) * *incy;
167 /* Start the operations. In this version the elements of A are */
168 /* accessed sequentially with one pass through the triangular part */
171 /* First form y := beta*y. */
177 for (i__ = 1; i__ <= i__1; ++i__) {
183 for (i__ = 1; i__ <= i__1; ++i__) {
184 y[i__] = *beta * y[i__];
192 for (i__ = 1; i__ <= i__1; ++i__) {
199 for (i__ = 1; i__ <= i__1; ++i__) {
200 y[iy] = *beta * y[iy];
210 if (lsame_(uplo, "U")) {
212 /* Form y when A is stored in upper triangle. */
214 if (*incx == 1 && *incy == 1) {
216 for (j = 1; j <= i__1; ++j) {
217 temp1 = *alpha * x[j];
220 for (i__ = 1; i__ <= i__2; ++i__) {
221 y[i__] += temp1 * a[i__ + j * a_dim1];
222 temp2 += a[i__ + j * a_dim1] * x[i__];
225 y[j] = y[j] + temp1 * a[j + j * a_dim1] + *alpha * temp2;
232 for (j = 1; j <= i__1; ++j) {
233 temp1 = *alpha * x[jx];
238 for (i__ = 1; i__ <= i__2; ++i__) {
239 y[iy] += temp1 * a[i__ + j * a_dim1];
240 temp2 += a[i__ + j * a_dim1] * x[ix];
245 y[jy] = y[jy] + temp1 * a[j + j * a_dim1] + *alpha * temp2;
253 /* Form y when A is stored in lower triangle. */
255 if (*incx == 1 && *incy == 1) {
257 for (j = 1; j <= i__1; ++j) {
258 temp1 = *alpha * x[j];
260 y[j] += temp1 * a[j + j * a_dim1];
262 for (i__ = j + 1; i__ <= i__2; ++i__) {
263 y[i__] += temp1 * a[i__ + j * a_dim1];
264 temp2 += a[i__ + j * a_dim1] * x[i__];
267 y[j] += *alpha * temp2;
274 for (j = 1; j <= i__1; ++j) {
275 temp1 = *alpha * x[jx];
277 y[jy] += temp1 * a[j + j * a_dim1];
281 for (i__ = j + 1; i__ <= i__2; ++i__) {
284 y[iy] += temp1 * a[i__ + j * a_dim1];
285 temp2 += a[i__ + j * a_dim1] * x[ix];
288 y[jy] += *alpha * temp2;