ssymv.c
Go to the documentation of this file.
00001 /* ssymv.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 ssymv_(char *uplo, integer *n, real *alpha, real *a, 
00017         integer *lda, real *x, integer *incx, real *beta, real *y, integer *
00018         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     real temp1, temp2;
00026     extern logical lsame_(char *, char *);
00027     extern /* Subroutine */ int xerbla_(char *, integer *);
00028 
00029 /*     .. Scalar Arguments .. */
00030 /*     .. */
00031 /*     .. Array Arguments .. */
00032 /*     .. */
00033 
00034 /*  Purpose */
00035 /*  ======= */
00036 
00037 /*  SSYMV  performs the matrix-vector  operation */
00038 
00039 /*     y := alpha*A*x + beta*y, */
00040 
00041 /*  where alpha and beta are scalars, x and y are n element vectors and */
00042 /*  A is an n by n symmetric matrix. */
00043 
00044 /*  Arguments */
00045 /*  ========== */
00046 
00047 /*  UPLO   - CHARACTER*1. */
00048 /*           On entry, UPLO specifies whether the upper or lower */
00049 /*           triangular part of the array A is to be referenced as */
00050 /*           follows: */
00051 
00052 /*              UPLO = 'U' or 'u'   Only the upper triangular part of A */
00053 /*                                  is to be referenced. */
00054 
00055 /*              UPLO = 'L' or 'l'   Only the lower triangular part of A */
00056 /*                                  is to be referenced. */
00057 
00058 /*           Unchanged on exit. */
00059 
00060 /*  N      - INTEGER. */
00061 /*           On entry, N specifies the order of the matrix A. */
00062 /*           N must be at least zero. */
00063 /*           Unchanged on exit. */
00064 
00065 /*  ALPHA  - REAL            . */
00066 /*           On entry, ALPHA specifies the scalar alpha. */
00067 /*           Unchanged on exit. */
00068 
00069 /*  A      - REAL             array of DIMENSION ( LDA, n ). */
00070 /*           Before entry with  UPLO = 'U' or 'u', the leading n by n */
00071 /*           upper triangular part of the array A must contain the upper */
00072 /*           triangular part of the symmetric matrix and the strictly */
00073 /*           lower triangular part of A is not referenced. */
00074 /*           Before entry with UPLO = 'L' or 'l', the leading n by n */
00075 /*           lower triangular part of the array A must contain the lower */
00076 /*           triangular part of the symmetric matrix and the strictly */
00077 /*           upper triangular part of A is not referenced. */
00078 /*           Unchanged on exit. */
00079 
00080 /*  LDA    - INTEGER. */
00081 /*           On entry, LDA specifies the first dimension of A as declared */
00082 /*           in the calling (sub) program. LDA must be at least */
00083 /*           max( 1, n ). */
00084 /*           Unchanged on exit. */
00085 
00086 /*  X      - REAL             array of dimension at least */
00087 /*           ( 1 + ( n - 1 )*abs( INCX ) ). */
00088 /*           Before entry, the incremented array X must contain the n */
00089 /*           element vector x. */
00090 /*           Unchanged on exit. */
00091 
00092 /*  INCX   - INTEGER. */
00093 /*           On entry, INCX specifies the increment for the elements of */
00094 /*           X. INCX must not be zero. */
00095 /*           Unchanged on exit. */
00096 
00097 /*  BETA   - REAL            . */
00098 /*           On entry, BETA specifies the scalar beta. When BETA is */
00099 /*           supplied as zero then Y need not be set on input. */
00100 /*           Unchanged on exit. */
00101 
00102 /*  Y      - REAL             array of dimension at least */
00103 /*           ( 1 + ( n - 1 )*abs( INCY ) ). */
00104 /*           Before entry, the incremented array Y must contain the n */
00105 /*           element vector y. On exit, Y is overwritten by the updated */
00106 /*           vector y. */
00107 
00108 /*  INCY   - INTEGER. */
00109 /*           On entry, INCY specifies the increment for the elements of */
00110 /*           Y. INCY must not be zero. */
00111 /*           Unchanged on exit. */
00112 
00113 
00114 /*  Level 2 Blas routine. */
00115 
00116 /*  -- Written on 22-October-1986. */
00117 /*     Jack Dongarra, Argonne National Lab. */
00118 /*     Jeremy Du Croz, Nag Central Office. */
00119 /*     Sven Hammarling, Nag Central Office. */
00120 /*     Richard Hanson, Sandia National Labs. */
00121 
00122 
00123 /*     .. Parameters .. */
00124 /*     .. */
00125 /*     .. Local Scalars .. */
00126 /*     .. */
00127 /*     .. External Functions .. */
00128 /*     .. */
00129 /*     .. External Subroutines .. */
00130 /*     .. */
00131 /*     .. Intrinsic Functions .. */
00132 /*     .. */
00133 
00134 /*     Test the input parameters. */
00135 
00136     /* Parameter adjustments */
00137     a_dim1 = *lda;
00138     a_offset = 1 + a_dim1;
00139     a -= a_offset;
00140     --x;
00141     --y;
00142 
00143     /* Function Body */
00144     info = 0;
00145     if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
00146         info = 1;
00147     } else if (*n < 0) {
00148         info = 2;
00149     } else if (*lda < max(1,*n)) {
00150         info = 5;
00151     } else if (*incx == 0) {
00152         info = 7;
00153     } else if (*incy == 0) {
00154         info = 10;
00155     }
00156     if (info != 0) {
00157         xerbla_("SSYMV ", &info);
00158         return 0;
00159     }
00160 
00161 /*     Quick return if possible. */
00162 
00163     if (*n == 0 || *alpha == 0.f && *beta == 1.f) {
00164         return 0;
00165     }
00166 
00167 /*     Set up the start points in  X  and  Y. */
00168 
00169     if (*incx > 0) {
00170         kx = 1;
00171     } else {
00172         kx = 1 - (*n - 1) * *incx;
00173     }
00174     if (*incy > 0) {
00175         ky = 1;
00176     } else {
00177         ky = 1 - (*n - 1) * *incy;
00178     }
00179 
00180 /*     Start the operations. In this version the elements of A are */
00181 /*     accessed sequentially with one pass through the triangular part */
00182 /*     of A. */
00183 
00184 /*     First form  y := beta*y. */
00185 
00186     if (*beta != 1.f) {
00187         if (*incy == 1) {
00188             if (*beta == 0.f) {
00189                 i__1 = *n;
00190                 for (i__ = 1; i__ <= i__1; ++i__) {
00191                     y[i__] = 0.f;
00192 /* L10: */
00193                 }
00194             } else {
00195                 i__1 = *n;
00196                 for (i__ = 1; i__ <= i__1; ++i__) {
00197                     y[i__] = *beta * y[i__];
00198 /* L20: */
00199                 }
00200             }
00201         } else {
00202             iy = ky;
00203             if (*beta == 0.f) {
00204                 i__1 = *n;
00205                 for (i__ = 1; i__ <= i__1; ++i__) {
00206                     y[iy] = 0.f;
00207                     iy += *incy;
00208 /* L30: */
00209                 }
00210             } else {
00211                 i__1 = *n;
00212                 for (i__ = 1; i__ <= i__1; ++i__) {
00213                     y[iy] = *beta * y[iy];
00214                     iy += *incy;
00215 /* L40: */
00216                 }
00217             }
00218         }
00219     }
00220     if (*alpha == 0.f) {
00221         return 0;
00222     }
00223     if (lsame_(uplo, "U")) {
00224 
00225 /*        Form  y  when A is stored in upper triangle. */
00226 
00227         if (*incx == 1 && *incy == 1) {
00228             i__1 = *n;
00229             for (j = 1; j <= i__1; ++j) {
00230                 temp1 = *alpha * x[j];
00231                 temp2 = 0.f;
00232                 i__2 = j - 1;
00233                 for (i__ = 1; i__ <= i__2; ++i__) {
00234                     y[i__] += temp1 * a[i__ + j * a_dim1];
00235                     temp2 += a[i__ + j * a_dim1] * x[i__];
00236 /* L50: */
00237                 }
00238                 y[j] = y[j] + temp1 * a[j + j * a_dim1] + *alpha * temp2;
00239 /* L60: */
00240             }
00241         } else {
00242             jx = kx;
00243             jy = ky;
00244             i__1 = *n;
00245             for (j = 1; j <= i__1; ++j) {
00246                 temp1 = *alpha * x[jx];
00247                 temp2 = 0.f;
00248                 ix = kx;
00249                 iy = ky;
00250                 i__2 = j - 1;
00251                 for (i__ = 1; i__ <= i__2; ++i__) {
00252                     y[iy] += temp1 * a[i__ + j * a_dim1];
00253                     temp2 += a[i__ + j * a_dim1] * x[ix];
00254                     ix += *incx;
00255                     iy += *incy;
00256 /* L70: */
00257                 }
00258                 y[jy] = y[jy] + temp1 * a[j + j * a_dim1] + *alpha * temp2;
00259                 jx += *incx;
00260                 jy += *incy;
00261 /* L80: */
00262             }
00263         }
00264     } else {
00265 
00266 /*        Form  y  when A is stored in lower triangle. */
00267 
00268         if (*incx == 1 && *incy == 1) {
00269             i__1 = *n;
00270             for (j = 1; j <= i__1; ++j) {
00271                 temp1 = *alpha * x[j];
00272                 temp2 = 0.f;
00273                 y[j] += temp1 * a[j + j * a_dim1];
00274                 i__2 = *n;
00275                 for (i__ = j + 1; i__ <= i__2; ++i__) {
00276                     y[i__] += temp1 * a[i__ + j * a_dim1];
00277                     temp2 += a[i__ + j * a_dim1] * x[i__];
00278 /* L90: */
00279                 }
00280                 y[j] += *alpha * temp2;
00281 /* L100: */
00282             }
00283         } else {
00284             jx = kx;
00285             jy = ky;
00286             i__1 = *n;
00287             for (j = 1; j <= i__1; ++j) {
00288                 temp1 = *alpha * x[jx];
00289                 temp2 = 0.f;
00290                 y[jy] += temp1 * a[j + j * a_dim1];
00291                 ix = jx;
00292                 iy = jy;
00293                 i__2 = *n;
00294                 for (i__ = j + 1; i__ <= i__2; ++i__) {
00295                     ix += *incx;
00296                     iy += *incy;
00297                     y[iy] += temp1 * a[i__ + j * a_dim1];
00298                     temp2 += a[i__ + j * a_dim1] * x[ix];
00299 /* L110: */
00300                 }
00301                 y[jy] += *alpha * temp2;
00302                 jx += *incx;
00303                 jy += *incy;
00304 /* L120: */
00305             }
00306         }
00307     }
00308 
00309     return 0;
00310 
00311 /*     End of SSYMV . */
00312 
00313 } /* ssymv_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:14