csyrk.c
Go to the documentation of this file.
00001 /* csyrk.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 csyrk_(char *uplo, char *trans, integer *n, integer *k, 
00017         complex *alpha, complex *a, integer *lda, complex *beta, complex *c__, 
00018          integer *ldc)
00019 {
00020     /* System generated locals */
00021     integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, 
00022             i__6;
00023     complex q__1, q__2, q__3;
00024 
00025     /* Local variables */
00026     integer i__, j, l, info;
00027     complex temp;
00028     extern logical lsame_(char *, char *);
00029     integer nrowa;
00030     logical upper;
00031     extern /* Subroutine */ int xerbla_(char *, integer *);
00032 
00033 /*     .. Scalar Arguments .. */
00034 /*     .. */
00035 /*     .. Array Arguments .. */
00036 /*     .. */
00037 
00038 /*  Purpose */
00039 /*  ======= */
00040 
00041 /*  CSYRK  performs one of the symmetric rank k operations */
00042 
00043 /*     C := alpha*A*A' + beta*C, */
00044 
00045 /*  or */
00046 
00047 /*     C := alpha*A'*A + beta*C, */
00048 
00049 /*  where  alpha and beta  are scalars,  C is an  n by n symmetric matrix */
00050 /*  and  A  is an  n by k  matrix in the first case and a  k by n  matrix */
00051 /*  in the second case. */
00052 
00053 /*  Arguments */
00054 /*  ========== */
00055 
00056 /*  UPLO   - CHARACTER*1. */
00057 /*           On  entry,   UPLO  specifies  whether  the  upper  or  lower */
00058 /*           triangular  part  of the  array  C  is to be  referenced  as */
00059 /*           follows: */
00060 
00061 /*              UPLO = 'U' or 'u'   Only the  upper triangular part of  C */
00062 /*                                  is to be referenced. */
00063 
00064 /*              UPLO = 'L' or 'l'   Only the  lower triangular part of  C */
00065 /*                                  is to be referenced. */
00066 
00067 /*           Unchanged on exit. */
00068 
00069 /*  TRANS  - CHARACTER*1. */
00070 /*           On entry,  TRANS  specifies the operation to be performed as */
00071 /*           follows: */
00072 
00073 /*              TRANS = 'N' or 'n'   C := alpha*A*A' + beta*C. */
00074 
00075 /*              TRANS = 'T' or 't'   C := alpha*A'*A + beta*C. */
00076 
00077 /*           Unchanged on exit. */
00078 
00079 /*  N      - INTEGER. */
00080 /*           On entry,  N specifies the order of the matrix C.  N must be */
00081 /*           at least zero. */
00082 /*           Unchanged on exit. */
00083 
00084 /*  K      - INTEGER. */
00085 /*           On entry with  TRANS = 'N' or 'n',  K  specifies  the number */
00086 /*           of  columns   of  the   matrix   A,   and  on   entry   with */
00087 /*           TRANS = 'T' or 't',  K  specifies  the number of rows of the */
00088 /*           matrix A.  K must be at least zero. */
00089 /*           Unchanged on exit. */
00090 
00091 /*  ALPHA  - COMPLEX         . */
00092 /*           On entry, ALPHA specifies the scalar alpha. */
00093 /*           Unchanged on exit. */
00094 
00095 /*  A      - COMPLEX          array of DIMENSION ( LDA, ka ), where ka is */
00096 /*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise. */
00097 /*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k */
00098 /*           part of the array  A  must contain the matrix  A,  otherwise */
00099 /*           the leading  k by n  part of the array  A  must contain  the */
00100 /*           matrix A. */
00101 /*           Unchanged on exit. */
00102 
00103 /*  LDA    - INTEGER. */
00104 /*           On entry, LDA specifies the first dimension of A as declared */
00105 /*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n' */
00106 /*           then  LDA must be at least  max( 1, n ), otherwise  LDA must */
00107 /*           be at least  max( 1, k ). */
00108 /*           Unchanged on exit. */
00109 
00110 /*  BETA   - COMPLEX         . */
00111 /*           On entry, BETA specifies the scalar beta. */
00112 /*           Unchanged on exit. */
00113 
00114 /*  C      - COMPLEX          array of DIMENSION ( LDC, n ). */
00115 /*           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n */
00116 /*           upper triangular part of the array C must contain the upper */
00117 /*           triangular part  of the  symmetric matrix  and the strictly */
00118 /*           lower triangular part of C is not referenced.  On exit, the */
00119 /*           upper triangular part of the array  C is overwritten by the */
00120 /*           upper triangular part of the updated matrix. */
00121 /*           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n */
00122 /*           lower triangular part of the array C must contain the lower */
00123 /*           triangular part  of the  symmetric matrix  and the strictly */
00124 /*           upper triangular part of C is not referenced.  On exit, the */
00125 /*           lower triangular part of the array  C is overwritten by the */
00126 /*           lower triangular part of the updated matrix. */
00127 
00128 /*  LDC    - INTEGER. */
00129 /*           On entry, LDC specifies the first dimension of C as declared */
00130 /*           in  the  calling  (sub)  program.   LDC  must  be  at  least */
00131 /*           max( 1, n ). */
00132 /*           Unchanged on exit. */
00133 
00134 
00135 /*  Level 3 Blas routine. */
00136 
00137 /*  -- Written on 8-February-1989. */
00138 /*     Jack Dongarra, Argonne National Laboratory. */
00139 /*     Iain Duff, AERE Harwell. */
00140 /*     Jeremy Du Croz, Numerical Algorithms Group Ltd. */
00141 /*     Sven Hammarling, Numerical Algorithms Group Ltd. */
00142 
00143 
00144 /*     .. External Functions .. */
00145 /*     .. */
00146 /*     .. External Subroutines .. */
00147 /*     .. */
00148 /*     .. Intrinsic Functions .. */
00149 /*     .. */
00150 /*     .. Local Scalars .. */
00151 /*     .. */
00152 /*     .. Parameters .. */
00153 /*     .. */
00154 
00155 /*     Test the input parameters. */
00156 
00157     /* Parameter adjustments */
00158     a_dim1 = *lda;
00159     a_offset = 1 + a_dim1;
00160     a -= a_offset;
00161     c_dim1 = *ldc;
00162     c_offset = 1 + c_dim1;
00163     c__ -= c_offset;
00164 
00165     /* Function Body */
00166     if (lsame_(trans, "N")) {
00167         nrowa = *n;
00168     } else {
00169         nrowa = *k;
00170     }
00171     upper = lsame_(uplo, "U");
00172 
00173     info = 0;
00174     if (! upper && ! lsame_(uplo, "L")) {
00175         info = 1;
00176     } else if (! lsame_(trans, "N") && ! lsame_(trans, 
00177             "T")) {
00178         info = 2;
00179     } else if (*n < 0) {
00180         info = 3;
00181     } else if (*k < 0) {
00182         info = 4;
00183     } else if (*lda < max(1,nrowa)) {
00184         info = 7;
00185     } else if (*ldc < max(1,*n)) {
00186         info = 10;
00187     }
00188     if (info != 0) {
00189         xerbla_("CSYRK ", &info);
00190         return 0;
00191     }
00192 
00193 /*     Quick return if possible. */
00194 
00195     if (*n == 0 || (alpha->r == 0.f && alpha->i == 0.f || *k == 0) && (
00196             beta->r == 1.f && beta->i == 0.f)) {
00197         return 0;
00198     }
00199 
00200 /*     And when  alpha.eq.zero. */
00201 
00202     if (alpha->r == 0.f && alpha->i == 0.f) {
00203         if (upper) {
00204             if (beta->r == 0.f && beta->i == 0.f) {
00205                 i__1 = *n;
00206                 for (j = 1; j <= i__1; ++j) {
00207                     i__2 = j;
00208                     for (i__ = 1; i__ <= i__2; ++i__) {
00209                         i__3 = i__ + j * c_dim1;
00210                         c__[i__3].r = 0.f, c__[i__3].i = 0.f;
00211 /* L10: */
00212                     }
00213 /* L20: */
00214                 }
00215             } else {
00216                 i__1 = *n;
00217                 for (j = 1; j <= i__1; ++j) {
00218                     i__2 = j;
00219                     for (i__ = 1; i__ <= i__2; ++i__) {
00220                         i__3 = i__ + j * c_dim1;
00221                         i__4 = i__ + j * c_dim1;
00222                         q__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
00223                                 .i, q__1.i = beta->r * c__[i__4].i + beta->i *
00224                                  c__[i__4].r;
00225                         c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;
00226 /* L30: */
00227                     }
00228 /* L40: */
00229                 }
00230             }
00231         } else {
00232             if (beta->r == 0.f && beta->i == 0.f) {
00233                 i__1 = *n;
00234                 for (j = 1; j <= i__1; ++j) {
00235                     i__2 = *n;
00236                     for (i__ = j; i__ <= i__2; ++i__) {
00237                         i__3 = i__ + j * c_dim1;
00238                         c__[i__3].r = 0.f, c__[i__3].i = 0.f;
00239 /* L50: */
00240                     }
00241 /* L60: */
00242                 }
00243             } else {
00244                 i__1 = *n;
00245                 for (j = 1; j <= i__1; ++j) {
00246                     i__2 = *n;
00247                     for (i__ = j; i__ <= i__2; ++i__) {
00248                         i__3 = i__ + j * c_dim1;
00249                         i__4 = i__ + j * c_dim1;
00250                         q__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
00251                                 .i, q__1.i = beta->r * c__[i__4].i + beta->i *
00252                                  c__[i__4].r;
00253                         c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;
00254 /* L70: */
00255                     }
00256 /* L80: */
00257                 }
00258             }
00259         }
00260         return 0;
00261     }
00262 
00263 /*     Start the operations. */
00264 
00265     if (lsame_(trans, "N")) {
00266 
00267 /*        Form  C := alpha*A*A' + beta*C. */
00268 
00269         if (upper) {
00270             i__1 = *n;
00271             for (j = 1; j <= i__1; ++j) {
00272                 if (beta->r == 0.f && beta->i == 0.f) {
00273                     i__2 = j;
00274                     for (i__ = 1; i__ <= i__2; ++i__) {
00275                         i__3 = i__ + j * c_dim1;
00276                         c__[i__3].r = 0.f, c__[i__3].i = 0.f;
00277 /* L90: */
00278                     }
00279                 } else if (beta->r != 1.f || beta->i != 0.f) {
00280                     i__2 = j;
00281                     for (i__ = 1; i__ <= i__2; ++i__) {
00282                         i__3 = i__ + j * c_dim1;
00283                         i__4 = i__ + j * c_dim1;
00284                         q__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
00285                                 .i, q__1.i = beta->r * c__[i__4].i + beta->i *
00286                                  c__[i__4].r;
00287                         c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;
00288 /* L100: */
00289                     }
00290                 }
00291                 i__2 = *k;
00292                 for (l = 1; l <= i__2; ++l) {
00293                     i__3 = j + l * a_dim1;
00294                     if (a[i__3].r != 0.f || a[i__3].i != 0.f) {
00295                         i__3 = j + l * a_dim1;
00296                         q__1.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i, 
00297                                 q__1.i = alpha->r * a[i__3].i + alpha->i * a[
00298                                 i__3].r;
00299                         temp.r = q__1.r, temp.i = q__1.i;
00300                         i__3 = j;
00301                         for (i__ = 1; i__ <= i__3; ++i__) {
00302                             i__4 = i__ + j * c_dim1;
00303                             i__5 = i__ + j * c_dim1;
00304                             i__6 = i__ + l * a_dim1;
00305                             q__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i, 
00306                                     q__2.i = temp.r * a[i__6].i + temp.i * a[
00307                                     i__6].r;
00308                             q__1.r = c__[i__5].r + q__2.r, q__1.i = c__[i__5]
00309                                     .i + q__2.i;
00310                             c__[i__4].r = q__1.r, c__[i__4].i = q__1.i;
00311 /* L110: */
00312                         }
00313                     }
00314 /* L120: */
00315                 }
00316 /* L130: */
00317             }
00318         } else {
00319             i__1 = *n;
00320             for (j = 1; j <= i__1; ++j) {
00321                 if (beta->r == 0.f && beta->i == 0.f) {
00322                     i__2 = *n;
00323                     for (i__ = j; i__ <= i__2; ++i__) {
00324                         i__3 = i__ + j * c_dim1;
00325                         c__[i__3].r = 0.f, c__[i__3].i = 0.f;
00326 /* L140: */
00327                     }
00328                 } else if (beta->r != 1.f || beta->i != 0.f) {
00329                     i__2 = *n;
00330                     for (i__ = j; i__ <= i__2; ++i__) {
00331                         i__3 = i__ + j * c_dim1;
00332                         i__4 = i__ + j * c_dim1;
00333                         q__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
00334                                 .i, q__1.i = beta->r * c__[i__4].i + beta->i *
00335                                  c__[i__4].r;
00336                         c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;
00337 /* L150: */
00338                     }
00339                 }
00340                 i__2 = *k;
00341                 for (l = 1; l <= i__2; ++l) {
00342                     i__3 = j + l * a_dim1;
00343                     if (a[i__3].r != 0.f || a[i__3].i != 0.f) {
00344                         i__3 = j + l * a_dim1;
00345                         q__1.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i, 
00346                                 q__1.i = alpha->r * a[i__3].i + alpha->i * a[
00347                                 i__3].r;
00348                         temp.r = q__1.r, temp.i = q__1.i;
00349                         i__3 = *n;
00350                         for (i__ = j; i__ <= i__3; ++i__) {
00351                             i__4 = i__ + j * c_dim1;
00352                             i__5 = i__ + j * c_dim1;
00353                             i__6 = i__ + l * a_dim1;
00354                             q__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i, 
00355                                     q__2.i = temp.r * a[i__6].i + temp.i * a[
00356                                     i__6].r;
00357                             q__1.r = c__[i__5].r + q__2.r, q__1.i = c__[i__5]
00358                                     .i + q__2.i;
00359                             c__[i__4].r = q__1.r, c__[i__4].i = q__1.i;
00360 /* L160: */
00361                         }
00362                     }
00363 /* L170: */
00364                 }
00365 /* L180: */
00366             }
00367         }
00368     } else {
00369 
00370 /*        Form  C := alpha*A'*A + beta*C. */
00371 
00372         if (upper) {
00373             i__1 = *n;
00374             for (j = 1; j <= i__1; ++j) {
00375                 i__2 = j;
00376                 for (i__ = 1; i__ <= i__2; ++i__) {
00377                     temp.r = 0.f, temp.i = 0.f;
00378                     i__3 = *k;
00379                     for (l = 1; l <= i__3; ++l) {
00380                         i__4 = l + i__ * a_dim1;
00381                         i__5 = l + j * a_dim1;
00382                         q__2.r = a[i__4].r * a[i__5].r - a[i__4].i * a[i__5]
00383                                 .i, q__2.i = a[i__4].r * a[i__5].i + a[i__4]
00384                                 .i * a[i__5].r;
00385                         q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
00386                         temp.r = q__1.r, temp.i = q__1.i;
00387 /* L190: */
00388                     }
00389                     if (beta->r == 0.f && beta->i == 0.f) {
00390                         i__3 = i__ + j * c_dim1;
00391                         q__1.r = alpha->r * temp.r - alpha->i * temp.i, 
00392                                 q__1.i = alpha->r * temp.i + alpha->i * 
00393                                 temp.r;
00394                         c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;
00395                     } else {
00396                         i__3 = i__ + j * c_dim1;
00397                         q__2.r = alpha->r * temp.r - alpha->i * temp.i, 
00398                                 q__2.i = alpha->r * temp.i + alpha->i * 
00399                                 temp.r;
00400                         i__4 = i__ + j * c_dim1;
00401                         q__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
00402                                 .i, q__3.i = beta->r * c__[i__4].i + beta->i *
00403                                  c__[i__4].r;
00404                         q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;
00405                         c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;
00406                     }
00407 /* L200: */
00408                 }
00409 /* L210: */
00410             }
00411         } else {
00412             i__1 = *n;
00413             for (j = 1; j <= i__1; ++j) {
00414                 i__2 = *n;
00415                 for (i__ = j; i__ <= i__2; ++i__) {
00416                     temp.r = 0.f, temp.i = 0.f;
00417                     i__3 = *k;
00418                     for (l = 1; l <= i__3; ++l) {
00419                         i__4 = l + i__ * a_dim1;
00420                         i__5 = l + j * a_dim1;
00421                         q__2.r = a[i__4].r * a[i__5].r - a[i__4].i * a[i__5]
00422                                 .i, q__2.i = a[i__4].r * a[i__5].i + a[i__4]
00423                                 .i * a[i__5].r;
00424                         q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;
00425                         temp.r = q__1.r, temp.i = q__1.i;
00426 /* L220: */
00427                     }
00428                     if (beta->r == 0.f && beta->i == 0.f) {
00429                         i__3 = i__ + j * c_dim1;
00430                         q__1.r = alpha->r * temp.r - alpha->i * temp.i, 
00431                                 q__1.i = alpha->r * temp.i + alpha->i * 
00432                                 temp.r;
00433                         c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;
00434                     } else {
00435                         i__3 = i__ + j * c_dim1;
00436                         q__2.r = alpha->r * temp.r - alpha->i * temp.i, 
00437                                 q__2.i = alpha->r * temp.i + alpha->i * 
00438                                 temp.r;
00439                         i__4 = i__ + j * c_dim1;
00440                         q__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
00441                                 .i, q__3.i = beta->r * c__[i__4].i + beta->i *
00442                                  c__[i__4].r;
00443                         q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;
00444                         c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;
00445                     }
00446 /* L230: */
00447                 }
00448 /* L240: */
00449             }
00450         }
00451     }
00452 
00453     return 0;
00454 
00455 /*     End of CSYRK . */
00456 
00457 } /* csyrk_ */


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