123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190 |
- /* dgttrs.f -- translated by f2c (version 20061008).
- You must link the resulting object file with libf2c:
- on Microsoft Windows system, link with libf2c.lib;
- on Linux or Unix systems, link with .../path/to/libf2c.a -lm
- or, if you install libf2c.a in a standard place, with -lf2c -lm
- -- in that order, at the end of the command line, as in
- cc *.o -lf2c -lm
- Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
- http://www.netlib.org/f2c/libf2c.zip
- */
- #include "f2c.h"
- #include "blaswrap.h"
- /* Table of constant values */
- static integer c__1 = 1;
- static integer c_n1 = -1;
- /* Subroutine */ int _starpu_dgttrs_(char *trans, integer *n, integer *nrhs,
- doublereal *dl, doublereal *d__, doublereal *du, doublereal *du2,
- integer *ipiv, doublereal *b, integer *ldb, integer *info)
- {
- /* System generated locals */
- integer b_dim1, b_offset, i__1, i__2, i__3;
- /* Local variables */
- integer j, jb, nb;
- extern /* Subroutine */ int _starpu_dgtts2_(integer *, integer *, integer *,
- doublereal *, doublereal *, doublereal *, doublereal *, integer *,
- doublereal *, integer *), _starpu_xerbla_(char *, integer *);
- extern integer _starpu_ilaenv_(integer *, char *, char *, integer *, integer *,
- integer *, integer *);
- integer itrans;
- logical notran;
- /* -- LAPACK routine (version 3.2) -- */
- /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
- /* November 2006 */
- /* .. Scalar Arguments .. */
- /* .. */
- /* .. Array Arguments .. */
- /* .. */
- /* Purpose */
- /* ======= */
- /* DGTTRS solves one of the systems of equations */
- /* A*X = B or A'*X = B, */
- /* with a tridiagonal matrix A using the LU factorization computed */
- /* by DGTTRF. */
- /* Arguments */
- /* ========= */
- /* TRANS (input) CHARACTER*1 */
- /* Specifies the form of the system of equations. */
- /* = 'N': A * X = B (No transpose) */
- /* = 'T': A'* X = B (Transpose) */
- /* = 'C': A'* X = B (Conjugate transpose = Transpose) */
- /* N (input) INTEGER */
- /* The order of the matrix A. */
- /* NRHS (input) INTEGER */
- /* The number of right hand sides, i.e., the number of columns */
- /* of the matrix B. NRHS >= 0. */
- /* DL (input) DOUBLE PRECISION array, dimension (N-1) */
- /* The (n-1) multipliers that define the matrix L from the */
- /* LU factorization of A. */
- /* D (input) DOUBLE PRECISION array, dimension (N) */
- /* The n diagonal elements of the upper triangular matrix U from */
- /* the LU factorization of A. */
- /* DU (input) DOUBLE PRECISION array, dimension (N-1) */
- /* The (n-1) elements of the first super-diagonal of U. */
- /* DU2 (input) DOUBLE PRECISION array, dimension (N-2) */
- /* The (n-2) elements of the second super-diagonal of U. */
- /* IPIV (input) INTEGER array, dimension (N) */
- /* The pivot indices; for 1 <= i <= n, row i of the matrix was */
- /* interchanged with row IPIV(i). IPIV(i) will always be either */
- /* i or i+1; IPIV(i) = i indicates a row interchange was not */
- /* required. */
- /* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) */
- /* On entry, the matrix of right hand side vectors B. */
- /* On exit, B is overwritten by the solution vectors X. */
- /* LDB (input) INTEGER */
- /* The leading dimension of the array B. LDB >= max(1,N). */
- /* INFO (output) INTEGER */
- /* = 0: successful exit */
- /* < 0: if INFO = -i, the i-th argument had an illegal value */
- /* ===================================================================== */
- /* .. Local Scalars .. */
- /* .. */
- /* .. External Functions .. */
- /* .. */
- /* .. External Subroutines .. */
- /* .. */
- /* .. Intrinsic Functions .. */
- /* .. */
- /* .. Executable Statements .. */
- /* Parameter adjustments */
- --dl;
- --d__;
- --du;
- --du2;
- --ipiv;
- b_dim1 = *ldb;
- b_offset = 1 + b_dim1;
- b -= b_offset;
- /* Function Body */
- *info = 0;
- notran = *(unsigned char *)trans == 'N' || *(unsigned char *)trans == 'n';
- if (! notran && ! (*(unsigned char *)trans == 'T' || *(unsigned char *)
- trans == 't') && ! (*(unsigned char *)trans == 'C' || *(unsigned
- char *)trans == 'c')) {
- *info = -1;
- } else if (*n < 0) {
- *info = -2;
- } else if (*nrhs < 0) {
- *info = -3;
- } else if (*ldb < max(*n,1)) {
- *info = -10;
- }
- if (*info != 0) {
- i__1 = -(*info);
- _starpu_xerbla_("DGTTRS", &i__1);
- return 0;
- }
- /* Quick return if possible */
- if (*n == 0 || *nrhs == 0) {
- return 0;
- }
- /* Decode TRANS */
- if (notran) {
- itrans = 0;
- } else {
- itrans = 1;
- }
- /* Determine the number of right-hand sides to solve at a time. */
- if (*nrhs == 1) {
- nb = 1;
- } else {
- /* Computing MAX */
- i__1 = 1, i__2 = _starpu_ilaenv_(&c__1, "DGTTRS", trans, n, nrhs, &c_n1, &
- c_n1);
- nb = max(i__1,i__2);
- }
- if (nb >= *nrhs) {
- _starpu_dgtts2_(&itrans, n, nrhs, &dl[1], &d__[1], &du[1], &du2[1], &ipiv[1],
- &b[b_offset], ldb);
- } else {
- i__1 = *nrhs;
- i__2 = nb;
- for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
- /* Computing MIN */
- i__3 = *nrhs - j + 1;
- jb = min(i__3,nb);
- _starpu_dgtts2_(&itrans, n, &jb, &dl[1], &d__[1], &du[1], &du2[1], &ipiv[
- 1], &b[j * b_dim1 + 1], ldb);
- /* L10: */
- }
- }
- /* End of DGTTRS */
- return 0;
- } /* _starpu_dgttrs_ */
|