clatm5.c
Go to the documentation of this file.
00001 /* clatm5.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 /* Table of constant values */
00017 
00018 static complex c_b1 = {1.f,0.f};
00019 static complex c_b3 = {0.f,0.f};
00020 static complex c_b5 = {20.f,0.f};
00021 
00022 /* Subroutine */ int clatm5_(integer *prtype, integer *m, integer *n, complex 
00023         *a, integer *lda, complex *b, integer *ldb, complex *c__, integer *
00024         ldc, complex *d__, integer *ldd, complex *e, integer *lde, complex *f, 
00025          integer *ldf, complex *r__, integer *ldr, complex *l, integer *ldl, 
00026         real *alpha, integer *qblcka, integer *qblckb)
00027 {
00028     /* System generated locals */
00029     integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, d_dim1, 
00030             d_offset, e_dim1, e_offset, f_dim1, f_offset, l_dim1, l_offset, 
00031             r_dim1, r_offset, i__1, i__2, i__3, i__4;
00032     doublereal d__1;
00033     complex q__1, q__2, q__3, q__4, q__5;
00034 
00035     /* Builtin functions */
00036     void c_sin(complex *, complex *), c_div(complex *, complex *, complex *);
00037 
00038     /* Local variables */
00039     integer i__, j, k;
00040     extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, 
00041             integer *, complex *, complex *, integer *, complex *, integer *, 
00042             complex *, complex *, integer *);
00043     complex imeps, reeps;
00044 
00045 
00046 /*  -- LAPACK test routine (version 3.1) -- */
00047 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00048 /*     November 2006 */
00049 
00050 /*     .. Scalar Arguments .. */
00051 /*     .. */
00052 /*     .. Array Arguments .. */
00053 /*     .. */
00054 
00055 /*  Purpose */
00056 /*  ======= */
00057 
00058 /*  CLATM5 generates matrices involved in the Generalized Sylvester */
00059 /*  equation: */
00060 
00061 /*      A * R - L * B = C */
00062 /*      D * R - L * E = F */
00063 
00064 /*  They also satisfy (the diagonalization condition) */
00065 
00066 /*   [ I -L ] ( [ A  -C ], [ D -F ] ) [ I  R ] = ( [ A    ], [ D    ] ) */
00067 /*   [    I ] ( [     B ]  [    E ] ) [    I ]   ( [    B ]  [    E ] ) */
00068 
00069 
00070 /*  Arguments */
00071 /*  ========= */
00072 
00073 /*  PRTYPE  (input) INTEGER */
00074 /*          "Points" to a certian type of the matrices to generate */
00075 /*          (see futher details). */
00076 
00077 /*  M       (input) INTEGER */
00078 /*          Specifies the order of A and D and the number of rows in */
00079 /*          C, F,  R and L. */
00080 
00081 /*  N       (input) INTEGER */
00082 /*          Specifies the order of B and E and the number of columns in */
00083 /*          C, F, R and L. */
00084 
00085 /*  A       (output) COMPLEX array, dimension (LDA, M). */
00086 /*          On exit A M-by-M is initialized according to PRTYPE. */
00087 
00088 /*  LDA     (input) INTEGER */
00089 /*          The leading dimension of A. */
00090 
00091 /*  B       (output) COMPLEX array, dimension (LDB, N). */
00092 /*          On exit B N-by-N is initialized according to PRTYPE. */
00093 
00094 /*  LDB     (input) INTEGER */
00095 /*          The leading dimension of B. */
00096 
00097 /*  C       (output) COMPLEX array, dimension (LDC, N). */
00098 /*          On exit C M-by-N is initialized according to PRTYPE. */
00099 
00100 /*  LDC     (input) INTEGER */
00101 /*          The leading dimension of C. */
00102 
00103 /*  D       (output) COMPLEX array, dimension (LDD, M). */
00104 /*          On exit D M-by-M is initialized according to PRTYPE. */
00105 
00106 /*  LDD     (input) INTEGER */
00107 /*          The leading dimension of D. */
00108 
00109 /*  E       (output) COMPLEX array, dimension (LDE, N). */
00110 /*          On exit E N-by-N is initialized according to PRTYPE. */
00111 
00112 /*  LDE     (input) INTEGER */
00113 /*          The leading dimension of E. */
00114 
00115 /*  F       (output) COMPLEX array, dimension (LDF, N). */
00116 /*          On exit F M-by-N is initialized according to PRTYPE. */
00117 
00118 /*  LDF     (input) INTEGER */
00119 /*          The leading dimension of F. */
00120 
00121 /*  R       (output) COMPLEX array, dimension (LDR, N). */
00122 /*          On exit R M-by-N is initialized according to PRTYPE. */
00123 
00124 /*  LDR     (input) INTEGER */
00125 /*          The leading dimension of R. */
00126 
00127 /*  L       (output) COMPLEX array, dimension (LDL, N). */
00128 /*          On exit L M-by-N is initialized according to PRTYPE. */
00129 
00130 /*  LDL     (input) INTEGER */
00131 /*          The leading dimension of L. */
00132 
00133 /*  ALPHA   (input) REAL */
00134 /*          Parameter used in generating PRTYPE = 1 and 5 matrices. */
00135 
00136 /*  QBLCKA  (input) INTEGER */
00137 /*          When PRTYPE = 3, specifies the distance between 2-by-2 */
00138 /*          blocks on the diagonal in A. Otherwise, QBLCKA is not */
00139 /*          referenced. QBLCKA > 1. */
00140 
00141 /*  QBLCKB  (input) INTEGER */
00142 /*          When PRTYPE = 3, specifies the distance between 2-by-2 */
00143 /*          blocks on the diagonal in B. Otherwise, QBLCKB is not */
00144 /*          referenced. QBLCKB > 1. */
00145 
00146 
00147 /*  Further Details */
00148 /*  =============== */
00149 
00150 /*  PRTYPE = 1: A and B are Jordan blocks, D and E are identity matrices */
00151 
00152 /*             A : if (i == j) then A(i, j) = 1.0 */
00153 /*                 if (j == i + 1) then A(i, j) = -1.0 */
00154 /*                 else A(i, j) = 0.0,            i, j = 1...M */
00155 
00156 /*             B : if (i == j) then B(i, j) = 1.0 - ALPHA */
00157 /*                 if (j == i + 1) then B(i, j) = 1.0 */
00158 /*                 else B(i, j) = 0.0,            i, j = 1...N */
00159 
00160 /*             D : if (i == j) then D(i, j) = 1.0 */
00161 /*                 else D(i, j) = 0.0,            i, j = 1...M */
00162 
00163 /*             E : if (i == j) then E(i, j) = 1.0 */
00164 /*                 else E(i, j) = 0.0,            i, j = 1...N */
00165 
00166 /*             L =  R are chosen from [-10...10], */
00167 /*                  which specifies the right hand sides (C, F). */
00168 
00169 /*  PRTYPE = 2 or 3: Triangular and/or quasi- triangular. */
00170 
00171 /*             A : if (i <= j) then A(i, j) = [-1...1] */
00172 /*                 else A(i, j) = 0.0,             i, j = 1...M */
00173 
00174 /*                 if (PRTYPE = 3) then */
00175 /*                    A(k + 1, k + 1) = A(k, k) */
00176 /*                    A(k + 1, k) = [-1...1] */
00177 /*                    sign(A(k, k + 1) = -(sin(A(k + 1, k)) */
00178 /*                        k = 1, M - 1, QBLCKA */
00179 
00180 /*             B : if (i <= j) then B(i, j) = [-1...1] */
00181 /*                 else B(i, j) = 0.0,            i, j = 1...N */
00182 
00183 /*                 if (PRTYPE = 3) then */
00184 /*                    B(k + 1, k + 1) = B(k, k) */
00185 /*                    B(k + 1, k) = [-1...1] */
00186 /*                    sign(B(k, k + 1) = -(sign(B(k + 1, k)) */
00187 /*                        k = 1, N - 1, QBLCKB */
00188 
00189 /*             D : if (i <= j) then D(i, j) = [-1...1]. */
00190 /*                 else D(i, j) = 0.0,            i, j = 1...M */
00191 
00192 
00193 /*             E : if (i <= j) then D(i, j) = [-1...1] */
00194 /*                 else E(i, j) = 0.0,            i, j = 1...N */
00195 
00196 /*                 L, R are chosen from [-10...10], */
00197 /*                 which specifies the right hand sides (C, F). */
00198 
00199 /*  PRTYPE = 4 Full */
00200 /*             A(i, j) = [-10...10] */
00201 /*             D(i, j) = [-1...1]    i,j = 1...M */
00202 /*             B(i, j) = [-10...10] */
00203 /*             E(i, j) = [-1...1]    i,j = 1...N */
00204 /*             R(i, j) = [-10...10] */
00205 /*             L(i, j) = [-1...1]    i = 1..M ,j = 1...N */
00206 
00207 /*             L, R specifies the right hand sides (C, F). */
00208 
00209 /*  PRTYPE = 5 special case common and/or close eigs. */
00210 
00211 /*  ===================================================================== */
00212 
00213 /*     .. Parameters .. */
00214 /*     .. */
00215 /*     .. Local Scalars .. */
00216 /*     .. */
00217 /*     .. Intrinsic Functions .. */
00218 /*     .. */
00219 /*     .. External Subroutines .. */
00220 /*     .. */
00221 /*     .. Executable Statements .. */
00222 
00223     /* Parameter adjustments */
00224     a_dim1 = *lda;
00225     a_offset = 1 + a_dim1;
00226     a -= a_offset;
00227     b_dim1 = *ldb;
00228     b_offset = 1 + b_dim1;
00229     b -= b_offset;
00230     c_dim1 = *ldc;
00231     c_offset = 1 + c_dim1;
00232     c__ -= c_offset;
00233     d_dim1 = *ldd;
00234     d_offset = 1 + d_dim1;
00235     d__ -= d_offset;
00236     e_dim1 = *lde;
00237     e_offset = 1 + e_dim1;
00238     e -= e_offset;
00239     f_dim1 = *ldf;
00240     f_offset = 1 + f_dim1;
00241     f -= f_offset;
00242     r_dim1 = *ldr;
00243     r_offset = 1 + r_dim1;
00244     r__ -= r_offset;
00245     l_dim1 = *ldl;
00246     l_offset = 1 + l_dim1;
00247     l -= l_offset;
00248 
00249     /* Function Body */
00250     if (*prtype == 1) {
00251         i__1 = *m;
00252         for (i__ = 1; i__ <= i__1; ++i__) {
00253             i__2 = *m;
00254             for (j = 1; j <= i__2; ++j) {
00255                 if (i__ == j) {
00256                     i__3 = i__ + j * a_dim1;
00257                     a[i__3].r = 1.f, a[i__3].i = 0.f;
00258                     i__3 = i__ + j * d_dim1;
00259                     d__[i__3].r = 1.f, d__[i__3].i = 0.f;
00260                 } else if (i__ == j - 1) {
00261                     i__3 = i__ + j * a_dim1;
00262                     q__1.r = -1.f, q__1.i = -0.f;
00263                     a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00264                     i__3 = i__ + j * d_dim1;
00265                     d__[i__3].r = 0.f, d__[i__3].i = 0.f;
00266                 } else {
00267                     i__3 = i__ + j * a_dim1;
00268                     a[i__3].r = 0.f, a[i__3].i = 0.f;
00269                     i__3 = i__ + j * d_dim1;
00270                     d__[i__3].r = 0.f, d__[i__3].i = 0.f;
00271                 }
00272 /* L10: */
00273             }
00274 /* L20: */
00275         }
00276 
00277         i__1 = *n;
00278         for (i__ = 1; i__ <= i__1; ++i__) {
00279             i__2 = *n;
00280             for (j = 1; j <= i__2; ++j) {
00281                 if (i__ == j) {
00282                     i__3 = i__ + j * b_dim1;
00283                     q__1.r = 1.f - *alpha, q__1.i = 0.f;
00284                     b[i__3].r = q__1.r, b[i__3].i = q__1.i;
00285                     i__3 = i__ + j * e_dim1;
00286                     e[i__3].r = 1.f, e[i__3].i = 0.f;
00287                 } else if (i__ == j - 1) {
00288                     i__3 = i__ + j * b_dim1;
00289                     b[i__3].r = 1.f, b[i__3].i = 0.f;
00290                     i__3 = i__ + j * e_dim1;
00291                     e[i__3].r = 0.f, e[i__3].i = 0.f;
00292                 } else {
00293                     i__3 = i__ + j * b_dim1;
00294                     b[i__3].r = 0.f, b[i__3].i = 0.f;
00295                     i__3 = i__ + j * e_dim1;
00296                     e[i__3].r = 0.f, e[i__3].i = 0.f;
00297                 }
00298 /* L30: */
00299             }
00300 /* L40: */
00301         }
00302 
00303         i__1 = *m;
00304         for (i__ = 1; i__ <= i__1; ++i__) {
00305             i__2 = *n;
00306             for (j = 1; j <= i__2; ++j) {
00307                 i__3 = i__ + j * r_dim1;
00308                 i__4 = i__ / j;
00309                 q__4.r = (real) i__4, q__4.i = 0.f;
00310                 c_sin(&q__3, &q__4);
00311                 q__2.r = .5f - q__3.r, q__2.i = 0.f - q__3.i;
00312                 q__1.r = q__2.r * 20.f - q__2.i * 0.f, q__1.i = q__2.r * 0.f 
00313                         + q__2.i * 20.f;
00314                 r__[i__3].r = q__1.r, r__[i__3].i = q__1.i;
00315                 i__3 = i__ + j * l_dim1;
00316                 i__4 = i__ + j * r_dim1;
00317                 l[i__3].r = r__[i__4].r, l[i__3].i = r__[i__4].i;
00318 /* L50: */
00319             }
00320 /* L60: */
00321         }
00322 
00323     } else if (*prtype == 2 || *prtype == 3) {
00324         i__1 = *m;
00325         for (i__ = 1; i__ <= i__1; ++i__) {
00326             i__2 = *m;
00327             for (j = 1; j <= i__2; ++j) {
00328                 if (i__ <= j) {
00329                     i__3 = i__ + j * a_dim1;
00330                     q__4.r = (real) i__, q__4.i = 0.f;
00331                     c_sin(&q__3, &q__4);
00332                     q__2.r = .5f - q__3.r, q__2.i = 0.f - q__3.i;
00333                     q__1.r = q__2.r * 2.f - q__2.i * 0.f, q__1.i = q__2.r * 
00334                             0.f + q__2.i * 2.f;
00335                     a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00336                     i__3 = i__ + j * d_dim1;
00337                     i__4 = i__ * j;
00338                     q__4.r = (real) i__4, q__4.i = 0.f;
00339                     c_sin(&q__3, &q__4);
00340                     q__2.r = .5f - q__3.r, q__2.i = 0.f - q__3.i;
00341                     q__1.r = q__2.r * 2.f - q__2.i * 0.f, q__1.i = q__2.r * 
00342                             0.f + q__2.i * 2.f;
00343                     d__[i__3].r = q__1.r, d__[i__3].i = q__1.i;
00344                 } else {
00345                     i__3 = i__ + j * a_dim1;
00346                     a[i__3].r = 0.f, a[i__3].i = 0.f;
00347                     i__3 = i__ + j * d_dim1;
00348                     d__[i__3].r = 0.f, d__[i__3].i = 0.f;
00349                 }
00350 /* L70: */
00351             }
00352 /* L80: */
00353         }
00354 
00355         i__1 = *n;
00356         for (i__ = 1; i__ <= i__1; ++i__) {
00357             i__2 = *n;
00358             for (j = 1; j <= i__2; ++j) {
00359                 if (i__ <= j) {
00360                     i__3 = i__ + j * b_dim1;
00361                     i__4 = i__ + j;
00362                     q__4.r = (real) i__4, q__4.i = 0.f;
00363                     c_sin(&q__3, &q__4);
00364                     q__2.r = .5f - q__3.r, q__2.i = 0.f - q__3.i;
00365                     q__1.r = q__2.r * 2.f - q__2.i * 0.f, q__1.i = q__2.r * 
00366                             0.f + q__2.i * 2.f;
00367                     b[i__3].r = q__1.r, b[i__3].i = q__1.i;
00368                     i__3 = i__ + j * e_dim1;
00369                     q__4.r = (real) j, q__4.i = 0.f;
00370                     c_sin(&q__3, &q__4);
00371                     q__2.r = .5f - q__3.r, q__2.i = 0.f - q__3.i;
00372                     q__1.r = q__2.r * 2.f - q__2.i * 0.f, q__1.i = q__2.r * 
00373                             0.f + q__2.i * 2.f;
00374                     e[i__3].r = q__1.r, e[i__3].i = q__1.i;
00375                 } else {
00376                     i__3 = i__ + j * b_dim1;
00377                     b[i__3].r = 0.f, b[i__3].i = 0.f;
00378                     i__3 = i__ + j * e_dim1;
00379                     e[i__3].r = 0.f, e[i__3].i = 0.f;
00380                 }
00381 /* L90: */
00382             }
00383 /* L100: */
00384         }
00385 
00386         i__1 = *m;
00387         for (i__ = 1; i__ <= i__1; ++i__) {
00388             i__2 = *n;
00389             for (j = 1; j <= i__2; ++j) {
00390                 i__3 = i__ + j * r_dim1;
00391                 i__4 = i__ * j;
00392                 q__4.r = (real) i__4, q__4.i = 0.f;
00393                 c_sin(&q__3, &q__4);
00394                 q__2.r = .5f - q__3.r, q__2.i = 0.f - q__3.i;
00395                 q__1.r = q__2.r * 20.f - q__2.i * 0.f, q__1.i = q__2.r * 0.f 
00396                         + q__2.i * 20.f;
00397                 r__[i__3].r = q__1.r, r__[i__3].i = q__1.i;
00398                 i__3 = i__ + j * l_dim1;
00399                 i__4 = i__ + j;
00400                 q__4.r = (real) i__4, q__4.i = 0.f;
00401                 c_sin(&q__3, &q__4);
00402                 q__2.r = .5f - q__3.r, q__2.i = 0.f - q__3.i;
00403                 q__1.r = q__2.r * 20.f - q__2.i * 0.f, q__1.i = q__2.r * 0.f 
00404                         + q__2.i * 20.f;
00405                 l[i__3].r = q__1.r, l[i__3].i = q__1.i;
00406 /* L110: */
00407             }
00408 /* L120: */
00409         }
00410 
00411         if (*prtype == 3) {
00412             if (*qblcka <= 1) {
00413                 *qblcka = 2;
00414             }
00415             i__1 = *m - 1;
00416             i__2 = *qblcka;
00417             for (k = 1; i__2 < 0 ? k >= i__1 : k <= i__1; k += i__2) {
00418                 i__3 = k + 1 + (k + 1) * a_dim1;
00419                 i__4 = k + k * a_dim1;
00420                 a[i__3].r = a[i__4].r, a[i__3].i = a[i__4].i;
00421                 i__3 = k + 1 + k * a_dim1;
00422                 c_sin(&q__2, &a[k + (k + 1) * a_dim1]);
00423                 q__1.r = -q__2.r, q__1.i = -q__2.i;
00424                 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00425 /* L130: */
00426             }
00427 
00428             if (*qblckb <= 1) {
00429                 *qblckb = 2;
00430             }
00431             i__2 = *n - 1;
00432             i__1 = *qblckb;
00433             for (k = 1; i__1 < 0 ? k >= i__2 : k <= i__2; k += i__1) {
00434                 i__3 = k + 1 + (k + 1) * b_dim1;
00435                 i__4 = k + k * b_dim1;
00436                 b[i__3].r = b[i__4].r, b[i__3].i = b[i__4].i;
00437                 i__3 = k + 1 + k * b_dim1;
00438                 c_sin(&q__2, &b[k + (k + 1) * b_dim1]);
00439                 q__1.r = -q__2.r, q__1.i = -q__2.i;
00440                 b[i__3].r = q__1.r, b[i__3].i = q__1.i;
00441 /* L140: */
00442             }
00443         }
00444 
00445     } else if (*prtype == 4) {
00446         i__1 = *m;
00447         for (i__ = 1; i__ <= i__1; ++i__) {
00448             i__2 = *m;
00449             for (j = 1; j <= i__2; ++j) {
00450                 i__3 = i__ + j * a_dim1;
00451                 i__4 = i__ * j;
00452                 q__4.r = (real) i__4, q__4.i = 0.f;
00453                 c_sin(&q__3, &q__4);
00454                 q__2.r = .5f - q__3.r, q__2.i = 0.f - q__3.i;
00455                 q__1.r = q__2.r * 20.f - q__2.i * 0.f, q__1.i = q__2.r * 0.f 
00456                         + q__2.i * 20.f;
00457                 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00458                 i__3 = i__ + j * d_dim1;
00459                 i__4 = i__ + j;
00460                 q__4.r = (real) i__4, q__4.i = 0.f;
00461                 c_sin(&q__3, &q__4);
00462                 q__2.r = .5f - q__3.r, q__2.i = 0.f - q__3.i;
00463                 q__1.r = q__2.r * 2.f - q__2.i * 0.f, q__1.i = q__2.r * 0.f + 
00464                         q__2.i * 2.f;
00465                 d__[i__3].r = q__1.r, d__[i__3].i = q__1.i;
00466 /* L150: */
00467             }
00468 /* L160: */
00469         }
00470 
00471         i__1 = *n;
00472         for (i__ = 1; i__ <= i__1; ++i__) {
00473             i__2 = *n;
00474             for (j = 1; j <= i__2; ++j) {
00475                 i__3 = i__ + j * b_dim1;
00476                 i__4 = i__ + j;
00477                 q__4.r = (real) i__4, q__4.i = 0.f;
00478                 c_sin(&q__3, &q__4);
00479                 q__2.r = .5f - q__3.r, q__2.i = 0.f - q__3.i;
00480                 q__1.r = q__2.r * 20.f - q__2.i * 0.f, q__1.i = q__2.r * 0.f 
00481                         + q__2.i * 20.f;
00482                 b[i__3].r = q__1.r, b[i__3].i = q__1.i;
00483                 i__3 = i__ + j * e_dim1;
00484                 i__4 = i__ * j;
00485                 q__4.r = (real) i__4, q__4.i = 0.f;
00486                 c_sin(&q__3, &q__4);
00487                 q__2.r = .5f - q__3.r, q__2.i = 0.f - q__3.i;
00488                 q__1.r = q__2.r * 2.f - q__2.i * 0.f, q__1.i = q__2.r * 0.f + 
00489                         q__2.i * 2.f;
00490                 e[i__3].r = q__1.r, e[i__3].i = q__1.i;
00491 /* L170: */
00492             }
00493 /* L180: */
00494         }
00495 
00496         i__1 = *m;
00497         for (i__ = 1; i__ <= i__1; ++i__) {
00498             i__2 = *n;
00499             for (j = 1; j <= i__2; ++j) {
00500                 i__3 = i__ + j * r_dim1;
00501                 i__4 = j / i__;
00502                 q__4.r = (real) i__4, q__4.i = 0.f;
00503                 c_sin(&q__3, &q__4);
00504                 q__2.r = .5f - q__3.r, q__2.i = 0.f - q__3.i;
00505                 q__1.r = q__2.r * 20.f - q__2.i * 0.f, q__1.i = q__2.r * 0.f 
00506                         + q__2.i * 20.f;
00507                 r__[i__3].r = q__1.r, r__[i__3].i = q__1.i;
00508                 i__3 = i__ + j * l_dim1;
00509                 i__4 = i__ * j;
00510                 q__4.r = (real) i__4, q__4.i = 0.f;
00511                 c_sin(&q__3, &q__4);
00512                 q__2.r = .5f - q__3.r, q__2.i = 0.f - q__3.i;
00513                 q__1.r = q__2.r * 2.f - q__2.i * 0.f, q__1.i = q__2.r * 0.f + 
00514                         q__2.i * 2.f;
00515                 l[i__3].r = q__1.r, l[i__3].i = q__1.i;
00516 /* L190: */
00517             }
00518 /* L200: */
00519         }
00520 
00521     } else if (*prtype >= 5) {
00522         q__3.r = 1.f, q__3.i = 0.f;
00523         q__2.r = q__3.r * 20.f - q__3.i * 0.f, q__2.i = q__3.r * 0.f + q__3.i 
00524                 * 20.f;
00525         q__1.r = q__2.r / *alpha, q__1.i = q__2.i / *alpha;
00526         reeps.r = q__1.r, reeps.i = q__1.i;
00527         q__2.r = -1.5f, q__2.i = 0.f;
00528         q__1.r = q__2.r / *alpha, q__1.i = q__2.i / *alpha;
00529         imeps.r = q__1.r, imeps.i = q__1.i;
00530         i__1 = *m;
00531         for (i__ = 1; i__ <= i__1; ++i__) {
00532             i__2 = *n;
00533             for (j = 1; j <= i__2; ++j) {
00534                 i__3 = i__ + j * r_dim1;
00535                 i__4 = i__ * j;
00536                 q__5.r = (real) i__4, q__5.i = 0.f;
00537                 c_sin(&q__4, &q__5);
00538                 q__3.r = .5f - q__4.r, q__3.i = 0.f - q__4.i;
00539                 q__2.r = *alpha * q__3.r, q__2.i = *alpha * q__3.i;
00540                 c_div(&q__1, &q__2, &c_b5);
00541                 r__[i__3].r = q__1.r, r__[i__3].i = q__1.i;
00542                 i__3 = i__ + j * l_dim1;
00543                 i__4 = i__ + j;
00544                 q__5.r = (real) i__4, q__5.i = 0.f;
00545                 c_sin(&q__4, &q__5);
00546                 q__3.r = .5f - q__4.r, q__3.i = 0.f - q__4.i;
00547                 q__2.r = *alpha * q__3.r, q__2.i = *alpha * q__3.i;
00548                 c_div(&q__1, &q__2, &c_b5);
00549                 l[i__3].r = q__1.r, l[i__3].i = q__1.i;
00550 /* L210: */
00551             }
00552 /* L220: */
00553         }
00554 
00555         i__1 = *m;
00556         for (i__ = 1; i__ <= i__1; ++i__) {
00557             i__2 = i__ + i__ * d_dim1;
00558             d__[i__2].r = 1.f, d__[i__2].i = 0.f;
00559 /* L230: */
00560         }
00561 
00562         i__1 = *m;
00563         for (i__ = 1; i__ <= i__1; ++i__) {
00564             if (i__ <= 4) {
00565                 i__2 = i__ + i__ * a_dim1;
00566                 a[i__2].r = 1.f, a[i__2].i = 0.f;
00567                 if (i__ > 2) {
00568                     i__2 = i__ + i__ * a_dim1;
00569                     q__1.r = reeps.r + 1.f, q__1.i = reeps.i + 0.f;
00570                     a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00571                 }
00572                 if (i__ % 2 != 0 && i__ < *m) {
00573                     i__2 = i__ + (i__ + 1) * a_dim1;
00574                     a[i__2].r = imeps.r, a[i__2].i = imeps.i;
00575                 } else if (i__ > 1) {
00576                     i__2 = i__ + (i__ - 1) * a_dim1;
00577                     q__1.r = -imeps.r, q__1.i = -imeps.i;
00578                     a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00579                 }
00580             } else if (i__ <= 8) {
00581                 if (i__ <= 6) {
00582                     i__2 = i__ + i__ * a_dim1;
00583                     a[i__2].r = reeps.r, a[i__2].i = reeps.i;
00584                 } else {
00585                     i__2 = i__ + i__ * a_dim1;
00586                     q__1.r = -reeps.r, q__1.i = -reeps.i;
00587                     a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00588                 }
00589                 if (i__ % 2 != 0 && i__ < *m) {
00590                     i__2 = i__ + (i__ + 1) * a_dim1;
00591                     a[i__2].r = 1.f, a[i__2].i = 0.f;
00592                 } else if (i__ > 1) {
00593                     i__2 = i__ + (i__ - 1) * a_dim1;
00594                     q__1.r = -1.f, q__1.i = -0.f;
00595                     a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00596                 }
00597             } else {
00598                 i__2 = i__ + i__ * a_dim1;
00599                 a[i__2].r = 1.f, a[i__2].i = 0.f;
00600                 if (i__ % 2 != 0 && i__ < *m) {
00601                     i__2 = i__ + (i__ + 1) * a_dim1;
00602                     d__1 = 2.;
00603                     q__1.r = d__1 * imeps.r, q__1.i = d__1 * imeps.i;
00604                     a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00605                 } else if (i__ > 1) {
00606                     i__2 = i__ + (i__ - 1) * a_dim1;
00607                     q__2.r = -imeps.r, q__2.i = -imeps.i;
00608                     d__1 = 2.;
00609                     q__1.r = d__1 * q__2.r, q__1.i = d__1 * q__2.i;
00610                     a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00611                 }
00612             }
00613 /* L240: */
00614         }
00615 
00616         i__1 = *n;
00617         for (i__ = 1; i__ <= i__1; ++i__) {
00618             i__2 = i__ + i__ * e_dim1;
00619             e[i__2].r = 1.f, e[i__2].i = 0.f;
00620             if (i__ <= 4) {
00621                 i__2 = i__ + i__ * b_dim1;
00622                 q__1.r = -1.f, q__1.i = -0.f;
00623                 b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00624                 if (i__ > 2) {
00625                     i__2 = i__ + i__ * b_dim1;
00626                     q__1.r = 1.f - reeps.r, q__1.i = 0.f - reeps.i;
00627                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00628                 }
00629                 if (i__ % 2 != 0 && i__ < *n) {
00630                     i__2 = i__ + (i__ + 1) * b_dim1;
00631                     b[i__2].r = imeps.r, b[i__2].i = imeps.i;
00632                 } else if (i__ > 1) {
00633                     i__2 = i__ + (i__ - 1) * b_dim1;
00634                     q__1.r = -imeps.r, q__1.i = -imeps.i;
00635                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00636                 }
00637             } else if (i__ <= 8) {
00638                 if (i__ <= 6) {
00639                     i__2 = i__ + i__ * b_dim1;
00640                     b[i__2].r = reeps.r, b[i__2].i = reeps.i;
00641                 } else {
00642                     i__2 = i__ + i__ * b_dim1;
00643                     q__1.r = -reeps.r, q__1.i = -reeps.i;
00644                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00645                 }
00646                 if (i__ % 2 != 0 && i__ < *n) {
00647                     i__2 = i__ + (i__ + 1) * b_dim1;
00648                     q__1.r = imeps.r + 1.f, q__1.i = imeps.i + 0.f;
00649                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00650                 } else if (i__ > 1) {
00651                     i__2 = i__ + (i__ - 1) * b_dim1;
00652                     q__2.r = -1.f, q__2.i = -0.f;
00653                     q__1.r = q__2.r - imeps.r, q__1.i = q__2.i - imeps.i;
00654                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00655                 }
00656             } else {
00657                 i__2 = i__ + i__ * b_dim1;
00658                 q__1.r = 1.f - reeps.r, q__1.i = 0.f - reeps.i;
00659                 b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00660                 if (i__ % 2 != 0 && i__ < *n) {
00661                     i__2 = i__ + (i__ + 1) * b_dim1;
00662                     d__1 = 2.;
00663                     q__1.r = d__1 * imeps.r, q__1.i = d__1 * imeps.i;
00664                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00665                 } else if (i__ > 1) {
00666                     i__2 = i__ + (i__ - 1) * b_dim1;
00667                     q__2.r = -imeps.r, q__2.i = -imeps.i;
00668                     d__1 = 2.;
00669                     q__1.r = d__1 * q__2.r, q__1.i = d__1 * q__2.i;
00670                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00671                 }
00672             }
00673 /* L250: */
00674         }
00675     }
00676 
00677 /*     Compute rhs (C, F) */
00678 
00679     cgemm_("N", "N", m, n, m, &c_b1, &a[a_offset], lda, &r__[r_offset], ldr, &
00680             c_b3, &c__[c_offset], ldc);
00681     q__1.r = -1.f, q__1.i = -0.f;
00682     cgemm_("N", "N", m, n, n, &q__1, &l[l_offset], ldl, &b[b_offset], ldb, &
00683             c_b1, &c__[c_offset], ldc);
00684     cgemm_("N", "N", m, n, m, &c_b1, &d__[d_offset], ldd, &r__[r_offset], ldr, 
00685              &c_b3, &f[f_offset], ldf);
00686     q__1.r = -1.f, q__1.i = -0.f;
00687     cgemm_("N", "N", m, n, n, &q__1, &l[l_offset], ldl, &e[e_offset], lde, &
00688             c_b1, &f[f_offset], ldf);
00689 
00690 /*     End of CLATM5 */
00691 
00692     return 0;
00693 } /* clatm5_ */


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