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); }