slagtm.c
Go to the documentation of this file.
00001 /* slagtm.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 slagtm_(char *trans, integer *n, integer *nrhs, real *
00017         alpha, real *dl, real *d__, real *du, real *x, integer *ldx, real *
00018         beta, real *b, integer *ldb)
00019 {
00020     /* System generated locals */
00021     integer b_dim1, b_offset, x_dim1, x_offset, i__1, i__2;
00022 
00023     /* Local variables */
00024     integer i__, j;
00025     extern logical lsame_(char *, char *);
00026 
00027 
00028 /*  -- LAPACK auxiliary routine (version 3.2) -- */
00029 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00030 /*     November 2006 */
00031 
00032 /*     .. Scalar Arguments .. */
00033 /*     .. */
00034 /*     .. Array Arguments .. */
00035 /*     .. */
00036 
00037 /*  Purpose */
00038 /*  ======= */
00039 
00040 /*  SLAGTM performs a matrix-vector product of the form */
00041 
00042 /*     B := alpha * A * X + beta * B */
00043 
00044 /*  where A is a tridiagonal matrix of order N, B and X are N by NRHS */
00045 /*  matrices, and alpha and beta are real scalars, each of which may be */
00046 /*  0., 1., or -1. */
00047 
00048 /*  Arguments */
00049 /*  ========= */
00050 
00051 /*  TRANS   (input) CHARACTER*1 */
00052 /*          Specifies the operation applied to A. */
00053 /*          = 'N':  No transpose, B := alpha * A * X + beta * B */
00054 /*          = 'T':  Transpose,    B := alpha * A'* X + beta * B */
00055 /*          = 'C':  Conjugate transpose = Transpose */
00056 
00057 /*  N       (input) INTEGER */
00058 /*          The order of the matrix A.  N >= 0. */
00059 
00060 /*  NRHS    (input) INTEGER */
00061 /*          The number of right hand sides, i.e., the number of columns */
00062 /*          of the matrices X and B. */
00063 
00064 /*  ALPHA   (input) REAL */
00065 /*          The scalar alpha.  ALPHA must be 0., 1., or -1.; otherwise, */
00066 /*          it is assumed to be 0. */
00067 
00068 /*  DL      (input) REAL array, dimension (N-1) */
00069 /*          The (n-1) sub-diagonal elements of T. */
00070 
00071 /*  D       (input) REAL array, dimension (N) */
00072 /*          The diagonal elements of T. */
00073 
00074 /*  DU      (input) REAL array, dimension (N-1) */
00075 /*          The (n-1) super-diagonal elements of T. */
00076 
00077 /*  X       (input) REAL array, dimension (LDX,NRHS) */
00078 /*          The N by NRHS matrix X. */
00079 /*  LDX     (input) INTEGER */
00080 /*          The leading dimension of the array X.  LDX >= max(N,1). */
00081 
00082 /*  BETA    (input) REAL */
00083 /*          The scalar beta.  BETA must be 0., 1., or -1.; otherwise, */
00084 /*          it is assumed to be 1. */
00085 
00086 /*  B       (input/output) REAL array, dimension (LDB,NRHS) */
00087 /*          On entry, the N by NRHS matrix B. */
00088 /*          On exit, B is overwritten by the matrix expression */
00089 /*          B := alpha * A * X + beta * B. */
00090 
00091 /*  LDB     (input) INTEGER */
00092 /*          The leading dimension of the array B.  LDB >= max(N,1). */
00093 
00094 /*  ===================================================================== */
00095 
00096 /*     .. Parameters .. */
00097 /*     .. */
00098 /*     .. Local Scalars .. */
00099 /*     .. */
00100 /*     .. External Functions .. */
00101 /*     .. */
00102 /*     .. Executable Statements .. */
00103 
00104     /* Parameter adjustments */
00105     --dl;
00106     --d__;
00107     --du;
00108     x_dim1 = *ldx;
00109     x_offset = 1 + x_dim1;
00110     x -= x_offset;
00111     b_dim1 = *ldb;
00112     b_offset = 1 + b_dim1;
00113     b -= b_offset;
00114 
00115     /* Function Body */
00116     if (*n == 0) {
00117         return 0;
00118     }
00119 
00120 /*     Multiply B by BETA if BETA.NE.1. */
00121 
00122     if (*beta == 0.f) {
00123         i__1 = *nrhs;
00124         for (j = 1; j <= i__1; ++j) {
00125             i__2 = *n;
00126             for (i__ = 1; i__ <= i__2; ++i__) {
00127                 b[i__ + j * b_dim1] = 0.f;
00128 /* L10: */
00129             }
00130 /* L20: */
00131         }
00132     } else if (*beta == -1.f) {
00133         i__1 = *nrhs;
00134         for (j = 1; j <= i__1; ++j) {
00135             i__2 = *n;
00136             for (i__ = 1; i__ <= i__2; ++i__) {
00137                 b[i__ + j * b_dim1] = -b[i__ + j * b_dim1];
00138 /* L30: */
00139             }
00140 /* L40: */
00141         }
00142     }
00143 
00144     if (*alpha == 1.f) {
00145         if (lsame_(trans, "N")) {
00146 
00147 /*           Compute B := B + A*X */
00148 
00149             i__1 = *nrhs;
00150             for (j = 1; j <= i__1; ++j) {
00151                 if (*n == 1) {
00152                     b[j * b_dim1 + 1] += d__[1] * x[j * x_dim1 + 1];
00153                 } else {
00154                     b[j * b_dim1 + 1] = b[j * b_dim1 + 1] + d__[1] * x[j * 
00155                             x_dim1 + 1] + du[1] * x[j * x_dim1 + 2];
00156                     b[*n + j * b_dim1] = b[*n + j * b_dim1] + dl[*n - 1] * x[*
00157                             n - 1 + j * x_dim1] + d__[*n] * x[*n + j * x_dim1]
00158                             ;
00159                     i__2 = *n - 1;
00160                     for (i__ = 2; i__ <= i__2; ++i__) {
00161                         b[i__ + j * b_dim1] = b[i__ + j * b_dim1] + dl[i__ - 
00162                                 1] * x[i__ - 1 + j * x_dim1] + d__[i__] * x[
00163                                 i__ + j * x_dim1] + du[i__] * x[i__ + 1 + j * 
00164                                 x_dim1];
00165 /* L50: */
00166                     }
00167                 }
00168 /* L60: */
00169             }
00170         } else {
00171 
00172 /*           Compute B := B + A'*X */
00173 
00174             i__1 = *nrhs;
00175             for (j = 1; j <= i__1; ++j) {
00176                 if (*n == 1) {
00177                     b[j * b_dim1 + 1] += d__[1] * x[j * x_dim1 + 1];
00178                 } else {
00179                     b[j * b_dim1 + 1] = b[j * b_dim1 + 1] + d__[1] * x[j * 
00180                             x_dim1 + 1] + dl[1] * x[j * x_dim1 + 2];
00181                     b[*n + j * b_dim1] = b[*n + j * b_dim1] + du[*n - 1] * x[*
00182                             n - 1 + j * x_dim1] + d__[*n] * x[*n + j * x_dim1]
00183                             ;
00184                     i__2 = *n - 1;
00185                     for (i__ = 2; i__ <= i__2; ++i__) {
00186                         b[i__ + j * b_dim1] = b[i__ + j * b_dim1] + du[i__ - 
00187                                 1] * x[i__ - 1 + j * x_dim1] + d__[i__] * x[
00188                                 i__ + j * x_dim1] + dl[i__] * x[i__ + 1 + j * 
00189                                 x_dim1];
00190 /* L70: */
00191                     }
00192                 }
00193 /* L80: */
00194             }
00195         }
00196     } else if (*alpha == -1.f) {
00197         if (lsame_(trans, "N")) {
00198 
00199 /*           Compute B := B - A*X */
00200 
00201             i__1 = *nrhs;
00202             for (j = 1; j <= i__1; ++j) {
00203                 if (*n == 1) {
00204                     b[j * b_dim1 + 1] -= d__[1] * x[j * x_dim1 + 1];
00205                 } else {
00206                     b[j * b_dim1 + 1] = b[j * b_dim1 + 1] - d__[1] * x[j * 
00207                             x_dim1 + 1] - du[1] * x[j * x_dim1 + 2];
00208                     b[*n + j * b_dim1] = b[*n + j * b_dim1] - dl[*n - 1] * x[*
00209                             n - 1 + j * x_dim1] - d__[*n] * x[*n + j * x_dim1]
00210                             ;
00211                     i__2 = *n - 1;
00212                     for (i__ = 2; i__ <= i__2; ++i__) {
00213                         b[i__ + j * b_dim1] = b[i__ + j * b_dim1] - dl[i__ - 
00214                                 1] * x[i__ - 1 + j * x_dim1] - d__[i__] * x[
00215                                 i__ + j * x_dim1] - du[i__] * x[i__ + 1 + j * 
00216                                 x_dim1];
00217 /* L90: */
00218                     }
00219                 }
00220 /* L100: */
00221             }
00222         } else {
00223 
00224 /*           Compute B := B - A'*X */
00225 
00226             i__1 = *nrhs;
00227             for (j = 1; j <= i__1; ++j) {
00228                 if (*n == 1) {
00229                     b[j * b_dim1 + 1] -= d__[1] * x[j * x_dim1 + 1];
00230                 } else {
00231                     b[j * b_dim1 + 1] = b[j * b_dim1 + 1] - d__[1] * x[j * 
00232                             x_dim1 + 1] - dl[1] * x[j * x_dim1 + 2];
00233                     b[*n + j * b_dim1] = b[*n + j * b_dim1] - du[*n - 1] * x[*
00234                             n - 1 + j * x_dim1] - d__[*n] * x[*n + j * x_dim1]
00235                             ;
00236                     i__2 = *n - 1;
00237                     for (i__ = 2; i__ <= i__2; ++i__) {
00238                         b[i__ + j * b_dim1] = b[i__ + j * b_dim1] - du[i__ - 
00239                                 1] * x[i__ - 1 + j * x_dim1] - d__[i__] * x[
00240                                 i__ + j * x_dim1] - dl[i__] * x[i__ + 1 + j * 
00241                                 x_dim1];
00242 /* L110: */
00243                     }
00244                 }
00245 /* L120: */
00246             }
00247         }
00248     }
00249     return 0;
00250 
00251 /*     End of SLAGTM */
00252 
00253 } /* slagtm_ */

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