zher2k.c
Go to the documentation of this file.
00001 /* zher2k.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 zher2k_(char *uplo, char *trans, integer *n, integer *k, 
00017         doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *
00018         b, integer *ldb, doublereal *beta, doublecomplex *c__, integer *ldc)
00019 {
00020     /* System generated locals */
00021     integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, 
00022             i__3, i__4, i__5, i__6, i__7;
00023     doublereal d__1;
00024     doublecomplex z__1, z__2, z__3, z__4, z__5, z__6;
00025 
00026     /* Builtin functions */
00027     void d_cnjg(doublecomplex *, doublecomplex *);
00028 
00029     /* Local variables */
00030     integer i__, j, l, info;
00031     doublecomplex temp1, temp2;
00032     extern logical lsame_(char *, char *);
00033     integer nrowa;
00034     logical upper;
00035     extern /* Subroutine */ int xerbla_(char *, integer *);
00036 
00037 /*     .. Scalar Arguments .. */
00038 /*     .. */
00039 /*     .. Array Arguments .. */
00040 /*     .. */
00041 
00042 /*  Purpose */
00043 /*  ======= */
00044 
00045 /*  ZHER2K  performs one of the hermitian rank 2k operations */
00046 
00047 /*     C := alpha*A*conjg( B' ) + conjg( alpha )*B*conjg( A' ) + beta*C, */
00048 
00049 /*  or */
00050 
00051 /*     C := alpha*conjg( A' )*B + conjg( alpha )*conjg( B' )*A + beta*C, */
00052 
00053 /*  where  alpha and beta  are scalars with  beta  real,  C is an  n by n */
00054 /*  hermitian matrix and  A and B  are  n by k matrices in the first case */
00055 /*  and  k by n  matrices in the second case. */
00056 
00057 /*  Arguments */
00058 /*  ========== */
00059 
00060 /*  UPLO   - CHARACTER*1. */
00061 /*           On  entry,   UPLO  specifies  whether  the  upper  or  lower */
00062 /*           triangular  part  of the  array  C  is to be  referenced  as */
00063 /*           follows: */
00064 
00065 /*              UPLO = 'U' or 'u'   Only the  upper triangular part of  C */
00066 /*                                  is to be referenced. */
00067 
00068 /*              UPLO = 'L' or 'l'   Only the  lower triangular part of  C */
00069 /*                                  is to be referenced. */
00070 
00071 /*           Unchanged on exit. */
00072 
00073 /*  TRANS  - CHARACTER*1. */
00074 /*           On entry,  TRANS  specifies the operation to be performed as */
00075 /*           follows: */
00076 
00077 /*              TRANS = 'N' or 'n'    C := alpha*A*conjg( B' )          + */
00078 /*                                         conjg( alpha )*B*conjg( A' ) + */
00079 /*                                         beta*C. */
00080 
00081 /*              TRANS = 'C' or 'c'    C := alpha*conjg( A' )*B          + */
00082 /*                                         conjg( alpha )*conjg( B' )*A + */
00083 /*                                         beta*C. */
00084 
00085 /*           Unchanged on exit. */
00086 
00087 /*  N      - INTEGER. */
00088 /*           On entry,  N specifies the order of the matrix C.  N must be */
00089 /*           at least zero. */
00090 /*           Unchanged on exit. */
00091 
00092 /*  K      - INTEGER. */
00093 /*           On entry with  TRANS = 'N' or 'n',  K  specifies  the number */
00094 /*           of  columns  of the  matrices  A and B,  and on  entry  with */
00095 /*           TRANS = 'C' or 'c',  K  specifies  the number of rows of the */
00096 /*           matrices  A and B.  K must be at least zero. */
00097 /*           Unchanged on exit. */
00098 
00099 /*  ALPHA  - COMPLEX*16         . */
00100 /*           On entry, ALPHA specifies the scalar alpha. */
00101 /*           Unchanged on exit. */
00102 
00103 /*  A      - COMPLEX*16       array of DIMENSION ( LDA, ka ), where ka is */
00104 /*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise. */
00105 /*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k */
00106 /*           part of the array  A  must contain the matrix  A,  otherwise */
00107 /*           the leading  k by n  part of the array  A  must contain  the */
00108 /*           matrix A. */
00109 /*           Unchanged on exit. */
00110 
00111 /*  LDA    - INTEGER. */
00112 /*           On entry, LDA specifies the first dimension of A as declared */
00113 /*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n' */
00114 /*           then  LDA must be at least  max( 1, n ), otherwise  LDA must */
00115 /*           be at least  max( 1, k ). */
00116 /*           Unchanged on exit. */
00117 
00118 /*  B      - COMPLEX*16       array of DIMENSION ( LDB, kb ), where kb is */
00119 /*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise. */
00120 /*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k */
00121 /*           part of the array  B  must contain the matrix  B,  otherwise */
00122 /*           the leading  k by n  part of the array  B  must contain  the */
00123 /*           matrix B. */
00124 /*           Unchanged on exit. */
00125 
00126 /*  LDB    - INTEGER. */
00127 /*           On entry, LDB specifies the first dimension of B as declared */
00128 /*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n' */
00129 /*           then  LDB must be at least  max( 1, n ), otherwise  LDB must */
00130 /*           be at least  max( 1, k ). */
00131 /*           Unchanged on exit. */
00132 
00133 /*  BETA   - DOUBLE PRECISION            . */
00134 /*           On entry, BETA specifies the scalar beta. */
00135 /*           Unchanged on exit. */
00136 
00137 /*  C      - COMPLEX*16          array of DIMENSION ( LDC, n ). */
00138 /*           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n */
00139 /*           upper triangular part of the array C must contain the upper */
00140 /*           triangular part  of the  hermitian matrix  and the strictly */
00141 /*           lower triangular part of C is not referenced.  On exit, the */
00142 /*           upper triangular part of the array  C is overwritten by the */
00143 /*           upper triangular part of the updated matrix. */
00144 /*           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n */
00145 /*           lower triangular part of the array C must contain the lower */
00146 /*           triangular part  of the  hermitian matrix  and the strictly */
00147 /*           upper triangular part of C is not referenced.  On exit, the */
00148 /*           lower triangular part of the array  C is overwritten by the */
00149 /*           lower triangular part of the updated matrix. */
00150 /*           Note that the imaginary parts of the diagonal elements need */
00151 /*           not be set,  they are assumed to be zero,  and on exit they */
00152 /*           are set to zero. */
00153 
00154 /*  LDC    - INTEGER. */
00155 /*           On entry, LDC specifies the first dimension of C as declared */
00156 /*           in  the  calling  (sub)  program.   LDC  must  be  at  least */
00157 /*           max( 1, n ). */
00158 /*           Unchanged on exit. */
00159 
00160 
00161 /*  Level 3 Blas routine. */
00162 
00163 /*  -- Written on 8-February-1989. */
00164 /*     Jack Dongarra, Argonne National Laboratory. */
00165 /*     Iain Duff, AERE Harwell. */
00166 /*     Jeremy Du Croz, Numerical Algorithms Group Ltd. */
00167 /*     Sven Hammarling, Numerical Algorithms Group Ltd. */
00168 
00169 /*  -- Modified 8-Nov-93 to set C(J,J) to DBLE( C(J,J) ) when BETA = 1. */
00170 /*     Ed Anderson, Cray Research Inc. */
00171 
00172 
00173 /*     .. External Functions .. */
00174 /*     .. */
00175 /*     .. External Subroutines .. */
00176 /*     .. */
00177 /*     .. Intrinsic Functions .. */
00178 /*     .. */
00179 /*     .. Local Scalars .. */
00180 /*     .. */
00181 /*     .. Parameters .. */
00182 /*     .. */
00183 
00184 /*     Test the input parameters. */
00185 
00186     /* Parameter adjustments */
00187     a_dim1 = *lda;
00188     a_offset = 1 + a_dim1;
00189     a -= a_offset;
00190     b_dim1 = *ldb;
00191     b_offset = 1 + b_dim1;
00192     b -= b_offset;
00193     c_dim1 = *ldc;
00194     c_offset = 1 + c_dim1;
00195     c__ -= c_offset;
00196 
00197     /* Function Body */
00198     if (lsame_(trans, "N")) {
00199         nrowa = *n;
00200     } else {
00201         nrowa = *k;
00202     }
00203     upper = lsame_(uplo, "U");
00204 
00205     info = 0;
00206     if (! upper && ! lsame_(uplo, "L")) {
00207         info = 1;
00208     } else if (! lsame_(trans, "N") && ! lsame_(trans, 
00209             "C")) {
00210         info = 2;
00211     } else if (*n < 0) {
00212         info = 3;
00213     } else if (*k < 0) {
00214         info = 4;
00215     } else if (*lda < max(1,nrowa)) {
00216         info = 7;
00217     } else if (*ldb < max(1,nrowa)) {
00218         info = 9;
00219     } else if (*ldc < max(1,*n)) {
00220         info = 12;
00221     }
00222     if (info != 0) {
00223         xerbla_("ZHER2K", &info);
00224         return 0;
00225     }
00226 
00227 /*     Quick return if possible. */
00228 
00229     if (*n == 0 || (alpha->r == 0. && alpha->i == 0. || *k == 0) && *beta == 
00230             1.) {
00231         return 0;
00232     }
00233 
00234 /*     And when  alpha.eq.zero. */
00235 
00236     if (alpha->r == 0. && alpha->i == 0.) {
00237         if (upper) {
00238             if (*beta == 0.) {
00239                 i__1 = *n;
00240                 for (j = 1; j <= i__1; ++j) {
00241                     i__2 = j;
00242                     for (i__ = 1; i__ <= i__2; ++i__) {
00243                         i__3 = i__ + j * c_dim1;
00244                         c__[i__3].r = 0., c__[i__3].i = 0.;
00245 /* L10: */
00246                     }
00247 /* L20: */
00248                 }
00249             } else {
00250                 i__1 = *n;
00251                 for (j = 1; j <= i__1; ++j) {
00252                     i__2 = j - 1;
00253                     for (i__ = 1; i__ <= i__2; ++i__) {
00254                         i__3 = i__ + j * c_dim1;
00255                         i__4 = i__ + j * c_dim1;
00256                         z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
00257                                 i__4].i;
00258                         c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
00259 /* L30: */
00260                     }
00261                     i__2 = j + j * c_dim1;
00262                     i__3 = j + j * c_dim1;
00263                     d__1 = *beta * c__[i__3].r;
00264                     c__[i__2].r = d__1, c__[i__2].i = 0.;
00265 /* L40: */
00266                 }
00267             }
00268         } else {
00269             if (*beta == 0.) {
00270                 i__1 = *n;
00271                 for (j = 1; j <= i__1; ++j) {
00272                     i__2 = *n;
00273                     for (i__ = j; i__ <= i__2; ++i__) {
00274                         i__3 = i__ + j * c_dim1;
00275                         c__[i__3].r = 0., c__[i__3].i = 0.;
00276 /* L50: */
00277                     }
00278 /* L60: */
00279                 }
00280             } else {
00281                 i__1 = *n;
00282                 for (j = 1; j <= i__1; ++j) {
00283                     i__2 = j + j * c_dim1;
00284                     i__3 = j + j * c_dim1;
00285                     d__1 = *beta * c__[i__3].r;
00286                     c__[i__2].r = d__1, c__[i__2].i = 0.;
00287                     i__2 = *n;
00288                     for (i__ = j + 1; i__ <= i__2; ++i__) {
00289                         i__3 = i__ + j * c_dim1;
00290                         i__4 = i__ + j * c_dim1;
00291                         z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
00292                                 i__4].i;
00293                         c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
00294 /* L70: */
00295                     }
00296 /* L80: */
00297                 }
00298             }
00299         }
00300         return 0;
00301     }
00302 
00303 /*     Start the operations. */
00304 
00305     if (lsame_(trans, "N")) {
00306 
00307 /*        Form  C := alpha*A*conjg( B' ) + conjg( alpha )*B*conjg( A' ) + */
00308 /*                   C. */
00309 
00310         if (upper) {
00311             i__1 = *n;
00312             for (j = 1; j <= i__1; ++j) {
00313                 if (*beta == 0.) {
00314                     i__2 = j;
00315                     for (i__ = 1; i__ <= i__2; ++i__) {
00316                         i__3 = i__ + j * c_dim1;
00317                         c__[i__3].r = 0., c__[i__3].i = 0.;
00318 /* L90: */
00319                     }
00320                 } else if (*beta != 1.) {
00321                     i__2 = j - 1;
00322                     for (i__ = 1; i__ <= i__2; ++i__) {
00323                         i__3 = i__ + j * c_dim1;
00324                         i__4 = i__ + j * c_dim1;
00325                         z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
00326                                 i__4].i;
00327                         c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
00328 /* L100: */
00329                     }
00330                     i__2 = j + j * c_dim1;
00331                     i__3 = j + j * c_dim1;
00332                     d__1 = *beta * c__[i__3].r;
00333                     c__[i__2].r = d__1, c__[i__2].i = 0.;
00334                 } else {
00335                     i__2 = j + j * c_dim1;
00336                     i__3 = j + j * c_dim1;
00337                     d__1 = c__[i__3].r;
00338                     c__[i__2].r = d__1, c__[i__2].i = 0.;
00339                 }
00340                 i__2 = *k;
00341                 for (l = 1; l <= i__2; ++l) {
00342                     i__3 = j + l * a_dim1;
00343                     i__4 = j + l * b_dim1;
00344                     if (a[i__3].r != 0. || a[i__3].i != 0. || (b[i__4].r != 
00345                             0. || b[i__4].i != 0.)) {
00346                         d_cnjg(&z__2, &b[j + l * b_dim1]);
00347                         z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, 
00348                                 z__1.i = alpha->r * z__2.i + alpha->i * 
00349                                 z__2.r;
00350                         temp1.r = z__1.r, temp1.i = z__1.i;
00351                         i__3 = j + l * a_dim1;
00352                         z__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i, 
00353                                 z__2.i = alpha->r * a[i__3].i + alpha->i * a[
00354                                 i__3].r;
00355                         d_cnjg(&z__1, &z__2);
00356                         temp2.r = z__1.r, temp2.i = z__1.i;
00357                         i__3 = j - 1;
00358                         for (i__ = 1; i__ <= i__3; ++i__) {
00359                             i__4 = i__ + j * c_dim1;
00360                             i__5 = i__ + j * c_dim1;
00361                             i__6 = i__ + l * a_dim1;
00362                             z__3.r = a[i__6].r * temp1.r - a[i__6].i * 
00363                                     temp1.i, z__3.i = a[i__6].r * temp1.i + a[
00364                                     i__6].i * temp1.r;
00365                             z__2.r = c__[i__5].r + z__3.r, z__2.i = c__[i__5]
00366                                     .i + z__3.i;
00367                             i__7 = i__ + l * b_dim1;
00368                             z__4.r = b[i__7].r * temp2.r - b[i__7].i * 
00369                                     temp2.i, z__4.i = b[i__7].r * temp2.i + b[
00370                                     i__7].i * temp2.r;
00371                             z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + 
00372                                     z__4.i;
00373                             c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
00374 /* L110: */
00375                         }
00376                         i__3 = j + j * c_dim1;
00377                         i__4 = j + j * c_dim1;
00378                         i__5 = j + l * a_dim1;
00379                         z__2.r = a[i__5].r * temp1.r - a[i__5].i * temp1.i, 
00380                                 z__2.i = a[i__5].r * temp1.i + a[i__5].i * 
00381                                 temp1.r;
00382                         i__6 = j + l * b_dim1;
00383                         z__3.r = b[i__6].r * temp2.r - b[i__6].i * temp2.i, 
00384                                 z__3.i = b[i__6].r * temp2.i + b[i__6].i * 
00385                                 temp2.r;
00386                         z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
00387                         d__1 = c__[i__4].r + z__1.r;
00388                         c__[i__3].r = d__1, c__[i__3].i = 0.;
00389                     }
00390 /* L120: */
00391                 }
00392 /* L130: */
00393             }
00394         } else {
00395             i__1 = *n;
00396             for (j = 1; j <= i__1; ++j) {
00397                 if (*beta == 0.) {
00398                     i__2 = *n;
00399                     for (i__ = j; i__ <= i__2; ++i__) {
00400                         i__3 = i__ + j * c_dim1;
00401                         c__[i__3].r = 0., c__[i__3].i = 0.;
00402 /* L140: */
00403                     }
00404                 } else if (*beta != 1.) {
00405                     i__2 = *n;
00406                     for (i__ = j + 1; i__ <= i__2; ++i__) {
00407                         i__3 = i__ + j * c_dim1;
00408                         i__4 = i__ + j * c_dim1;
00409                         z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
00410                                 i__4].i;
00411                         c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
00412 /* L150: */
00413                     }
00414                     i__2 = j + j * c_dim1;
00415                     i__3 = j + j * c_dim1;
00416                     d__1 = *beta * c__[i__3].r;
00417                     c__[i__2].r = d__1, c__[i__2].i = 0.;
00418                 } else {
00419                     i__2 = j + j * c_dim1;
00420                     i__3 = j + j * c_dim1;
00421                     d__1 = c__[i__3].r;
00422                     c__[i__2].r = d__1, c__[i__2].i = 0.;
00423                 }
00424                 i__2 = *k;
00425                 for (l = 1; l <= i__2; ++l) {
00426                     i__3 = j + l * a_dim1;
00427                     i__4 = j + l * b_dim1;
00428                     if (a[i__3].r != 0. || a[i__3].i != 0. || (b[i__4].r != 
00429                             0. || b[i__4].i != 0.)) {
00430                         d_cnjg(&z__2, &b[j + l * b_dim1]);
00431                         z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, 
00432                                 z__1.i = alpha->r * z__2.i + alpha->i * 
00433                                 z__2.r;
00434                         temp1.r = z__1.r, temp1.i = z__1.i;
00435                         i__3 = j + l * a_dim1;
00436                         z__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i, 
00437                                 z__2.i = alpha->r * a[i__3].i + alpha->i * a[
00438                                 i__3].r;
00439                         d_cnjg(&z__1, &z__2);
00440                         temp2.r = z__1.r, temp2.i = z__1.i;
00441                         i__3 = *n;
00442                         for (i__ = j + 1; i__ <= i__3; ++i__) {
00443                             i__4 = i__ + j * c_dim1;
00444                             i__5 = i__ + j * c_dim1;
00445                             i__6 = i__ + l * a_dim1;
00446                             z__3.r = a[i__6].r * temp1.r - a[i__6].i * 
00447                                     temp1.i, z__3.i = a[i__6].r * temp1.i + a[
00448                                     i__6].i * temp1.r;
00449                             z__2.r = c__[i__5].r + z__3.r, z__2.i = c__[i__5]
00450                                     .i + z__3.i;
00451                             i__7 = i__ + l * b_dim1;
00452                             z__4.r = b[i__7].r * temp2.r - b[i__7].i * 
00453                                     temp2.i, z__4.i = b[i__7].r * temp2.i + b[
00454                                     i__7].i * temp2.r;
00455                             z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + 
00456                                     z__4.i;
00457                             c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
00458 /* L160: */
00459                         }
00460                         i__3 = j + j * c_dim1;
00461                         i__4 = j + j * c_dim1;
00462                         i__5 = j + l * a_dim1;
00463                         z__2.r = a[i__5].r * temp1.r - a[i__5].i * temp1.i, 
00464                                 z__2.i = a[i__5].r * temp1.i + a[i__5].i * 
00465                                 temp1.r;
00466                         i__6 = j + l * b_dim1;
00467                         z__3.r = b[i__6].r * temp2.r - b[i__6].i * temp2.i, 
00468                                 z__3.i = b[i__6].r * temp2.i + b[i__6].i * 
00469                                 temp2.r;
00470                         z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
00471                         d__1 = c__[i__4].r + z__1.r;
00472                         c__[i__3].r = d__1, c__[i__3].i = 0.;
00473                     }
00474 /* L170: */
00475                 }
00476 /* L180: */
00477             }
00478         }
00479     } else {
00480 
00481 /*        Form  C := alpha*conjg( A' )*B + conjg( alpha )*conjg( B' )*A + */
00482 /*                   C. */
00483 
00484         if (upper) {
00485             i__1 = *n;
00486             for (j = 1; j <= i__1; ++j) {
00487                 i__2 = j;
00488                 for (i__ = 1; i__ <= i__2; ++i__) {
00489                     temp1.r = 0., temp1.i = 0.;
00490                     temp2.r = 0., temp2.i = 0.;
00491                     i__3 = *k;
00492                     for (l = 1; l <= i__3; ++l) {
00493                         d_cnjg(&z__3, &a[l + i__ * a_dim1]);
00494                         i__4 = l + j * b_dim1;
00495                         z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i, 
00496                                 z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
00497                                 .r;
00498                         z__1.r = temp1.r + z__2.r, z__1.i = temp1.i + z__2.i;
00499                         temp1.r = z__1.r, temp1.i = z__1.i;
00500                         d_cnjg(&z__3, &b[l + i__ * b_dim1]);
00501                         i__4 = l + j * a_dim1;
00502                         z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i, 
00503                                 z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
00504                                 .r;
00505                         z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
00506                         temp2.r = z__1.r, temp2.i = z__1.i;
00507 /* L190: */
00508                     }
00509                     if (i__ == j) {
00510                         if (*beta == 0.) {
00511                             i__3 = j + j * c_dim1;
00512                             z__2.r = alpha->r * temp1.r - alpha->i * temp1.i, 
00513                                     z__2.i = alpha->r * temp1.i + alpha->i * 
00514                                     temp1.r;
00515                             d_cnjg(&z__4, alpha);
00516                             z__3.r = z__4.r * temp2.r - z__4.i * temp2.i, 
00517                                     z__3.i = z__4.r * temp2.i + z__4.i * 
00518                                     temp2.r;
00519                             z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
00520                                     z__3.i;
00521                             d__1 = z__1.r;
00522                             c__[i__3].r = d__1, c__[i__3].i = 0.;
00523                         } else {
00524                             i__3 = j + j * c_dim1;
00525                             i__4 = j + j * c_dim1;
00526                             z__2.r = alpha->r * temp1.r - alpha->i * temp1.i, 
00527                                     z__2.i = alpha->r * temp1.i + alpha->i * 
00528                                     temp1.r;
00529                             d_cnjg(&z__4, alpha);
00530                             z__3.r = z__4.r * temp2.r - z__4.i * temp2.i, 
00531                                     z__3.i = z__4.r * temp2.i + z__4.i * 
00532                                     temp2.r;
00533                             z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
00534                                     z__3.i;
00535                             d__1 = *beta * c__[i__4].r + z__1.r;
00536                             c__[i__3].r = d__1, c__[i__3].i = 0.;
00537                         }
00538                     } else {
00539                         if (*beta == 0.) {
00540                             i__3 = i__ + j * c_dim1;
00541                             z__2.r = alpha->r * temp1.r - alpha->i * temp1.i, 
00542                                     z__2.i = alpha->r * temp1.i + alpha->i * 
00543                                     temp1.r;
00544                             d_cnjg(&z__4, alpha);
00545                             z__3.r = z__4.r * temp2.r - z__4.i * temp2.i, 
00546                                     z__3.i = z__4.r * temp2.i + z__4.i * 
00547                                     temp2.r;
00548                             z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
00549                                     z__3.i;
00550                             c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
00551                         } else {
00552                             i__3 = i__ + j * c_dim1;
00553                             i__4 = i__ + j * c_dim1;
00554                             z__3.r = *beta * c__[i__4].r, z__3.i = *beta * 
00555                                     c__[i__4].i;
00556                             z__4.r = alpha->r * temp1.r - alpha->i * temp1.i, 
00557                                     z__4.i = alpha->r * temp1.i + alpha->i * 
00558                                     temp1.r;
00559                             z__2.r = z__3.r + z__4.r, z__2.i = z__3.i + 
00560                                     z__4.i;
00561                             d_cnjg(&z__6, alpha);
00562                             z__5.r = z__6.r * temp2.r - z__6.i * temp2.i, 
00563                                     z__5.i = z__6.r * temp2.i + z__6.i * 
00564                                     temp2.r;
00565                             z__1.r = z__2.r + z__5.r, z__1.i = z__2.i + 
00566                                     z__5.i;
00567                             c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
00568                         }
00569                     }
00570 /* L200: */
00571                 }
00572 /* L210: */
00573             }
00574         } else {
00575             i__1 = *n;
00576             for (j = 1; j <= i__1; ++j) {
00577                 i__2 = *n;
00578                 for (i__ = j; i__ <= i__2; ++i__) {
00579                     temp1.r = 0., temp1.i = 0.;
00580                     temp2.r = 0., temp2.i = 0.;
00581                     i__3 = *k;
00582                     for (l = 1; l <= i__3; ++l) {
00583                         d_cnjg(&z__3, &a[l + i__ * a_dim1]);
00584                         i__4 = l + j * b_dim1;
00585                         z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i, 
00586                                 z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
00587                                 .r;
00588                         z__1.r = temp1.r + z__2.r, z__1.i = temp1.i + z__2.i;
00589                         temp1.r = z__1.r, temp1.i = z__1.i;
00590                         d_cnjg(&z__3, &b[l + i__ * b_dim1]);
00591                         i__4 = l + j * a_dim1;
00592                         z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i, 
00593                                 z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
00594                                 .r;
00595                         z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
00596                         temp2.r = z__1.r, temp2.i = z__1.i;
00597 /* L220: */
00598                     }
00599                     if (i__ == j) {
00600                         if (*beta == 0.) {
00601                             i__3 = j + j * c_dim1;
00602                             z__2.r = alpha->r * temp1.r - alpha->i * temp1.i, 
00603                                     z__2.i = alpha->r * temp1.i + alpha->i * 
00604                                     temp1.r;
00605                             d_cnjg(&z__4, alpha);
00606                             z__3.r = z__4.r * temp2.r - z__4.i * temp2.i, 
00607                                     z__3.i = z__4.r * temp2.i + z__4.i * 
00608                                     temp2.r;
00609                             z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
00610                                     z__3.i;
00611                             d__1 = z__1.r;
00612                             c__[i__3].r = d__1, c__[i__3].i = 0.;
00613                         } else {
00614                             i__3 = j + j * c_dim1;
00615                             i__4 = j + j * c_dim1;
00616                             z__2.r = alpha->r * temp1.r - alpha->i * temp1.i, 
00617                                     z__2.i = alpha->r * temp1.i + alpha->i * 
00618                                     temp1.r;
00619                             d_cnjg(&z__4, alpha);
00620                             z__3.r = z__4.r * temp2.r - z__4.i * temp2.i, 
00621                                     z__3.i = z__4.r * temp2.i + z__4.i * 
00622                                     temp2.r;
00623                             z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
00624                                     z__3.i;
00625                             d__1 = *beta * c__[i__4].r + z__1.r;
00626                             c__[i__3].r = d__1, c__[i__3].i = 0.;
00627                         }
00628                     } else {
00629                         if (*beta == 0.) {
00630                             i__3 = i__ + j * c_dim1;
00631                             z__2.r = alpha->r * temp1.r - alpha->i * temp1.i, 
00632                                     z__2.i = alpha->r * temp1.i + alpha->i * 
00633                                     temp1.r;
00634                             d_cnjg(&z__4, alpha);
00635                             z__3.r = z__4.r * temp2.r - z__4.i * temp2.i, 
00636                                     z__3.i = z__4.r * temp2.i + z__4.i * 
00637                                     temp2.r;
00638                             z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
00639                                     z__3.i;
00640                             c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
00641                         } else {
00642                             i__3 = i__ + j * c_dim1;
00643                             i__4 = i__ + j * c_dim1;
00644                             z__3.r = *beta * c__[i__4].r, z__3.i = *beta * 
00645                                     c__[i__4].i;
00646                             z__4.r = alpha->r * temp1.r - alpha->i * temp1.i, 
00647                                     z__4.i = alpha->r * temp1.i + alpha->i * 
00648                                     temp1.r;
00649                             z__2.r = z__3.r + z__4.r, z__2.i = z__3.i + 
00650                                     z__4.i;
00651                             d_cnjg(&z__6, alpha);
00652                             z__5.r = z__6.r * temp2.r - z__6.i * temp2.i, 
00653                                     z__5.i = z__6.r * temp2.i + z__6.i * 
00654                                     temp2.r;
00655                             z__1.r = z__2.r + z__5.r, z__1.i = z__2.i + 
00656                                     z__5.i;
00657                             c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
00658                         }
00659                     }
00660 /* L230: */
00661                 }
00662 /* L240: */
00663             }
00664         }
00665     }
00666 
00667     return 0;
00668 
00669 /*     End of ZHER2K. */
00670 
00671 } /* zher2k_ */


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