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 dsymv_(char *uplo, integer *n, doublereal *alpha, 
kusano 7d535a
	doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal 
kusano 7d535a
	*beta, doublereal *y, integer *incy)
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
    DSYMV  performs the matrix-vector  operation   
kusano 7d535a
kusano 7d535a
       y := alpha*A*x + beta*y,   
kusano 7d535a
kusano 7d535a
    where alpha and beta are scalars, x and y are n element vectors and   
kusano 7d535a
    A is an n 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
    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.   
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.   
kusano 7d535a
             Unchanged on exit.   
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
    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
    BETA   - DOUBLE PRECISION.   
kusano 7d535a
             On entry, BETA specifies the scalar beta. When BETA is   
kusano 7d535a
             supplied as zero then Y need not be set on input.   
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. On exit, Y is overwritten by the updated   
kusano 7d535a
             vector y.   
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
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 (*lda < max(1,*n)) {
kusano 7d535a
	info = 5;
kusano 7d535a
    } else if (*incx == 0) {
kusano 7d535a
	info = 7;
kusano 7d535a
    } else if (*incy == 0) {
kusano 7d535a
	info = 10;
kusano 7d535a
    }
kusano 7d535a
    if (info != 0) {
kusano 7d535a
	xerbla_("DSYMV ", &info);
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Quick return if possible. */
kusano 7d535a
kusano 7d535a
    if (*n == 0 || *alpha == 0. && *beta == 1.) {
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Set up the start points in  X  and  Y. */
kusano 7d535a
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
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
       First form  y := beta*y. */
kusano 7d535a
kusano 7d535a
    if (*beta != 1.) {
kusano 7d535a
	if (*incy == 1) {
kusano 7d535a
	    if (*beta == 0.) {
kusano 7d535a
		i__1 = *n;
kusano 7d535a
		for (i = 1; i <= *n; ++i) {
kusano 7d535a
		    Y(i) = 0.;
kusano 7d535a
/* L10: */
kusano 7d535a
		}
kusano 7d535a
	    } else {
kusano 7d535a
		i__1 = *n;
kusano 7d535a
		for (i = 1; i <= *n; ++i) {
kusano 7d535a
		    Y(i) = *beta * Y(i);
kusano 7d535a
/* L20: */
kusano 7d535a
		}
kusano 7d535a
	    }
kusano 7d535a
	} else {
kusano 7d535a
	    iy = ky;
kusano 7d535a
	    if (*beta == 0.) {
kusano 7d535a
		i__1 = *n;
kusano 7d535a
		for (i = 1; i <= *n; ++i) {
kusano 7d535a
		    Y(iy) = 0.;
kusano 7d535a
		    iy += *incy;
kusano 7d535a
/* L30: */
kusano 7d535a
		}
kusano 7d535a
	    } else {
kusano 7d535a
		i__1 = *n;
kusano 7d535a
		for (i = 1; i <= *n; ++i) {
kusano 7d535a
		    Y(iy) = *beta * Y(iy);
kusano 7d535a
		    iy += *incy;
kusano 7d535a
/* L40: */
kusano 7d535a
		}
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
    }
kusano 7d535a
    if (*alpha == 0.) {
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
    if (lsame_(uplo, "U")) {
kusano 7d535a
kusano 7d535a
/*        Form  y  when A is stored in 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
		temp1 = *alpha * X(j);
kusano 7d535a
		temp2 = 0.;
kusano 7d535a
		i__2 = j - 1;
kusano 7d535a
		for (i = 1; i <= j-1; ++i) {
kusano 7d535a
		    Y(i) += temp1 * A(i,j);
kusano 7d535a
		    temp2 += A(i,j) * X(i);
kusano 7d535a
/* L50: */
kusano 7d535a
		}
kusano 7d535a
		Y(j) = Y(j) + temp1 * A(j,j) + *alpha * temp2;
kusano 7d535a
/* L60: */
kusano 7d535a
	    }
kusano 7d535a
	} else {
kusano 7d535a
	    jx = kx;
kusano 7d535a
	    jy = ky;
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (j = 1; j <= *n; ++j) {
kusano 7d535a
		temp1 = *alpha * X(jx);
kusano 7d535a
		temp2 = 0.;
kusano 7d535a
		ix = kx;
kusano 7d535a
		iy = ky;
kusano 7d535a
		i__2 = j - 1;
kusano 7d535a
		for (i = 1; i <= j-1; ++i) {
kusano 7d535a
		    Y(iy) += temp1 * A(i,j);
kusano 7d535a
		    temp2 += A(i,j) * X(ix);
kusano 7d535a
		    ix += *incx;
kusano 7d535a
		    iy += *incy;
kusano 7d535a
/* L70: */
kusano 7d535a
		}
kusano 7d535a
		Y(jy) = Y(jy) + temp1 * A(j,j) + *alpha * temp2;
kusano 7d535a
		jx += *incx;
kusano 7d535a
		jy += *incy;
kusano 7d535a
/* L80: */
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
    } else {
kusano 7d535a
kusano 7d535a
/*        Form  y  when A is stored in 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
		temp1 = *alpha * X(j);
kusano 7d535a
		temp2 = 0.;
kusano 7d535a
		Y(j) += temp1 * A(j,j);
kusano 7d535a
		i__2 = *n;
kusano 7d535a
		for (i = j + 1; i <= *n; ++i) {
kusano 7d535a
		    Y(i) += temp1 * A(i,j);
kusano 7d535a
		    temp2 += A(i,j) * X(i);
kusano 7d535a
/* L90: */
kusano 7d535a
		}
kusano 7d535a
		Y(j) += *alpha * temp2;
kusano 7d535a
/* L100: */
kusano 7d535a
	    }
kusano 7d535a
	} else {
kusano 7d535a
	    jx = kx;
kusano 7d535a
	    jy = ky;
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (j = 1; j <= *n; ++j) {
kusano 7d535a
		temp1 = *alpha * X(jx);
kusano 7d535a
		temp2 = 0.;
kusano 7d535a
		Y(jy) += temp1 * A(j,j);
kusano 7d535a
		ix = jx;
kusano 7d535a
		iy = jy;
kusano 7d535a
		i__2 = *n;
kusano 7d535a
		for (i = j + 1; i <= *n; ++i) {
kusano 7d535a
		    ix += *incx;
kusano 7d535a
		    iy += *incy;
kusano 7d535a
		    Y(iy) += temp1 * A(i,j);
kusano 7d535a
		    temp2 += A(i,j) * X(ix);
kusano 7d535a
/* L110: */
kusano 7d535a
		}
kusano 7d535a
		Y(jy) += *alpha * temp2;
kusano 7d535a
		jx += *incx;
kusano 7d535a
		jy += *incy;
kusano 7d535a
/* L120: */
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    return 0;
kusano 7d535a
kusano 7d535a
/*     End of DSYMV . */
kusano 7d535a
kusano 7d535a
} /* dsymv_ */
kusano 7d535a