void
gsl_eigen_genhermv_free (gsl_eigen_genhermv_workspace * w)
{
if (w->hermv_workspace_p)
gsl_eigen_hermv_free(w->hermv_workspace_p);
free(w);
} /* gsl_eigen_genhermv_free() */
void
gsl_eigen_genhermv_free (gsl_eigen_genhermv_workspace * w)
{
RETURN_IF_NULL (w);
if (w->hermv_workspace_p)
gsl_eigen_hermv_free(w->hermv_workspace_p);
free(w);
} /* gsl_eigen_genhermv_free() */
void
test_eigen_herm_matrix(const gsl_matrix_complex * m, size_t count,
const char * desc)
{
const size_t N = m->size1;
gsl_matrix_complex * A = gsl_matrix_complex_alloc(N, N);
gsl_vector * eval = gsl_vector_alloc(N);
gsl_vector * evalv = gsl_vector_alloc(N);
gsl_vector * x = gsl_vector_alloc(N);
gsl_vector * y = gsl_vector_alloc(N);
gsl_matrix_complex * evec = gsl_matrix_complex_alloc(N, N);
gsl_eigen_herm_workspace * w = gsl_eigen_herm_alloc(N);
gsl_eigen_hermv_workspace * wv = gsl_eigen_hermv_alloc(N);
gsl_matrix_complex_memcpy(A, m);
gsl_eigen_hermv(A, evalv, evec, wv);
test_eigen_herm_results(m, evalv, evec, count, desc, "unsorted");
gsl_matrix_complex_memcpy(A, m);
gsl_eigen_herm(A, eval, w);
/* sort eval and evalv */
gsl_vector_memcpy(x, eval);
gsl_vector_memcpy(y, evalv);
gsl_sort_vector(x);
gsl_sort_vector(y);
test_eigenvalues_real(y, x, desc, "unsorted");
gsl_eigen_hermv_sort(evalv, evec, GSL_EIGEN_SORT_VAL_ASC);
test_eigen_herm_results(m, evalv, evec, count, desc, "val/asc");
gsl_eigen_hermv_sort(evalv, evec, GSL_EIGEN_SORT_VAL_DESC);
test_eigen_herm_results(m, evalv, evec, count, desc, "val/desc");
gsl_eigen_hermv_sort(evalv, evec, GSL_EIGEN_SORT_ABS_ASC);
test_eigen_herm_results(m, evalv, evec, count, desc, "abs/asc");
gsl_eigen_hermv_sort(evalv, evec, GSL_EIGEN_SORT_ABS_DESC);
test_eigen_herm_results(m, evalv, evec, count, desc, "abs/desc");
gsl_matrix_complex_free(A);
gsl_vector_free(eval);
gsl_vector_free(evalv);
gsl_vector_free(x);
gsl_vector_free(y);
gsl_matrix_complex_free(evec);
gsl_eigen_herm_free(w);
gsl_eigen_hermv_free(wv);
} /* test_eigen_herm_matrix() */
void
qpb_sun_project(qpb_link *u, int n)
{
gsl_eigen_hermv_workspace *gsl_work = gsl_eigen_hermv_alloc(NC);
gsl_matrix_complex *B = gsl_matrix_complex_alloc(NC, NC);
gsl_matrix_complex *A = gsl_matrix_complex_alloc(NC, NC);
gsl_matrix_complex *V = gsl_matrix_complex_alloc(NC, NC);
gsl_matrix_complex *U = gsl_matrix_complex_alloc(NC, NC);
gsl_matrix_complex *D = gsl_matrix_complex_alloc(NC, NC);
gsl_vector *S = gsl_vector_alloc(NC);
gsl_permutation *perm = gsl_permutation_alloc(NC);
for(int k=0; k<n; k++){
qpb_complex *a = (qpb_complex *)(u + k);
for(int i=0; i<NC; i++)
for(int j=0; j<NC; j++)
gsl_matrix_complex_set(A, i, j, gsl_complex_rect(a[j + i*NC].re, a[j + i*NC].im));
gsl_matrix_complex_memcpy(U, A);
int sgn;
gsl_linalg_complex_LU_decomp(U, perm, &sgn);
gsl_complex det_A = gsl_linalg_complex_LU_det(U, sgn);
qpb_double phi = gsl_complex_arg(det_A);
gsl_complex one = gsl_complex_rect(1., 0.);
gsl_complex zero = gsl_complex_rect(0., 0.);
gsl_matrix_complex_memcpy(U, A);
svd(U, V, S);
get_theta_matrix(D, S, phi);
gsl_blas_zgemm(CblasNoTrans, CblasNoTrans, one, U, D, zero, B);
gsl_blas_zgemm(CblasNoTrans, CblasConjTrans, one, B, V, zero, A);
for(int i=0; i<NC; i++)
for(int j=0; j<NC; j++){
a[j + i*NC].re = GSL_REAL(gsl_matrix_complex_get(A, i, j));
a[j + i*NC].im = GSL_IMAG(gsl_matrix_complex_get(A, i, j));
}
}
gsl_matrix_complex_free(A);
gsl_matrix_complex_free(B);
gsl_matrix_complex_free(V);
gsl_matrix_complex_free(U);
gsl_matrix_complex_free(D);
gsl_permutation_free(perm);
gsl_vector_free(S);
gsl_eigen_hermv_free(gsl_work);
return;
}
WKSP::~WKSP()
{
printf("start memory free\n");
umat<gsl_eigen_hermv_workspace*> mat_gsl_eigen_hermv_workspace_pointer;
umat<gsl_matrix_complex*> mat_gsl_matrix_complex_pointer;
umat<gsl_vector*> mat_gsl_vector_pointer;
umat<double> mat_double;
for(int i=0; i<tot_th; i++)
{
gsl_eigen_hermv_free(ws[i]);
gsl_vector_free(eval[i]);
}
for(int i=0; i<N_radial; i++)
{
for(int j=0; j<N_theta; j++)
{
gsl_matrix_complex_free(eigen_state[i][j]);
gsl_matrix_complex_free(H[i][j]);
for(int e=0; e<N2; e++)
{
gsl_matrix_complex_free(epho[e][i][j]);
}
}
}
mat_gsl_matrix_complex_pointer.Tfree2(eigen_state);
mat_gsl_matrix_complex_pointer.Tfree2(H);
mat_gsl_matrix_complex_pointer.Tfree3(epho);
mat_double.Tfree3(energy);
mat_double.Tfree1(en);
mat_double.Tfree1(diag_term);
printf("finish memory free\n");
}
/*
computes the svd of a complex matrix. Missing in gsl.
*/
int
svd(gsl_matrix_complex *A, gsl_matrix_complex *V, gsl_vector *S)
{
int n = A->size1;
gsl_eigen_hermv_workspace *gsl_work = gsl_eigen_hermv_alloc(n);
gsl_matrix_complex *Asq = gsl_matrix_complex_alloc(n, n);
gsl_complex zero = gsl_complex_rect(0., 0.);
gsl_complex one = gsl_complex_rect(1., 0.);
gsl_vector *e = gsl_vector_alloc(n);
gsl_matrix_complex *U = gsl_matrix_complex_alloc(n, n);
gsl_blas_zgemm(CblasNoTrans, CblasConjTrans, one, A, A, zero, Asq);
gsl_eigen_hermv(Asq, e, U, gsl_work);
gsl_eigen_hermv_sort(e, U, GSL_EIGEN_SORT_VAL_DESC);
gsl_blas_zgemm(CblasConjTrans, CblasNoTrans, one, A, A, zero, Asq);
gsl_eigen_hermv(Asq, e, V, gsl_work);
gsl_eigen_hermv_sort(e, V, GSL_EIGEN_SORT_VAL_DESC);
gsl_blas_zgemm(CblasNoTrans, CblasNoTrans, one, A, V, zero, Asq);
gsl_blas_zgemm(CblasConjTrans, CblasNoTrans, one, U, Asq, zero, A);
for(int i=0; i<n; i++){
gsl_complex x = gsl_matrix_complex_get(A, i, i);
double phase = gsl_complex_arg(gsl_complex_mul_real(x, 1./sqrt(e->data[i])));
gsl_vector_complex_view U_col = gsl_matrix_complex_column(U, i);
gsl_vector_complex_scale(&U_col.vector, gsl_complex_polar(1., phase));
gsl_vector_set(S, i, sqrt(gsl_vector_get(e, i)));
}
gsl_matrix_complex_memcpy(A, U);
gsl_vector_free(e);
gsl_matrix_complex_free(U);
gsl_matrix_complex_free(Asq);
gsl_eigen_hermv_free(gsl_work);
return 0;
}
int ComputeUnitaryMatrix_GSL(gsl_matrix_complex * const M,
gsl_matrix * const U)
{
int result;
gsl_vector *eval, *order;
gsl_matrix_complex *evec;
gsl_eigen_hermv_workspace *w;
unsigned int i, j;
gsl_complex z;
float real, imag;
// Allocations
eval = gsl_vector_alloc(M->size1);
order = gsl_vector_alloc(M->size1);
evec = gsl_matrix_complex_alloc(M->size1, M->size1);
w = gsl_eigen_hermv_alloc(M->size1);
#ifdef VERBOSE
PrintGSLMatrixComplex(M, "Computing Unitary Matrix for M");
#endif
result = gsl_eigen_hermv(M, eval, evec, w);
#ifdef VERBOSE
fprintf(stderr, "Result from gsl_eigen_hermv = %d\n", result);
#endif
if(result != GSL_SUCCESS)
{
fprintf(stderr, "ERROR %d when calling gsl_eigen_hermv()!\n", result);
return -1;
}
if(HasNaN(evec) == true)
return -1;
// Get ascending order of values in eval
// PrintGSLVector(eval, "eval (BEFORE)");
for(i = 0; i < order->size; i++)
gsl_vector_set(order, i, i);
QuickSort(eval, order, 0, order->size-1);
#ifdef VERBOSE
PrintGSLVector(eval, "eval (AFTER)");
PrintGSLVector(order, "order (AFTER)");
PrintGSLMatrixComplex(evec, "evec");
#endif
for(i = 0; i < U->size1; i++)
{
for(j = 0; j < U->size2; j++)
{
z = gsl_matrix_complex_get(evec, i, gsl_vector_get(order,j));
real = GSL_REAL(z);
imag = GSL_IMAG(z);
gsl_matrix_set(U, i, j, sqrt(real*real + imag*imag));
}
}
// Free
gsl_eigen_hermv_free(w);
gsl_matrix_complex_free(evec);
gsl_vector_free(order);
gsl_vector_free(eval);
return GSL_SUCCESS;
}
static int
mc_eigen(lua_State *L) /* (-1,+2,e) */
{
mMatComplex *m = qlua_checkMatComplex(L, 1);
gsl_matrix_complex_view mx;
gsl_eigen_hermv_workspace *w;
gsl_vector *ev;
mVecReal *lambda;
mMatComplex *trans;
mMatComplex *tmp;
int n;
int i;
int lo, hi;
switch (lua_gettop(L)) {
case 1:
if (m->l_size != m->r_size)
return luaL_error(L, "matrix:eigen() expects square matrix");
lo = 0;
hi = m->l_size;
break;
case 2:
lo = 0;
hi = luaL_checkint(L, 2);
if ((hi > m->l_size) || (hi > m->r_size))
return slice_out(L);
break;
case 3:
lo = luaL_checkint(L, 2);
hi = luaL_checkint(L, 3);
if ((lo >= hi) ||
(lo > m->l_size) || (lo > m->r_size) ||
(hi > m->l_size) || (hi > m->r_size))
return slice_out(L);
break;
default:
return luaL_error(L, "matrix:eigen(): illegal arguments");
}
n = hi - lo;
mx = gsl_matrix_complex_submatrix(m->m, lo, lo, n, n);
tmp = qlua_newMatComplex(L, n, n);
gsl_matrix_complex_memcpy(tmp->m, &mx.matrix);
lambda = qlua_newVecReal(L, n);
trans = qlua_newMatComplex(L, n, n);
ev = new_gsl_vector(L, n);
w = gsl_eigen_hermv_alloc(n);
if (w == 0) {
lua_gc(L, LUA_GCCOLLECT, 0);
w = gsl_eigen_hermv_alloc(n);
if (w == 0)
luaL_error(L, "not enough memory");
}
if (gsl_eigen_hermv(tmp->m, ev, trans->m, w))
luaL_error(L, "matrix:eigen() failed");
if (gsl_eigen_hermv_sort(ev, trans->m, GSL_EIGEN_SORT_VAL_ASC))
luaL_error(L, "matrix:eigen() eigenvalue ordering failed");
for (i = 0; i < n; i++)
lambda->val[i] = gsl_vector_get(ev, i);
gsl_vector_free(ev);
gsl_eigen_hermv_free(w);
return 2;
}
int main(int argc, char *argv[]){
int i,j,k,
c,
N;
int dflag=0,
eflag=0,
gflag=0,
vflag=0,
hflag=0;
float w; /* frec */
//char *lvalue=NULL;
double **M, // XYZ coordinates
dos,
lambda=0;
while((c = getopt (argc, argv, "degvhl:")) != -1){
switch (c){
case 'd':
dflag = 1;
break;
case 'e':
eflag = 1;
break;
case 'g':
gflag = 1;
break;
case 'v':
vflag = 1;
break;
case 'h':
hflag = 1;
break;
case 'l':
lambda = atof(optarg);
break;
}
}
scanf("%d",&N);
M = (double **) malloc (N*sizeof(double *)); // coordinate matrix
// read coordinates (XYZ format file)
for (int i=0; i<N; i++){
char null[5]; // discard element
double *tmp = (double *) malloc (3 * sizeof(double)); // 3 coordinates
scanf("%s%lf%lf%lf", null, &tmp[0], &tmp[1], &tmp[2]);
M[i] = tmp;
// printf("- %.2f %.2f\n",M[i][0], M[i][1]); // DEBUG
}
/* M: coordinate matrix, N: number of atoms, l: spin-orbit parameter (set to 0 to tight-binding)*/
gsl_matrix_complex * Hso = hamiltonian(M, N, lambda);
/* print hamiltonial */
if (hflag){
printComMat(Hso,N*SPIN*ORB);
return 0;
}
/* eigenvalues */
gsl_matrix_complex * evec = gsl_matrix_complex_alloc(N*SPIN*ORB, N*SPIN*ORB);
gsl_vector * eval = gsl_vector_alloc(N*SPIN*ORB);
gsl_eigen_hermv_workspace * ws = gsl_eigen_hermv_alloc(N*SPIN*ORB);
gsl_matrix_complex * A = Hso; // gsl_eigen_hermv() destroys Hso matrix, use a copy instead
gsl_eigen_hermv (A, eval, evec, ws);
gsl_eigen_hermv_sort (eval, evec, GSL_EIGEN_SORT_VAL_ASC);
gsl_eigen_hermv_free(ws);
if (eflag){
for (int i=0; i<N*SPIN*ORB; i++)
printf("%d %.4g \n", i, gsl_vector_get(eval,i));
return 0;
}
if (vflag){
printComMat(evec, N*SPIN*ORB);
return 0;
}
/* calculate DoS
* __ __
* \ \ Hij Hji
* DOS(E) = -imag /_ /_ ----------------
* i j E - En + i*eta
*
* where H is the hamiltonian, and n is the state.
* NOTE: i and j 0-indexed list. i*eta
*/
double eval_min = gsl_vector_min (eval), /* lower bound */
eval_max = gsl_vector_max (eval); /* upper bound */
if (dflag)
for (w = eval_min; w < eval_max; w += 1e-3){
dos = 0;
#pragma omp parallel num_threads(4)
{
int tid = omp_get_thread_num();
#pragma omp for private(i,k) reduction (+:dos)
for (i=0; i<N*SPIN*ORB; i++)
for (k=0; k<N*SPIN*ORB; k++){
gsl_complex h = gsl_matrix_complex_get (Hso, i, k);
double l = gsl_vector_get (eval ,k);
gsl_complex z = gsl_complex_rect(0,5e-3); /* parte imaginaria */
gsl_complex num = gsl_complex_mul(h,gsl_complex_conjugate(h)); /* numerador */
gsl_complex den = gsl_complex_add_real(z, w-l); /* denominador */
gsl_complex g = gsl_complex_div(num,den);
dos += GSL_IMAG(g);
}
if (dflag && tid==0)
printf("%.3g %g \n", w, -dos/PI);
}
}
/* Green's function
*
* <i|n> <n|j>
* Gij(E) = ----------------
* E - En + i*eta
*
* where i and j are atoms, and n is the state.
* NOTE: i and j 0-indexed list.
*/
int list[]={0,1,2,5,6,7}; /* atoms to get conductance */
int NL = (int) sizeof(list)/sizeof(list[0]);
gsl_matrix_complex * G = gsl_matrix_complex_alloc(NL*SPIN*ORB, NL*SPIN*ORB); // Green
if (gflag)
for (double E = eval_min; E < eval_max; E += 1e-3){ // energy
gsl_matrix_complex_set_all(G, GSL_COMPLEX_ZERO); // init
for (int n=0; n<N*SPIN*ORB; n++) // states
for (i=0; i<NL; i++) // atoms
for (j=0; j<NL; j++) // atoms
for (int k0=0; k0<SPIN*ORB; k0++){ // orbitals
for (int k1=0; k1<SPIN*ORB; k1++){ // orbitals
gsl_complex in = gsl_matrix_complex_get (evec, n, list[i]*SPIN*ORB+k0);
gsl_complex nj = gsl_matrix_complex_get (evec, n, list[j]*SPIN*ORB+k1);
double En = gsl_vector_get (eval ,n);
gsl_complex eta = gsl_complex_rect(0,5e-3); /* delta */
gsl_complex num = gsl_complex_mul(in, gsl_complex_conjugate(nj)); /* num */
gsl_complex den = gsl_complex_add_real(eta, E - En); /* den */
gsl_complex Gij = gsl_complex_div(num,den);
gsl_complex tmp = gsl_matrix_complex_get(G, i*SPIN*ORB+k0, j*SPIN*ORB+k1);
gsl_complex sum = gsl_complex_add(tmp, Gij);
gsl_matrix_complex_set(G, i*SPIN*ORB+k0, j*SPIN*ORB+k1, sum);
}
}
dos = 0 ;
for(int i=0; i<NL*SPIN*ORB; i++)
dos += GSL_IMAG( gsl_matrix_complex_get(G, i, i) );
printf("%.3g %g\n", E, -dos/PI);
// printComMat(G, NL*SPIN*ORB);
}
gsl_matrix_complex_free(G);
gsl_vector_free(eval);
gsl_matrix_complex_free(evec);
return 0;
}
