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

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