dgemv.c
Go to the documentation of this file.
00001 /* dgemv.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Subroutine */ int dgemv_(char *trans, integer *m, integer *n, doublereal *
00017         alpha, doublereal *a, integer *lda, doublereal *x, integer *incx, 
00018         doublereal *beta, doublereal *y, integer *incy)
00019 {
00020     /* System generated locals */
00021     integer a_dim1, a_offset, i__1, i__2;
00022 
00023     /* Local variables */
00024     integer i__, j, ix, iy, jx, jy, kx, ky, info;
00025     doublereal temp;
00026     integer lenx, leny;
00027     extern logical lsame_(char *, char *);
00028     extern /* Subroutine */ int xerbla_(char *, integer *);
00029 
00030 /*     .. Scalar Arguments .. */
00031 /*     .. */
00032 /*     .. Array Arguments .. */
00033 /*     .. */
00034 
00035 /*  Purpose */
00036 /*  ======= */
00037 
00038 /*  DGEMV  performs one of the matrix-vector operations */
00039 
00040 /*     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y, */
00041 
00042 /*  where alpha and beta are scalars, x and y are vectors and A is an */
00043 /*  m by n matrix. */
00044 
00045 /*  Arguments */
00046 /*  ========== */
00047 
00048 /*  TRANS  - CHARACTER*1. */
00049 /*           On entry, TRANS specifies the operation to be performed as */
00050 /*           follows: */
00051 
00052 /*              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y. */
00053 
00054 /*              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y. */
00055 
00056 /*              TRANS = 'C' or 'c'   y := alpha*A'*x + beta*y. */
00057 
00058 /*           Unchanged on exit. */
00059 
00060 /*  M      - INTEGER. */
00061 /*           On entry, M specifies the number of rows of the matrix A. */
00062 /*           M must be at least zero. */
00063 /*           Unchanged on exit. */
00064 
00065 /*  N      - INTEGER. */
00066 /*           On entry, N specifies the number of columns of the matrix A. */
00067 /*           N must be at least zero. */
00068 /*           Unchanged on exit. */
00069 
00070 /*  ALPHA  - DOUBLE PRECISION. */
00071 /*           On entry, ALPHA specifies the scalar alpha. */
00072 /*           Unchanged on exit. */
00073 
00074 /*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
00075 /*           Before entry, the leading m by n part of the array A must */
00076 /*           contain the matrix of coefficients. */
00077 /*           Unchanged on exit. */
00078 
00079 /*  LDA    - INTEGER. */
00080 /*           On entry, LDA specifies the first dimension of A as declared */
00081 /*           in the calling (sub) program. LDA must be at least */
00082 /*           max( 1, m ). */
00083 /*           Unchanged on exit. */
00084 
00085 /*  X      - DOUBLE PRECISION array of DIMENSION at least */
00086 /*           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' */
00087 /*           and at least */
00088 /*           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. */
00089 /*           Before entry, the incremented array X must contain the */
00090 /*           vector x. */
00091 /*           Unchanged on exit. */
00092 
00093 /*  INCX   - INTEGER. */
00094 /*           On entry, INCX specifies the increment for the elements of */
00095 /*           X. INCX must not be zero. */
00096 /*           Unchanged on exit. */
00097 
00098 /*  BETA   - DOUBLE PRECISION. */
00099 /*           On entry, BETA specifies the scalar beta. When BETA is */
00100 /*           supplied as zero then Y need not be set on input. */
00101 /*           Unchanged on exit. */
00102 
00103 /*  Y      - DOUBLE PRECISION array of DIMENSION at least */
00104 /*           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' */
00105 /*           and at least */
00106 /*           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. */
00107 /*           Before entry with BETA non-zero, the incremented array Y */
00108 /*           must contain the vector y. On exit, Y is overwritten by the */
00109 /*           updated vector y. */
00110 
00111 /*  INCY   - INTEGER. */
00112 /*           On entry, INCY specifies the increment for the elements of */
00113 /*           Y. INCY must not be zero. */
00114 /*           Unchanged on exit. */
00115 
00116 
00117 /*  Level 2 Blas routine. */
00118 
00119 /*  -- Written on 22-October-1986. */
00120 /*     Jack Dongarra, Argonne National Lab. */
00121 /*     Jeremy Du Croz, Nag Central Office. */
00122 /*     Sven Hammarling, Nag Central Office. */
00123 /*     Richard Hanson, Sandia National Labs. */
00124 
00125 
00126 /*     .. Parameters .. */
00127 /*     .. */
00128 /*     .. Local Scalars .. */
00129 /*     .. */
00130 /*     .. External Functions .. */
00131 /*     .. */
00132 /*     .. External Subroutines .. */
00133 /*     .. */
00134 /*     .. Intrinsic Functions .. */
00135 /*     .. */
00136 
00137 /*     Test the input parameters. */
00138 
00139     /* Parameter adjustments */
00140     a_dim1 = *lda;
00141     a_offset = 1 + a_dim1;
00142     a -= a_offset;
00143     --x;
00144     --y;
00145 
00146     /* Function Body */
00147     info = 0;
00148     if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")
00149             ) {
00150         info = 1;
00151     } else if (*m < 0) {
00152         info = 2;
00153     } else if (*n < 0) {
00154         info = 3;
00155     } else if (*lda < max(1,*m)) {
00156         info = 6;
00157     } else if (*incx == 0) {
00158         info = 8;
00159     } else if (*incy == 0) {
00160         info = 11;
00161     }
00162     if (info != 0) {
00163         xerbla_("DGEMV ", &info);
00164         return 0;
00165     }
00166 
00167 /*     Quick return if possible. */
00168 
00169     if (*m == 0 || *n == 0 || *alpha == 0. && *beta == 1.) {
00170         return 0;
00171     }
00172 
00173 /*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set */
00174 /*     up the start points in  X  and  Y. */
00175 
00176     if (lsame_(trans, "N")) {
00177         lenx = *n;
00178         leny = *m;
00179     } else {
00180         lenx = *m;
00181         leny = *n;
00182     }
00183     if (*incx > 0) {
00184         kx = 1;
00185     } else {
00186         kx = 1 - (lenx - 1) * *incx;
00187     }
00188     if (*incy > 0) {
00189         ky = 1;
00190     } else {
00191         ky = 1 - (leny - 1) * *incy;
00192     }
00193 
00194 /*     Start the operations. In this version the elements of A are */
00195 /*     accessed sequentially with one pass through A. */
00196 
00197 /*     First form  y := beta*y. */
00198 
00199     if (*beta != 1.) {
00200         if (*incy == 1) {
00201             if (*beta == 0.) {
00202                 i__1 = leny;
00203                 for (i__ = 1; i__ <= i__1; ++i__) {
00204                     y[i__] = 0.;
00205 /* L10: */
00206                 }
00207             } else {
00208                 i__1 = leny;
00209                 for (i__ = 1; i__ <= i__1; ++i__) {
00210                     y[i__] = *beta * y[i__];
00211 /* L20: */
00212                 }
00213             }
00214         } else {
00215             iy = ky;
00216             if (*beta == 0.) {
00217                 i__1 = leny;
00218                 for (i__ = 1; i__ <= i__1; ++i__) {
00219                     y[iy] = 0.;
00220                     iy += *incy;
00221 /* L30: */
00222                 }
00223             } else {
00224                 i__1 = leny;
00225                 for (i__ = 1; i__ <= i__1; ++i__) {
00226                     y[iy] = *beta * y[iy];
00227                     iy += *incy;
00228 /* L40: */
00229                 }
00230             }
00231         }
00232     }
00233     if (*alpha == 0.) {
00234         return 0;
00235     }
00236     if (lsame_(trans, "N")) {
00237 
00238 /*        Form  y := alpha*A*x + y. */
00239 
00240         jx = kx;
00241         if (*incy == 1) {
00242             i__1 = *n;
00243             for (j = 1; j <= i__1; ++j) {
00244                 if (x[jx] != 0.) {
00245                     temp = *alpha * x[jx];
00246                     i__2 = *m;
00247                     for (i__ = 1; i__ <= i__2; ++i__) {
00248                         y[i__] += temp * a[i__ + j * a_dim1];
00249 /* L50: */
00250                     }
00251                 }
00252                 jx += *incx;
00253 /* L60: */
00254             }
00255         } else {
00256             i__1 = *n;
00257             for (j = 1; j <= i__1; ++j) {
00258                 if (x[jx] != 0.) {
00259                     temp = *alpha * x[jx];
00260                     iy = ky;
00261                     i__2 = *m;
00262                     for (i__ = 1; i__ <= i__2; ++i__) {
00263                         y[iy] += temp * a[i__ + j * a_dim1];
00264                         iy += *incy;
00265 /* L70: */
00266                     }
00267                 }
00268                 jx += *incx;
00269 /* L80: */
00270             }
00271         }
00272     } else {
00273 
00274 /*        Form  y := alpha*A'*x + y. */
00275 
00276         jy = ky;
00277         if (*incx == 1) {
00278             i__1 = *n;
00279             for (j = 1; j <= i__1; ++j) {
00280                 temp = 0.;
00281                 i__2 = *m;
00282                 for (i__ = 1; i__ <= i__2; ++i__) {
00283                     temp += a[i__ + j * a_dim1] * x[i__];
00284 /* L90: */
00285                 }
00286                 y[jy] += *alpha * temp;
00287                 jy += *incy;
00288 /* L100: */
00289             }
00290         } else {
00291             i__1 = *n;
00292             for (j = 1; j <= i__1; ++j) {
00293                 temp = 0.;
00294                 ix = kx;
00295                 i__2 = *m;
00296                 for (i__ = 1; i__ <= i__2; ++i__) {
00297                     temp += a[i__ + j * a_dim1] * x[ix];
00298                     ix += *incx;
00299 /* L110: */
00300                 }
00301                 y[jy] += *alpha * temp;
00302                 jy += *incy;
00303 /* L120: */
00304             }
00305         }
00306     }
00307 
00308     return 0;
00309 
00310 /*     End of DGEMV . */
00311 
00312 } /* dgemv_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:44