void expm(gsl_matrix_complex * L, gsl_complex t, gsl_matrix * m)
{
int i,j,s;
gsl_vector_complex *eval = gsl_vector_complex_alloc(4);
gsl_matrix_complex *evec = gsl_matrix_complex_alloc(4, 4);
gsl_eigen_nonsymmv_workspace * w = gsl_eigen_nonsymmv_alloc(4);
gsl_matrix_complex *evalmat = gsl_matrix_complex_alloc(4, 4);
gsl_matrix_complex *vd = gsl_matrix_complex_alloc(4, 4);
gsl_complex one = gsl_complex_rect(1, 0);
gsl_complex zero = gsl_complex_rect(0, 0);
gsl_matrix_complex *K = gsl_matrix_complex_alloc(4, 4);
gsl_permutation *p = gsl_permutation_alloc(4);
gsl_vector_complex *x = gsl_vector_complex_alloc(4);
gsl_vector_complex_view bp;
gsl_complex z;
gsl_eigen_nonsymmv(m, eval, evec, w);
gsl_eigen_nonsymmv_sort(eval, evec, GSL_EIGEN_SORT_ABS_DESC);
gsl_eigen_nonsymmv_free(w); // clear workspace
for (i = 0; i < 4; i++)
{
gsl_complex eval_i = gsl_vector_complex_get(eval, i);
gsl_complex expeval = gsl_complex_mul(eval_i,t);
expeval = gsl_complex_exp(expeval);
gsl_matrix_complex_set(evalmat, i, i, expeval);
}
gsl_vector_complex_free(eval); // clear vector for eigenvalues
// v'L'=De'v'
gsl_blas_zgemm(CblasTrans, CblasTrans, one, evalmat, evec, zero, vd);
gsl_matrix_complex_transpose(evec);//transpose v
gsl_matrix_complex_memcpy(K,evec);
for (i = 0; i < 4; i++)
{
bp = gsl_matrix_complex_column(vd, i);
gsl_linalg_complex_LU_decomp(evec, p, &s);
gsl_linalg_complex_LU_solve(evec, p, &bp.vector, x);
for (j = 0; j < 4; j++)
{
z = gsl_vector_complex_get(x, j);
gsl_matrix_complex_set(L,i,j,z); //'through the looking glass' transpose
}
gsl_matrix_complex_memcpy(evec,K);
}
gsl_permutation_free(p);
gsl_vector_complex_free(x);
gsl_matrix_complex_free(vd);
gsl_matrix_complex_free(evec);
gsl_matrix_complex_free(evalmat);
gsl_matrix_complex_free(K);
}
/*
* Calculate the matrix exponent of A and store in eA.
* Algorithm: Truncated Talyor series.
*
* WARNING: Large errors possible and it's slow.
*/
int
gsl_ext_expm_complex(gsl_matrix_complex *A, gsl_matrix_complex *eA)
{
int i;
gsl_complex alpha, beta, z;
gsl_matrix_complex *I, *T;
I = gsl_matrix_complex_alloc(A->size1, A->size2);
T = gsl_matrix_complex_alloc(A->size1, A->size2);
GSL_SET_COMPLEX(&alpha, 1.0, 0.0);
GSL_SET_COMPLEX(&beta, 0.0, 0.0);
gsl_matrix_complex_set_identity(I);
gsl_matrix_complex_set_identity(eA);
for (i = 50; i > 0; i--)
{
GSL_SET_COMPLEX(&z, 1.0 / i, 0.0);
gsl_matrix_complex_scale(eA, z);
gsl_blas_zgemm(CblasNoTrans, CblasNoTrans, alpha, eA, A, beta, T);
gsl_matrix_complex_add(T, I);
gsl_matrix_complex_memcpy(eA, T);
}
return 0;
}
lls_complex_workspace *
lls_complex_alloc(const size_t max_block, const size_t p)
{
const gsl_multifit_robust_type *robust_t = gsl_multifit_robust_huber;
const size_t nblock = GSL_MAX(max_block, p);
lls_complex_workspace *w;
w = calloc(1, sizeof(lls_complex_workspace));
if (!w)
return 0;
w->AHA = gsl_matrix_complex_alloc(p, p);
w->work_A = gsl_matrix_complex_alloc(p, p);
if (!w->AHA || !w->work_A)
{
lls_complex_free(w);
return 0;
}
w->AHb = gsl_vector_complex_alloc(p);
w->work_b = gsl_vector_complex_alloc(p);
w->AF = gsl_matrix_complex_alloc(p, p);
w->S = gsl_vector_alloc(p);
if (!w->AHb || !w->work_b)
{
lls_complex_free(w);
return 0;
}
w->r_complex = gsl_vector_complex_alloc(nblock);
w->c = gsl_vector_complex_alloc(p);
w->r = gsl_vector_alloc(nblock);
w->w_robust = gsl_vector_alloc(nblock);
w->robust_workspace_p = gsl_multifit_robust_alloc(robust_t, nblock, p);
if (!w->r_complex || !w->w_robust || !w->c)
{
lls_complex_free(w);
return 0;
}
w->eigen_p = gsl_eigen_herm_alloc(p);
w->eval = gsl_vector_alloc(p);
w->p = p;
w->max_block = nblock;
w->residual = 0.0;
w->chisq = 0.0;
w->cond = -1.0;
w->niter = 0;
w->bHb = 0.0;
/* initialize matrices/vectors to 0 */
lls_complex_reset(w);
return w;
} /* lls_complex_alloc() */
bool Matrix_Transform(gsl_matrix *M1,gsl_matrix_complex *A,gsl_matrix *M2,gsl_matrix_complex *M){
gsl_matrix_complex *T,*T1,*T2;
T1=gsl_matrix_complex_alloc(M1->size1,M1->size2);
T2=gsl_matrix_complex_alloc(M2->size1,M2->size2);
T=gsl_matrix_complex_alloc(M1->size1,A->size2);
Matrix_Copy_Real(M1,T1);
Matrix_Copy_Real(M2,T2);
Matrix_Product(T1,A,T);
Matrix_Product(T,T2,M);
return true;
}
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;
}
static VALUE rb_gsl_linalg_complex_LU_svx(int argc, VALUE *argv, VALUE obj)
{
gsl_matrix_complex *m = NULL, *mtmp = NULL;
gsl_permutation *p = NULL;
gsl_vector_complex *x = NULL;
int flagm = 0, itmp, signum;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
CHECK_MATRIX(argv[0]);
Data_Get_Struct(argv[0], gsl_matrix_complex, m);
if (CLASS_OF(argv[0]) != cgsl_matrix_complex_LU) {
flagm = 1;
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
} else {
mtmp = m;
}
itmp = 1;
break;
default:
Data_Get_Struct(obj, gsl_matrix_complex, m);
if (CLASS_OF(obj) != cgsl_matrix_complex_LU) {
flagm = 1;
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
} else {
mtmp = m;
}
itmp = 0;
}
if (flagm == 1) {
if (itmp != argc-1) rb_raise(rb_eArgError, "Usage: m.LU_solve(b)");
Data_Get_Struct(argv[itmp], gsl_vector_complex, x);
p = gsl_permutation_alloc(x->size);
gsl_linalg_complex_LU_decomp(mtmp, p, &signum);
} else {
Data_Get_Struct(argv[itmp], gsl_permutation, p);
itmp++;
Data_Get_Struct(argv[itmp], gsl_vector_complex, x);
itmp++;
}
gsl_linalg_complex_LU_svx(mtmp, p, x);
if (flagm == 1) {
gsl_matrix_complex_free(mtmp);
gsl_permutation_free(p);
}
return argv[argc-1];
}
std::unique_ptr<gsl_matrix_complex,void (*)(gsl_matrix_complex*)> Const::GetTransformationMatrix(size_t dim) const{
if(dim>SQUIDS_MAX_HILBERT_DIM)
throw std::runtime_error("Const::GetTransformationMatrix: dimension must be less than " SQUIDS_MAX_HILBERT_DIM_STR);
gsl_matrix_complex* U = gsl_matrix_complex_alloc(dim,dim);
gsl_matrix_complex* R = gsl_matrix_complex_alloc(dim,dim);
gsl_matrix_complex* dummy = gsl_matrix_complex_alloc(dim,dim);
gsl_matrix_complex_set_identity(U);
gsl_matrix_complex_set_identity(R);
gsl_matrix_complex_set_zero(dummy);
const auto unit=gsl_complex_rect(1,0);
const auto zero=gsl_complex_rect(0,0);
auto to_gsl=[](const std::complex<double>& c)->gsl_complex{
return(gsl_complex_rect(c.real(),c.imag()));
};
//construct each subspace rotation and accumulate the product
for(size_t j=1; j<dim; j++){
for(size_t i=0; i<j; i++){
//set up the subspace rotation
double theta=GetMixingAngle(i,j);
double delta=GetPhase(i,j);
double c=cos(theta);
auto cp=sin(theta)*std::exp(std::complex<double>(0,-delta));
auto cpc=-std::conj(cp);
gsl_matrix_complex_set(R,i,i,to_gsl(c));
gsl_matrix_complex_set(R,i,j,to_gsl(cp));
gsl_matrix_complex_set(R,j,i,to_gsl(cpc));
gsl_matrix_complex_set(R,j,j,to_gsl(c));
//multiply this rotation onto the product from the left
gsl_blas_zgemm(CblasNoTrans,CblasNoTrans,unit,R,U,zero,dummy);
std::swap(U,dummy);
//clean up the rotation matrix for next iteration
gsl_matrix_complex_set(R,i,i,unit);
gsl_matrix_complex_set(R,i,j,zero);
gsl_matrix_complex_set(R,j,i,zero);
gsl_matrix_complex_set(R,j,j,unit);
}
}
//clean up temporary matrices
gsl_matrix_complex_free(R);
gsl_matrix_complex_free(dummy);
return std::unique_ptr<gsl_matrix_complex,void (*)(gsl_matrix_complex*)>(U,gsl_matrix_complex_free);
}
static VALUE rb_gsl_linalg_complex_LU_sgndet(int argc, VALUE *argv, VALUE obj)
{
gsl_matrix_complex *m = NULL, *mtmp = NULL;
gsl_permutation *p = NULL;
gsl_complex *z = NULL;
VALUE vz;
int flagm = 0, signum, itmp;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
CHECK_MATRIX_COMPLEX(argv[0]);
Data_Get_Struct(argv[0], gsl_matrix_complex, m);
if (CLASS_OF(argv[0]) != cgsl_matrix_complex_LU) {
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
flagm = 1;
} else {
mtmp = m;
}
itmp = 1;
break;
default:
Data_Get_Struct(obj, gsl_matrix_complex, m);
if (CLASS_OF(obj) != cgsl_matrix_complex_LU) {
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
flagm = 1;
} else {
mtmp = m;
}
itmp = 0;
}
if (flagm == 1) {
p = gsl_permutation_alloc(m->size1);
gsl_linalg_complex_LU_decomp(mtmp, p, &signum);
} else {
if (itmp != argc-1) rb_raise(rb_eArgError, "signum not given");
signum = NUM2DBL(argv[itmp]);
}
vz = Data_Make_Struct(cgsl_complex, gsl_complex, 0, free, z);
*z = gsl_linalg_complex_LU_sgndet(mtmp, signum);
if (flagm == 1) {
gsl_matrix_complex_free(mtmp);
gsl_permutation_free(p);
}
return vz;
}
test_eigen_gen_workspace *
test_eigen_gen_alloc(const size_t n)
{
test_eigen_gen_workspace *w;
w = (test_eigen_gen_workspace *) calloc(1, sizeof(test_eigen_gen_workspace));
w->A = gsl_matrix_alloc(n, n);
w->B = gsl_matrix_alloc(n, n);
w->alpha = gsl_vector_complex_alloc(n);
w->beta = gsl_vector_alloc(n);
w->alphav = gsl_vector_complex_alloc(n);
w->betav = gsl_vector_alloc(n);
w->eval = gsl_vector_complex_alloc(n);
w->evalv = gsl_vector_complex_alloc(n);
w->x = gsl_vector_alloc(n);
w->y = gsl_vector_alloc(n);
w->Q = gsl_matrix_alloc(n, n);
w->Z = gsl_matrix_alloc(n, n);
w->evec = gsl_matrix_complex_alloc(n, n);
w->gen_p = gsl_eigen_gen_alloc(n);
w->genv_p = gsl_eigen_genv_alloc(n);
return (w);
} /* test_eigen_gen_alloc() */
//-----------------------------------------------------------------------------
// Returns the eigendecomposition A = X*D*X^-1.
// d is the diagonal entries of D.
// X and d must be preallocated: X should be n x n and d should be length n.
//-----------------------------------------------------------------------------
void eigendecomp (double **A, double complex **X, double complex *d, int n)
{
double *a;
double complex **Xtmp;
double complex *dtmp;
gsl_matrix_view m;
gsl_vector_complex *eval;
gsl_matrix_complex *evec;
gsl_eigen_nonsymmv_workspace *w;
// Use GSL routine to compute eigenvalues and eigenvectors
a = matrixToVector (A, n, n);
m = gsl_matrix_view_array (a, n, n);
eval = gsl_vector_complex_alloc (n);
evec = gsl_matrix_complex_alloc (n, n);
w = gsl_eigen_nonsymmv_alloc (n);
gsl_eigen_nonsymmv (&m.matrix, eval, evec, w);
gsl_eigen_nonsymmv_free (w);
// Convert from GSL to intrinsic types
Xtmp = gslmToCx (evec, n, n);
dtmp = gslvToCx (eval, n);
copycm_inplace (X, Xtmp, n, n);
copycv_inplace (d, dtmp, n);
freecmatrix(Xtmp, n);
free(a);
free(dtmp);
gsl_vector_complex_free(eval);
gsl_matrix_complex_free(evec);
}
gsl_matrix_complex *
pca_read_matrix_complex(const char *filename)
{
FILE *fp;
gsl_matrix_complex *m;
size_t size1, size2;
fp = fopen(filename, "r");
if (!fp)
{
fprintf(stderr, "pca_read_matrix_complex: unable to open %s: %s\n",
filename, strerror(errno));
return NULL;
}
fread(&size1, sizeof(size_t), 1, fp);
fread(&size2, sizeof(size_t), 1, fp);
m = gsl_matrix_complex_alloc(size1, size2);
gsl_matrix_complex_fread(fp, m);
fclose(fp);
return m;
}
/* -----------------------------------------------------------------------------------
* Convert a sparse matrix to dense format (standard GSL matrix).
*
*/
gsl_matrix_complex *
gsl_sparse_matrix_complex_convert_to_dense(gsl_sparse_matrix_complex *spmat)
{
int i;
if (spmat == NULL)
{
return NULL;
}
spmat->M_dense = gsl_matrix_complex_alloc(spmat->n, spmat->m);
gsl_matrix_complex_set_zero(spmat->M_dense);
//
// triplet form to dense form:
//
for (i = 0; i < spmat->nz; i++)
{
gsl_complex z;
GSL_SET_COMPLEX(&z, spmat->val_real[i], spmat->val_imag[i]);
gsl_matrix_complex_set(spmat->M_dense, spmat->row[i], spmat->col[i], z);
}
return spmat->M_dense;
}
static VALUE rb_gsl_blas_ztrsm2(VALUE obj, VALUE s, VALUE u, VALUE ta,
VALUE d, VALUE a, VALUE aa, VALUE bb)
{
gsl_matrix_complex *A = NULL, *B = NULL, *Bnew = NULL;
gsl_complex *pa = NULL;
CBLAS_SIDE_t Side;
CBLAS_UPLO_t Uplo;
CBLAS_TRANSPOSE_t TransA;
CBLAS_DIAG_t Diag;
CHECK_FIXNUM(s); CHECK_FIXNUM(u); CHECK_FIXNUM(ta); CHECK_FIXNUM(d);
CHECK_COMPLEX(a);
CHECK_MATRIX_COMPLEX(aa);
CHECK_MATRIX_COMPLEX(bb);
Side = FIX2INT(s);
Uplo = FIX2INT(u);
TransA = FIX2INT(ta);
Diag = FIX2INT(d);
Data_Get_Struct(a, gsl_complex, pa);
Data_Get_Struct(aa, gsl_matrix_complex, A);
Data_Get_Struct(bb, gsl_matrix_complex, B);
Bnew = gsl_matrix_complex_alloc(B->size1, B->size2);
gsl_matrix_complex_memcpy(Bnew, B);
gsl_blas_ztrsm(Side, Uplo, TransA, Diag, *pa, A, Bnew);
return Data_Wrap_Struct(cgsl_matrix_complex, 0, gsl_matrix_complex_free, Bnew);
}
VALUE rb_gsl_math_complex_eval(gsl_complex (*func)(gsl_complex), VALUE obj)
{
gsl_complex *z, *znew;
gsl_vector_complex *v, *vnew;
gsl_matrix_complex *m, *mnew;
size_t i, j;
if (COMPLEX_P(obj)) {
Data_Get_Struct(obj, gsl_complex, z);
znew = xmalloc(sizeof(gsl_complex));
*znew = (*func)(*z);
return Data_Wrap_Struct(cgsl_complex, 0, free, znew);
} else if (VECTOR_COMPLEX_P(obj)) {
Data_Get_Struct(obj, gsl_vector_complex, v);
vnew = gsl_vector_complex_alloc(v->size);
for (i = 0; i < v->size; i++) {
z = GSL_COMPLEX_AT(v, i);
gsl_vector_complex_set(vnew, i, (*func)(*z));
}
return Data_Wrap_Struct(cgsl_vector_complex, 0, gsl_vector_complex_free, vnew);
} else if (MATRIX_COMPLEX_P(obj)) {
Data_Get_Struct(obj, gsl_matrix_complex, m);
mnew = gsl_matrix_complex_alloc(m->size1, m->size2);
for (i = 0; i < m->size1; i++) {
for (j = 0; j < m->size2; j++) {
gsl_matrix_complex_set(mnew, i, j, (*func)(gsl_matrix_complex_get(m, i, j)));
}
}
return Data_Wrap_Struct(cgsl_matrix_complex, 0, gsl_matrix_complex_free, mnew);
} else {
rb_raise(rb_eTypeError,
"wrong argument type %s "
" (GSL::Complex or GSL::Vector::Complex expected)",
rb_class2name(CLASS_OF(obj)));
}
}
int Eigen(gsl_matrix_complex *A, gsl_matrix_complex *vec, gsl_vector_complex *val) {
gsl_matrix_complex *T;
T=gsl_matrix_complex_alloc(A->size1,A->size2);
// Matrix_Copy(T,A);
Matrix_Transpose(T,A);
char jobvl='N';
char jobvr='V';
int n=T->size1;
int lda=T->tda;
int ldvl=T->tda;
int ldvr=T->tda;
int info;
int lwork=2*n;
double *rwork;
double _Complex *work;
rwork=(double*)malloc(2*n*sizeof(double));
work=(double _Complex*)malloc(sizeof(double _Complex)*lwork);
zgeev_(&jobvl,&jobvr,&n, (double _Complex*)T->data, &lda, (double _Complex*)val->data,NULL, &ldvl,(double _Complex*)vec->data, &ldvr, work, &lwork, rwork, &info);
Matrix_Transpose(vec);
// for(int k=0;k<A->size2;k++){
// double _Complex Scale;
// for(int l=0;l<n;l++)
// Scale+=cpow(cabs(matrix_get(vec,l,k)),2);
// printf("NORM %E %E\n",creal(Scale),cimag(Scale));
// for(int l=0;l<n;l++){
// matrix_div(vec,l,k,csqrt(Scale));
// }
// }
gsl_matrix_complex_free(T);
return info;
}
bool Matrix_Transform(gsl_matrix_complex *T1,gsl_matrix_complex *A,gsl_matrix_complex *T2,gsl_matrix_complex *M){
gsl_matrix_complex *T;
T=gsl_matrix_complex_alloc(T1->size1,A->size2);
Matrix_Product(T1,A,T);
Matrix_Product(T,T2,M);
return true;
}
static bool matrix_determinant(CMATRIX *m, COMPLEX_VALUE *det)
{
int sign = 0;
int size = WIDTH(m);
if (size != HEIGHT(m))
return TRUE;
gsl_permutation *p = gsl_permutation_calloc(size);
if (COMPLEX(m))
{
gsl_matrix_complex *tmp = gsl_matrix_complex_alloc(size, size);
gsl_matrix_complex_memcpy(tmp, CMAT(m));
gsl_linalg_complex_LU_decomp(tmp, p, &sign);
det->z = gsl_linalg_complex_LU_det(tmp, sign);
gsl_matrix_complex_free(tmp);
}
else
{
gsl_matrix *tmp = gsl_matrix_alloc(size, size);
gsl_matrix_memcpy(tmp, MAT(m));
gsl_linalg_LU_decomp(tmp, p, &sign);
det->x = gsl_linalg_LU_det(tmp, sign);
det->z.dat[1] = 0;
gsl_matrix_free(tmp);
}
gsl_permutation_free(p);
return FALSE;
}
static int _equalf(CMATRIX *a, double f)
{
bool result;
if (COMPLEX(a))
{
if (f == 0.0)
return gsl_matrix_complex_isnull(CMAT(a));
gsl_matrix_complex *m = gsl_matrix_complex_alloc(WIDTH(a), HEIGHT(a));
gsl_matrix_complex_set_identity(m);
gsl_matrix_complex_scale(m, gsl_complex_rect(f, 0));
result = gsl_matrix_complex_equal(CMAT(a), m);
gsl_matrix_complex_free(m);
}
else
{
if (f == 0.0)
return gsl_matrix_isnull(MAT(a));
gsl_matrix *m = gsl_matrix_alloc(WIDTH(a), HEIGHT(a));
gsl_matrix_set_identity(m);
gsl_matrix_scale(m, f);
result = gsl_matrix_equal(MAT(a), m);
gsl_matrix_free(m);
}
return result;
}
static VALUE rb_gsl_linalg_complex_LU_invert(int argc, VALUE *argv, VALUE obj)
{
gsl_matrix_complex *m = NULL, *mtmp = NULL, *inverse = NULL;
gsl_permutation *p = NULL;
int flagm = 0, signum, itmp;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
CHECK_MATRIX_COMPLEX(argv[0]);
Data_Get_Struct(argv[0], gsl_matrix_complex, m);
if (CLASS_OF(argv[0]) != cgsl_matrix_complex_LU) {
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
flagm = 1;
} else {
mtmp = m;
}
itmp = 1;
break;
default:
Data_Get_Struct(obj, gsl_matrix_complex, m);
if (CLASS_OF(obj) != cgsl_matrix_complex_LU) {
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
flagm = 1;
} else {
mtmp = m;
}
itmp = 0;
}
if (flagm == 1) {
p = gsl_permutation_alloc(m->size1);
gsl_linalg_complex_LU_decomp(mtmp, p, &signum);
} else {
Data_Get_Struct(argv[itmp], gsl_permutation, p);
}
inverse = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_linalg_complex_LU_invert(mtmp, p, inverse);
if (flagm == 1) {
gsl_matrix_complex_free(mtmp);
gsl_permutation_free(p);
}
return Data_Wrap_Struct(cgsl_matrix_complex, 0, gsl_matrix_complex_free, inverse);
}
static VALUE rb_dirac_anticommute(VALUE obj, VALUE mm1, VALUE mm2)
{
gsl_matrix_complex *m1, *m2;
gsl_matrix_complex *mnew1, *mnew2;
CHECK_MATRIX_COMPLEX(mm1);
CHECK_MATRIX_COMPLEX(mm2);
Data_Get_Struct(mm1, gsl_matrix_complex, m1);
Data_Get_Struct(mm2, gsl_matrix_complex, m2);
mnew1 = gsl_matrix_complex_alloc(m1->size1, m1->size2);
mnew2 = gsl_matrix_complex_alloc(m1->size1, m1->size2);
gsl_matrix_complex_mul(mnew1, m1, m2);
gsl_matrix_complex_mul(mnew2, m2, m1);
gsl_matrix_complex_add(mnew1, mnew2);
gsl_matrix_complex_free(mnew2);
return Data_Wrap_Struct(cgsl_matrix_complex, 0, gsl_matrix_complex_free,
mnew1);
}
static void matrix_complex_add_identity(gsl_matrix_complex *m, gsl_complex c)
{
gsl_matrix_complex *id = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_set_identity(id);
gsl_matrix_complex_scale(id, c);
gsl_matrix_complex_add(m, id);
gsl_matrix_complex_free(id);
}
void WKSP::initial_malloc(int Nnew, int N2new)
{
printf("start initial_malloc()\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;
ws = mat_gsl_eigen_hermv_workspace_pointer.Tmatrix1(tot_th);
eval = mat_gsl_vector_pointer.Tmatrix1(tot_th);
for(int i=0; i<tot_th; i++)
{
ws[i] = gsl_eigen_hermv_alloc(N2new);
eval[i] = gsl_vector_alloc(N2new);
}
eigen_state = mat_gsl_matrix_complex_pointer.Tmatrix2(N_radial,N_theta);
H = mat_gsl_matrix_complex_pointer.Tmatrix2(N_radial,N_theta);
epho = mat_gsl_matrix_complex_pointer.Tmatrix3(N2new,N_radial,N_theta);
// N2 is # of bnads of system.
energy = mat_double.Tmatrix3(N2new,N_radial,N_theta);
en = mat_double.Tmatrix1(N2new);
diag_term=mat_double.Tmatrix1(Nnew);
for(int ii=0;ii<Nnew;ii++)
diag_term[ii]=0;
for(int i=0; i<N_radial; i++)
{
for(int j=0; j<N_theta; j++)
{
eigen_state[i][j]= gsl_matrix_complex_alloc(N2new,N2new);
H[i][j]= gsl_matrix_complex_alloc(N2new,N2new);
for(int e=0; e<N2new; e++)
{
epho[e][i][j] = gsl_matrix_complex_alloc(N2new,N2new);
}
}
// printf("malloc %d\n",i);
}
printf("finish initial_malloc()\n");
}
int main(int argc, char* argv[]) {
step = gsl_matrix_complex_alloc(N,N);
psi = gsl_matrix_complex_alloc(N,N);
temp = gsl_matrix_complex_alloc(N,N);
initial_max =init_wave_function( psi , circular_step_pdf );
normalization = 1;
glutInit(&argc, argv);
glutInitDisplayMode(GLUT_RGBA|GLUT_DEPTH|GLUT_DOUBLE);
glutInitWindowSize(width, height);
glutCreateWindow("graph");
GLenum glew_status = glewInit();
if (GLEW_OK != glew_status) {
fprintf(stderr, "Error: %s\n", glewGetErrorString(glew_status));
return 1;
}
if (!GLEW_VERSION_2_0) {
fprintf(stderr, "No support for OpenGL 2.0 found\n");
return 1;
}
GLint max_units;
glGetIntegerv(GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS, &max_units);
if(max_units < 1) {
fprintf(stderr, "Your GPU does not have any vertex texture image units\n");
return 1;
}
if (init_resources()) {
glutDisplayFunc(display);
glutIdleFunc(display);
glutSpecialFunc(special);
glutMouseFunc(mouse);
glutMotionFunc(motion);
glutKeyboardFunc(keyboard);
glutMainLoop();
}
free_resources();
return 0;
}
gsl_matrix_complex* nm_to_gm_complex(VALUE nm) {
DENSE_STORAGE* s = NM_DENSE_STORAGE(nm);
gsl_matrix_complex* m = gsl_matrix_complex_alloc( s->shape[0], s->shape[1] );
if (s->dtype != NM_COMPLEX128) {
rb_raise(nm_eDataTypeError, "requires dtype of :complex128 to convert from a GSL complex vector");
}
memcpy(m->data, s->elements, s->count);
return m;
}
static VALUE rb_gsl_linalg_complex_LU_lndet(int argc, VALUE *argv, VALUE obj)
{
gsl_matrix_complex *m = NULL, *mtmp = NULL;
gsl_permutation *p = NULL;
double lndet;
int flagm = 0, signum;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
CHECK_MATRIX_COMPLEX(argv[0]);
Data_Get_Struct(argv[0], gsl_matrix_complex, m);
if (CLASS_OF(argv[0]) != cgsl_matrix_complex_LU) {
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
flagm = 1;
} else {
mtmp = m;
}
break;
default:
Data_Get_Struct(obj, gsl_matrix_complex, m);
if (CLASS_OF(obj) != cgsl_matrix_complex_LU) {
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
flagm = 1;
} else {
mtmp = m;
}
}
if (flagm == 1) {
p = gsl_permutation_alloc(m->size1);
gsl_linalg_complex_LU_decomp(mtmp, p, &signum);
}
lndet = gsl_linalg_complex_LU_lndet(mtmp);
if (flagm == 1) {
gsl_matrix_complex_free(mtmp);
gsl_permutation_free(p);
}
return rb_float_new(lndet);
}
void testcase1( gsl_matrix_complex **A,
gsl_matrix_complex **B )
{
gsl_complex z;
*A = gsl_matrix_complex_alloc(4, 4);
GSL_COMPLEX_SET(*A, 0, 0, z, 0, 0);
GSL_COMPLEX_SET(*A, 0, 1, z, 1.5, 1.5);
GSL_COMPLEX_SET(*A, 0, 2, z, 2.5, 1.5);
GSL_COMPLEX_SET(*A, 0, 3, z, 1, 1);
GSL_COMPLEX_SET(*A, 1, 0, z, 1.5, -1.5);
GSL_COMPLEX_SET(*A, 1, 1, z, 0, 0);
GSL_COMPLEX_SET(*A, 1, 2, z, 0.5, 0.5);
GSL_COMPLEX_SET(*A, 1, 3, z, 1, 1);
GSL_COMPLEX_SET(*A, 2, 0, z, 2.5, -1.5);
GSL_COMPLEX_SET(*A, 2, 1, z, 0.5, -0.5);
GSL_COMPLEX_SET(*A, 2, 2, z, 0, 0);
GSL_COMPLEX_SET(*A, 2, 3, z, 1, 0);
GSL_COMPLEX_SET(*A, 3, 0, z, 1, -1);
GSL_COMPLEX_SET(*A, 3, 1, z, 1, -1);
GSL_COMPLEX_SET(*A, 3, 2, z, 1, 0);
GSL_COMPLEX_SET(*A, 3, 3, z, 0, 0);
*B = gsl_matrix_complex_alloc(4, 4);
GSL_COMPLEX_SET(*B, 0, 0, z, 0, 0);
GSL_COMPLEX_SET(*B, 0, 1, z, 2, 2);
GSL_COMPLEX_SET(*B, 0, 2, z, 1, 1);
GSL_COMPLEX_SET(*B, 0, 3, z, 2, 2);
GSL_COMPLEX_SET(*B, 1, 0, z, 2, -2);
GSL_COMPLEX_SET(*B, 1, 1, z, 0, 0);
GSL_COMPLEX_SET(*B, 1, 2, z, 1.5, -0.5);
GSL_COMPLEX_SET(*B, 1, 3, z, 0.5, -0.5);
GSL_COMPLEX_SET(*B, 2, 0, z, 1, -1);
GSL_COMPLEX_SET(*B, 2, 1, z, 1.5, 0.5);
GSL_COMPLEX_SET(*B, 2, 2, z, 0, 0);
GSL_COMPLEX_SET(*B, 2, 3, z, 2, 0);
GSL_COMPLEX_SET(*B, 3, 0, z, 2, -2);
GSL_COMPLEX_SET(*B, 3, 1, z, 0.5, 0.5);
GSL_COMPLEX_SET(*B, 3, 2, z, 2, 0);
GSL_COMPLEX_SET(*B, 3, 3, z, 0, 0);
}
static void *matrix_invert(void *m, bool complex)
{
int sign = 0;
int size = ((gsl_matrix *)m)->size1;
void *result;
if (size != ((gsl_matrix *)m)->size2)
return NULL;
gsl_permutation *p = gsl_permutation_calloc(size);
if (!complex)
{
gsl_matrix *tmp = gsl_matrix_alloc(size, size);
result = gsl_matrix_alloc(size, size);
gsl_matrix_memcpy(tmp, (gsl_matrix *)m);
gsl_linalg_LU_decomp(tmp, p, &sign);
if (gsl_linalg_LU_invert(tmp, p, (gsl_matrix *)result) != GSL_SUCCESS)
{
gsl_matrix_free(result);
return NULL;
}
gsl_matrix_free(tmp);
}
else
{
gsl_matrix_complex *tmp = gsl_matrix_complex_alloc(size, size);
result = gsl_matrix_complex_alloc(size, size);
gsl_matrix_complex_memcpy(tmp, (gsl_matrix_complex *)m);
gsl_linalg_complex_LU_decomp(tmp, p, &sign);
if (gsl_linalg_complex_LU_invert(tmp, p, (gsl_matrix_complex *)result) != GSL_SUCCESS)
{
gsl_matrix_complex_free(result);
return NULL;
}
gsl_matrix_complex_free(tmp);
}
gsl_permutation_free(p);
return result;
}
static CMATRIX *MATRIX_create(int width, int height, bool complex, bool init)
{
CMATRIX *m = GB.Create(CLASS_Matrix, NULL,NULL);
if (complex)
m->matrix = init ? gsl_matrix_complex_calloc(height, width) : gsl_matrix_complex_alloc(height, width);
else
m->matrix = init ? gsl_matrix_calloc(height, width) : gsl_matrix_alloc(height, width);
m->complex = complex;
return m;
}
/*
* Allocate a complex matrix, convert the real matrix it complex form
* and free the real matrix.
*
*/
gsl_matrix_complex *
gsl_ext_matrix_convert_and_free(gsl_matrix *m)
{
gsl_matrix_complex *zm;
zm = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_ext_matrix_convert(zm, m);
gsl_matrix_free(m);
return zm;
}