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 sgemv_(char *trans, integer *m, integer *n, real *alpha, 
kusano 7d535a
	real *a, integer *lda, real *x, integer *incx, real *beta, real *y, 
kusano 7d535a
	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 real temp;
kusano 7d535a
    static integer lenx, leny, 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
    SGEMV  performs one of the matrix-vector operations   
kusano 7d535a
kusano 7d535a
       y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,   
kusano 7d535a
kusano 7d535a
    where alpha and beta are scalars, x and y are vectors and A is an   
kusano 7d535a
    m by n matrix.   
kusano 7d535a
kusano 7d535a
    Parameters   
kusano 7d535a
    ==========   
kusano 7d535a
kusano 7d535a
    TRANS  - CHARACTER*1.   
kusano 7d535a
             On entry, TRANS specifies the operation to be performed as   
kusano 7d535a
             follows:   
kusano 7d535a
kusano 7d535a
                TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.   
kusano 7d535a
kusano 7d535a
                TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.   
kusano 7d535a
kusano 7d535a
                TRANS = 'C' or 'c'   y := alpha*A'*x + beta*y.   
kusano 7d535a
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    M      - INTEGER.   
kusano 7d535a
             On entry, M specifies the number of rows of the matrix A.   
kusano 7d535a
             M must be at least zero.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    N      - INTEGER.   
kusano 7d535a
             On entry, N specifies the number of columns of the matrix A. 
kusano 7d535a
  
kusano 7d535a
             N must be at least zero.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    ALPHA  - REAL            .   
kusano 7d535a
             On entry, ALPHA specifies the scalar alpha.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    A      - REAL             array of DIMENSION ( LDA, n ).   
kusano 7d535a
             Before entry, the leading m by n part of the array A must   
kusano 7d535a
             contain the matrix of coefficients.   
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, m ).   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    X      - REAL             array of DIMENSION at least   
kusano 7d535a
             ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'   
kusano 7d535a
             and at least   
kusano 7d535a
             ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.   
kusano 7d535a
             Before entry, the incremented array X must contain the   
kusano 7d535a
             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   - REAL            .   
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      - REAL             array of DIMENSION at least   
kusano 7d535a
             ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'   
kusano 7d535a
             and at least   
kusano 7d535a
             ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.   
kusano 7d535a
             Before entry with BETA non-zero, the incremented array Y   
kusano 7d535a
             must contain the vector y. On exit, Y is overwritten by the 
kusano 7d535a
  
kusano 7d535a
             updated 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_(trans, "N") && ! lsame_(trans, "T") && ! 
kusano 7d535a
	    lsame_(trans, "C")) {
kusano 7d535a
	info = 1;
kusano 7d535a
    } else if (*m < 0) {
kusano 7d535a
	info = 2;
kusano 7d535a
    } else if (*n < 0) {
kusano 7d535a
	info = 3;
kusano 7d535a
    } else if (*lda < max(1,*m)) {
kusano 7d535a
	info = 6;
kusano 7d535a
    } else if (*incx == 0) {
kusano 7d535a
	info = 8;
kusano 7d535a
    } else if (*incy == 0) {
kusano 7d535a
	info = 11;
kusano 7d535a
    }
