csymv.c
Go to the documentation of this file.
00001 /* csymv.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 csymv_(char *uplo, integer *n, complex *alpha, complex *
00017         a, integer *lda, complex *x, integer *incx, complex *beta, complex *y, 
00018          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, q__4;
00023 
00024     /* Local variables */
00025     integer i__, j, ix, iy, jx, jy, kx, ky, info;
00026     complex temp1, temp2;
00027     extern logical lsame_(char *, char *);
00028     extern /* Subroutine */ int xerbla_(char *, integer *);
00029 
00030 
00031 /*  -- LAPACK auxiliary routine (version 3.2) -- */
00032 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00033 /*     November 2006 */
00034 
00035 /*     .. Scalar Arguments .. */
00036 /*     .. */
00037 /*     .. Array Arguments .. */
00038 /*     .. */
00039 
00040 /*  Purpose */
00041 /*  ======= */
00042 
00043 /*  CSYMV  performs the matrix-vector  operation */
00044 
00045 /*     y := alpha*A*x + beta*y, */
00046 
00047 /*  where alpha and beta are scalars, x and y are n element vectors and */
00048 /*  A is an n by n symmetric matrix. */
00049 
00050 /*  Arguments */
00051 /*  ========== */
00052 
00053 /*  UPLO     (input) CHARACTER*1 */
00054 /*           On entry, UPLO specifies whether the upper or lower */
00055 /*           triangular part of the array A is to be referenced as */
00056 /*           follows: */
00057 
00058 /*              UPLO = 'U' or 'u'   Only the upper triangular part of A */
00059 /*                                  is to be referenced. */
00060 
00061 /*              UPLO = 'L' or 'l'   Only the lower triangular part of A */
00062 /*                                  is to be referenced. */
00063 
00064 /*           Unchanged on exit. */
00065 
00066 /*  N        (input) INTEGER */
00067 /*           On entry, N specifies the order of the matrix A. */
00068 /*           N must be at least zero. */
00069 /*           Unchanged on exit. */
00070 
00071 /*  ALPHA    (input) COMPLEX */
00072 /*           On entry, ALPHA specifies the scalar alpha. */
00073 /*           Unchanged on exit. */
00074 
00075 /*  A        (input) COMPLEX array, dimension ( LDA, N ) */
00076 /*           Before entry, with  UPLO = 'U' or 'u', the leading n by n */
00077 /*           upper triangular part of the array A must contain the upper */
00078 /*           triangular part of the symmetric matrix and the strictly */
00079 /*           lower triangular part of A is not referenced. */
00080 /*           Before entry, with UPLO = 'L' or 'l', the leading n by n */
00081 /*           lower triangular part of the array A must contain the lower */
00082 /*           triangular part of the symmetric matrix and the strictly */
00083 /*           upper triangular part of A is not referenced. */
00084 /*           Unchanged on exit. */
00085 
00086 /*  LDA      (input) 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, N ). */
00090 /*           Unchanged on exit. */
00091 
00092 /*  X        (input) COMPLEX array, dimension at least */
00093 /*           ( 1 + ( N - 1 )*abs( INCX ) ). */
00094 /*           Before entry, the incremented array X must contain the N- */
00095 /*           element vector x. */
00096 /*           Unchanged on exit. */
00097 
00098 /*  INCX     (input) INTEGER */
00099 /*           On entry, INCX specifies the increment for the elements of */
00100 /*           X. INCX must not be zero. */
00101 /*           Unchanged on exit. */
00102 
00103 /*  BETA     (input) COMPLEX */
00104 /*           On entry, BETA specifies the scalar beta. When BETA is */
00105 /*           supplied as zero then Y need not be set on input. */
00106 /*           Unchanged on exit. */
00107 
00108 /*  Y        (input/output) COMPLEX array, dimension at least */
00109 /*           ( 1 + ( N - 1 )*abs( INCY ) ). */
00110 /*           Before entry, the incremented array Y must contain the n */
00111 /*           element vector y. On exit, Y is overwritten by the updated */
00112 /*           vector y. */
00113 
00114 /*  INCY     (input) INTEGER */
00115 /*           On entry, INCY specifies the increment for the elements of */
00116 /*           Y. INCY must not be zero. */
00117 /*           Unchanged on exit. */
00118 
00119 /* ===================================================================== */
00120 
00121 /*     .. Parameters .. */
00122 /*     .. */
00123 /*     .. Local Scalars .. */
00124 /*     .. */
00125 /*     .. External Functions .. */
00126 /*     .. */
00127 /*     .. External Subroutines .. */
00128 /*     .. */
00129 /*     .. Intrinsic Functions .. */
00130 /*     .. */
00131 /*     .. Executable Statements .. */
00132 
00133 /*     Test the input parameters. */
00134 
00135     /* Parameter adjustments */
00136     a_dim1 = *lda;
00137     a_offset = 1 + a_dim1;
00138     a -= a_offset;
00139     --x;
00140     --y;
00141 
00142     /* Function Body */
00143     info = 0;
00144     if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
00145         info = 1;
00146     } else if (*n < 0) {
00147         info = 2;
00148     } else if (*lda < max(1,*n)) {
00149         info = 5;
00150     } else if (*incx == 0) {
00151         info = 7;
00152     } else if (*incy == 0) {
00153         info = 10;
00154     }
00155     if (info != 0) {
00156         xerbla_("CSYMV ", &info);
00157         return 0;
00158     }
00159 
00160 /*     Quick return if possible. */
00161 
00162     if (*n == 0 || alpha->r == 0.f && alpha->i == 0.f && (beta->r == 1.f && 
00163             beta->i == 0.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->r != 1.f || beta->i != 0.f) {
00187         if (*incy == 1) {
00188             if (beta->r == 0.f && beta->i == 0.f) {
00189                 i__1 = *n;
00190                 for (i__ = 1; i__ <= i__1; ++i__) {
00191                     i__2 = i__;
00192                     y[i__2].r = 0.f, y[i__2].i = 0.f;
00193 /* L10: */
00194                 }
00195             } else {
00196                 i__1 = *n;
00197                 for (i__ = 1; i__ <= i__1; ++i__) {
00198                     i__2 = i__;
00199                     i__3 = i__;
00200                     q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, 
00201                             q__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
00202                             .r;
00203                     y[i__2].r = q__1.r, y[i__2].i = q__1.i;
00204 /* L20: */
00205                 }
00206             }
00207         } else {
00208             iy = ky;
00209             if (beta->r == 0.f && beta->i == 0.f) {
00210                 i__1 = *n;
00211                 for (i__ = 1; i__ <= i__1; ++i__) {
00212                     i__2 = iy;
00213                     y[i__2].r = 0.f, y[i__2].i = 0.f;
00214                     iy += *incy;
00215 /* L30: */
00216                 }
00217             } else {
00218                 i__1 = *n;
00219                 for (i__ = 1; i__ <= i__1; ++i__) {
00220                     i__2 = iy;
00221                     i__3 = iy;
00222                     q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, 
00223                             q__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
00224                             .r;
00225                     y[i__2].r = q__1.r, y[i__2].i = q__1.i;
00226                     iy += *incy;
00227 /* L40: */
00228                 }
00229             }
00230         }
00231     }
00232     if (alpha->r == 0.f && alpha->i == 0.f) {
00233         return 0;
00234     }
00235     if (lsame_(uplo, "U")) {
00236 
00237 /*        Form  y  when A is stored in upper triangle. */
00238 
00239         if (*incx == 1 && *incy == 1) {
00240             i__1 = *n;
00241             for (j = 1; j <= i__1; ++j) {
00242                 i__2 = j;
00243                 q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i =
00244                          alpha->r * x[i__2].i + alpha->i * x[i__2].r;
00245                 temp1.r = q__1.r, temp1.i = q__1.i;
00246                 temp2.r = 0.f, temp2.i = 0.f;
00247                 i__2 = j - 1;
00248                 for (i__ = 1; i__ <= i__2; ++i__) {
00249                     i__3 = i__;
00250                     i__4 = i__;
00251                     i__5 = i__ + j * a_dim1;
00252                     q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 
00253                             q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
00254                             .r;
00255                     q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
00256                     y[i__3].r = q__1.r, y[i__3].i = q__1.i;
00257                     i__3 = i__ + j * a_dim1;
00258                     i__4 = i__;
00259                     q__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4].i, 
00260                             q__2.i = a[i__3].r * x[i__4].i + a[i__3].i * x[
00261                             i__4].r;
00262                     q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
00263                     temp2.r = q__1.r, temp2.i = q__1.i;
00264 /* L50: */
00265                 }
00266                 i__2 = j;
00267                 i__3 = j;
00268                 i__4 = j + j * a_dim1;
00269                 q__3.r = temp1.r * a[i__4].r - temp1.i * a[i__4].i, q__3.i = 
00270                         temp1.r * a[i__4].i + temp1.i * a[i__4].r;
00271                 q__2.r = y[i__3].r + q__3.r, q__2.i = y[i__3].i + q__3.i;
00272                 q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i = 
00273                         alpha->r * temp2.i + alpha->i * temp2.r;
00274                 q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;
00275                 y[i__2].r = q__1.r, y[i__2].i = q__1.i;
00276 /* L60: */
00277             }
00278         } else {
00279             jx = kx;
00280             jy = ky;
00281             i__1 = *n;
00282             for (j = 1; j <= i__1; ++j) {
00283                 i__2 = jx;
00284                 q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i =
00285                          alpha->r * x[i__2].i + alpha->i * x[i__2].r;
00286                 temp1.r = q__1.r, temp1.i = q__1.i;
00287                 temp2.r = 0.f, temp2.i = 0.f;
00288                 ix = kx;
00289                 iy = ky;
00290                 i__2 = j - 1;
00291                 for (i__ = 1; i__ <= i__2; ++i__) {
00292                     i__3 = iy;
00293                     i__4 = iy;
00294                     i__5 = i__ + j * a_dim1;
00295                     q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 
00296                             q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
00297                             .r;
00298                     q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
00299                     y[i__3].r = q__1.r, y[i__3].i = q__1.i;
00300                     i__3 = i__ + j * a_dim1;
00301                     i__4 = ix;
00302                     q__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4].i, 
00303                             q__2.i = a[i__3].r * x[i__4].i + a[i__3].i * x[
00304                             i__4].r;
00305                     q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
00306                     temp2.r = q__1.r, temp2.i = q__1.i;
00307                     ix += *incx;
00308                     iy += *incy;
00309 /* L70: */
00310                 }
00311                 i__2 = jy;
00312                 i__3 = jy;
00313                 i__4 = j + j * a_dim1;
00314                 q__3.r = temp1.r * a[i__4].r - temp1.i * a[i__4].i, q__3.i = 
00315                         temp1.r * a[i__4].i + temp1.i * a[i__4].r;
00316                 q__2.r = y[i__3].r + q__3.r, q__2.i = y[i__3].i + q__3.i;
00317                 q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i = 
00318                         alpha->r * temp2.i + alpha->i * temp2.r;
00319                 q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;
00320                 y[i__2].r = q__1.r, y[i__2].i = q__1.i;
00321                 jx += *incx;
00322                 jy += *incy;
00323 /* L80: */
00324             }
00325         }
00326     } else {
00327 
00328 /*        Form  y  when A is stored in lower triangle. */
00329 
00330         if (*incx == 1 && *incy == 1) {
00331             i__1 = *n;
00332             for (j = 1; j <= i__1; ++j) {
00333                 i__2 = j;
00334                 q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i =
00335                          alpha->r * x[i__2].i + alpha->i * x[i__2].r;
00336                 temp1.r = q__1.r, temp1.i = q__1.i;
00337                 temp2.r = 0.f, temp2.i = 0.f;
00338                 i__2 = j;
00339                 i__3 = j;
00340                 i__4 = j + j * a_dim1;
00341                 q__2.r = temp1.r * a[i__4].r - temp1.i * a[i__4].i, q__2.i = 
00342                         temp1.r * a[i__4].i + temp1.i * a[i__4].r;
00343                 q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
00344                 y[i__2].r = q__1.r, y[i__2].i = q__1.i;
00345                 i__2 = *n;
00346                 for (i__ = j + 1; i__ <= i__2; ++i__) {
00347                     i__3 = i__;
00348                     i__4 = i__;
00349                     i__5 = i__ + j * a_dim1;
00350                     q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 
00351                             q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
00352                             .r;
00353                     q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
00354                     y[i__3].r = q__1.r, y[i__3].i = q__1.i;
00355                     i__3 = i__ + j * a_dim1;
00356                     i__4 = i__;
00357                     q__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4].i, 
00358                             q__2.i = a[i__3].r * x[i__4].i + a[i__3].i * x[
00359                             i__4].r;
00360                     q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
00361                     temp2.r = q__1.r, temp2.i = q__1.i;
00362 /* L90: */
00363                 }
00364                 i__2 = j;
00365                 i__3 = j;
00366                 q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = 
00367                         alpha->r * temp2.i + alpha->i * temp2.r;
00368                 q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
00369                 y[i__2].r = q__1.r, y[i__2].i = q__1.i;
00370 /* L100: */
00371             }
00372         } else {
00373             jx = kx;
00374             jy = ky;
00375             i__1 = *n;
00376             for (j = 1; j <= i__1; ++j) {
00377                 i__2 = jx;
00378                 q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i =
00379                          alpha->r * x[i__2].i + alpha->i * x[i__2].r;
00380                 temp1.r = q__1.r, temp1.i = q__1.i;
00381                 temp2.r = 0.f, temp2.i = 0.f;
00382                 i__2 = jy;
00383                 i__3 = jy;
00384                 i__4 = j + j * a_dim1;
00385                 q__2.r = temp1.r * a[i__4].r - temp1.i * a[i__4].i, q__2.i = 
00386                         temp1.r * a[i__4].i + temp1.i * a[i__4].r;
00387                 q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
00388                 y[i__2].r = q__1.r, y[i__2].i = q__1.i;
00389                 ix = jx;
00390                 iy = jy;
00391                 i__2 = *n;
00392                 for (i__ = j + 1; i__ <= i__2; ++i__) {
00393                     ix += *incx;
00394                     iy += *incy;
00395                     i__3 = iy;
00396                     i__4 = iy;
00397                     i__5 = i__ + j * a_dim1;
00398                     q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 
00399                             q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
00400                             .r;
00401                     q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;
00402                     y[i__3].r = q__1.r, y[i__3].i = q__1.i;
00403                     i__3 = i__ + j * a_dim1;
00404                     i__4 = ix;
00405                     q__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4].i, 
00406                             q__2.i = a[i__3].r * x[i__4].i + a[i__3].i * x[
00407                             i__4].r;
00408                     q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;
00409                     temp2.r = q__1.r, temp2.i = q__1.i;
00410 /* L110: */
00411                 }
00412                 i__2 = jy;
00413                 i__3 = jy;
00414                 q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i = 
00415                         alpha->r * temp2.i + alpha->i * temp2.r;
00416                 q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;
00417                 y[i__2].r = q__1.r, y[i__2].i = q__1.i;
00418                 jx += *incx;
00419                 jy += *incy;
00420 /* L120: */
00421             }
00422         }
00423     }
00424 
00425     return 0;
00426 
00427 /*     End of CSYMV */
00428 
00429 } /* csymv_ */

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