int main()
{
int n = 3;
int info;
int ipiv[3];
double a[3][3] = {10., 1., 5.,
1., 2., -1.,
5., -1., 5.};
double b[3][3] = { 1., 0., 0.,
0., 1., 0.,
0., 0., 1.};
for (int i = 0; i < n; ++i)
{
for (int j = 0; j < n; ++j)
cout << setw(10) << a[j][i];
cout << endl;
}
cout << endl;
dgetf2(n, n, (double*)a, ipiv, info);
for (int i = 0; i < n; ++i)
{
for (int j = 0; j < n; ++j)
cout << setw(10) << a[j][i];
cout << endl;
}
cout << "info is " << info << endl;
dgetrs(n, n, 3, (double*)a, ipiv, (double*)b);
for (int i = 0; i < n; ++i)
{
for (int j = 0; j < n; ++j)
cout << setw(10) << b[j][i];
cout << endl;
}
return 0;
}
void dgetrf( long m, long n, double a[], long lda, long ipiv[], long *info )
{
/**
* -- LAPACK routine (version 1.1) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* March 31, 1993
*
* .. Scalar Arguments ..*/
/** ..
* .. Array Arguments ..*/
#undef ipiv_1
#define ipiv_1(a1) ipiv[a1-1]
#undef a_2
#define a_2(a1,a2) a[a1-1+lda*(a2-1)]
/** ..
*
* Purpose
* =======
*
* DGETRF computes an LU factorization of a general M-by-N matrix A
* using partial pivoting with row interchanges.
*
* The factorization has the form
* A = P * L * U
* where P is a permutation matrix, L is lower triangular with unit
* diagonal elements (lower trapezoidal if m > n), and U is upper
* triangular (upper trapezoidal if m < n).
*
* This is the right-looking Level 3 BLAS version of the algorithm.
*
* Arguments
* =========
*
* M (input) INTEGER
* The number of rows of the matrix A. M >= 0.
*
* N (input) INTEGER
* The number of columns of the matrix A. N >= 0.
*
* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
* On entry, the M-by-N matrix to be factored.
* 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,M).
*
* IPIV (output) INTEGER array, dimension (min(M,N))
* The pivot indices; for 1 <= i <= min(M,N), row i of the
* matrix was interchanged with row IPIV(i).
*
* 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, and division by zero will occur if it is used
* to solve a system of equations.
*
* =====================================================================
*
* .. Parameters ..*/
#undef one
#define one 1.0e+0
/** ..
* .. Local Scalars ..*/
long i, iinfo, j, jb, nb;
/** ..
* .. Intrinsic Functions ..*/
/* intrinsic max, min;*/
/** ..
* .. Executable Statements ..
*
* Test the input parameters.
**/
/*-----implicit-declarations-----*/
/*-----end-of-declarations-----*/
*info = 0;
if( m<0 ) {
*info = -1;
} else if( n<0 ) {
*info = -2;
} else if( lda<max( 1, m ) ) {
*info = -4;
}
if( *info!=0 ) {
xerbla( "dgetrf", -*info );
return;
}
/**
* Quick return if possible
**/
if( m==0 || n==0 )
return;
/**
* Determine the block size for this environment.
**/
nb = ilaenv( 1, "dgetrf", " ", m, n, -1, -1 );
if( nb<=1 || nb>=min( m, n ) ) {
/**
* Use unblocked code.
**/
dgetf2( m, n, a, lda, ipiv, info );
} else {
/**
* Use blocked code.
**/
for (j=1 ; nb>0?j<=min( m, n ):j>=min( m, n ) ; j+=nb) {
jb = min( min( m, n )-j+1, nb );
/**
* Factor diagonal and subdiagonal blocks and test for exact
* singularity.
**/
dgetf2( m-j+1, jb, &a_2( j, j ), lda, &ipiv_1( j ), &iinfo );
/**
* Adjust INFO and the pivot indices.
**/
if( *info==0 && iinfo>0 )
*info = iinfo + j - 1;
for (i=j ; i<=min( m, j+jb-1 ) ; i+=1) {
ipiv_1( i ) = j - 1 + ipiv_1( i );
}
/**
* Apply interchanges to columns 1:J-1.
**/
dlaswp( j-1, a, lda, j, j+jb-1, ipiv, 1 );
if( j+jb<=n ) {
/**
* Apply interchanges to columns J+JB:N.
**/
dlaswp( n-j-jb+1, &a_2( 1, j+jb ), lda, j, j+jb-1,
ipiv, 1 );
/**
* Compute block row of U.
**/
cblas_dtrsm(CblasColMajor, CblasLeft, CblasLower, CblasNoTrans,
CblasUnit, jb, n-j-jb+1, one, &a_2( j, j ), lda,
&a_2( j, j+jb ), lda );
if( j+jb<=m ) {
/**
* Update trailing submatrix.
**/
cblas_dgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, m-j-jb+1,
n-j-jb+1, jb, -one, &a_2( j+jb, j ), lda,
&a_2( j, j+jb ), lda, one, &a_2( j+jb, j+jb ), lda );
}
}
}
}
return;
/**
* End of DGETRF
**/
}
