dptsv.c 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131
  1. /* dptsv.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. /* Subroutine */ int _starpu_dptsv_(integer *n, integer *nrhs, doublereal *d__,
  14. doublereal *e, doublereal *b, integer *ldb, integer *info)
  15. {
  16. /* System generated locals */
  17. integer b_dim1, b_offset, i__1;
  18. /* Local variables */
  19. extern /* Subroutine */ int _starpu_xerbla_(char *, integer *), _starpu_dpttrf_(
  20. integer *, doublereal *, doublereal *, integer *), _starpu_dpttrs_(
  21. integer *, integer *, doublereal *, doublereal *, doublereal *,
  22. integer *, integer *);
  23. /* -- LAPACK routine (version 3.2) -- */
  24. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  25. /* November 2006 */
  26. /* .. Scalar Arguments .. */
  27. /* .. */
  28. /* .. Array Arguments .. */
  29. /* .. */
  30. /* Purpose */
  31. /* ======= */
  32. /* DPTSV computes the solution to a real system of linear equations */
  33. /* A*X = B, where A is an N-by-N symmetric positive definite tridiagonal */
  34. /* matrix, and X and B are N-by-NRHS matrices. */
  35. /* A is factored as A = L*D*L**T, and the factored form of A is then */
  36. /* used to solve the system of equations. */
  37. /* Arguments */
  38. /* ========= */
  39. /* N (input) INTEGER */
  40. /* The order of the matrix A. N >= 0. */
  41. /* NRHS (input) INTEGER */
  42. /* The number of right hand sides, i.e., the number of columns */
  43. /* of the matrix B. NRHS >= 0. */
  44. /* D (input/output) DOUBLE PRECISION array, dimension (N) */
  45. /* On entry, the n diagonal elements of the tridiagonal matrix */
  46. /* A. On exit, the n diagonal elements of the diagonal matrix */
  47. /* D from the factorization A = L*D*L**T. */
  48. /* E (input/output) DOUBLE PRECISION array, dimension (N-1) */
  49. /* On entry, the (n-1) subdiagonal elements of the tridiagonal */
  50. /* matrix A. On exit, the (n-1) subdiagonal elements of the */
  51. /* unit bidiagonal factor L from the L*D*L**T factorization of */
  52. /* A. (E can also be regarded as the superdiagonal of the unit */
  53. /* bidiagonal factor U from the U**T*D*U factorization of A.) */
  54. /* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) */
  55. /* On entry, the N-by-NRHS right hand side matrix B. */
  56. /* On exit, if INFO = 0, the N-by-NRHS solution matrix X. */
  57. /* LDB (input) INTEGER */
  58. /* The leading dimension of the array B. LDB >= max(1,N). */
  59. /* INFO (output) INTEGER */
  60. /* = 0: successful exit */
  61. /* < 0: if INFO = -i, the i-th argument had an illegal value */
  62. /* > 0: if INFO = i, the leading minor of order i is not */
  63. /* positive definite, and the solution has not been */
  64. /* computed. The factorization has not been completed */
  65. /* unless i = N. */
  66. /* ===================================================================== */
  67. /* .. External Subroutines .. */
  68. /* .. */
  69. /* .. Intrinsic Functions .. */
  70. /* .. */
  71. /* .. Executable Statements .. */
  72. /* Test the input parameters. */
  73. /* Parameter adjustments */
  74. --d__;
  75. --e;
  76. b_dim1 = *ldb;
  77. b_offset = 1 + b_dim1;
  78. b -= b_offset;
  79. /* Function Body */
  80. *info = 0;
  81. if (*n < 0) {
  82. *info = -1;
  83. } else if (*nrhs < 0) {
  84. *info = -2;
  85. } else if (*ldb < max(1,*n)) {
  86. *info = -6;
  87. }
  88. if (*info != 0) {
  89. i__1 = -(*info);
  90. _starpu_xerbla_("DPTSV ", &i__1);
  91. return 0;
  92. }
  93. /* Compute the L*D*L' (or U'*D*U) factorization of A. */
  94. _starpu_dpttrf_(n, &d__[1], &e[1], info);
  95. if (*info == 0) {
  96. /* Solve the system A*X = B, overwriting B with X. */
  97. _starpu_dpttrs_(n, nrhs, &d__[1], &e[1], &b[b_offset], ldb, info);
  98. }
  99. return 0;
  100. /* End of DPTSV */
  101. } /* _starpu_dptsv_ */