dpbsv.c 6.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183
  1. /* dpbsv.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_dpbsv_(char *uplo, integer *n, integer *kd, integer *
  14. nrhs, doublereal *ab, integer *ldab, doublereal *b, integer *ldb,
  15. integer *info)
  16. {
  17. /* System generated locals */
  18. integer ab_dim1, ab_offset, b_dim1, b_offset, i__1;
  19. /* Local variables */
  20. extern logical _starpu_lsame_(char *, char *);
  21. extern /* Subroutine */ int _starpu_xerbla_(char *, integer *), _starpu_dpbtrf_(
  22. char *, integer *, integer *, doublereal *, integer *, integer *), _starpu_dpbtrs_(char *, integer *, integer *, integer *,
  23. doublereal *, integer *, doublereal *, integer *, integer *);
  24. /* -- LAPACK driver routine (version 3.2) -- */
  25. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  26. /* November 2006 */
  27. /* .. Scalar Arguments .. */
  28. /* .. */
  29. /* .. Array Arguments .. */
  30. /* .. */
  31. /* Purpose */
  32. /* ======= */
  33. /* DPBSV computes the solution to a real system of linear equations */
  34. /* A * X = B, */
  35. /* where A is an N-by-N symmetric positive definite band matrix and X */
  36. /* and B are N-by-NRHS matrices. */
  37. /* The Cholesky decomposition is used to factor A as */
  38. /* A = U**T * U, if UPLO = 'U', or */
  39. /* A = L * L**T, if UPLO = 'L', */
  40. /* where U is an upper triangular band matrix, and L is a lower */
  41. /* triangular band matrix, with the same number of superdiagonals or */
  42. /* subdiagonals as A. The factored form of A is then used to solve the */
  43. /* system of equations A * X = B. */
  44. /* Arguments */
  45. /* ========= */
  46. /* UPLO (input) CHARACTER*1 */
  47. /* = 'U': Upper triangle of A is stored; */
  48. /* = 'L': Lower triangle of A is stored. */
  49. /* N (input) INTEGER */
  50. /* The number of linear equations, i.e., the order of the */
  51. /* matrix A. N >= 0. */
  52. /* KD (input) INTEGER */
  53. /* The number of superdiagonals of the matrix A if UPLO = 'U', */
  54. /* or the number of subdiagonals if UPLO = 'L'. KD >= 0. */
  55. /* NRHS (input) INTEGER */
  56. /* The number of right hand sides, i.e., the number of columns */
  57. /* of the matrix B. NRHS >= 0. */
  58. /* AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N) */
  59. /* On entry, the upper or lower triangle of the symmetric band */
  60. /* matrix A, stored in the first KD+1 rows of the array. The */
  61. /* j-th column of A is stored in the j-th column of the array AB */
  62. /* as follows: */
  63. /* if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j; */
  64. /* if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD). */
  65. /* See below for further details. */
  66. /* On exit, if INFO = 0, the triangular factor U or L from the */
  67. /* Cholesky factorization A = U**T*U or A = L*L**T of the band */
  68. /* matrix A, in the same storage format as A. */
  69. /* LDAB (input) INTEGER */
  70. /* The leading dimension of the array AB. LDAB >= KD+1. */
  71. /* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) */
  72. /* On entry, the N-by-NRHS right hand side matrix B. */
  73. /* On exit, if INFO = 0, the N-by-NRHS solution matrix 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. /* > 0: if INFO = i, the leading minor of order i of A is not */
  80. /* positive definite, so the factorization could not be */
  81. /* completed, and the solution has not been computed. */
  82. /* Further Details */
  83. /* =============== */
  84. /* The band storage scheme is illustrated by the following example, when */
  85. /* N = 6, KD = 2, and UPLO = 'U': */
  86. /* On entry: On exit: */
  87. /* * * a13 a24 a35 a46 * * u13 u24 u35 u46 */
  88. /* * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56 */
  89. /* a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66 */
  90. /* Similarly, if UPLO = 'L' the format of A is as follows: */
  91. /* On entry: On exit: */
  92. /* a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66 */
  93. /* a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 * */
  94. /* a31 a42 a53 a64 * * l31 l42 l53 l64 * * */
  95. /* Array elements marked * are not used by the routine. */
  96. /* ===================================================================== */
  97. /* .. External Functions .. */
  98. /* .. */
  99. /* .. External Subroutines .. */
  100. /* .. */
  101. /* .. Intrinsic Functions .. */
  102. /* .. */
  103. /* .. Executable Statements .. */
  104. /* Test the input parameters. */
  105. /* Parameter adjustments */
  106. ab_dim1 = *ldab;
  107. ab_offset = 1 + ab_dim1;
  108. ab -= ab_offset;
  109. b_dim1 = *ldb;
  110. b_offset = 1 + b_dim1;
  111. b -= b_offset;
  112. /* Function Body */
  113. *info = 0;
  114. if (! _starpu_lsame_(uplo, "U") && ! _starpu_lsame_(uplo, "L")) {
  115. *info = -1;
  116. } else if (*n < 0) {
  117. *info = -2;
  118. } else if (*kd < 0) {
  119. *info = -3;
  120. } else if (*nrhs < 0) {
  121. *info = -4;
  122. } else if (*ldab < *kd + 1) {
  123. *info = -6;
  124. } else if (*ldb < max(1,*n)) {
  125. *info = -8;
  126. }
  127. if (*info != 0) {
  128. i__1 = -(*info);
  129. _starpu_xerbla_("DPBSV ", &i__1);
  130. return 0;
  131. }
  132. /* Compute the Cholesky factorization A = U'*U or A = L*L'. */
  133. _starpu_dpbtrf_(uplo, n, kd, &ab[ab_offset], ldab, info);
  134. if (*info == 0) {
  135. /* Solve the system A*X = B, overwriting B with X. */
  136. _starpu_dpbtrs_(uplo, n, kd, nrhs, &ab[ab_offset], ldab, &b[b_offset], ldb,
  137. info);
  138. }
  139. return 0;
  140. /* End of DPBSV */
  141. } /* _starpu_dpbsv_ */