2 /* -- translated by f2c (version 19940927).
3 You must link the resulting object file with the libraries:
4 -lf2c -lm (in that order)
9 /* Subroutine */ int dsyr_(char *uplo, integer *n, doublereal *alpha,
10 doublereal *x, integer *incx, doublereal *a, integer *lda)
14 /* System generated locals */
15 integer a_dim1, a_offset, i__1, i__2;
19 static doublereal temp;
21 extern logical lsame_(char *, char *);
22 static integer ix, jx, kx;
23 extern /* Subroutine */ int xerbla_(char *, integer *);
29 DSYR performs the symmetric rank 1 operation
33 where alpha is a real scalar, x is an n element vector and A is an
34 n by n symmetric matrix.
40 On entry, UPLO specifies whether the upper or lower
41 triangular part of the array A is to be referenced as
44 UPLO = 'U' or 'u' Only the upper triangular part of A
47 UPLO = 'L' or 'l' Only the lower triangular part of A
53 On entry, N specifies the order of the matrix A.
54 N must be at least zero.
57 ALPHA - DOUBLE PRECISION.
58 On entry, ALPHA specifies the scalar alpha.
61 X - DOUBLE PRECISION array of dimension at least
62 ( 1 + ( n - 1 )*abs( INCX ) ).
63 Before entry, the incremented array X must contain the n
68 On entry, INCX specifies the increment for the elements of
69 X. INCX must not be zero.
72 A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
73 Before entry with UPLO = 'U' or 'u', the leading n by n
74 upper triangular part of the array A must contain the upper
76 triangular part of the symmetric matrix and the strictly
77 lower triangular part of A is not referenced. On exit, the
78 upper triangular part of the array A is overwritten by the
79 upper triangular part of the updated matrix.
80 Before entry with UPLO = 'L' or 'l', the leading n by n
81 lower triangular part of the array A must contain the lower
83 triangular part of the symmetric matrix and the strictly
84 upper triangular part of A is not referenced. On exit, the
85 lower triangular part of the array A is overwritten by the
86 lower triangular part of the updated matrix.
89 On entry, LDA specifies the first dimension of A as declared
91 in the calling (sub) program. LDA must be at least
98 -- Written on 22-October-1986.
99 Jack Dongarra, Argonne National Lab.
100 Jeremy Du Croz, Nag Central Office.
101 Sven Hammarling, Nag Central Office.
102 Richard Hanson, Sandia National Labs.
106 Test the input parameters.
109 Parameter adjustments
111 #define X(I) x[(I)-1]
113 #define A(I,J) a[(I)-1 + ((J)-1)* ( *lda)]
116 if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
120 } else if (*incx == 0) {
122 } else if (*lda < max(1,*n)) {
126 xerbla_("DSYR ", &info);
130 /* Quick return if possible. */
132 if (*n == 0 || *alpha == 0.) {
136 /* Set the start point in X if the increment is not unity. */
139 kx = 1 - (*n - 1) * *incx;
140 } else if (*incx != 1) {
144 /* Start the operations. In this version the elements of A are
145 accessed sequentially with one pass through the triangular part
148 if (lsame_(uplo, "U")) {
150 /* Form A when A is stored in upper triangle. */
154 for (j = 1; j <= *n; ++j) {
156 temp = *alpha * X(j);
158 for (i = 1; i <= j; ++i) {
159 A(i,j) += X(i) * temp;
168 for (j = 1; j <= *n; ++j) {
170 temp = *alpha * X(jx);
173 for (i = 1; i <= j; ++i) {
174 A(i,j) += X(ix) * temp;
185 /* Form A when A is stored in lower triangle. */
189 for (j = 1; j <= *n; ++j) {
191 temp = *alpha * X(j);
193 for (i = j; i <= *n; ++i) {
194 A(i,j) += X(i) * temp;
203 for (j = 1; j <= *n; ++j) {
205 temp = *alpha * X(jx);
208 for (i = j; i <= *n; ++i) {
209 A(i,j) += X(ix) * temp;