dgesv.c 4.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139
  1. /* dgesv.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 dgesv_(integer *n, integer *nrhs, doublereal *a, integer
  14. *lda, integer *ipiv, doublereal *b, integer *ldb, integer *info)
  15. {
  16. /* System generated locals */
  17. integer a_dim1, a_offset, b_dim1, b_offset, i__1;
  18. /* Local variables */
  19. extern /* Subroutine */ int dgetrf_(integer *, integer *, doublereal *,
  20. integer *, integer *, integer *), xerbla_(char *, integer *), dgetrs_(char *, integer *, integer *, doublereal *,
  21. integer *, integer *, doublereal *, integer *, integer *);
  22. /* -- LAPACK driver routine (version 3.2) -- */
  23. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  24. /* November 2006 */
  25. /* .. Scalar Arguments .. */
  26. /* .. */
  27. /* .. Array Arguments .. */
  28. /* .. */
  29. /* Purpose */
  30. /* ======= */
  31. /* DGESV computes the solution to a real system of linear equations */
  32. /* A * X = B, */
  33. /* where A is an N-by-N matrix and X and B are N-by-NRHS matrices. */
  34. /* The LU decomposition with partial pivoting and row interchanges is */
  35. /* used to factor A as */
  36. /* A = P * L * U, */
  37. /* where P is a permutation matrix, L is unit lower triangular, and U is */
  38. /* upper triangular. The factored form of A is then used to solve the */
  39. /* system of equations A * X = B. */
  40. /* Arguments */
  41. /* ========= */
  42. /* N (input) INTEGER */
  43. /* The number of linear equations, i.e., the order of the */
  44. /* matrix A. N >= 0. */
  45. /* NRHS (input) INTEGER */
  46. /* The number of right hand sides, i.e., the number of columns */
  47. /* of the matrix B. NRHS >= 0. */
  48. /* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
  49. /* On entry, the N-by-N coefficient matrix A. */
  50. /* On exit, the factors L and U from the factorization */
  51. /* A = P*L*U; the unit diagonal elements of L are not stored. */
  52. /* LDA (input) INTEGER */
  53. /* The leading dimension of the array A. LDA >= lmax(1,N). */
  54. /* IPIV (output) INTEGER array, dimension (N) */
  55. /* The pivot indices that define the permutation matrix P; */
  56. /* row i of the matrix was interchanged with row IPIV(i). */
  57. /* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) */
  58. /* On entry, the N-by-NRHS matrix of right hand side matrix B. */
  59. /* On exit, if INFO = 0, the N-by-NRHS solution matrix X. */
  60. /* LDB (input) INTEGER */
  61. /* The leading dimension of the array B. LDB >= lmax(1,N). */
  62. /* INFO (output) INTEGER */
  63. /* = 0: successful exit */
  64. /* < 0: if INFO = -i, the i-th argument had an illegal value */
  65. /* > 0: if INFO = i, U(i,i) is exactly zero. The factorization */
  66. /* has been completed, but the factor U is exactly */
  67. /* singular, so the solution could not be computed. */
  68. /* ===================================================================== */
  69. /* .. External Subroutines .. */
  70. /* .. */
  71. /* .. Intrinsic Functions .. */
  72. /* .. */
  73. /* .. Executable Statements .. */
  74. /* Test the input parameters. */
  75. /* Parameter adjustments */
  76. a_dim1 = *lda;
  77. a_offset = 1 + a_dim1;
  78. a -= a_offset;
  79. --ipiv;
  80. b_dim1 = *ldb;
  81. b_offset = 1 + b_dim1;
  82. b -= b_offset;
  83. /* Function Body */
  84. *info = 0;
  85. if (*n < 0) {
  86. *info = -1;
  87. } else if (*nrhs < 0) {
  88. *info = -2;
  89. } else if (*lda < lmax(1,*n)) {
  90. *info = -4;
  91. } else if (*ldb < lmax(1,*n)) {
  92. *info = -7;
  93. }
  94. if (*info != 0) {
  95. i__1 = -(*info);
  96. xerbla_("DGESV ", &i__1);
  97. return 0;
  98. }
  99. /* Compute the LU factorization of A. */
  100. dgetrf_(n, n, &a[a_offset], lda, &ipiv[1], info);
  101. if (*info == 0) {
  102. /* Solve the system A*X = B, overwriting B with X. */
  103. dgetrs_("No transpose", n, nrhs, &a[a_offset], lda, &ipiv[1], &b[
  104. b_offset], ldb, info);
  105. }
  106. return 0;
  107. /* End of DGESV */
  108. } /* dgesv_ */