dgttrs.c 5.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190
  1. /* dgttrs.f -- translated by f2c (version 20061008).
  2. You must link the resulting object file with libf2c:
  3. on Microsoft Windows system, link with libf2c.lib;
  4. on Linux or Unix systems, link with .../path/to/libf2c.a -lm
  5. or, if you install libf2c.a in a standard place, with -lf2c -lm
  6. -- in that order, at the end of the command line, as in
  7. cc *.o -lf2c -lm
  8. Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
  9. http://www.netlib.org/f2c/libf2c.zip
  10. */
  11. #include "f2c.h"
  12. #include "blaswrap.h"
  13. /* Table of constant values */
  14. static integer c__1 = 1;
  15. static integer c_n1 = -1;
  16. /* Subroutine */ int _starpu_dgttrs_(char *trans, integer *n, integer *nrhs,
  17. doublereal *dl, doublereal *d__, doublereal *du, doublereal *du2,
  18. integer *ipiv, doublereal *b, integer *ldb, integer *info)
  19. {
  20. /* System generated locals */
  21. integer b_dim1, b_offset, i__1, i__2, i__3;
  22. /* Local variables */
  23. integer j, jb, nb;
  24. extern /* Subroutine */ int _starpu_dgtts2_(integer *, integer *, integer *,
  25. doublereal *, doublereal *, doublereal *, doublereal *, integer *,
  26. doublereal *, integer *), _starpu_xerbla_(char *, integer *);
  27. extern integer _starpu_ilaenv_(integer *, char *, char *, integer *, integer *,
  28. integer *, integer *);
  29. integer itrans;
  30. logical notran;
  31. /* -- LAPACK routine (version 3.2) -- */
  32. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  33. /* November 2006 */
  34. /* .. Scalar Arguments .. */
  35. /* .. */
  36. /* .. Array Arguments .. */
  37. /* .. */
  38. /* Purpose */
  39. /* ======= */
  40. /* DGTTRS solves one of the systems of equations */
  41. /* A*X = B or A'*X = B, */
  42. /* with a tridiagonal matrix A using the LU factorization computed */
  43. /* by DGTTRF. */
  44. /* Arguments */
  45. /* ========= */
  46. /* TRANS (input) CHARACTER*1 */
  47. /* Specifies the form of the system of equations. */
  48. /* = 'N': A * X = B (No transpose) */
  49. /* = 'T': A'* X = B (Transpose) */
  50. /* = 'C': A'* X = B (Conjugate transpose = Transpose) */
  51. /* N (input) INTEGER */
  52. /* The order of the matrix A. */
  53. /* NRHS (input) INTEGER */
  54. /* The number of right hand sides, i.e., the number of columns */
  55. /* of the matrix B. NRHS >= 0. */
  56. /* DL (input) DOUBLE PRECISION array, dimension (N-1) */
  57. /* The (n-1) multipliers that define the matrix L from the */
  58. /* LU factorization of A. */
  59. /* D (input) DOUBLE PRECISION array, dimension (N) */
  60. /* The n diagonal elements of the upper triangular matrix U from */
  61. /* the LU factorization of A. */
  62. /* DU (input) DOUBLE PRECISION array, dimension (N-1) */
  63. /* The (n-1) elements of the first super-diagonal of U. */
  64. /* DU2 (input) DOUBLE PRECISION array, dimension (N-2) */
  65. /* The (n-2) elements of the second super-diagonal of U. */
  66. /* IPIV (input) INTEGER array, dimension (N) */
  67. /* The pivot indices; for 1 <= i <= n, row i of the matrix was */
  68. /* interchanged with row IPIV(i). IPIV(i) will always be either */
  69. /* i or i+1; IPIV(i) = i indicates a row interchange was not */
  70. /* required. */
  71. /* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) */
  72. /* On entry, the matrix of right hand side vectors B. */
  73. /* On exit, B is overwritten by the solution vectors X. */
  74. /* LDB (input) INTEGER */
  75. /* The leading dimension of the array B. LDB >= max(1,N). */
  76. /* INFO (output) INTEGER */
  77. /* = 0: successful exit */
  78. /* < 0: if INFO = -i, the i-th argument had an illegal value */
  79. /* ===================================================================== */
  80. /* .. Local Scalars .. */
  81. /* .. */
  82. /* .. External Functions .. */
  83. /* .. */
  84. /* .. External Subroutines .. */
  85. /* .. */
  86. /* .. Intrinsic Functions .. */
  87. /* .. */
  88. /* .. Executable Statements .. */
  89. /* Parameter adjustments */
  90. --dl;
  91. --d__;
  92. --du;
  93. --du2;
  94. --ipiv;
  95. b_dim1 = *ldb;
  96. b_offset = 1 + b_dim1;
  97. b -= b_offset;
  98. /* Function Body */
  99. *info = 0;
  100. notran = *(unsigned char *)trans == 'N' || *(unsigned char *)trans == 'n';
  101. if (! notran && ! (*(unsigned char *)trans == 'T' || *(unsigned char *)
  102. trans == 't') && ! (*(unsigned char *)trans == 'C' || *(unsigned
  103. char *)trans == 'c')) {
  104. *info = -1;
  105. } else if (*n < 0) {
  106. *info = -2;
  107. } else if (*nrhs < 0) {
  108. *info = -3;
  109. } else if (*ldb < max(*n,1)) {
  110. *info = -10;
  111. }
  112. if (*info != 0) {
  113. i__1 = -(*info);
  114. _starpu_xerbla_("DGTTRS", &i__1);
  115. return 0;
  116. }
  117. /* Quick return if possible */
  118. if (*n == 0 || *nrhs == 0) {
  119. return 0;
  120. }
  121. /* Decode TRANS */
  122. if (notran) {
  123. itrans = 0;
  124. } else {
  125. itrans = 1;
  126. }
  127. /* Determine the number of right-hand sides to solve at a time. */
  128. if (*nrhs == 1) {
  129. nb = 1;
  130. } else {
  131. /* Computing MAX */
  132. i__1 = 1, i__2 = _starpu_ilaenv_(&c__1, "DGTTRS", trans, n, nrhs, &c_n1, &
  133. c_n1);
  134. nb = max(i__1,i__2);
  135. }
  136. if (nb >= *nrhs) {
  137. _starpu_dgtts2_(&itrans, n, nrhs, &dl[1], &d__[1], &du[1], &du2[1], &ipiv[1],
  138. &b[b_offset], ldb);
  139. } else {
  140. i__1 = *nrhs;
  141. i__2 = nb;
  142. for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
  143. /* Computing MIN */
  144. i__3 = *nrhs - j + 1;
  145. jb = min(i__3,nb);
  146. _starpu_dgtts2_(&itrans, n, &jb, &dl[1], &d__[1], &du[1], &du2[1], &ipiv[
  147. 1], &b[j * b_dim1 + 1], ldb);
  148. /* L10: */
  149. }
  150. }
  151. /* End of DGTTRS */
  152. return 0;
  153. } /* _starpu_dgttrs_ */