kusano 7d535a
    if (info != 0) {
kusano 7d535a
	xerbla_("SGEMV ", &info);
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Quick return if possible. */
kusano 7d535a
kusano 7d535a
    if (*m == 0 || *n == 0 || *alpha == 0.f && *beta == 1.f) {
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set 
kusano 7d535a
  
kusano 7d535a
       up the start points in  X  and  Y. */
kusano 7d535a
kusano 7d535a
    if (lsame_(trans, "N")) {
kusano 7d535a
	lenx = *n;
kusano 7d535a
	leny = *m;
kusano 7d535a
    } else {
kusano 7d535a
	lenx = *m;
kusano 7d535a
	leny = *n;
kusano 7d535a
    }
kusano 7d535a
    if (*incx > 0) {
kusano 7d535a
	kx = 1;
kusano 7d535a
    } else {
kusano 7d535a
	kx = 1 - (lenx - 1) * *incx;
kusano 7d535a
    }
kusano 7d535a
    if (*incy > 0) {
kusano 7d535a
	ky = 1;
kusano 7d535a
    } else {
kusano 7d535a
	ky = 1 - (leny - 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 A.   
kusano 7d535a
kusano 7d535a
       First form  y := beta*y. */
kusano 7d535a
kusano 7d535a
    if (*beta != 1.f) {
kusano 7d535a
	if (*incy == 1) {
kusano 7d535a
	    if (*beta == 0.f) {
kusano 7d535a
		i__1 = leny;
kusano 7d535a
		for (i = 1; i <= leny; ++i) {
kusano 7d535a
		    Y(i) = 0.f;
kusano 7d535a
/* L10: */
kusano 7d535a
		}
kusano 7d535a
	    } else {
kusano 7d535a
		i__1 = leny;
kusano 7d535a
		for (i = 1; i <= leny; ++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.f) {
kusano 7d535a
		i__1 = leny;
kusano 7d535a
		for (i = 1; i <= leny; ++i) {
kusano 7d535a
		    Y(iy) = 0.f;
kusano 7d535a
		    iy += *incy;
kusano 7d535a
/* L30: */
kusano 7d535a
		}
kusano 7d535a
	    } else {
kusano 7d535a
		i__1 = leny;
kusano 7d535a
		for (i = 1; i <= leny; ++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.f) {
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
    if (lsame_(trans, "N")) {
kusano 7d535a
kusano 7d535a
/*        Form  y := alpha*A*x + y. */
kusano 7d535a
kusano 7d535a
	jx = kx;
kusano 7d535a
	if (*incy == 1) {
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (j = 1; j <= *n; ++j) {
kusano 7d535a
		if (X(jx) != 0.f) {
kusano 7d535a
		    temp = *alpha * X(jx);
kusano 7d535a
		    i__2 = *m;
kusano 7d535a
		    for (i = 1; i <= *m; ++i) {
kusano 7d535a
			Y(i) += temp * A(i,j);
kusano 7d535a
/* L50: */
kusano 7d535a
		    }
kusano 7d535a
		}
kusano 7d535a
		jx += *incx;
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.f) {
kusano 7d535a
		    temp = *alpha * X(jx);
kusano 7d535a
		    iy = ky;
kusano 7d535a
		    i__2 = *m;
kusano 7d535a
		    for (i = 1; i <= *m; ++i) {
kusano 7d535a
			Y(iy) += temp * A(i,j);
kusano 7d535a
			iy += *incy;
kusano 7d535a
/* L70: */
kusano 7d535a
		    }
kusano 7d535a
		}
kusano 7d535a
		jx += *incx;
kusano 7d535a
/* L80: */
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
    } else {
kusano 7d535a
kusano 7d535a
/*        Form  y := alpha*A'*x + y. */
kusano 7d535a
kusano 7d535a
	jy = ky;
kusano 7d535a
	if (*incx == 1) {
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (j = 1; j <= *n; ++j) {
kusano 7d535a
		temp = 0.f;
kusano 7d535a
		i__2 = *m;
kusano 7d535a
		for (i = 1; i <= *m; ++i) {
kusano 7d535a
		    temp += A(i,j) * X(i);
kusano 7d535a
/* L90: */
kusano 7d535a
		}
kusano 7d535a
		Y(jy) += *alpha * temp;
kusano 7d535a
		jy += *incy;
kusano 7d535a
/* L100: */
kusano 7d535a
	    }
kusano 7d535a
	} else {
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (j = 1; j <= *n; ++j) {
kusano 7d535a
		temp = 0.f;
kusano 7d535a
		ix = kx;
kusano 7d535a
		i__2 = *m;
kusano 7d535a
		for (i = 1; i <= *m; ++i) {
kusano 7d535a
		    temp += A(i,j) * X(ix);
kusano 7d535a
		    ix += *incx;
kusano 7d535a
/* L110: */
kusano 7d535a
		}
kusano 7d535a
		Y(jy) += *alpha * temp;
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 SGEMV . */
kusano 7d535a
kusano 7d535a
} /* sgemv_ */
kusano 7d535a