1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
/* sgesv.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 sgesv_(integer *n, integer *nrhs, real *a, integer *lda,
integer *ipiv, real *b, integer *ldb, integer *info)
{
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, i__1;
/* Local variables */
extern /* Subroutine */ int xerbla_(char *, integer *), sgetrf_(
integer *, integer *, real *, integer *, integer *, integer *),
sgetrs_(char *, integer *, integer *, real *, integer *, integer *
, real *, 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 */
/* ======= */
/* SGESV 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) REAL 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 >= max(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) REAL 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 >= max(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 < max(1,*n)) {
*info = -4;
} else if (*ldb < max(1,*n)) {
*info = -7;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("SGESV ", &i__1);
return 0;
}
/* Compute the LU factorization of A. */
sgetrf_(n, n, &a[a_offset], lda, &ipiv[1], info);
if (*info == 0) {
/* Solve the system A*X = B, overwriting B with X. */
sgetrs_("No transpose", n, nrhs, &a[a_offset], lda, &ipiv[1], &b[
b_offset], ldb, info);
}
return 0;
/* End of SGESV */
} /* sgesv_ */
|
