123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139 |
- /* dgesv.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"
- /* Subroutine */ int dgesv_(integer *n, integer *nrhs, doublereal *a, integer
- *lda, integer *ipiv, doublereal *b, integer *ldb, integer *info)
- {
- /* System generated locals */
- integer a_dim1, a_offset, b_dim1, b_offset, i__1;
- /* Local variables */
- extern /* Subroutine */ int dgetrf_(integer *, integer *, doublereal *,
- integer *, integer *, integer *), xerbla_(char *, integer *), dgetrs_(char *, integer *, integer *, doublereal *,
- integer *, integer *, doublereal *, integer *, integer *);
- /* -- LAPACK driver routine (version 3.2) -- */
- /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
- /* November 2006 */
- /* .. Scalar Arguments .. */
- /* .. */
- /* .. Array Arguments .. */
- /* .. */
- /* Purpose */
- /* ======= */
- /* DGESV computes the solution to a real system of linear equations */
- /* A * X = B, */
- /* where A is an N-by-N matrix and X and B are N-by-NRHS matrices. */
- /* The LU decomposition with partial pivoting and row interchanges is */
- /* used to factor A as */
- /* A = P * L * U, */
- /* where P is a permutation matrix, L is unit lower triangular, and U is */
- /* upper triangular. The factored form of A is then used to solve the */
- /* system of equations A * X = B. */
- /* Arguments */
- /* ========= */
- /* N (input) INTEGER */
- /* The number of linear equations, i.e., the order of the */
- /* matrix A. N >= 0. */
- /* NRHS (input) INTEGER */
- /* The number of right hand sides, i.e., the number of columns */
- /* of the matrix B. NRHS >= 0. */
- /* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
- /* On entry, the N-by-N coefficient matrix A. */
- /* On exit, the factors L and U from the factorization */
- /* A = P*L*U; the unit diagonal elements of L are not stored. */
- /* LDA (input) INTEGER */
- /* The leading dimension of the array A. LDA >= lmax(1,N). */
- /* IPIV (output) INTEGER array, dimension (N) */
- /* The pivot indices that define the permutation matrix P; */
- /* row i of the matrix was interchanged with row IPIV(i). */
- /* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) */
- /* On entry, the N-by-NRHS matrix of right hand side matrix B. */
- /* On exit, if INFO = 0, the N-by-NRHS solution matrix X. */
- /* LDB (input) INTEGER */
- /* The leading dimension of the array B. LDB >= lmax(1,N). */
- /* INFO (output) INTEGER */
- /* = 0: successful exit */
- /* < 0: if INFO = -i, the i-th argument had an illegal value */
- /* > 0: if INFO = i, U(i,i) is exactly zero. The factorization */
- /* has been completed, but the factor U is exactly */
- /* singular, so the solution could not be computed. */
- /* ===================================================================== */
- /* .. External Subroutines .. */
- /* .. */
- /* .. Intrinsic Functions .. */
- /* .. */
- /* .. Executable Statements .. */
- /* Test the input parameters. */
- /* Parameter adjustments */
- a_dim1 = *lda;
- a_offset = 1 + a_dim1;
- a -= a_offset;
- --ipiv;
- b_dim1 = *ldb;
- b_offset = 1 + b_dim1;
- b -= b_offset;
- /* Function Body */
- *info = 0;
- if (*n < 0) {
- *info = -1;
- } else if (*nrhs < 0) {
- *info = -2;
- } else if (*lda < lmax(1,*n)) {
- *info = -4;
- } else if (*ldb < lmax(1,*n)) {
- *info = -7;
- }
- if (*info != 0) {
- i__1 = -(*info);
- xerbla_("DGESV ", &i__1);
- return 0;
- }
- /* Compute the LU factorization of A. */
- dgetrf_(n, n, &a[a_offset], lda, &ipiv[1], info);
- if (*info == 0) {
- /* Solve the system A*X = B, overwriting B with X. */
- dgetrs_("No transpose", n, nrhs, &a[a_offset], lda, &ipiv[1], &b[
- b_offset], ldb, info);
- }
- return 0;
- /* End of DGESV */
- } /* dgesv_ */
|