void mexFunction(int nlhs, mxArray *plhs[],
int nrhs, const mxArray *prhs[]){
/*Declarar las variables locales*/
mexPrintf("hios\n"); //Tarea1 termina aqui
double *A, *B, determinante;
int *pivot, info, Nfilas, Ncolumnas;
/*Insertar el código */
if (nrhs != 1){ // nº args diferente de 1
mexErrMsgTxt("Error. myla, Debe tener un arg de entrada");
}
if (!mxIsNumeric(prhs[0])){
mexErrMsgTxt("Error. El argumento de entrada debe ser una matriz");
}
Nfilas = mxGetM(prhs[0]);
Ncolumnas = mxGetN(prhs[0]);
if (Nfilas != Ncolumnas){
mexErrMsgTxt("Error. La matriz debe ser cuadrada");
}
if (Nfilas == 0){
mexErrMsgTxt("Error. La matriz debe no ser vacía");
}
if (nlhs > 2){
mexErrMsgTxt("Error. Debe haber uno o dos args de salida");
}
// copia de las variables
A = mxGetPr(prhs[0]);
B = (double *)mkl_malloc(Nfilas*Ncolumnas*sizeof(double), 64);
memcpy(B, A, Nfilas*Ncolumnas*sizeof(double));
pivot = (int *)mkl_malloc(Nfilas*sizeof(int), 32);
//procesos computacionales
info = LAPACKE_dgetrf(LAPACK_COL_MAJOR, Nfilas, Ncolumnas, B, Ncolumnas, pivot);
determinante = 1.0;
for (int i = 0; i < Nfilas; i++){
if (pivot[i] != (i+1)){
determinante *= -B[i*Ncolumnas + i];
}
else{
determinante *= B[i*Ncolumnas + i];
}
}
// crear los resultados de salida
plhs[0] = mxCreateDoubleScalar(determinante);
if (nlhs == 2){
if (fabs(determinante) < 1.0e-8){
mexWarnMsgTxt("Matriz singular o casi singular");
}
LAPACKE_dgetri(LAPACK_COL_MAJOR, Nfilas, B, Ncolumnas, pivot);
plhs[1] = mxCreateDoubleMatrix(Nfilas, Ncolumnas, mxREAL);
double *C = mxGetPr(plhs[1]);
memcpy(C, B, Nfilas*Ncolumnas*sizeof(double));
}
mkl_free(pivot);
mkl_free(B);
}
//Given a value, calculates the sylvester's determinant with the use of LAPACKE_dgetrf
double SylvesterDeterminant(Sylvester * sylv, double value, int print){
int i=0,j=0;
int dim=sylv->dim;
double ** matrix=NULL;
double * matrix1d;
double det=1;
int * ipiv=NULL;
matrix=malloc(sizeof(double*)*dim);
if(matrix==NULL){perror("Det matrix malloc 1D");exit(0);}
for(i=0;i<dim;i++){
matrix[i]=malloc(sizeof(double)*dim);
if(matrix[i]==NULL){perror("Det matrix malloc 2D");exit(0);}
}
ipiv=LAPACKE_malloc(sizeof(int) * (dim*(dim>=6) + 6*(dim<6)) );
if(ipiv==NULL){perror("ipiv malloc comp matrx creation");exit(0);}
for(i=0;i<dim;i++){
for(j=0;j<dim;j++){
matrix[i][j]=get_polyonymvalue(&(sylv->matrix[i][j]), value);
}
}
if(print==1){
for(i=0;i<dim;i++){
for(j=0;j<dim;j++){
printf("%.5f|\t",matrix[i][j]);
}
printf("\n");
}
}
from2Dto1D_double(matrix, &matrix1d, dim, dim);
LAPACKE_dgetrf(LAPACK_ROW_MAJOR, dim, dim, matrix1d, dim, ipiv);
for(i=0;i<dim;i++){
det=det*( (ipiv[i]==(i+1)) + (-1)*(ipiv[i]!=(i+1)) ) *(matrix1d[i*dim+i]);
}
free(matrix1d);
LAPACKE_free(ipiv);
for(i=0;i<dim;i++){free(matrix[i]);}
free(matrix);
return det;
}
void
doit_in_col_major (const char * description,
const int Anrows, const int Ancols, double A[Ancols][Anrows],
double packedLU[Ancols][Anrows])
{
lapack_int ldA = Anrows; /* leading dimension of A */
/* Lower-triangular factor L. */
lapack_int Lnrows = Anrows;
lapack_int Lncols = MIN(Anrows,Ancols);
lapack_int ldL = Lnrows;
double L[Lncols][Lnrows];
/* Upper-triangular factor U. */
lapack_int Unrows = MIN(Anrows,Ancols);
lapack_int Uncols = Ancols;
lapack_int ldU = Unrows;
double U[Uncols][Unrows];
/* Result of computation: tuple of partial pivot indices representing
the permutation matrix. */
lapack_int IPIV_DIM = MIN(Anrows,Ancols);
lapack_int ipiv[IPIV_DIM];
/* Result of computation: error code, zero if success. */
lapack_int info;
/* Data needed to reconstruct A from the results: permutations
vector. */
int perms[Anrows];
/* Data needed to reconstruct A from the results: matrix A1 = LU. */
lapack_int ldA1 = ldA;
double A1[Ancols][Anrows];
/* Data needed to reconstruct A from the results: permutation
matrix. */
int P[Anrows][Anrows];
/* Data needed to reconstruct A from the results:
*
* reconstructed_A_ipiv = P A1 = PLU
*
* reconstructed by applying IPIV to A1 backwards.
*/
double reconstructed_A_ipiv[Ancols][Anrows];
/* Data needed to reconstruct A from the results:
*
* reconstructed_A_P = P A1 = PLU
*
* reconstructed by left-multiplying A1 by the permutations matrix P.
*/
double reconstructed_A_P[Ancols][Anrows];
/* Load the original coefficients matrix from A to packedLU. The LU
factorisation result of dgetrf() will be stored in packedLU,
overwriting it. */
memcpy(packedLU, A, sizeof(double) * Anrows * Ancols);
/* Do it. */
info = LAPACKE_dgetrf(LAPACK_COL_MAJOR, Anrows, Ancols, MREF(packedLU), ldA, VREF(ipiv));
/* If something went wrong in the function call INFO is non-zero: exit
with failure. */
if (0 != info) {
printf("Error computing solution with col-major operands: INFO=%d.\n", info);
exit(EXIT_FAILURE);
}
/* Reconstruct A from the results. */
{
col_major_PLU_permutation_matrix_from_ipiv (Anrows, Ancols, ipiv, perms, P);
real_col_major_split_LU(Anrows, Ancols, MIN(Anrows, Ancols), packedLU, L, U);
/* Multiply L and U to verify that the result is indeed PA; we need
* CBLAS for this. In general DGEMM does:
*
* \alpha A B + \beta C
*
* where A, B and C are matrices. We need to inspect both the
* header file "cblas.h" and the source file "dgemm.f" for the
* documentation of the parameters; the prototype of "cblas_dgemm()"
* is:
*
* void cblas_dgemm(const enum CBLAS_ORDER Order,
* const enum CBLAS_TRANSPOSE TransA,
* const enum CBLAS_TRANSPOSE TransB,
* const int M, const int N, const int K,
* const double alpha,
* const double *A, const int lda,
* const double *B, const int ldb,
* const double beta,
* double *C, const int ldc);
*
* In our case all the matrices are in col-major order and we the
* representations in the arrays A and B are not transposed, so: M
* is the number of rows of A and C; N is the number of columns of B
* and of columns of C; K is the number of columns of A and rows of
* B. In other words:
*
* A has dimensions M x K
* B has dimensions K x N
* C has dimensions M x N
*
* obviously the product AB has dimensions M x N.
*
* Here we want to do:
*
* A1 = 1.0 L U + 0 A1
*
* where R is a matrix whose contents at input are not important,
* and whose contents at output are the result of the operation.
*/
if (1) {
double alpha = 1.0;
double beta = 0.0;
cblas_dgemm(CblasColMajor, CblasNoTrans, CblasNoTrans,
Anrows, Ancols, Lncols,
alpha, MREF(L), ldL, MREF(U), ldU, beta, MREF(A1), ldA1);
real_col_major_apply_ipiv (Anrows, Ancols, ipiv, BACKWARD_IPIV_APPLICATION,
reconstructed_A_ipiv, A1);
real_col_major_apply_permutation_matrix (Anrows, Ancols, reconstructed_A_P, P, A1);
}
}
printf("Column-major dgetrf results, %s:\n", description);
/* Result verification. */
if (1) {
compare_real_col_major_result_and_expected_result("reconstructed A with IPIV application",
Anrows, Ancols, reconstructed_A_ipiv, A);
compare_real_col_major_result_and_expected_result("reconstructed A with P application",
Anrows, Ancols, reconstructed_A_P, A);
}
/* Results logging. */
{
print_real_col_major_matrix("A, original coefficient matrix", Anrows, Ancols, A);
print_col_major_PLU_partial_pivoting_vectors_and_matrix (Anrows, Ancols, ipiv, perms, P);
print_real_col_major_matrix("packedLU representing L and U packed in single matrix",
Anrows, Ancols, packedLU);
print_real_col_major_matrix("L, elements of packedLU", Lnrows, Lncols, L);
print_real_col_major_matrix("U, elements of packedLU", Unrows, Uncols, U);
print_real_col_major_matrix("A1 = LU, it must be such that A = PR", Anrows, Ancols, A1);
print_real_col_major_matrix("reconstructed_A_ipiv = PA1 = PLU, it must be such that A = reconstructed_A",
Anrows, Ancols, reconstructed_A_ipiv);
print_real_col_major_matrix("reconstructed_A_P = PA1 = PLU, it must be such that A = reconstructed_A",
Anrows, Ancols, reconstructed_A_P);
}
}
int LUDecomposition(int argc, char *argv[]) {
int ret_code = 1;
int option;
unsigned long *II;
unsigned long *J;
double *values;
unsigned long M;
unsigned long N;
unsigned long long nz;
int _M;
int _N;
char *outputFileName = NULL;
char *inputMatrixFile = NULL;
int inputFormatRow = 0;
while ((option = getopt(argc, argv,"ro:")) >= 0) {
switch (option) {
case 'o' :
//free(outputFileName);
outputFileName = (char *) malloc(sizeof(char)*strlen(optarg)+1);
strcpy(outputFileName,optarg);
break;
case 'r':
inputFormatRow = 1;
break;
default: break;
}
}
if ((optind + 1 > argc) || (optind + 2 <= argc)) {
usageLUDecomposition();
return 0;
}
if(outputFileName == NULL) {
outputFileName = (char *) malloc(sizeof(char)*7);
sprintf(outputFileName,"stdout");
}
inputMatrixFile = (char *)malloc(sizeof(char)*strlen(argv[optind])+1);
strcpy(inputMatrixFile,argv[optind]);
//Read matrix
if(inputFormatRow){
if(!readDenseCoordinateMatrixRowLine(inputMatrixFile,&II,&J,&values,&M,&N,&nz)){
fprintf(stderr, "[%s] Can not read Matrix\n",__func__);
return 0;
}
}
else {
if(!readDenseCoordinateMatrix(inputMatrixFile,&II,&J,&values,&M,&N,&nz)){
fprintf(stderr, "[%s] Can not read Matrix\n",__func__);
return 0;
}
}
_M = (int) M;
_N = (int) N;
int ipiv[_M];
/*
lapack_int LAPACKE_dgetrf( int matrix_layout, lapack_int m, lapack_int n,
double* a, lapack_int lda, lapack_int* ipiv );
*/
ret_code = LAPACKE_dgetrf(LAPACK_ROW_MAJOR,_M,_N, values,_N, ipiv);
if(inputFormatRow){
writeLUCoordinateMatrixRowLine(outputFileName, values,M,N,nz, ipiv);
}
else{
writeLUCoordinateMatrix(outputFileName, values,M,N,nz, ipiv);
}
//writeDenseCoordinateMatrix("stdout",values,M,N,nz);
if(!ret_code)
return 1;
else
return 0;
}
/* Main program */
int main() {
/* Locals */
lapack_int n = N, nrhs = NRHS, lda = LDA, ldb = LDB, info;
/* Local arrays */
lapack_int ipiv[N];
double a[LDA*N] = {
6.80, -6.05, -0.45, 8.32, -9.67,
-2.11, -3.30, 2.58, 2.71, -5.14,
5.66, 5.36, -2.70, 4.35, -7.26,
5.97, -4.44, 0.27, -7.17, 6.08,
8.23, 1.08, 9.04, 2.14, -6.87
};
double b[LDB*N] = {
4.02, -1.56, 9.81,
6.19, 4.00, -4.09,
-8.22, -8.67, -4.57,
-7.57, 1.75, -8.61,
-3.03, 2.86, 8.99
};
double aNorm;
double rcond;
char ONE_NORM = '1';
lapack_int NROWS = n;
lapack_int NCOLS = n;
lapack_int LEADING_DIMENSION_A = n;
/* Print Entry Matrix */
print_matrix( "Entry Matrix A", n, n, a, lda );
/* Print Right Rand Side */
print_matrix( "Right Rand Side", n, nrhs, b, ldb );
printf( "\n" );
/* Executable statements */
printf( "LAPACKE_dgecon Example Program Results\n" );
aNorm = LAPACKE_dlange(LAPACK_ROW_MAJOR, ONE_NORM, NROWS, NCOLS, a, LEADING_DIMENSION_A);
info = LAPACKE_dgetrf(LAPACK_ROW_MAJOR, NROWS, NCOLS, a, LEADING_DIMENSION_A, ipiv);
info = LAPACKE_dgecon(LAPACK_ROW_MAJOR, ONE_NORM, n, a, LEADING_DIMENSION_A, aNorm, &rcond); // aNorm should be 35.019999999999996
double work[4*N];
int iwork[N];
//info = LAPACKE_dgecon_work(LAPACK_ROW_MAJOR, ONE_NORM, n, a, LEADING_DIMENSION_A, aNorm, &rcond, work, iwork); // aNorm should be 35.019999999999996
//dgecon_( &ONE_NORM, &n, a, &LEADING_DIMENSION_A, &aNorm, &rcond, work, iwork, &info );
/* Check for the exact singularity */
if (info == 0)
{
printf("LAPACKE_dgecon completed SUCCESSFULLY...\n");
}
else if ( info < 0 )
{
printf( "Element %d of A had an illegal value\n", -info );
exit( 1 );
}
else
{
printf( "Unrecognized value of INFO = %d\n", info );
exit( 1 );
}
/* Print solution */
printf("LAPACKE_dlange / One-norm of A = %lf\n", aNorm);
printf("LAPACKE_dgecon / RCOND of A = %f\n", rcond);
exit( 0 );
} /* End of LAPACKE_dgesv Example */
void runSequentialLU(double *matrix, int matrixSize)
{
int *piv = new int[matrixSize*matrixSize];
LAPACKE_dgetrf(LAPACK_COL_MAJOR, matrixSize, matrixSize, matrix, matrixSize, piv);
}
