claptm.c
Go to the documentation of this file.
00001 /* claptm.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 claptm_(char *uplo, integer *n, integer *nrhs, real *
00017         alpha, real *d__, complex *e, complex *x, integer *ldx, real *beta, 
00018         complex *b, integer *ldb)
00019 {
00020     /* System generated locals */
00021     integer b_dim1, b_offset, x_dim1, x_offset, i__1, i__2, i__3, i__4, i__5, 
00022             i__6, i__7, i__8, i__9;
00023     complex q__1, q__2, q__3, q__4, q__5, q__6, q__7;
00024 
00025     /* Builtin functions */
00026     void r_cnjg(complex *, complex *);
00027 
00028     /* Local variables */
00029     integer i__, j;
00030     extern logical lsame_(char *, char *);
00031 
00032 
00033 /*  -- LAPACK auxiliary routine (version 3.1) -- */
00034 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00035 /*     November 2006 */
00036 
00037 /*     .. Scalar Arguments .. */
00038 /*     .. */
00039 /*     .. Array Arguments .. */
00040 /*     .. */
00041 
00042 /*  Purpose */
00043 /*  ======= */
00044 
00045 /*  CLAPTM multiplies an N by NRHS matrix X by a Hermitian tridiagonal */
00046 /*  matrix A and stores the result in a matrix B.  The operation has the */
00047 /*  form */
00048 
00049 /*     B := alpha * A * X + beta * B */
00050 
00051 /*  where alpha may be either 1. or -1. and beta may be 0., 1., or -1. */
00052 
00053 /*  Arguments */
00054 /*  ========= */
00055 
00056 /*  UPLO    (input) CHARACTER */
00057 /*          Specifies whether the superdiagonal or the subdiagonal of the */
00058 /*          tridiagonal matrix A is stored. */
00059 /*          = 'U':  Upper, E is the superdiagonal of A. */
00060 /*          = 'L':  Lower, E is the subdiagonal of A. */
00061 
00062 /*  N       (input) INTEGER */
00063 /*          The order of the matrix A.  N >= 0. */
00064 
00065 /*  NRHS    (input) INTEGER */
00066 /*          The number of right hand sides, i.e., the number of columns */
00067 /*          of the matrices X and B. */
00068 
00069 /*  ALPHA   (input) REAL */
00070 /*          The scalar alpha.  ALPHA must be 1. or -1.; otherwise, */
00071 /*          it is assumed to be 0. */
00072 
00073 /*  D       (input) REAL array, dimension (N) */
00074 /*          The n diagonal elements of the tridiagonal matrix A. */
00075 
00076 /*  E       (input) COMPLEX array, dimension (N-1) */
00077 /*          The (n-1) subdiagonal or superdiagonal elements of A. */
00078 
00079 /*  X       (input) COMPLEX array, dimension (LDX,NRHS) */
00080 /*          The N by NRHS matrix X. */
00081 
00082 /*  LDX     (input) INTEGER */
00083 /*          The leading dimension of the array X.  LDX >= max(N,1). */
00084 
00085 /*  BETA    (input) REAL */
00086 /*          The scalar beta.  BETA must be 0., 1., or -1.; otherwise, */
00087 /*          it is assumed to be 1. */
00088 
00089 /*  B       (input/output) COMPLEX array, dimension (LDB,NRHS) */
00090 /*          On entry, the N by NRHS matrix B. */
00091 /*          On exit, B is overwritten by the matrix expression */
00092 /*          B := alpha * A * X + beta * B. */
00093 
00094 /*  LDB     (input) INTEGER */
00095 /*          The leading dimension of the array B.  LDB >= max(N,1). */
00096 
00097 /*  ===================================================================== */
00098 
00099 /*     .. Parameters .. */
00100 /*     .. */
00101 /*     .. Local Scalars .. */
00102 /*     .. */
00103 /*     .. External Functions .. */
00104 /*     .. */
00105 /*     .. Intrinsic Functions .. */
00106 /*     .. */
00107 /*     .. Executable Statements .. */
00108 
00109     /* Parameter adjustments */
00110     --d__;
00111     --e;
00112     x_dim1 = *ldx;
00113     x_offset = 1 + x_dim1;
00114     x -= x_offset;
00115     b_dim1 = *ldb;
00116     b_offset = 1 + b_dim1;
00117     b -= b_offset;
00118 
00119     /* Function Body */
00120     if (*n == 0) {
00121         return 0;
00122     }
00123 
00124     if (*beta == 0.f) {
00125         i__1 = *nrhs;
00126         for (j = 1; j <= i__1; ++j) {
00127             i__2 = *n;
00128             for (i__ = 1; i__ <= i__2; ++i__) {
00129                 i__3 = i__ + j * b_dim1;
00130                 b[i__3].r = 0.f, b[i__3].i = 0.f;
00131 /* L10: */
00132             }
00133 /* L20: */
00134         }
00135     } else if (*beta == -1.f) {
00136         i__1 = *nrhs;
00137         for (j = 1; j <= i__1; ++j) {
00138             i__2 = *n;
00139             for (i__ = 1; i__ <= i__2; ++i__) {
00140                 i__3 = i__ + j * b_dim1;
00141                 i__4 = i__ + j * b_dim1;
00142                 q__1.r = -b[i__4].r, q__1.i = -b[i__4].i;
00143                 b[i__3].r = q__1.r, b[i__3].i = q__1.i;
00144 /* L30: */
00145             }
00146 /* L40: */
00147         }
00148     }
00149 
00150     if (*alpha == 1.f) {
00151         if (lsame_(uplo, "U")) {
00152 
00153 /*           Compute B := B + A*X, where E is the superdiagonal of A. */
00154 
00155             i__1 = *nrhs;
00156             for (j = 1; j <= i__1; ++j) {
00157                 if (*n == 1) {
00158                     i__2 = j * b_dim1 + 1;
00159                     i__3 = j * b_dim1 + 1;
00160                     i__4 = j * x_dim1 + 1;
00161                     q__2.r = d__[1] * x[i__4].r, q__2.i = d__[1] * x[i__4].i;
00162                     q__1.r = b[i__3].r + q__2.r, q__1.i = b[i__3].i + q__2.i;
00163                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00164                 } else {
00165                     i__2 = j * b_dim1 + 1;
00166                     i__3 = j * b_dim1 + 1;
00167                     i__4 = j * x_dim1 + 1;
00168                     q__3.r = d__[1] * x[i__4].r, q__3.i = d__[1] * x[i__4].i;
00169                     q__2.r = b[i__3].r + q__3.r, q__2.i = b[i__3].i + q__3.i;
00170                     i__5 = j * x_dim1 + 2;
00171                     q__4.r = e[1].r * x[i__5].r - e[1].i * x[i__5].i, q__4.i =
00172                              e[1].r * x[i__5].i + e[1].i * x[i__5].r;
00173                     q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;
00174                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00175                     i__2 = *n + j * b_dim1;
00176                     i__3 = *n + j * b_dim1;
00177                     r_cnjg(&q__4, &e[*n - 1]);
00178                     i__4 = *n - 1 + j * x_dim1;
00179                     q__3.r = q__4.r * x[i__4].r - q__4.i * x[i__4].i, q__3.i =
00180                              q__4.r * x[i__4].i + q__4.i * x[i__4].r;
00181                     q__2.r = b[i__3].r + q__3.r, q__2.i = b[i__3].i + q__3.i;
00182                     i__5 = *n;
00183                     i__6 = *n + j * x_dim1;
00184                     q__5.r = d__[i__5] * x[i__6].r, q__5.i = d__[i__5] * x[
00185                             i__6].i;
00186                     q__1.r = q__2.r + q__5.r, q__1.i = q__2.i + q__5.i;
00187                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00188                     i__2 = *n - 1;
00189                     for (i__ = 2; i__ <= i__2; ++i__) {
00190                         i__3 = i__ + j * b_dim1;
00191                         i__4 = i__ + j * b_dim1;
00192                         r_cnjg(&q__5, &e[i__ - 1]);
00193                         i__5 = i__ - 1 + j * x_dim1;
00194                         q__4.r = q__5.r * x[i__5].r - q__5.i * x[i__5].i, 
00195                                 q__4.i = q__5.r * x[i__5].i + q__5.i * x[i__5]
00196                                 .r;
00197                         q__3.r = b[i__4].r + q__4.r, q__3.i = b[i__4].i + 
00198                                 q__4.i;
00199                         i__6 = i__;
00200                         i__7 = i__ + j * x_dim1;
00201                         q__6.r = d__[i__6] * x[i__7].r, q__6.i = d__[i__6] * 
00202                                 x[i__7].i;
00203                         q__2.r = q__3.r + q__6.r, q__2.i = q__3.i + q__6.i;
00204                         i__8 = i__;
00205                         i__9 = i__ + 1 + j * x_dim1;
00206                         q__7.r = e[i__8].r * x[i__9].r - e[i__8].i * x[i__9]
00207                                 .i, q__7.i = e[i__8].r * x[i__9].i + e[i__8]
00208                                 .i * x[i__9].r;
00209                         q__1.r = q__2.r + q__7.r, q__1.i = q__2.i + q__7.i;
00210                         b[i__3].r = q__1.r, b[i__3].i = q__1.i;
00211 /* L50: */
00212                     }
00213                 }
00214 /* L60: */
00215             }
00216         } else {
00217 
00218 /*           Compute B := B + A*X, where E is the subdiagonal of A. */
00219 
00220             i__1 = *nrhs;
00221             for (j = 1; j <= i__1; ++j) {
00222                 if (*n == 1) {
00223                     i__2 = j * b_dim1 + 1;
00224                     i__3 = j * b_dim1 + 1;
00225                     i__4 = j * x_dim1 + 1;
00226                     q__2.r = d__[1] * x[i__4].r, q__2.i = d__[1] * x[i__4].i;
00227                     q__1.r = b[i__3].r + q__2.r, q__1.i = b[i__3].i + q__2.i;
00228                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00229                 } else {
00230                     i__2 = j * b_dim1 + 1;
00231                     i__3 = j * b_dim1 + 1;
00232                     i__4 = j * x_dim1 + 1;
00233                     q__3.r = d__[1] * x[i__4].r, q__3.i = d__[1] * x[i__4].i;
00234                     q__2.r = b[i__3].r + q__3.r, q__2.i = b[i__3].i + q__3.i;
00235                     r_cnjg(&q__5, &e[1]);
00236                     i__5 = j * x_dim1 + 2;
00237                     q__4.r = q__5.r * x[i__5].r - q__5.i * x[i__5].i, q__4.i =
00238                              q__5.r * x[i__5].i + q__5.i * x[i__5].r;
00239                     q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;
00240                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00241                     i__2 = *n + j * b_dim1;
00242                     i__3 = *n + j * b_dim1;
00243                     i__4 = *n - 1;
00244                     i__5 = *n - 1 + j * x_dim1;
00245                     q__3.r = e[i__4].r * x[i__5].r - e[i__4].i * x[i__5].i, 
00246                             q__3.i = e[i__4].r * x[i__5].i + e[i__4].i * x[
00247                             i__5].r;
00248                     q__2.r = b[i__3].r + q__3.r, q__2.i = b[i__3].i + q__3.i;
00249                     i__6 = *n;
00250                     i__7 = *n + j * x_dim1;
00251                     q__4.r = d__[i__6] * x[i__7].r, q__4.i = d__[i__6] * x[
00252                             i__7].i;
00253                     q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;
00254                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00255                     i__2 = *n - 1;
00256                     for (i__ = 2; i__ <= i__2; ++i__) {
00257                         i__3 = i__ + j * b_dim1;
00258                         i__4 = i__ + j * b_dim1;
00259                         i__5 = i__ - 1;
00260                         i__6 = i__ - 1 + j * x_dim1;
00261                         q__4.r = e[i__5].r * x[i__6].r - e[i__5].i * x[i__6]
00262                                 .i, q__4.i = e[i__5].r * x[i__6].i + e[i__5]
00263                                 .i * x[i__6].r;
00264                         q__3.r = b[i__4].r + q__4.r, q__3.i = b[i__4].i + 
00265                                 q__4.i;
00266                         i__7 = i__;
00267                         i__8 = i__ + j * x_dim1;
00268                         q__5.r = d__[i__7] * x[i__8].r, q__5.i = d__[i__7] * 
00269                                 x[i__8].i;
00270                         q__2.r = q__3.r + q__5.r, q__2.i = q__3.i + q__5.i;
00271                         r_cnjg(&q__7, &e[i__]);
00272                         i__9 = i__ + 1 + j * x_dim1;
00273                         q__6.r = q__7.r * x[i__9].r - q__7.i * x[i__9].i, 
00274                                 q__6.i = q__7.r * x[i__9].i + q__7.i * x[i__9]
00275                                 .r;
00276                         q__1.r = q__2.r + q__6.r, q__1.i = q__2.i + q__6.i;
00277                         b[i__3].r = q__1.r, b[i__3].i = q__1.i;
00278 /* L70: */
00279                     }
00280                 }
00281 /* L80: */
00282             }
00283         }
00284     } else if (*alpha == -1.f) {
00285         if (lsame_(uplo, "U")) {
00286 
00287 /*           Compute B := B - A*X, where E is the superdiagonal of A. */
00288 
00289             i__1 = *nrhs;
00290             for (j = 1; j <= i__1; ++j) {
00291                 if (*n == 1) {
00292                     i__2 = j * b_dim1 + 1;
00293                     i__3 = j * b_dim1 + 1;
00294                     i__4 = j * x_dim1 + 1;
00295                     q__2.r = d__[1] * x[i__4].r, q__2.i = d__[1] * x[i__4].i;
00296                     q__1.r = b[i__3].r - q__2.r, q__1.i = b[i__3].i - q__2.i;
00297                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00298                 } else {
00299                     i__2 = j * b_dim1 + 1;
00300                     i__3 = j * b_dim1 + 1;
00301                     i__4 = j * x_dim1 + 1;
00302                     q__3.r = d__[1] * x[i__4].r, q__3.i = d__[1] * x[i__4].i;
00303                     q__2.r = b[i__3].r - q__3.r, q__2.i = b[i__3].i - q__3.i;
00304                     i__5 = j * x_dim1 + 2;
00305                     q__4.r = e[1].r * x[i__5].r - e[1].i * x[i__5].i, q__4.i =
00306                              e[1].r * x[i__5].i + e[1].i * x[i__5].r;
00307                     q__1.r = q__2.r - q__4.r, q__1.i = q__2.i - q__4.i;
00308                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00309                     i__2 = *n + j * b_dim1;
00310                     i__3 = *n + j * b_dim1;
00311                     r_cnjg(&q__4, &e[*n - 1]);
00312                     i__4 = *n - 1 + j * x_dim1;
00313                     q__3.r = q__4.r * x[i__4].r - q__4.i * x[i__4].i, q__3.i =
00314                              q__4.r * x[i__4].i + q__4.i * x[i__4].r;
00315                     q__2.r = b[i__3].r - q__3.r, q__2.i = b[i__3].i - q__3.i;
00316                     i__5 = *n;
00317                     i__6 = *n + j * x_dim1;
00318                     q__5.r = d__[i__5] * x[i__6].r, q__5.i = d__[i__5] * x[
00319                             i__6].i;
00320                     q__1.r = q__2.r - q__5.r, q__1.i = q__2.i - q__5.i;
00321                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00322                     i__2 = *n - 1;
00323                     for (i__ = 2; i__ <= i__2; ++i__) {
00324                         i__3 = i__ + j * b_dim1;
00325                         i__4 = i__ + j * b_dim1;
00326                         r_cnjg(&q__5, &e[i__ - 1]);
00327                         i__5 = i__ - 1 + j * x_dim1;
00328                         q__4.r = q__5.r * x[i__5].r - q__5.i * x[i__5].i, 
00329                                 q__4.i = q__5.r * x[i__5].i + q__5.i * x[i__5]
00330                                 .r;
00331                         q__3.r = b[i__4].r - q__4.r, q__3.i = b[i__4].i - 
00332                                 q__4.i;
00333                         i__6 = i__;
00334                         i__7 = i__ + j * x_dim1;
00335                         q__6.r = d__[i__6] * x[i__7].r, q__6.i = d__[i__6] * 
00336                                 x[i__7].i;
00337                         q__2.r = q__3.r - q__6.r, q__2.i = q__3.i - q__6.i;
00338                         i__8 = i__;
00339                         i__9 = i__ + 1 + j * x_dim1;
00340                         q__7.r = e[i__8].r * x[i__9].r - e[i__8].i * x[i__9]
00341                                 .i, q__7.i = e[i__8].r * x[i__9].i + e[i__8]
00342                                 .i * x[i__9].r;
00343                         q__1.r = q__2.r - q__7.r, q__1.i = q__2.i - q__7.i;
00344                         b[i__3].r = q__1.r, b[i__3].i = q__1.i;
00345 /* L90: */
00346                     }
00347                 }
00348 /* L100: */
00349             }
00350         } else {
00351 
00352 /*           Compute B := B - A*X, where E is the subdiagonal of A. */
00353 
00354             i__1 = *nrhs;
00355             for (j = 1; j <= i__1; ++j) {
00356                 if (*n == 1) {
00357                     i__2 = j * b_dim1 + 1;
00358                     i__3 = j * b_dim1 + 1;
00359                     i__4 = j * x_dim1 + 1;
00360                     q__2.r = d__[1] * x[i__4].r, q__2.i = d__[1] * x[i__4].i;
00361                     q__1.r = b[i__3].r - q__2.r, q__1.i = b[i__3].i - q__2.i;
00362                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00363                 } else {
00364                     i__2 = j * b_dim1 + 1;
00365                     i__3 = j * b_dim1 + 1;
00366                     i__4 = j * x_dim1 + 1;
00367                     q__3.r = d__[1] * x[i__4].r, q__3.i = d__[1] * x[i__4].i;
00368                     q__2.r = b[i__3].r - q__3.r, q__2.i = b[i__3].i - q__3.i;
00369                     r_cnjg(&q__5, &e[1]);
00370                     i__5 = j * x_dim1 + 2;
00371                     q__4.r = q__5.r * x[i__5].r - q__5.i * x[i__5].i, q__4.i =
00372                              q__5.r * x[i__5].i + q__5.i * x[i__5].r;
00373                     q__1.r = q__2.r - q__4.r, q__1.i = q__2.i - q__4.i;
00374                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00375                     i__2 = *n + j * b_dim1;
00376                     i__3 = *n + j * b_dim1;
00377                     i__4 = *n - 1;
00378                     i__5 = *n - 1 + j * x_dim1;
00379                     q__3.r = e[i__4].r * x[i__5].r - e[i__4].i * x[i__5].i, 
00380                             q__3.i = e[i__4].r * x[i__5].i + e[i__4].i * x[
00381                             i__5].r;
00382                     q__2.r = b[i__3].r - q__3.r, q__2.i = b[i__3].i - q__3.i;
00383                     i__6 = *n;
00384                     i__7 = *n + j * x_dim1;
00385                     q__4.r = d__[i__6] * x[i__7].r, q__4.i = d__[i__6] * x[
00386                             i__7].i;
00387                     q__1.r = q__2.r - q__4.r, q__1.i = q__2.i - q__4.i;
00388                     b[i__2].r = q__1.r, b[i__2].i = q__1.i;
00389                     i__2 = *n - 1;
00390                     for (i__ = 2; i__ <= i__2; ++i__) {
00391                         i__3 = i__ + j * b_dim1;
00392                         i__4 = i__ + j * b_dim1;
00393                         i__5 = i__ - 1;
00394                         i__6 = i__ - 1 + j * x_dim1;
00395                         q__4.r = e[i__5].r * x[i__6].r - e[i__5].i * x[i__6]
00396                                 .i, q__4.i = e[i__5].r * x[i__6].i + e[i__5]
00397                                 .i * x[i__6].r;
00398                         q__3.r = b[i__4].r - q__4.r, q__3.i = b[i__4].i - 
00399                                 q__4.i;
00400                         i__7 = i__;
00401                         i__8 = i__ + j * x_dim1;
00402                         q__5.r = d__[i__7] * x[i__8].r, q__5.i = d__[i__7] * 
00403                                 x[i__8].i;
00404                         q__2.r = q__3.r - q__5.r, q__2.i = q__3.i - q__5.i;
00405                         r_cnjg(&q__7, &e[i__]);
00406                         i__9 = i__ + 1 + j * x_dim1;
00407                         q__6.r = q__7.r * x[i__9].r - q__7.i * x[i__9].i, 
00408                                 q__6.i = q__7.r * x[i__9].i + q__7.i * x[i__9]
00409                                 .r;
00410                         q__1.r = q__2.r - q__6.r, q__1.i = q__2.i - q__6.i;
00411                         b[i__3].r = q__1.r, b[i__3].i = q__1.i;
00412 /* L110: */
00413                     }
00414                 }
00415 /* L120: */
00416             }
00417         }
00418     }
00419     return 0;
00420 
00421 /*     End of CLAPTM */
00422 
00423 } /* claptm_ */

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