int main(int argc, char *argv[]){
if (argc != 3){
printf("Please enter a matrix size and a method: 0 for LAPACK, 1 for C\n");
return EXIT_SUCCESS;
}
int n = atoi(argv[1]); /* matrix size */
int m = n/2; /* subproblem size */
int method = atoi(argv[2]);
/* Initial matrix */
double *T_D;
double *T_L;
T_D = malloc(n*sizeof(double));
T_L = malloc((n-1)*sizeof(double));
init_tridiagonal(n, T_D, T_L);
int i, j;
/* Subproblems */
double *T1_D;
double *T1_L;
double *T2_D;
double *T2_L;
T1_D = malloc(m*sizeof(double));
T1_L = malloc((m-1)*sizeof(double));
T2_D = malloc((n-m)*sizeof(double));
T2_L = malloc((n-m-1)*sizeof(double));
double beta = T_L[m-1];
split(n, m, T_D, T_L, T1_D, T1_L, T2_D, T2_L, beta);
/* Solve differents problems */
double *Q_ini = malloc(n*n*sizeof(double));
memset(Q_ini, 0, n*n*sizeof(double));
int info = LAPACKE_dstedc(LAPACK_COL_MAJOR, 'I', n, T_D, T_L, Q_ini, n);
assert(!info);
double *Q1 = malloc(m*m*sizeof(double));
memset(Q1, 0, m*m*sizeof(double));
info = LAPACKE_dstedc(LAPACK_COL_MAJOR, 'I', m, T1_D, T1_L, Q1, m);
assert(!info);
double *Q2 = malloc((n-m)*(n-m)*sizeof(double));
memset(Q2, 0, (n-m)*(n-m)*sizeof(double));
info = LAPACKE_dstedc(LAPACK_COL_MAJOR, 'I', n-m, T2_D, T2_L, Q2, n-m);
assert(!info);
/* Eigenvalues of the rank-1 perturbed matrix */
double *D;
D = malloc(n*sizeof(double));
for (i=0; i<m; i++){
D[i] = T1_D[i];
}
for (i=0; i<n-m; i++){
D[m+i] = T2_D[i];
}
/* Eigenvectors of the rank-1 perturbed matrix */
double *Q = malloc(n*n*sizeof(double));
memset(Q, 0, n*n*sizeof(double));
for (i=0; i<m; i++){
for (j=0; j<m; j++){
Q[n*i+j] = Q1[m*i+j];
}
}
for (i=0; i<n-m; i++){
for (j=0; j<n-m; j++){
Q[n*(m+i)+m+j] = Q2[(n-m)*i+j];
}
}
/* Saved eigenvalues with rank-1 pertubation */
double *saved = malloc(n*sizeof(double));
for (i=0; i<n; i++){
saved[i] = D[i];
}
/* Eigenvalues permutation: no permutation here */
int *perm;
perm = malloc(n*sizeof(int));
/* For C */
if (method == 1){
for (i=0; i<m; i++){
perm[i] = i;
}
for (i=m; i<n; i++){
perm[i] = i-m;
}
}
/* For Fortran */
else{
for (i=0; i<m; i++){
perm[i] = i+1;
}
for (i=m; i<n; i++){
perm[i] = i-m+1;
}
}
int K;
double *Z = malloc((n*n+4*n)*sizeof(double));
for (i=0; i<m; i++){
Z[i] = Q1[m*i+m-1];
}
for (i=m; i<n; i++){
Z[i] = Q2[(i-m)*(n-m)];
}
double *DLAMBDA;
double *W_3;
double *W5;
double *Q2_3;
DLAMBDA = Z + n;
W_3 = DLAMBDA + n;
Q2_3 = W_3 + n;
memset(Q2_3, 0, n*n*sizeof(double));
int *INDX;
int *INDXC;
int *INDXP;
int *COLTYP;
INDX = malloc(4*n*sizeof(int));
INDXC = INDX + n;
COLTYP = INDXC + n;
INDXP = COLTYP + n;
/* C version */
if (method == 1){
dlaed2(&K, &n, &m, D, Q, &n, perm, &beta, Z,
DLAMBDA, W_3, Q2_3,
INDX, INDXC, INDXP,
COLTYP, &info);
}
/* LAPACK version */
else{
dlaed2_(&K, &n, &m, D, Q, &n, perm, &beta, Z,
DLAMBDA, W_3, Q2_3,
INDX, INDXC, INDXP,
COLTYP, &info);
assert(!info);
}
/* Comparison C/LAPACK */
/* printf("N %d K %d\n", n, K); */
/* for (i=0; i<K; i++){ */
/* printf("PERM %10d DLAMBDA %10f W %10f\n", perm[i], DLAMBDA[i], W_3[i]); */
/* printf("INDX %10d INDXC %10d INDXP %10d COLTYP %10d\n", INDX[i], INDXC[i], INDXP[i], COLTYP[i]); */
/* } */
/* For Fortran change C exit: for dlaed2 in C and dlaed3 in f77 */
/* if (method == 1){ */
/* for (i=0; i<n; i++){ */
/* INDXC[i]++; */
/* } */
/* } */
/* printf("\nEigenvectors comparison\n"); */
/* for (i=0; i<n; i++){ */
/* for (j=0; j<n; j++){ */
/* printf("%10f", Q[n*i+j]); */
/* } */
/* printf("\n"); */
/* } */
W5 = Q2_3 + (COLTYP[0]+COLTYP[1]) * m + (COLTYP[1]+COLTYP[2]) * (n-m);
/* C Version */
if (method == 1){
dlaed3(&K, &n, &m, D, Q, &n, &beta, DLAMBDA,
Q2_3, INDXC, COLTYP,
W_3, W5, &info);
}
/* LAPACK Version */
else{
dlaed3_(&K, &n, &m, D, Q, &n, &beta, DLAMBDA,
Q2_3, INDXC, COLTYP,
W_3, W5, &info);
assert(!info);
}
/* Sort eigenvalues */
int n2 = n - K;
int id1 = 1;
int id2 = -1;
dlamrg_(&K, &n2, D, &id1, &id2, perm);
double *saved_D = malloc(n*sizeof(double));
memcpy(saved_D, D, n*sizeof(double));
/* WARNING: same operation for eigenvectors */
for (i=0; i<n; i++){
D[i] = saved_D[perm[i]-1];
}
free(saved_D);
/* printf("\nEigenvalues with beta %f\n", beta); */
/* for (i=0; i<n; i++){ */
/* printf("Saved %10f Found %10f Expected %10f\n", saved[i], D[i], T_D[i]); */
/* } */
/* printf("\nEigenvectors comparison\n"); */
/* for (i=0; i<n; i++){ */
/* for (j=0; j<n; j++){ */
/* printf("%10f", Q[n*i+j]); */
/* } */
/* printf("\n"); */
/* } */
free(Z);
free(INDX);
free(perm);
free(T_D);
free(T_L);
free(T1_D);
free(T1_L);
free(T2_D);
free(T2_L);
free(Q_ini);
free(Q1);
free(Q2);
free(D);
free(saved);
free(Q);
return EXIT_SUCCESS;
}
void lanczos(double *F, double *Es, double *L, int n_eigs, int n_patch,
int LANCZOS_ITR)
{
double *b;
double b_norm;
double *z;
double *alpha, *beta;
double *q;
int i;
double *eigvec; // eigenvectors
// generate random b with norm 1.
srand((unsigned int)time(NULL));
b = (double *)malloc(n_patch * sizeof(double));
for (i = 0; i < n_patch; i++)
b[i] = rand();
b_norm = norm2(b, n_patch);
for (i = 0; i < n_patch; i++)
b[i] /= b_norm;
alpha = (double *)malloc( (LANCZOS_ITR + 1) * sizeof(double) );
beta = (double *)malloc( (LANCZOS_ITR + 1) * sizeof(double) );
beta[0] = 0.0; // beta_0 <- 0
z = (double *)malloc( n_patch * sizeof(double));
q = (double *)malloc( n_patch * (LANCZOS_ITR + 2) * sizeof(double) );
memset(&q[0], 0, n_patch * sizeof(double)); // q_0 <- 0
memcpy(&q[n_patch], b, n_patch * sizeof(double)); // q_1 <- b
for (i = 1; i <= LANCZOS_ITR; i++) {
// z = L * Q(:, i)
cblas_dsymv(CblasColMajor, CblasLower, n_patch, 1.0, L,
n_patch, &q[i * n_patch], 1, 0.0, z, 1);
// alpha(i) = Q(:, i)' * z;
alpha[i] = cblas_ddot(n_patch, &q[i * n_patch], 1, z, 1);
// z = z - alpha(i) * Q(:, i)
cblas_daxpy(n_patch, -alpha[i], &q[i * n_patch], 1, z, 1);
// z = z - beta(i - 1) * Q(:, i - 1);
cblas_daxpy(n_patch, -beta[i - 1], &q[(i - 1) * n_patch], 1, z, 1);
// beta(i) = norm(z, 2);
beta[i] = cblas_dnrm2(n_patch, z, 1);
// Q(:, i + 1) = z / beta(i);
divide_copy(&q[(i + 1) * n_patch], z, n_patch, beta[i]);
}
// compute approximate eigensystem
eigvec = (double *)malloc(LANCZOS_ITR * LANCZOS_ITR * sizeof(double));
LAPACKE_dstedc(LAPACK_COL_MAJOR, 'I', LANCZOS_ITR, &alpha[1], &beta[1],
eigvec, LANCZOS_ITR);
// copy specified number of eigenvalues
memcpy(Es, &alpha[1], n_eigs * sizeof(double));
// V = Q(:, 1:k) * U
cblas_dgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, n_patch,
LANCZOS_ITR, LANCZOS_ITR, 1.0, &q[n_patch], n_patch, eigvec,
LANCZOS_ITR, 0.0, L, n_patch);
// copy the corresponding eigenvectors
memcpy(F, L, n_patch * n_eigs * sizeof(double));
free(b);
free(z);
free(alpha);
free(beta);
free(q);
free(eigvec);
}
void solve_tridiag_dc(int n, double *D, double *E, char type){
double *Q = malloc(n*n*sizeof(double)); assert(Q);
int info = LAPACKE_dstedc(LAPACK_COL_MAJOR, type, n, D, E, Q, n);
assert(!info);
free(Q);
}