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