cgemv.c
Go to the documentation of this file.
00001 /* cgemv.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 cgemv_(char *trans, integer *m, integer *n, complex *
00017         alpha, complex *a, integer *lda, complex *x, integer *incx, complex *
00018         beta, complex *y, integer *incy)
00019 {
00020     /* System generated locals */
00021     integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
00022     complex q__1, q__2, q__3;
00023 
00024     /* Builtin functions */
00025     void r_cnjg(complex *, complex *);
00026 
00027     /* Local variables */
00028     integer i__, j, ix, iy, jx, jy, kx, ky, info;
00029     complex temp;
00030     integer lenx, leny;
00031     extern logical lsame_(char *, char *);
00032     extern /* Subroutine */ int xerbla_(char *, integer *);
00033     logical noconj;
00034 
00035 /*     .. Scalar Arguments .. */
00036 /*     .. */
00037 /*     .. Array Arguments .. */
00038 /*     .. */
00039 
00040 /*  Purpose */
00041 /*  ======= */
00042 
00043 /*  CGEMV performs one of the matrix-vector operations */
00044 
00045 /*     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,   or */
00046 
00047 /*     y := alpha*conjg( A' )*x + beta*y, */
00048 
00049 /*  where alpha and beta are scalars, x and y are vectors and A is an */
00050 /*  m by n matrix. */
00051 
00052 /*  Arguments */
00053 /*  ========== */
00054 
00055 /*  TRANS  - CHARACTER*1. */
00056 /*           On entry, TRANS specifies the operation to be performed as */
00057 /*           follows: */
00058 
00059 /*              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y. */
00060 
00061 /*              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y. */
00062 
00063 /*              TRANS = 'C' or 'c'   y := alpha*conjg( A' )*x + beta*y. */
00064 
00065 /*           Unchanged on exit. */
00066 
00067 /*  M      - INTEGER. */
00068 /*           On entry, M specifies the number of rows of the matrix A. */
00069 /*           M must be at least zero. */
00070 /*           Unchanged on exit. */
00071 
00072 /*  N      - INTEGER. */
00073 /*           On entry, N specifies the number of columns of the matrix A. */
00074 /*           N must be at least zero. */
00075 /*           Unchanged on exit. */
00076 
00077 /*  ALPHA  - COMPLEX         . */
00078 /*           On entry, ALPHA specifies the scalar alpha. */
00079 /*           Unchanged on exit. */
00080 
00081 /*  A      - COMPLEX          array of DIMENSION ( LDA, n ). */
00082 /*           Before entry, the leading m by n part of the array A must */
00083 /*           contain the matrix of coefficients. */
00084 /*           Unchanged on exit. */
00085 
00086 /*  LDA    - INTEGER. */
00087 /*           On entry, LDA specifies the first dimension of A as declared */
00088 /*           in the calling (sub) program. LDA must be at least */
00089 /*           max( 1, m ). */
00090 /*           Unchanged on exit. */
00091 
00092 /*  X      - COMPLEX          array of DIMENSION at least */
00093 /*           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' */
00094 /*           and at least */
00095 /*           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. */
00096 /*           Before entry, the incremented array X must contain the */
00097 /*           vector x. */
00098 /*           Unchanged on exit. */
00099 
00100 /*  INCX   - INTEGER. */
00101 /*           On entry, INCX specifies the increment for the elements of */
00102 /*           X. INCX must not be zero. */
00103 /*           Unchanged on exit. */
00104 
00105 /*  BETA   - COMPLEX         . */
00106 /*           On entry, BETA specifies the scalar beta. When BETA is */
00107 /*           supplied as zero then Y need not be set on input. */
00108 /*           Unchanged on exit. */
00109 
00110 /*  Y      - COMPLEX          array of DIMENSION at least */
00111 /*           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' */
00112 /*           and at least */
00113 /*           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. */
00114 /*           Before entry with BETA non-zero, the incremented array Y */
00115 /*           must contain the vector y. On exit, Y is overwritten by the */
00116 /*           updated vector y. */
00117 
00118 /*  INCY   - INTEGER. */
00119 /*           On entry, INCY specifies the increment for the elements of */
00120 /*           Y. INCY must not be zero. */
00121 /*           Unchanged on exit. */
00122 
00123 
00124 /*  Level 2 Blas routine. */
00125 
00126 /*  -- Written on 22-October-1986. */
00127 /*     Jack Dongarra, Argonne National Lab. */
00128 /*     Jeremy Du Croz, Nag Central Office. */
00129 /*     Sven Hammarling, Nag Central Office. */
00130 /*     Richard Hanson, Sandia National Labs. */
00131 
00132 
00133 /*     .. Parameters .. */
00134 /*     .. */
00135 /*     .. Local Scalars .. */
00136 /*     .. */
00137 /*     .. External Functions .. */
00138 /*     .. */
00139 /*     .. External Subroutines .. */
00140 /*     .. */
00141 /*     .. Intrinsic Functions .. */
00142 /*     .. */
00143 
00144 /*     Test the input parameters. */
00145 
00146     /* Parameter adjustments */
00147     a_dim1 = *lda;
00148     a_offset = 1 + a_dim1;
00149     a -= a_offset;
00150     --x;
00151     --y;
00152 
00153     /* Function Body */
00154     info = 0;
00155     if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")
00156             ) {
00157         info = 1;
00158     } else if (*m < 0) {
00159         info = 2;
00160     } else if (*n < 0) {
00161         info = 3;
00162     } else if (*lda < max(1,*m)) {
00163         info = 6;
00164     } else if (*incx == 0) {
00165         info = 8;
00166     } else if (*incy == 0) {
00167         info = 11;
00168     }
00169     if (info != 0) {
00170         xerbla_("CGEMV ", &info);
00171         return 0;
00172     }
00173 
00174 /*     Quick return if possible. */
00175 
00176     if (*m == 0 || *n == 0 || alpha->r == 0.f && alpha->i == 0.f && (beta->r 
00177             == 1.f && beta->i == 0.f)) {
00178         return 0;
00179     }
00180 
00181     noconj = lsame_(trans, "T");
00182 
00183 /*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set */
00184 /*     up the start points in  X  and  Y. */
00185 
00186     if (lsame_(trans, "N")) {
00187         lenx = *n;
00188         leny = *m;
00189     } else {
00190         lenx = *m;
00191         leny = *n;
00192     }
00193     if (*incx > 0) {
00194         kx = 1;
00195     } else {
00196         kx = 1 - (lenx - 1) * *incx;
00197     }
00198     if (*incy > 0) {
00199         ky = 1;
00200     } else {
00201         ky = 1 - (leny - 1) * *incy;
00202     }
00203 
00204 /*     Start the operations. In this version the elements of A are */
00205 /*     accessed sequentially with one pass through A. */
00206 
00207 /*     First form  y := beta*y. */
00208 
00209     if (beta->r != 1.f || beta->i != 0.f) {
00210         if (*incy == 1) {
00211             if (beta->r == 0.f && beta->i == 0.f) {
00212                 i__1 = leny;
00213                 for (i__ = 1; i__ <= i__1; ++i__) {
00214                     i__2 = i__;
00215                     y[i__2].r = 0.f, y[i__2].i = 0.f;
00216 /* L10: */
00217                 }
00218             } else {
00219                 i__1 = leny;
00220                 for (i__ = 1; i__ <= i__1; ++i__) {
00221                     i__2 = i__;
00222                     i__3 = i__;
00223                     q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, 
00224                             q__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
00225                             .r;
00226                     y[i__2].r = q__1.r, y[i__2].i = q__1.i;
00227 /* L20: */
00228                 }
00229             }
00230         } else {
00231             iy = ky;
00232             if (beta->r == 0.f && beta->i == 0.f) {
00233                 i__1 = leny;
00234                 for (i__ = 1; i__ <= i__1; ++i__) {
00235                     i__2 = iy;
00236                     y[i__2].r = 0.f, y[i__2].i = 0.f;
00237                     iy += *incy;
00238 /* L30: */
00239                 }
00240             } else {
00241                 i__1 = leny;
00242                 for (i__ = 1; i__ <= i__1; ++i__) {
00243                     i__2 = iy;
00244                     i__3 = iy;
00245                     q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, 
00246                             q__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
00247                             .r;
00248                     y[i__2].r = q__1.r, y[i__2].i = q__1.i;
00249                     iy += *incy;
00250 /* L40: */
00251                 }
00252             }
00253         }
00254     }
00255     if (alpha->r == 0.f && alpha->i == 0.f) {
00256         return 0;
00257     }
00258     if (lsame_(trans, "N")) {
00259 
00260 /*        Form  y := alpha*A*x + y. */
00261 
00262         jx = kx;
00263         if (*incy == 1) {
00264             i__1 = *n;
00265             for (j = 1; j <= i__1; ++j) {
00266                 i__2 = jx;
00267                 if (x[i__2].r != 0.f || x[i__2].i != 0.f) {
00268                     i__2 = jx;
00269                     q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, 
00270                             q__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
00271                             .r;
00272                     temp.r = q__1.r, temp.i = q__1.i;
00273                     i__2 = *m;
00274                     for (i__ = 1; i__ <= i__2; ++i__) {
00275                         i__3 = i__;
00276                         i__4 = i__;
00277                         i__5 = i__ + j * a_dim1;
00278                         q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, 
00279                                 q__2.i = temp.r * a[i__5].i + temp.i * a[i__5]
00280                                 .r;
00281                         q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + 
00282                                 q__2.i;
00283                         y[i__3].r = q__1.r, y[i__3].i = q__1.i;
00284 /* L50: */
00285                     }
00286                 }
00287                 jx += *incx;
00288 /* L60: */
00289             }
00290         } else {
00291             i__1 = *n;
00292             for (j = 1; j <= i__1; ++j) {
00293                 i__2 = jx;
00294                 if (x[i__2].r != 0.f || x[i__2].i != 0.f) {
00295                     i__2 = jx;
00296                     q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, 
00297                             q__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
00298                             .r;
00299                     temp.r = q__1.r, temp.i = q__1.i;
00300                     iy = ky;
00301                     i__2 = *m;
00302                     for (i__ = 1; i__ <= i__2; ++i__) {
00303                         i__3 = iy;
00304                         i__4 = iy;
00305                         i__5 = i__ + j * a_dim1;
00306                         q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, 
00307                                 q__2.i = temp.r * a[i__5].i + temp.i * a[i__5]
00308                                 .r;
00309                         q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + 
00310                                 q__2.i;
00311                         y[i__3].r = q__1.r, y[i__3].i = q__1.i;
00312                         iy += *incy;
00313 /* L70: */
00314                     }
00315                 }
00316                 jx += *incx;
00317 /* L80: */
00318             }
00319         }
00320     } else {
00321 
00322 /*        Form  y := alpha*A'*x + y  or  y := alpha*conjg( A' )*x + y. */
00323 
00324         jy = ky;
00325         if (*incx == 1) {
00326             i__1 = *n;
00327             for (j = 1; j <= i__1; ++j) {
00328                 temp.r = 0.f, temp.i = 0.f;
00329                 if (noconj) {
00330                     i__2 = *m;
00331                     for (i__ = 1; i__ <= i__2; ++i__) {
00332                         i__3 = i__ + j * a_dim1;
00333                         i__4 = i__;
00334                         q__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4]
00335                                 .i, q__2.i = a[i__3].r * x[i__4].i + a[i__3]
00336                                 .i * x[i__4].r;
00337                         q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
00338                         temp.r = q__1.r, temp.i = q__1.i;
00339 /* L90: */
00340                     }
00341                 } else {
00342                     i__2 = *m;
00343                     for (i__ = 1; i__ <= i__2; ++i__) {
00344                         r_cnjg(&q__3, &a[i__ + j * a_dim1]);
00345                         i__3 = i__;
00346                         q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, 
00347                                 q__2.i = q__3.r * x[i__3].i + q__3.i * x[i__3]
00348                                 .r;
00349                         q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
00350                         temp.r = q__1.r, temp.i = q__1.i;
00351 /* L100: */
00352                     }
00353                 }
00354                 i__2 = jy;
00355                 i__3 = jy;
00356                 q__2.r = alpha->r * temp.r - alpha->i * temp.i, q__2.i = 
00357                         alpha->r * temp.i + alpha->i * temp.r;
00358                 q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
00359                 y[i__2].r = q__1.r, y[i__2].i = q__1.i;
00360                 jy += *incy;
00361 /* L110: */
00362             }
00363         } else {
00364             i__1 = *n;
00365             for (j = 1; j <= i__1; ++j) {
00366                 temp.r = 0.f, temp.i = 0.f;
00367                 ix = kx;
00368                 if (noconj) {
00369                     i__2 = *m;
00370                     for (i__ = 1; i__ <= i__2; ++i__) {
00371                         i__3 = i__ + j * a_dim1;
00372                         i__4 = ix;
00373                         q__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4]
00374                                 .i, q__2.i = a[i__3].r * x[i__4].i + a[i__3]
00375                                 .i * x[i__4].r;
00376                         q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
00377                         temp.r = q__1.r, temp.i = q__1.i;
00378                         ix += *incx;
00379 /* L120: */
00380                     }
00381                 } else {
00382                     i__2 = *m;
00383                     for (i__ = 1; i__ <= i__2; ++i__) {
00384                         r_cnjg(&q__3, &a[i__ + j * a_dim1]);
00385                         i__3 = ix;
00386                         q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, 
00387                                 q__2.i = q__3.r * x[i__3].i + q__3.i * x[i__3]
00388                                 .r;
00389                         q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
00390                         temp.r = q__1.r, temp.i = q__1.i;
00391                         ix += *incx;
00392 /* L130: */
00393                     }
00394                 }
00395                 i__2 = jy;
00396                 i__3 = jy;
00397                 q__2.r = alpha->r * temp.r - alpha->i * temp.i, q__2.i = 
00398                         alpha->r * temp.i + alpha->i * temp.r;
00399                 q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
00400                 y[i__2].r = q__1.r, y[i__2].i = q__1.i;
00401                 jy += *incy;
00402 /* L140: */
00403             }
00404         }
00405     }
00406 
00407     return 0;
00408 
00409 /*     End of CGEMV . */
00410 
00411 } /* cgemv_ */

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