dgttrs.c
Go to the documentation of this file.
00001 /* dgttrs.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 integer c__1 = 1;
00019 static integer c_n1 = -1;
00020 
00021 /* Subroutine */ int dgttrs_(char *trans, integer *n, integer *nrhs, 
00022         doublereal *dl, doublereal *d__, doublereal *du, doublereal *du2, 
00023         integer *ipiv, doublereal *b, integer *ldb, integer *info)
00024 {
00025     /* System generated locals */
00026     integer b_dim1, b_offset, i__1, i__2, i__3;
00027 
00028     /* Local variables */
00029     integer j, jb, nb;
00030     extern /* Subroutine */ int dgtts2_(integer *, integer *, integer *, 
00031             doublereal *, doublereal *, doublereal *, doublereal *, integer *, 
00032              doublereal *, integer *), xerbla_(char *, integer *);
00033     extern integer ilaenv_(integer *, char *, char *, integer *, integer *, 
00034             integer *, integer *);
00035     integer itrans;
00036     logical notran;
00037 
00038 
00039 /*  -- LAPACK routine (version 3.2) -- */
00040 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00041 /*     November 2006 */
00042 
00043 /*     .. Scalar Arguments .. */
00044 /*     .. */
00045 /*     .. Array Arguments .. */
00046 /*     .. */
00047 
00048 /*  Purpose */
00049 /*  ======= */
00050 
00051 /*  DGTTRS solves one of the systems of equations */
00052 /*     A*X = B  or  A'*X = B, */
00053 /*  with a tridiagonal matrix A using the LU factorization computed */
00054 /*  by DGTTRF. */
00055 
00056 /*  Arguments */
00057 /*  ========= */
00058 
00059 /*  TRANS   (input) CHARACTER*1 */
00060 /*          Specifies the form of the system of equations. */
00061 /*          = 'N':  A * X = B  (No transpose) */
00062 /*          = 'T':  A'* X = B  (Transpose) */
00063 /*          = 'C':  A'* X = B  (Conjugate transpose = Transpose) */
00064 
00065 /*  N       (input) INTEGER */
00066 /*          The order of the matrix A. */
00067 
00068 /*  NRHS    (input) INTEGER */
00069 /*          The number of right hand sides, i.e., the number of columns */
00070 /*          of the matrix B.  NRHS >= 0. */
00071 
00072 /*  DL      (input) DOUBLE PRECISION array, dimension (N-1) */
00073 /*          The (n-1) multipliers that define the matrix L from the */
00074 /*          LU factorization of A. */
00075 
00076 /*  D       (input) DOUBLE PRECISION array, dimension (N) */
00077 /*          The n diagonal elements of the upper triangular matrix U from */
00078 /*          the LU factorization of A. */
00079 
00080 /*  DU      (input) DOUBLE PRECISION array, dimension (N-1) */
00081 /*          The (n-1) elements of the first super-diagonal of U. */
00082 
00083 /*  DU2     (input) DOUBLE PRECISION array, dimension (N-2) */
00084 /*          The (n-2) elements of the second super-diagonal of U. */
00085 
00086 /*  IPIV    (input) INTEGER array, dimension (N) */
00087 /*          The pivot indices; for 1 <= i <= n, row i of the matrix was */
00088 /*          interchanged with row IPIV(i).  IPIV(i) will always be either */
00089 /*          i or i+1; IPIV(i) = i indicates a row interchange was not */
00090 /*          required. */
00091 
00092 /*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) */
00093 /*          On entry, the matrix of right hand side vectors B. */
00094 /*          On exit, B is overwritten by the solution vectors X. */
00095 
00096 /*  LDB     (input) INTEGER */
00097 /*          The leading dimension of the array B.  LDB >= max(1,N). */
00098 
00099 /*  INFO    (output) INTEGER */
00100 /*          = 0:  successful exit */
00101 /*          < 0:  if INFO = -i, the i-th argument had an illegal value */
00102 
00103 /*  ===================================================================== */
00104 
00105 /*     .. Local Scalars .. */
00106 /*     .. */
00107 /*     .. External Functions .. */
00108 /*     .. */
00109 /*     .. External Subroutines .. */
00110 /*     .. */
00111 /*     .. Intrinsic Functions .. */
00112 /*     .. */
00113 /*     .. Executable Statements .. */
00114 
00115     /* Parameter adjustments */
00116     --dl;
00117     --d__;
00118     --du;
00119     --du2;
00120     --ipiv;
00121     b_dim1 = *ldb;
00122     b_offset = 1 + b_dim1;
00123     b -= b_offset;
00124 
00125     /* Function Body */
00126     *info = 0;
00127     notran = *(unsigned char *)trans == 'N' || *(unsigned char *)trans == 'n';
00128     if (! notran && ! (*(unsigned char *)trans == 'T' || *(unsigned char *)
00129             trans == 't') && ! (*(unsigned char *)trans == 'C' || *(unsigned 
00130             char *)trans == 'c')) {
00131         *info = -1;
00132     } else if (*n < 0) {
00133         *info = -2;
00134     } else if (*nrhs < 0) {
00135         *info = -3;
00136     } else if (*ldb < max(*n,1)) {
00137         *info = -10;
00138     }
00139     if (*info != 0) {
00140         i__1 = -(*info);
00141         xerbla_("DGTTRS", &i__1);
00142         return 0;
00143     }
00144 
00145 /*     Quick return if possible */
00146 
00147     if (*n == 0 || *nrhs == 0) {
00148         return 0;
00149     }
00150 
00151 /*     Decode TRANS */
00152 
00153     if (notran) {
00154         itrans = 0;
00155     } else {
00156         itrans = 1;
00157     }
00158 
00159 /*     Determine the number of right-hand sides to solve at a time. */
00160 
00161     if (*nrhs == 1) {
00162         nb = 1;
00163     } else {
00164 /* Computing MAX */
00165         i__1 = 1, i__2 = ilaenv_(&c__1, "DGTTRS", trans, n, nrhs, &c_n1, &
00166                 c_n1);
00167         nb = max(i__1,i__2);
00168     }
00169 
00170     if (nb >= *nrhs) {
00171         dgtts2_(&itrans, n, nrhs, &dl[1], &d__[1], &du[1], &du2[1], &ipiv[1], 
00172                 &b[b_offset], ldb);
00173     } else {
00174         i__1 = *nrhs;
00175         i__2 = nb;
00176         for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
00177 /* Computing MIN */
00178             i__3 = *nrhs - j + 1;
00179             jb = min(i__3,nb);
00180             dgtts2_(&itrans, n, &jb, &dl[1], &d__[1], &du[1], &du2[1], &ipiv[
00181                     1], &b[j * b_dim1 + 1], ldb);
00182 /* L10: */
00183         }
00184     }
00185 
00186 /*     End of DGTTRS */
00187 
00188     return 0;
00189 } /* dgttrs_ */


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