kusano 7d535a
kusano 7d535a
/*  -- translated by f2c (version 19940927).
kusano 7d535a
   You must link the resulting object file with the libraries:
kusano 7d535a
	-lf2c -lm   (in that order)
kusano 7d535a
*/
kusano 7d535a
kusano 7d535a
#include "f2c.h"
kusano 7d535a
kusano 7d535a
/* Subroutine */ int dsyr2_(char *uplo, integer *n, doublereal *alpha, 
kusano 7d535a
	doublereal *x, integer *incx, doublereal *y, integer *incy, 
kusano 7d535a
	doublereal *a, integer *lda)
kusano 7d535a
{
kusano 7d535a
kusano 7d535a
kusano 7d535a
    /* System generated locals */
kusano 7d535a
    integer a_dim1, a_offset, i__1, i__2;
kusano 7d535a
kusano 7d535a
    /* Local variables */
kusano 7d535a
    static integer info;
kusano 7d535a
    static doublereal temp1, temp2;
kusano 7d535a
    static integer i, j;
kusano 7d535a
    extern logical lsame_(char *, char *);
kusano 7d535a
    static integer ix, iy, jx, jy, kx, ky;
kusano 7d535a
    extern /* Subroutine */ int xerbla_(char *, integer *);
kusano 7d535a
kusano 7d535a
kusano 7d535a
/*  Purpose   
kusano 7d535a
    =======   
kusano 7d535a
kusano 7d535a
    DSYR2  performs the symmetric rank 2 operation   
kusano 7d535a
kusano 7d535a
       A := alpha*x*y' + alpha*y*x' + A,   
kusano 7d535a
kusano 7d535a
    where alpha is a scalar, x and y are n element vectors and A is an n 
kusano 7d535a
  
kusano 7d535a
    by n symmetric matrix.   
kusano 7d535a
kusano 7d535a
    Parameters   
kusano 7d535a
    ==========   
kusano 7d535a
kusano 7d535a
    UPLO   - CHARACTER*1.   
kusano 7d535a
             On entry, UPLO specifies whether the upper or lower   
kusano 7d535a
             triangular part of the array A is to be referenced as   
kusano 7d535a
             follows:   
kusano 7d535a
kusano 7d535a
                UPLO = 'U' or 'u'   Only the upper triangular part of A   
kusano 7d535a
                                    is to be referenced.   
kusano 7d535a
kusano 7d535a
                UPLO = 'L' or 'l'   Only the lower triangular part of A   
kusano 7d535a
                                    is to be referenced.   
kusano 7d535a
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    N      - INTEGER.   
kusano 7d535a
             On entry, N specifies the order of the matrix A.   
kusano 7d535a
             N must be at least zero.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    ALPHA  - DOUBLE PRECISION.   
kusano 7d535a
             On entry, ALPHA specifies the scalar alpha.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    X      - DOUBLE PRECISION array of dimension at least   
kusano 7d535a
             ( 1 + ( n - 1 )*abs( INCX ) ).   
kusano 7d535a
             Before entry, the incremented array X must contain the n   
kusano 7d535a
             element vector x.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    INCX   - INTEGER.   
kusano 7d535a
             On entry, INCX specifies the increment for the elements of   
kusano 7d535a
             X. INCX must not be zero.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    Y      - DOUBLE PRECISION array of dimension at least   
kusano 7d535a
             ( 1 + ( n - 1 )*abs( INCY ) ).   
kusano 7d535a
             Before entry, the incremented array Y must contain the n   
kusano 7d535a
             element vector y.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    INCY   - INTEGER.   
kusano 7d535a
             On entry, INCY specifies the increment for the elements of   
kusano 7d535a
             Y. INCY must not be zero.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).   
kusano 7d535a
             Before entry with  UPLO = 'U' or 'u', the leading n by n   
kusano 7d535a
             upper triangular part of the array A must contain the upper 
kusano 7d535a
  
kusano 7d535a
             triangular part of the symmetric matrix and the strictly   
kusano 7d535a
             lower triangular part of A is not referenced. On exit, the   
kusano 7d535a
             upper triangular part of the array A is overwritten by the   
kusano 7d535a
             upper triangular part of the updated matrix.   
kusano 7d535a
             Before entry with UPLO = 'L' or 'l', the leading n by n   
kusano 7d535a
             lower triangular part of the array A must contain the lower 
kusano 7d535a
  
kusano 7d535a
             triangular part of the symmetric matrix and the strictly   
kusano 7d535a
             upper triangular part of A is not referenced. On exit, the   
kusano 7d535a
             lower triangular part of the array A is overwritten by the   
kusano 7d535a
             lower triangular part of the updated matrix.   
kusano 7d535a
kusano 7d535a
    LDA    - INTEGER.   
kusano 7d535a
             On entry, LDA specifies the first dimension of A as declared 
kusano 7d535a
  
kusano 7d535a
             in the calling (sub) program. LDA must be at least   
kusano 7d535a
             max( 1, n ).   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
kusano 7d535a
    Level 2 Blas routine.   
kusano 7d535a
kusano 7d535a
    -- Written on 22-October-1986.   
kusano 7d535a
       Jack Dongarra, Argonne National Lab.   
kusano 7d535a
       Jeremy Du Croz, Nag Central Office.   
kusano 7d535a
       Sven Hammarling, Nag Central Office.   
kusano 7d535a
       Richard Hanson, Sandia National Labs.   
kusano 7d535a
kusano 7d535a
kusano 7d535a
kusano 7d535a
       Test the input parameters.   
kusano 7d535a
kusano 7d535a
    
kusano 7d535a
   Parameter adjustments   
kusano 7d535a
       Function Body */
kusano 7d535a
#define X(I) x[(I)-1]
kusano 7d535a
#define Y(I) y[(I)-1]
kusano 7d535a
kusano 7d535a
#define A(I,J) a[(I)-1 + ((J)-1)* ( *lda)]
kusano 7d535a
kusano 7d535a
    info = 0;
kusano 7d535a
    if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
kusano 7d535a
	info = 1;
kusano 7d535a
    } else if (*n < 0) {
kusano 7d535a
	info = 2;
kusano 7d535a
    } else if (*incx == 0) {
kusano 7d535a
	info = 5;
kusano 7d535a
    } else if (*incy == 0) {
kusano 7d535a
	info = 7;
kusano 7d535a
    } else if (*lda < max(1,*n)) {
kusano 7d535a
	info = 9;
kusano 7d535a
    }
