matrix_t matrix_t::solve(matrix_t const &rhs) const { stack::fe_asserter dummy{}; // it appears as if dgesv works only for square matrices Oo // --> if the matrix was rectangular, then they system would be over/under determined // and we would need least squares instead (LAPACKE_dgels) stack_assert(get_rows() == get_cols()); stack_assert(this->get_rows() == rhs.get_rows()); // TODO assert that this matrix is not singular matrix_t A = this->clone(); // will be overwritten by LU factorization matrix_t b = rhs.clone(); // thes solution is overwritten in b vector_ll_t ipiv{A.get_rows()}; stack_assert(0 == LAPACKE_dgesv(LAPACK_COL_MAJOR, A.get_rows(), rhs.get_cols()/*nrhs*/, A.get_data(), A.ld(), ipiv.get_data(), b.get_data(), b.ld())); return b; }
bool SingularPart::newtonRaphson(double* sigma, double* beta, double* diffOp) const { int nTheta = basis->getRank(); double* residue = new double[nTheta]; double* jacobian = new double[nTheta*nTheta]; double totalResidue = fillResidue(sigma, beta, diffOp, residue); int maxIterations = 10, nIterations = 0; double tolerance = 1.0e-12*nTheta; double p = getRegularityPower(); while (totalResidue > tolerance && nIterations++ < maxIterations) { // Make the Jacobian for (int i = 0; i < nTheta; i++) { for (int j = 0; j < nTheta; j++) { int iTrans = basis->index(j,i); int iDirect = basis->index(i,j); // We transpose because of usage of Lapack (fortran). jacobian[iTrans] = diffOp[iDirect]; } int iDelta = basis->index(i,i); jacobian[iDelta] += p*(p-1.) - 0.875*beta[i]*pow(sigma[i], -8); } // Solve the linear system. int one = 1, pivots[nTheta]; #warning "TODO: Don't need to compute transpose." int info = LAPACKE_dgesv(LAPACK_COL_MAJOR, nTheta, one, jacobian, nTheta, pivots, residue, nTheta); for (int i = 0; i < nTheta; i++) { sigma[i] += residue[i]; } totalResidue = fillResidue(sigma, beta, diffOp, residue); } return (maxIterations >= nIterations) && (totalResidue < tolerance); }
int BACKEND_dgesv(int n, int nrhs, double* a, int lda, int* ipiv, double* b, int ldb) { return LAPACKE_dgesv(LAPACK_ROW_MAJOR, n, nrhs, a, lda, ipiv, b, ldb ); }
int solve(double *A, double *b,long nnn) { int *IPIV = new int[nnn] (); int n_col_b = 1; int INFO = LAPACKE_dgesv(LAPACK_COL_MAJOR,nnn,n_col_b,A,nnn,IPIV,b,nnn); delete [] IPIV; return INFO; }
int main() { /*int N = 4; double A[16] = { 1, 2 , 3 , 1, 4, 2 , 0 , 2, -2, 0 ,-1 , 2, 3, 4 , 2 ,-3}; double B[8] = { 6, 2 , 1 , 8, 1, 2 , 3 , 4}; int ipiv[4]; int n = N; int nrhs = 2; int lda = N; int ldb = 2;*/ int N = 3; double A[9] = { 1, 3, 5, 2, 4, 7, -3, 2, 5 }; double B[3] = { 2, -1, -5}; int ipiv[3]; int n = N; int nrhs = 1; int lda = N; int ldb = 1; int info = LAPACKE_dgesv(LAPACK_ROW_MAJOR, n, nrhs, A, lda, ipiv, B, ldb); printf("info:%d\n", info); if (info == 0) { int i = 0; int j = 0; for (j = 0; j < nrhs; j++) { printf("x%d\n", j); for (i = 0; i < N; i++) printf("%.6g \t", B[i + j * N]); printf("\n"); } } return 0; }
double partial_autocorrelation(double* series, unsigned int size, unsigned int lag, double mean){ int i, j; double* ac = (double*)malloc(lag*sizeof(double)); double* A = (double*)malloc(lag*lag*sizeof(double)); double* b = (double*)malloc(lag*sizeof(double)); int* ipiv = (int*)malloc(lag*sizeof(int)); for(i=0;i<(int)lag;i++){ ac[i] = autocorrelation(series, size, i+1, mean); b[i] = ac[i]; } for(i=0;i<(int)lag;i++){ for(j=0;j<(int)lag;j++){ if(i==j){ A[lag*i+j] = 1.0f; }else{ A[lag*i+j] = ac[abs(j-i)-1]; } } } LAPACKE_dgesv(LAPACK_ROW_MAJOR, lag, 1, A, lag, ipiv, b, 1); double partial_correlation = b[lag-1]; free(ac); free(A); free(b); free(ipiv); return partial_correlation; }
/* Main program */ int main() { /* Locals */ lapack_int n = N, nrhs = NRHS, lda = LDA, ldb = LDB, info; /* Local arrays */ lapack_int ipiv[N]; int i, j; for (i = 0; i < LDA; i++){ for (j = 0; j < N; j++) fscanf(stdin, "%lf", &a[i*N+j]); fscanf(stdin, "%lf", &b[i]); } /* 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_dgesv (row-major, high-level) Example Program Results\n" ); /* Solve the equations A*X = B */ info = LAPACKE_dgesv( LAPACK_ROW_MAJOR, n, nrhs, a, lda, ipiv, b, ldb ); /* Check for the exact singularity */ if( info > 0 ) { printf( "The diagonal element of the triangular factor of A,\n" ); printf( "U(%i,%i) is zero, so that A is singular;\n", info, info ); printf( "the solution could not be computed.\n" ); exit( 1 ); } /* Print solution */ //print_matrix( "Solution", n, nrhs, b, ldb ); /* Print details of LU factorization */ //print_matrix( "Details of LU factorization", n, n, a, lda ); /* Print pivot indices */ //print_int_vector( "Pivot indices", n, ipiv ); exit( 0 ); } /* End of LAPACKE_dgesv Example */
int main(int argc, char *argv[]){ double inicio, fin = dsecnd(); double *A = (double *)mkl_malloc(N*N*sizeof(double), 64); double *B = (double *)mkl_malloc(N*sizeof(double), 64); int *pivot = (int *)mkl_malloc(N*sizeof(int), 32); // distribucion normal de media 0 y varianza 1 std::default_random_engine generador; std::normal_distribution<double> aleatorio(0.0, 1.0); for (int i = 0; i < N*N; i++) A[i] = aleatorio(generador); for (int i = 0; i < N; i++) B[i] = aleatorio(generador); // matriz A marcadamente diagonal para evitar riesgo de singularidad for (int i = 0; i < N; i++) A[i*N + i] += 10.0; int result; inicio = dsecnd(); for (int i = 0; i < NTEST; i++) result = LAPACKE_dgesv(LAPACK_ROW_MAJOR, N, 1, A, N, pivot, B, 1); fin = dsecnd(); double tiempo = (fin - inicio) / (double)NTEST; printf("Tiempo: %lf msec\n", tiempo*1.0e3); mkl_free(A); mkl_free(B); std::getchar(); return 0; }
void doit_in_col_major (const char * description, const int N, const int NRHS, double A[N][N], double X[NRHS][N], double B[NRHS][N], double expected_X[NRHS][N]) { lapack_int Anrows = N; lapack_int Ancols = N; lapack_int ldA = Anrows; /* leading dimension of A */ lapack_int ldB = N; /* leading dimension of B */ /* Result of computation: permuted matrix A decomposed in LU. */ double packedLU[Ancols][Anrows]; /* Result of computation: tuple of partial pivot indexes 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: permutation vector. */ int perms[Anrows]; /* Data needed to reconstruct A from the results: permutation matrix, such that A = PLU. */ int Pnrows = Anrows; int Pncols = Anrows; int P[Pncols][Pnrows]; /* Lower-triangular factor L. */ lapack_int Lnrows = Anrows; lapack_int Lncols = MIN(Anrows,Ancols); lapack_int ldL = Lncols; double L[Lncols][Lnrows]; /* Upper-triangular factor U. */ lapack_int Unrows = MIN(Anrows,Ancols); lapack_int Uncols = Ancols; lapack_int ldU = Uncols; double U[Uncols][Unrows]; /* Data needed to reconstruct A from the results: product A1 = LU, such that A = P A1. */ double A1[Ancols][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 dgesv() will be stored in packedLU, overwriting it. */ memcpy(packedLU, A, sizeof(double) * Anrows * Ancols); /* Load the right-hand side from B to X. The unknowns result of dgesv() will be stored in X, overwriting it. */ memcpy(X, B, sizeof(double) * N * NRHS); /* Do it. */ info = LAPACKE_dgesv(LAPACK_COL_MAJOR, N, NRHS, MREF(packedLU), ldA, VREF(ipiv), MREF(X), ldB); /* If something went wrong in the function call INFO is non-zero: exit with failure. */ if (0 != info) { printf("Error computing solution with row-major operands: INFO=%d.\n", info); exit(EXIT_FAILURE); } /* Reconstructing 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 A1 is a matrix whose contents at input are not important, * and whose contents at output are the result of the operation. */ { 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), ldA); 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 dgesv results, %s:\n", description); /* Result verification. */ { compare_real_col_major_result_and_expected_result("computed unknowns", N, NRHS, X, expected_X); 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("X, resulting unknowns", N, NRHS, X); 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); } }
/* * Use DIIS to help SCF */ void calculateSCFDIIS(molecule_t *molecule) { #define EPS 0.0000000000001 #define DEL 0.0000000000001 double **fs[6], **es[6], **b, *c; int **piv; hamiltonian(molecule); sqrtMolecule(molecule); int n = molecule->orbitals; //So that the same thing does not need to be typed repeatedly. int count = 0; double elec, energy = 0, elast, rms; double **f0, **f1, **f2, **c0, **c1, **d0, **d1, **work1, **work2, **work3, **ham, **shalf, **s; double **sort; f0 = calloc_contiguous(2, sizeof(double), n, n); f1 = calloc_contiguous(2, sizeof(double), n, n); f2 = calloc_contiguous(2, sizeof(double), n, n); c0 = calloc_contiguous(2, sizeof(double), n, n); c1 = calloc_contiguous(2, sizeof(double), n, n); d0 = calloc_contiguous(2, sizeof(double), n, n); d1 = calloc_contiguous(2, sizeof(double), n, n); work1 = calloc_contiguous(2, sizeof(double), n, n); work2 = calloc_contiguous(2, sizeof(double), n, n); work3 = calloc_contiguous(2, sizeof(double), n, n); ham = calloc_contiguous(2, sizeof(double), n, n); shalf = calloc_contiguous(2, sizeof(double), n, n); sort = calloc_contiguous(2, sizeof(double), n, n); b = calloc_contiguous(2, sizeof(double), 7, 7); c = calloc(7, sizeof(double)); s = calloc_contiguous(2, sizeof(double), n, n); piv = calloc_contiguous(2, sizeof(double), 7, 7); for(int i = 0; i < 6; i++) { fs[i] = calloc_contiguous(2, sizeof(double), n, n); es[i] = calloc_contiguous(2, sizeof(double), n, n); } for(int i = 0; i < n; i++) { for(int j = 0; j < n; j++) { s[i][j] = molecule->overlap[i][j]; shalf[i][j] = molecule->symmetric[i][j]; } } printf("\nElec\t\tEnergy\t\tDiff\t\tRMS\n"); do { elast = energy; if(count == 0) { for(int i = 0; i < n; i++) { for(int j = 0; j < n; j++) { //Find the initial Fock guess. f0[i][j] = ham[i][j] = molecule->hamiltonian[i][j]; } } } else { memcpy(*d1, *d0, n * n * sizeof(double)); for(int i = 0; i < n; i++) { for(int j = 0; j < n; j++) { f0[i][j] = ham[i][j]; for(int k = 0; k < n; k++) { for(int l = 0; l < n; l++) { f0[i][j] += d0[k][l] * (2 * molecule->two_electron[TEI(i, j, k, l)] - molecule->two_electron[TEI(i, k, j, l)]); } } } } } //DIIS extrapolation. memcpy(*(fs[count % 6]), *f0, n * n * sizeof(double)); cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, n, n, n, 1.0, *s, n, *d0, n, 0, *work1, n); cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, n, n, n, 1.0, *work1, n, *f0, n, 0, *work2, n); cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, n, n, n, 1.0, *f0, n, *d0, n, 0, *work1, n); cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, n, n, n, 1.0, *work1, n, *s, n, 0, *work3, n); for(int i = 0; i < n; i++) { for(int j = 0; j < n; j++) { es[count % 6][i][j] = work3[i][j] - work2[i][j]; } } if(count >= 6) { for(int i = 0; i < ((count > 6)? 6: count); i++) { for(int j = 0; j < ((count > 6)? 6: count); j++) { b[i][j] = 0; for(int k = 0; k < n; k++) { for(int l = 0; l < n; l++) { b[i][j] += es[i][k][l] * es[j][k][l]; } } } } if(count < 6) { for(int i = 0; i < 6; i++) { for(int j = 0; j < 6; j++) { if(i < count && j < count) { continue; } if(i == j) { b[i][j] = 1; } else { b[i][j] = 0; } } } } for(int i = 0; i < 6; i++) { b[6][i] = -1; b[i][6] = -1; c[i] = 0; } b[6][6] = 0; c[6] = -1; LAPACKE_dgesv(LAPACK_ROW_MAJOR, 7, 1, *b, 7, *piv, c, 1); for(int i = 0; i < n; i++) { for(int j = 0; j < n; j++) { f2[i][j] = 0; for(int m = 0; m < 6; m++) { f2[i][j] += c[m] * fs[m][i][j]; } } } cblas_dgemm(CblasRowMajor, CblasTrans, CblasNoTrans, n, n, n, 1.0, *shalf, n, *f2, n, 0, *work1, n); cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, n, n, n, 1.0, *work1, n, *shalf, n, 0, *f1, n); } else { cblas_dgemm(CblasRowMajor, CblasTrans, CblasNoTrans, n, n, n, 1.0, *shalf, n, *f0, n, 0, *work1, n); cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, n, n, n, 1.0, *work1, n, *shalf, n, 0, *f1, n); } memset(work1[0], 0, n * n * sizeof(double)); memset(work2[0], 0, n * n * sizeof(double)); memset(work3[0], 0, n * n * sizeof(double)); LAPACKE_dgeev(LAPACK_ROW_MAJOR, 'N', 'V', n, *f1, n, *work1, *work2, *work3, n, *c1, n); //Prepare for sorting. for(int i = 0; i < n; i++) { for(int j = 0; j < n; j++) { work2[i][j] = c1[i][j]; } } //Sort for(int i = 0; i < n; i++) { sort[i] = work1[0] + i; } qsort(sort, n, sizeof(double *), comparedd); //Sift through data. for(int i = 0; i < n; i++) { unsigned long off = ((unsigned long) sort[i] - (unsigned long) work1[0]); off /= sizeof(double); for(int j = 0; j < n; j++) { c1[j][i] = work2[j][off]; } } cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, n, n, n, 1.0, *shalf, n, *c1, n, 0, *c0, n); for(int i = 0; i < n; i++) { for(int j = 0; j < n; j++) { d0[i][j] = 0; for(int k = 0; k < molecule->electrons / 2; k++) { d0[i][j] += c0[i][k] * c0[j][k]; } } } elec = 0; for(int i = 0; i < n; i++) { for(int j = 0; j < n; j++) { elec += d0[i][j] * (ham[i][j] + f0[i][j]); } } energy = elec + molecule->enuc; rms = 0; for(int i = 0; i < n; i++) { for(int j = 0; j < n; j++) { rms += (d0[i][j] - d1[i][j]) * (d0[i][j] - d1[i][j]); } } rms = sqrt(rms); count++; printf("%d\t%.15f\t%.15f\t%.15f\t%.15f\n", count, elec, energy, fabs(elast - energy), rms); } while(count < 100 && (fabs(elast - energy) > EPS && rms > DEL)); molecule->scf_energy = energy; for(int i = 0; i < n; i++) { for(int j = 0; j < n; j++) { molecule->density[i][j] = d0[i][j]; molecule->fock[i][j] = f0[i][j]; molecule->molecular_orbitals[i][j] = c0[i][j]; molecule->molecular_eigs[i][j] = ((i == j)? sort[i][0]: 0); } } free_mult_contig(16, c0, c1, d0, d1, f0, f1, f2, ham, shalf, work1, work2, work3, sort, b, c, s); for(int i = 0; i < 6; i++) { free(fs[i]); free(es[i]); } }
void Compute_primal_dual_direction (const struct_ip_vars &s_ip_vars, struct_primal_dual_direction &s_primal_dual_dir) { int i,j,k,m; double Hessian_Lagrangian [HESSIAN_LAGRANGIAN_SIZE][HESSIAN_LAGRANGIAN_SIZE]; Compute_Hessian_Lagrangian(s_ip_vars, Hessian_Lagrangian); double Jacobian_Inequalities [JACOBIAN_INEQUALITIES_NUM_ROWS][JACOBIAN_INEQUALITIES_NUM_COLS]; Compute_Jacobian_Inequalities(s_ip_vars, Jacobian_Inequalities); double Diag_Matrix_Sigma [DIAG_MATRIX_SIGMA_SIZE]; Compute_Diag_Matrix_Sigma(s_ip_vars, Diag_Matrix_Sigma); double Jacobian_Equalities [JACOBIAN_EQUALITIES_NUM_ROWS][JACOBIAN_EQUALITIES_NUM_COLS]; Compute_Jacobian_Equalities(s_ip_vars, Jacobian_Equalities); // ++ Create Sq_Matrix_A ++ double Sq_Matrix_A [SQ_MATRIX_A_SIZE][SQ_MATRIX_A_SIZE]; for(i = 0; i < SQ_MATRIX_A_SIZE; i++) for(j = 0; j < SQ_MATRIX_A_SIZE; j++) { Sq_Matrix_A[i][j] = 0.0; } for(i = 0; i < HESSIAN_LAGRANGIAN_SIZE; i++) for(j = 0; j < HESSIAN_LAGRANGIAN_SIZE; j++) { Sq_Matrix_A[i][j] = Hessian_Lagrangian[i][j]; } for(i = 0, k = ( HESSIAN_LAGRANGIAN_SIZE + DIAG_MATRIX_SIGMA_SIZE); i < JACOBIAN_EQUALITIES_NUM_ROWS ; i++, k++) for(j = 0, m = 0; j < JACOBIAN_EQUALITIES_NUM_COLS; j++, m++) { Sq_Matrix_A[k][m] = Jacobian_Equalities[i][j]; } for(i = 0, k = ( HESSIAN_LAGRANGIAN_SIZE + DIAG_MATRIX_SIGMA_SIZE + JACOBIAN_EQUALITIES_NUM_ROWS ); i < JACOBIAN_INEQUALITIES_NUM_ROWS ; i++, k++) for(j = 0, m = 0; j < JACOBIAN_INEQUALITIES_NUM_COLS; j++, m++) { Sq_Matrix_A[k][m] = Jacobian_Inequalities[i][j]; } for(i = HESSIAN_LAGRANGIAN_SIZE, j = 0; i < ( HESSIAN_LAGRANGIAN_SIZE + DIAG_MATRIX_SIGMA_SIZE ); i++, j++ ) { Sq_Matrix_A[i][i] = Diag_Matrix_Sigma[j]; } for(i = ( HESSIAN_LAGRANGIAN_SIZE + DIAG_MATRIX_SIGMA_SIZE + JACOBIAN_EQUALITIES_NUM_ROWS ), j = JACOBIAN_INEQUALITIES_NUM_COLS; i < SQ_MATRIX_A_SIZE; i++, j++) { Sq_Matrix_A[i][j] = -1.0; } //copy upper triangular for(i = 0; i < SQ_MATRIX_A_SIZE; i++) for(j = 0; j < i; j++) { Sq_Matrix_A[j][i] = Sq_Matrix_A[i][j]; } // -- Create Sq_Matrix_A -- double Vector_b0 [VECTOR_SIZE_b0]; //Jacobian_Lagrangian Compute_Gradient_Lagrangian(s_ip_vars, Vector_b0); double Vector_b1 [VECTOR_SIZE_b1]; Compute_vector_b1(s_ip_vars, Vector_b1); double Vector_b2 [VECTOR_SIZE_b2]; Compute_vector_b2(s_ip_vars, Vector_b2); double Vector_b3 [VECTOR_SIZE_b3]; Compute_vector_b3(s_ip_vars, Vector_b3); //Create Vector b double Vector_b [VECTOR_b_SIZE]; j = 0; for(i = 0; i < VECTOR_SIZE_b0; i++, j++) Vector_b[j] = -Vector_b0[i]; for(i = 0; i < VECTOR_SIZE_b1; i++, j++) Vector_b[j] = -Vector_b1[i]; for(i = 0; i < VECTOR_SIZE_b2; i++, j++) Vector_b[j] = -Vector_b2[i]; for(i = 0; i < VECTOR_SIZE_b3; i++, j++) Vector_b[j] = -Vector_b3[i]; double Vector_x [VECTOR_x_SIZE]; /* ++ Solve Linear System ++ */ double a[SQ_MATRIX_A_SIZE * SQ_MATRIX_A_SIZE]; double b[VECTOR_b_SIZE]; //switch to column major for (i = 0; i < SQ_MATRIX_A_SIZE; i++) for(j = 0; j < SQ_MATRIX_A_SIZE; j++) a[j * SQ_MATRIX_A_SIZE + i] = Sq_Matrix_A[i][j]; for(i = 0; i < VECTOR_b_SIZE; i++) b[i] = Vector_b[i]; lapack_int n, nrhs, lda, ldb, info; n = SQ_MATRIX_A_SIZE; nrhs = 1; lda = SQ_MATRIX_A_SIZE; ldb = VECTOR_b_SIZE; lapack_int ipiv[SQ_MATRIX_A_SIZE]; // lapack_int LAPACKE_dgesv( int matrix_layout, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, lapack_int* ipiv, double* b, lapack_int ldb ); info = LAPACKE_dgesv( LAPACK_COL_MAJOR, n, nrhs, a, lda, ipiv, b, ldb ); if(info == 0) { for(i = 0; i < VECTOR_x_SIZE; i++) Vector_x[i] = b[i]; } else { printf("\nLapack error!!!\n"); printf("\ninfo = %d\n", info); exit(1); } /* -- Solve Linear System -- */ j = 0; for(i = 0; i < VECTOR_SIZE_Px; i++, j++) s_primal_dual_dir.Vector_Px[i] = Vector_x[j]; for(i = 0; i < VECTOR_SIZE_Ps; i++, j++) s_primal_dual_dir.Vector_Ps[i] = Vector_x[j]; for(i = 0; i < VECTOR_SIZE_Py; i++, j++) s_primal_dual_dir.Vector_Py[i] = -Vector_x[j]; for(i = 0; i < VECTOR_SIZE_Pz; i++, j++) s_primal_dual_dir.Vector_Pz[i] = -Vector_x[j]; }
template <> inline int gesvd(const char order, const int N, const int M, double *A, const int LDA, int *IPIV, double *B, const int LDB) { return LAPACKE_dgesv(order, N, M, A, LDA, IPIV, B, LDB); }
/* Main program */ int main(int argc, char **argv) { /* Locals */ lapack_int n, nrhs, lda, ldb, info; int i, j; /* Local arrays */ double *A, *b; lapack_int *ipiv; /* Default Value */ n = 5; nrhs = 1; /* Arguments */ for( i = 1; i < argc; i++ ) { if( strcmp( argv[i], "-n" ) == 0 ) { n = atoi(argv[i+1]); i++; } if( strcmp( argv[i], "-nrhs" ) == 0 ) { nrhs = atoi(argv[i+1]); i++; } } /* Initialization */ lda=n, ldb=nrhs; A = (double *)malloc(n*n*sizeof(double)) ; if (A==NULL){ printf("error of memory allocation\n"); exit(0); } b = (double *)malloc(n*nrhs*sizeof(double)) ; if (b==NULL){ printf("error of memory allocation\n"); exit(0); } ipiv = (lapack_int *)malloc(n*sizeof(lapack_int)) ; if (ipiv==NULL){ printf("error of memory allocation\n"); exit(0); } for( i = 0; i < n; i++ ) { for( j = 0; j < n; j++ ) A[i*lda+j] = ((double) rand()) / ((double) RAND_MAX) - 0.5; } for(i=0;i<n*nrhs;i++) b[i] = ((double) rand()) / ((double) RAND_MAX) - 0.5; /* Print Entry Matrix */ print_matrix_rowmajor( "Entry Matrix A", n, n, A, lda ); /* Print Right Rand Side */ print_matrix_rowmajor( "Right Rand Side b", n, nrhs, b, ldb ); printf( "\n" ); /* Executable statements */ printf( "LAPACKE_dgesv (row-major, high-level) Example Program Results\n" ); /* Solve the equations A*X = B */ info = LAPACKE_dgesv( LAPACK_ROW_MAJOR, n, nrhs, A, lda, ipiv, b, ldb ); /* Check for the exact singularity */ if( info > 0 ) { printf( "The diagonal element of the triangular factor of A,\n" ); printf( "U(%i,%i) is zero, so that A is singular;\n", info, info ); printf( "the solution could not be computed.\n" ); exit( 1 ); } if (info <0) exit( 1 ); /* Print solution */ print_matrix_rowmajor( "Solution", n, nrhs, b, ldb ); /* Print details of LU factorization */ print_matrix_rowmajor( "Details of LU factorization", n, n, A, lda ); /* Print pivot indices */ print_vector( "Pivot indices", n, ipiv ); exit( 0 ); } /* End of LAPACKE_dgesv Example */
// int main(int argc, char *argv[]) { int main(void) { int i; MKL_INT ipiv[NR_ELEMENTS]; // Integer Pivot Indices // Whatever that may mean MKL_INT info; // Variables right here // int CoreWidth = 100; // int CoreHeight = 100; int FixPoints[] = {100, 175, 200, 225}; //, 145, 250, 160, 150}; int NetList[] = {1, 2, 2, 3}; //, 1, 3, 1, 4, 3, 4, 1, 5, 2, 5}; int FixPNetList[] = {1, 1, 3, 2}; //, 2, 3, 3, 4, 4, 1, 4, 2, 4, 3, 4, 4, 5, 3}; // Count Element Wires int ElementConnections[NR_ELEMENTS] = {[0 ... (NR_ELEMENTS - 1)] = 0}; for (i = 0; i < NR_ARRAY_ELEMENTS(FixPNetList); i += 2) { ElementConnections[FixPNetList[i] - 1]++; printf(" %d, ",ElementConnections[i]); } printf("\n\n\n"); for (i = 0; i < NR_ARRAY_ELEMENTS(NetList); i++) { ElementConnections[NetList[i] - 1]++; printf(" %d, ",ElementConnections[i]); } printf("\n\n\n"); double matrixA[NR_ELEMENTS * NR_ELEMENTS] = {[0 ... (NR_ELEMENTS * NR_ELEMENTS - 1)] = 0}; // also {0}; is valid for (i = 0; i < NR_ARRAY_ELEMENTS(NetList); i += 2) { matrixA[(NetList[i] - 1)* NR_ELEMENTS + NetList[i + 1] - 1] = -1; matrixA[(NetList[i + 1] - 1)* NR_ELEMENTS + NetList[i] - 1] = -1; } for (i = 0; i < NR_ELEMENTS; i++) { matrixA[i * NR_ELEMENTS + i] = ElementConnections[i]; } print_matrix("Matrix A", NR_ELEMENTS, NR_ELEMENTS, matrixA, NR_ELEMENTS); double vectorB[NR_ELEMENTS * 2] = {[0 ... (NR_ELEMENTS * 2 - 1)] = 0}; // also {0}; is valid for (i = 0; i < NR_ARRAY_ELEMENTS(FixPNetList); i += 2) { vectorB[(FixPNetList[i] - 1) * NR_B_COEFF + 0] += FixPoints[FixPNetList[i] - 1]; vectorB[(FixPNetList[i] - 1) * NR_B_COEFF + 1] += FixPoints[FixPNetList[i]]; } //print_matrix("Vector B", NR_ELEMENTS, NR_B_COEFF, vectorB, NR_B_COEFF); printf("\nLAPACKE_dgesv(row-major, high-level): Quadratic Placement Results\n"); /* Paradime call * info = LAPACKE_dgesv(LAPACK_ROW_MAJOR, // You can call it LAPACK_COLUMN_MAJOR, but C-logic ain't * n, // *extrapolated* Number of Rows * nrhs, // CBLAS level 3 function: Matrix x Matrix <-- Number of concated vectors * a, // Pointer to A matrix * lda, // *extrapolated* Number of Columns -- possibly it is * ipiv, // *--Something--* * b, // Pointer to B vector - matrix * ldb // *extrapolated* Number of Columns * ); */ info = LAPACKE_dgesv(LAPACK_ROW_MAJOR, NR_ELEMENTS, NR_B_COEFF, matrixA, NR_ELEMENTS, ipiv, vectorB, NR_B_COEFF); /* Check for the exact singularity */ if (info > 0) { printf("The diagonal element of the triangular factor of A,\n"); printf("U(%i,%i) is zero, so that A is singular;\n", info, info); printf("the solution could not be computed.\n"); return (1); } /* Print solution */ //print_matrix("Solution", NR_ELEMENTS, NR_B_COEFF, vectorB, NR_B_COEFF); /* Print details of LU factorization */ //print_matrix("Details of LU factorization", NR_ELEMENTS, NR_ELEMENTS, matrixA, NR_ELEMENTS); /* Print pivot indices */ //print_int_vector("Pivot indices", NR_ELEMENTS, ipiv); return (0); }