kusano 7d535a
    if (info != 0) {
kusano 7d535a
	xerbla_("DSYR2 ", &info);
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Quick return if possible. */
kusano 7d535a
kusano 7d535a
    if (*n == 0 || *alpha == 0.) {
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Set up the start points in X and Y if the increments are not both 
kusano 7d535a
  
kusano 7d535a
       unity. */
kusano 7d535a
kusano 7d535a
    if (*incx != 1 || *incy != 1) {
kusano 7d535a
	if (*incx > 0) {
kusano 7d535a
	    kx = 1;
kusano 7d535a
	} else {
kusano 7d535a
	    kx = 1 - (*n - 1) * *incx;
kusano 7d535a
	}
kusano 7d535a
	if (*incy > 0) {
kusano 7d535a
	    ky = 1;
kusano 7d535a
	} else {
kusano 7d535a
	    ky = 1 - (*n - 1) * *incy;
kusano 7d535a
	}
kusano 7d535a
	jx = kx;
kusano 7d535a
	jy = ky;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Start the operations. In this version the elements of A are   
kusano 7d535a
       accessed sequentially with one pass through the triangular part   
kusano 7d535a
       of A. */
kusano 7d535a
kusano 7d535a
    if (lsame_(uplo, "U")) {
kusano 7d535a
kusano 7d535a
/*        Form  A  when A is stored in the upper triangle. */
kusano 7d535a
kusano 7d535a
	if (*incx == 1 && *incy == 1) {
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (j = 1; j <= *n; ++j) {
kusano 7d535a
		if (X(j) != 0. || Y(j) != 0.) {
kusano 7d535a
		    temp1 = *alpha * Y(j);
kusano 7d535a
		    temp2 = *alpha * X(j);
kusano 7d535a
		    i__2 = j;
kusano 7d535a
		    for (i = 1; i <= j; ++i) {
kusano 7d535a
			A(i,j) = A(i,j) + X(i) * temp1 
kusano 7d535a
				+ Y(i) * temp2;
kusano 7d535a
/* L10: */
kusano 7d535a
		    }
kusano 7d535a
		}
kusano 7d535a
/* L20: */
kusano 7d535a
	    }
kusano 7d535a
	} else {
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (j = 1; j <= *n; ++j) {
kusano 7d535a
		if (X(jx) != 0. || Y(jy) != 0.) {
kusano 7d535a
		    temp1 = *alpha * Y(jy);
kusano 7d535a
		    temp2 = *alpha * X(jx);
kusano 7d535a
		    ix = kx;
kusano 7d535a
		    iy = ky;
kusano 7d535a
		    i__2 = j;
kusano 7d535a
		    for (i = 1; i <= j; ++i) {
kusano 7d535a
			A(i,j) = A(i,j) + X(ix) * temp1 
kusano 7d535a
				+ Y(iy) * temp2;
kusano 7d535a
			ix += *incx;
kusano 7d535a
			iy += *incy;
kusano 7d535a
/* L30: */
kusano 7d535a
		    }
kusano 7d535a
		}
kusano 7d535a
		jx += *incx;
kusano 7d535a
		jy += *incy;
kusano 7d535a
/* L40: */
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
    } else {
kusano 7d535a
kusano 7d535a
/*        Form  A  when A is stored in the lower triangle. */
kusano 7d535a
kusano 7d535a
	if (*incx == 1 && *incy == 1) {
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (j = 1; j <= *n; ++j) {
kusano 7d535a
		if (X(j) != 0. || Y(j) != 0.) {
kusano 7d535a
		    temp1 = *alpha * Y(j);
kusano 7d535a
		    temp2 = *alpha * X(j);
kusano 7d535a
		    i__2 = *n;
kusano 7d535a
		    for (i = j; i <= *n; ++i) {
kusano 7d535a
			A(i,j) = A(i,j) + X(i) * temp1 
kusano 7d535a
				+ Y(i) * temp2;
kusano 7d535a
/* L50: */
kusano 7d535a
		    }
kusano 7d535a
		}
kusano 7d535a
/* L60: */
kusano 7d535a
	    }
kusano 7d535a
	} else {
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (j = 1; j <= *n; ++j) {
kusano 7d535a
		if (X(jx) != 0. || Y(jy) != 0.) {
kusano 7d535a
		    temp1 = *alpha * Y(jy);
kusano 7d535a
		    temp2 = *alpha * X(jx);
kusano 7d535a
		    ix = jx;
kusano 7d535a
		    iy = jy;
kusano 7d535a
		    i__2 = *n;
kusano 7d535a
		    for (i = j; i <= *n; ++i) {
kusano 7d535a
			A(i,j) = A(i,j) + X(ix) * temp1 
kusano 7d535a
				+ Y(iy) * temp2;
kusano 7d535a
			ix += *incx;
kusano 7d535a
			iy += *incy;
kusano 7d535a
/* L70: */
kusano 7d535a
		    }
kusano 7d535a
		}
kusano 7d535a
		jx += *incx;
kusano 7d535a
		jy += *incy;
kusano 7d535a
/* L80: */
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    return 0;
kusano 7d535a
kusano 7d535a
/*     End of DSYR2 . */
kusano 7d535a
kusano 7d535a
} /* dsyr2_ */
kusano 7d535a