/* Returns the projected matrix A and the error of each eigenvector */
void
constructArray_qdp(QDP_ColorVector **eigVec, Matrix *A, QLA_Real *err,
QDP_Subset subset)
{
QLA_Complex cc;
QLA_Real rr;
QDP_ColorVector *res, *grad;
int i, j, Nvecs;
Nvecs = A->N;
res = QDP_create_V();
grad = QDP_create_V();
for(i=0; i<Nvecs; i++) {
Matrix_Vec_mult_qdp(eigVec[i], res, subset);
QDP_r_eq_re_V_dot_V(&rr, res, eigVec[i], subset);
A->M[i][i].real = rr;
A->M[i][i].imag = 0.0;
QDP_V_eq_V(grad, res, subset);
QDP_V_meq_r_times_V(grad, &rr, eigVec[i], subset);
QDP_r_eq_norm2_V(&rr, grad, subset);
err[i] = sqrt(rr);
for(j=i+1; j<Nvecs; j++) {
QDP_c_eq_V_dot_V(&cc, res, eigVec[j], subset);
A->M[i][j].real = QLA_real(cc);
A->M[i][j].imag = QLA_imag(cc);
A->M[j][i].real = QLA_real(cc);
A->M[j][i].imag = -QLA_imag(cc);
}
}
QDP_destroy_V(grad);
QDP_destroy_V(res);
}
static void
su2_extract(NCPROT QLA_Real r[4], QLA_ColorMatrix(*m), int i, int j)
{
QLA_Complex *a00, *a01, *a10, *a11;
a00 = &QLA_elem_M(*m, i, i);
a01 = &QLA_elem_M(*m, i, j);
a10 = &QLA_elem_M(*m, j, i);
a11 = &QLA_elem_M(*m, j, j);
r[0] = QLA_real(*a00) + QLA_real(*a11);
r[1] = QLA_imag(*a01) + QLA_imag(*a10);
r[2] = QLA_real(*a01) - QLA_real(*a10);
r[3] = QLA_imag(*a00) - QLA_imag(*a11);
}
static void
Qs(float_DD_put)(char *buf, size_t index, int count, void *v_arg)
{
Qs(USQCDArgs) *arg = v_arg;
#if QNc == 'N'
typedef QLA_DN_DiracPropagator(arg->nc, Ptype);
#else
typedef Qx(QLA_D,_DiracPropagator) Ptype;
#endif
Ptype *P = arg->P;
Ptype *dst = &P[index];
QLA_F_Complex *src = (void *)buf;
int js = arg->js;
int jc = arg->jc;
int is, ic;
if (count != 1)
luaL_error(arg->L, "qcd.ddpairs.read(): count != 1");
for (is = 0; is < QDP_Ns; is++) {
for (ic = 0; ic < arg->nc; ic++, src++) {
QLA_c_eq_r_plus_ir(QLA_elem_P(*dst, ic, is, jc, js),
QLA_real(*src), QLA_imag(*src));
}
}
}
static int
mc_det(lua_State *L)
{
mMatComplex *m = qlua_checkMatComplex(L, 1);
mMatComplex *lu;
mMatComplex *r;
gsl_permutation *p;
int signum;
gsl_complex d;
QLA_D_Complex *z;
if (m->l_size != m->r_size)
return luaL_error(L, "square matrix expected");
p = new_permutation(L, m->l_size);
lu = qlua_newMatComplex(L, m->l_size, m->l_size);
r = qlua_newMatComplex(L, m->l_size, m->l_size);
gsl_matrix_complex_memcpy(lu->m, m->m);
gsl_linalg_complex_LU_decomp(lu->m, p, &signum);
d = gsl_linalg_complex_LU_det(lu->m, signum);
gsl_permutation_free(p);
z = qlua_newComplex(L);
QLA_real(*z) = GSL_REAL(d);
QLA_imag(*z) = GSL_IMAG(d);
return 1;
}
static int
mc_put(lua_State *L) /* (-3,+0,e) */
{
mMatComplex *v = qlua_checkMatComplex(L, 1);
int sl, sr;
qlua_checkindex2(L, 2, "matrix set", &sl, &sr);
if ((sl >= 0) && (sl < v->l_size) &&
(sr >= 0) && (sr < v->r_size)) {
switch (qlua_qtype(L, 3)) {
case qReal: {
gsl_complex z;
double x = luaL_checknumber(L, 3);
GSL_SET_COMPLEX(&z, x, 0);
gsl_matrix_complex_set(v->m, sl, sr, z);
return 0;
}
case qComplex: {
gsl_complex zz;
QLA_D_Complex *z = qlua_checkComplex(L, 3);
GSL_SET_COMPLEX(&zz, QLA_real(*z), QLA_imag(*z));
gsl_matrix_complex_set(v->m, sl, sr, zz);
return 0;
}
default:
break;
}
}
return qlua_badindex(L, "matrix.complex[]");
}
static int
mc_get(lua_State *L) /* (-2,+1,e) */
{
switch (qlua_qtype(L, 2)) {
case qTable: {
mMatComplex *v = qlua_checkMatComplex(L, 1);
int sl, sr;
qlua_checkindex2(L, 2, "matrix get", &sl, &sr);
if ((sl >= 0) && (sl < v->l_size) &&
(sr >= 0) && (sr < v->r_size)) {
QLA_D_Complex *z = qlua_newComplex(L);
gsl_complex zz = gsl_matrix_complex_get(v->m, sl, sr);
QLA_real(*z) = GSL_REAL(zz);
QLA_imag(*z) = GSL_IMAG(zz);
return 1;
}
break;
}
case qString:
return qlua_lookup(L, 2, opMatComplex);
default:
break;
}
return qlua_badindex(L, "matrix.complex[]");
}
void
RotateBasis_qdp(QDP_ColorVector **eigVec, Matrix *V, QDP_Subset subset)
{
QLA_Complex z;
QDP_ColorVector **Tmp;
int i, j, N;
N = V->N;
/* Allocate the temporary vectors needed */
Tmp = malloc(N*sizeof(QDP_ColorVector *));
for(i=0; i<N; i++) Tmp[i] = QDP_create_V();
for(i=0; i<N; i++) {
QDP_V_eq_zero(Tmp[i], subset);
for(j=0; j<N; j++) {
QLA_real(z) = V->M[j][i].real;
QLA_imag(z) = V->M[j][i].imag;
QDP_V_peq_c_times_V(Tmp[i], &z, eigVec[j], subset);
}
}
/* Copy rotated basis to the eigVec and free temporaries */
for(i=0; i<N; i++) {
QDP_V_eq_V(eigVec[i], Tmp[i], subset);
normalize_qdp(eigVec[i], subset);
QDP_destroy_V(Tmp[i]);
}
free(Tmp);
}
static void
show_dot(const char *name, QDP_DiracFermion *a, QDP_DiracFermion *b)
{
QLA_Complex v;
QDP_c_eq_D_dot_D(&v, a, b, QDP_all);
printf0(" <%s> = %30.20e %+30.20e\n", name, QLA_real(v), QLA_imag(v));
}
static int
c_mul_cm(lua_State *L)
{
QLA_D_Complex *b = qlua_checkComplex(L, 1);
mMatComplex *a = qlua_checkMatComplex(L, 2);
return do_ccmul(L, a, QLA_real(*b), QLA_imag(*b));
}
void
printm(QLA_ColorMatrix *m)
{
for(int i=0; i<QLA_Nc; i++) {
for(int j=0; j<QLA_Nc; j++) {
QLA_Complex *z = &QLA_elem_M(*m,i,j);
printf("%10g%+10gi ", QLA_real(*z), QLA_imag(*z));
}
printf("\n");
}
}
static void
q_CL_P_writer(const int p[], int c, int d, int re_im, double v, void *e)
{
qCL_P_env *env = e;
int i = QDP_index_L(env->lat, p);
if (re_im == 0) {
QLA_real(QLA_elem_P(env->out[i], c, d, env->c, env->d)) = v;
} else {
QLA_imag(QLA_elem_P(env->out[i], c, d, env->c, env->d)) = v;
}
}
static int
cm_div_c(lua_State *L)
{
mMatComplex *a = qlua_checkMatComplex(L, 1);
QLA_D_Complex *b = qlua_checkComplex(L, 2);
double br = QLA_real(*b);
double bi = QLA_imag(*b);
double h = hypot(br, bi);
double n = 1/h;
return do_ccmul(L, a, br * n * n, -bi * n * n);
}
static void
q_CL_D_writer(const int p[], int c, int d, int re_im, double v, void *e)
{
CL_D_env *env = e;
int i = QDP_index_L(env->lat, p);
QLA_D3_DiracFermion *f = env->f;
if (re_im == 0) {
QLA_real(QLA_elem_D(f[i], c, d)) = v;
} else {
QLA_imag(QLA_elem_D(f[i], c, d)) = v;
}
}
static void
f_writer(const int pos[4], int c, int d, int re_im, double v, void *env)
{
int n = QDP_node_number(pos);
int i = QDP_index(pos);
QDP_DiracFermion *f = (QDP_DiracFermion *)env;
QLA_DiracFermion *df = QDP_expose_D(f);
assert(n == self);
if (re_im == 0) {
QLA_real(QLA_elem_D(df[i], c, d)) = v;
} else {
QLA_imag(QLA_elem_D(df[i], c, d)) = v;
}
QDP_reset_D(f);
}
static double
q_CL_u_reader(int d, const int p[], int a, int b, int re_im, void *env)
{
QLA_D_Complex z;
QCArgs *args = env;
int i = QDP_index_L(args->lat, p);
if (p[d] == (args->lattice[d] - 1)) {
QLA_c_eq_c_times_c(z, args->bf[d], QLA_elem_M(args->uf[d][i], a, b));
} else {
QLA_c_eq_c(z, QLA_elem_M(args->uf[d][i], a, b));
}
if (re_im == 0)
return QLA_real(z);
else
return QLA_imag(z);
}
static void
qlamakegroup(QLA_Complex *x, int g)
{
switch(g&GROUP_TYPE) {
case GROUP_GL: break;
case GROUP_U: {
QLA_Real n = QLA_norm2_c(*x);
if(n==0) { QLA_c_eq_r(*x, 1); }
else {
n = 1/sqrt(n);
QLA_c_eq_r_times_c(*x, n, *x);
}
} break;
case GROUP_H: QLA_c_eq_r(*x, QLA_real(*x)); break;
case GROUP_AH: QLA_c_eq_r_plus_ir(*x, 0, QLA_imag(*x)); break;
}
if(g&GROUP_S) QLA_c_eq_r(*x, 1);
if(g&GROUP_T) QLA_c_eq_r(*x, 0);
}
static int
mc_trace(lua_State *L) /* (-1,+2,e) */
{
mMatComplex *m = qlua_checkMatComplex(L, 1);
int i;
double tr;
double ti;
QLA_D_Complex *t = qlua_newComplex(L);
if (m->l_size != m->r_size)
return luaL_error(L, "matrix:trace() expects square matrix");
for (ti = tr = 0, i = 0; i < m->l_size; i++) {
gsl_complex z = gsl_matrix_complex_get(m->m, i, i);
tr += GSL_REAL(z);
ti += GSL_IMAG(z);
}
QLA_real(*t) = tr;
QLA_imag(*t) = ti;
return 1;
}
int
main(void) {
QLA_ColorMatrix O, iQ, tmp, matI;
QLA_M_eq_zero(&matI);
for(int i=0; i<QLA_Nc; i++) {
QLA_c_eq_r_plus_ir(QLA_elem_M(matI,i,i), 1.0, 0.0);
}
printm(&matI);
QLA_Complex tr;
QLA_Real half = 0.5;
for(int i=0; i<QLA_Nc; i++) {
for(int j=0; j<QLA_Nc; j++) {
QLA_c_eq_r_plus_ir(QLA_elem_M(O,i,j), i+1, QLA_Nc*(j+1));
}
QLA_c_eq_r_plus_ir(QLA_elem_M(O,i,i), 2+1, 1);
}
#if QDP_Colors == 3
QLA_Complex ci;
QLA_c_eq_r_plus_ir(ci, 0, 1);
//use my own implementation
QLA_ColorMatrix expiQ;
QLA_ColorMatrix QQ;
QLA_ColorMatrix QQQ;
QLA_M_eq_M_times_M(&QQ, &iQ, &iQ); //-Q^2
QLA_M_eq_M_times_M(&QQQ, &QQ, &iQ); //-iQ^3
QLA_M_eq_c_times_M(&QQQ, &ci, &QQQ); //Q^3
QLA_Complex c0, c1;
QLA_C_eq_trace_M(&c0, &QQQ);
QLA_c_eq_r_times_c(c0, 0.3333333, c0);
QLA_C_eq_trace_M(&c1, &QQ);
QLA_c_eq_r_times_c(c1, -0.5, c1);
double _Complex tf0, tf1, tf2;
getfs(&tf0, &tf1, &tf2, QLA_real(c0), QLA_real(c1));
QLA_Complex f0, f1, f2;
f0 = tf0;
f1 = tf1;
f2 = tf2;
printm(&O);
printf("iQ = \n");
printm(&iQ);
printf("QLA: exp(iQ) = \n");
printm(&qla_exp);
printf("Q^3 = \n");
printm(&QQQ);
printf("c0 = "); printc(&c0);
printf("c1 = "); printc(&c1);
#endif
#if QDP_Colors == 2
QLA_ColorMatrix expO;
QLA_Complex Tr, det;
QLA_c_eq_c_times_c(det, QLA_elem_M(O,0,0),QLA_elem_M(O,1,1));
QLA_c_meq_c_times_c(det, QLA_elem_M(O,0,1), QLA_elem_M(O,1,0));
QLA_C_eq_trace_M(&Tr, &O);
QLA_Complex s, t;
QLA_c_eq_r_times_c(s, 0.5, Tr); // s=TrA/2
QLA_Complex s2;
QLA_c_eq_c_times_c(s2, s, s); //s2 = s^2
QLA_c_meq_c(s2, det); //s2 = s^2 - detA
double _Complex dc_t = QLA_real(s2) + QLA_imag(s2) * _Complex_I;
dc_t = csqrt(dc_t); // sqrt(s^2 - det A)
QLA_c_eq_r_plus_ir(t, creal(dc_t), cimag(dc_t)); // t = sqrt(s^2 - det A)
printf(" Matrix O = \n"); printm(&O);
printf("TrO = "); printc(&Tr);
printf("detO = "); printc(&det);
printf("s = "); printc(&s);
printf("t^2 = "); printc(&s2);
printf("t = "); printc(&t);
//use the QLA exp function
QLA_ColorMatrix qla_exp;
QLA_M_eq_exp_M(&qla_exp, &O); //exp(O)
double _Complex cosht, sinht, sinht_t;
if(QLA_real(t) == 0 && QLA_imag(t) == 0) {
cosht = 1;
sinht = 0;
sinht_t = 1;
} else {
cosht = ccosh(dc_t);
sinht = csinh(dc_t);
sinht_t = sinht/dc_t;
}
double _Complex dc_s = QLA_real(s) + QLA_imag(s) * _Complex_I;
double _Complex dc_f0, dc_f1;
dc_f0 = cexp(dc_s) * (cosht - dc_s * sinht_t);
dc_f1 = cexp(dc_s) * sinht_t;
QLA_Complex f0, f1;
QLA_c_eq_r_plus_ir(f0, creal(dc_f0), cimag(dc_f0));
QLA_c_eq_r_plus_ir(f1, creal(dc_f1), cimag(dc_f1));
QLA_M_eq_c_times_M(&expO, &f1, &O);
QLA_M_peq_c(&expO, &f0);
printf("QLA exp = \n"); printm(&qla_exp);
printf("my expO = \n"); printm(&expO);
#endif
return 0;
}
static int
qaff_w_write(lua_State *L)
{
mAffWriter *b = qlua_checkAffWriter(L, 1);
const char *p = luaL_checkstring(L, 2);
struct AffNode_s *n;
int status;
const char *msg = NULL;
check_writer(L, b);
qlua_Aff_enter(L);
if (b->master) {
status = 0;
n = qlua_AffWriterMkPath(b, p);
if (n == 0) {
msg = aff_writer_errstr(b->ptr);
goto end;
}
msg = "Write error";
switch (qlua_qtype(L, 3)) {
case qString: {
const char *str = luaL_checkstring(L, 3);
if (aff_node_put_char(b->ptr, n, str, strlen(str)) == 0)
status = 1;
break;
}
case qVecInt: {
mVecInt *v = qlua_checkVecInt(L, 3);
int size = v->size;
uint32_t *d = qlua_malloc(L, size * sizeof (uint32_t));
int i;
for (i = 0; i < size; i++)
d[i] = v->val[i];
if (aff_node_put_int(b->ptr, n, d, size) == 0)
status = 1;
qlua_free(L, d);
break;
}
case qVecReal: {
mVecReal *v = qlua_checkVecReal(L, 3);
int size = v->size;
double *d = qlua_malloc(L, size * sizeof (double));
int i;
for (i = 0; i < size; i++)
d[i] = v->val[i];
if (aff_node_put_double(b->ptr, n, d, size) == 0)
status = 1;
qlua_free(L, d);
break;
}
case qVecComplex: {
mVecComplex *v = qlua_checkVecComplex(L, 3);
int size = v->size;
double _Complex *d = qlua_malloc(L, size * sizeof (double _Complex));
int i;
for (i = 0; i < size; i++) {
d[i] = QLA_real(v->val[i]) + I * QLA_imag(v->val[i]);
}
if (aff_node_put_complex(b->ptr, n, d, size) == 0)
status = 1;
qlua_free(L, d);
break;
}
default:
msg = "Unsupported data type";
break;
}
end:
;
} else {
status = 0;
}
qlua_Aff_leave();
QMP_sum_int(&status);
if (status)
return 0;
if (b->master)
return luaL_error(L, msg);
else
return luaL_error(L, "generic writer error");
}
static int
qaff_r_read(lua_State *L)
{
mAffReader *b = qlua_checkAffReader(L, 1);
const char *p = luaL_checkstring(L, 2);
struct AffNode_s *n;
uint32_t size;
check_reader(L, b);
qlua_Aff_enter(L);
n = qlua_AffReaderChPath(b, p);
if (n == 0)
goto end;
size = aff_node_size(n);
switch (aff_node_type(n)) {
case affNodeVoid:
lua_pushboolean(L, 1);
qlua_Aff_leave();
return 1;
case affNodeChar: {
char *d = qlua_malloc(L, size + 1);
if (aff_node_get_char(b->ptr, n, d, size) == 0) {
d[size] = 0;
lua_pushstring(L, d);
qlua_Aff_leave();
qlua_free(L, d);
return 1;
}
qlua_free(L, d);
break;
}
case affNodeInt: {
uint32_t *d = qlua_malloc(L, size * sizeof (uint32_t));
if (aff_node_get_int(b->ptr, n, d, size) == 0) {
mVecInt *v = qlua_newVecInt(L, size);
int i;
for (i = 0; i < size; i++)
v->val[i] = d[i];
qlua_Aff_leave();
qlua_free(L, d);
return 1;
}
qlua_free(L, d);
break;
}
case affNodeDouble: {
double *d = qlua_malloc(L, size * sizeof (double));
if (aff_node_get_double(b->ptr, n, d, size) == 0) {
mVecReal *v = qlua_newVecReal(L, size);
int i;
for (i = 0; i < size; i++)
v->val[i] = d[i];
qlua_Aff_leave();
qlua_free(L, d);
return 1;
}
qlua_free(L, d);
break;
}
case affNodeComplex: {
double _Complex *d = qlua_malloc(L, size * sizeof (double _Complex));
if (aff_node_get_complex(b->ptr, n, d, size) == 0) {
mVecComplex *v = qlua_newVecComplex(L, size);
int i;
for (i = 0; i < size; i++) {
QLA_real(v->val[i]) = creal(d[i]);
QLA_imag(v->val[i]) = cimag(d[i]);
}
qlua_Aff_leave();
qlua_free(L, d);
return 1;
}
qlua_free(L, d);
break;
}
default:
goto end;
}
qlua_Aff_leave();
return luaL_error(L, aff_reader_errstr(b->ptr));
end:
qlua_Aff_leave();
return luaL_error(L, "bad arguments for AFF read");
}
static void
pushqlatype(lua_State *L, QLA_Complex *c)
{
qhmc_complex_create(L, QLA_real(*c), QLA_imag(*c));
}
void
QOPPC(symanzik_1loop_gauge_force1) (QOP_info_t *info, QOP_GaugeField *gauge,
QOP_Force *force, QOP_gauge_coeffs_t *coeffs, REAL eps)
{
REAL Plaq, Rect, Pgm ;
QDP_ColorMatrix *tempmom_qdp[4];
QDP_ColorMatrix *Amu[6]; // products of 2 links Unu(x)*Umu(x+nu)
QDP_ColorMatrix *tmpmat;
QDP_ColorMatrix *tmpmat1;
QDP_ColorMatrix *tmpmat2;
QDP_ColorMatrix *staples;
QDP_ColorMatrix *tmpmat3;
QDP_ColorMatrix *tmpmat4;
int i, k;
int mu, nu, sig;
double dtime;
//REAL eb3 = -eps*beta/3.0;
REAL eb3 = -eps/3.0;
int j[3][2] = {{1,2},
{0,2},
{0,1}};
// QOP_printf0("beta: %e, eb3: %e\n", beta, eb3);
dtime = -QOP_time();
for(mu=0; mu<4; mu++) {
tempmom_qdp[mu] = QDP_create_M();
QDP_M_eq_zero(tempmom_qdp[mu], QDP_all);
}
tmpmat = QDP_create_M();
for(i=0; i<QOP_common.ndim; i++) {
fblink[i] = gauge->links[i];
fblink[OPP_DIR(i)] = QDP_create_M();
QDP_M_eq_sM(tmpmat, fblink[i], QDP_neighbor[i], QDP_backward, QDP_all);
QDP_M_eq_Ma(fblink[OPP_DIR(i)], tmpmat, QDP_all);
}
for(i=0; i<6; i++) {
Amu[i] = QDP_create_M();
}
staples = QDP_create_M();
tmpmat1 = QDP_create_M();
tmpmat2 = QDP_create_M();
tmpmat3 = QDP_create_M();
tmpmat4 = QDP_create_M();
Plaq = coeffs->plaquette;
Rect = coeffs->rectangle;
Pgm = coeffs->parallelogram;
//Construct 3-staples and rectangles
for(mu=0; mu<4; mu++) {
i=0;
for(nu=0; nu<4; nu++) {
if(nu!=mu){
// tmpmat1 = Umu(x+nu)
QDP_M_eq_sM(tmpmat1, fblink[mu], QDP_neighbor[nu], QDP_forward, QDP_all);
QDP_M_eq_M_times_M(Amu[i], fblink[nu], tmpmat1, QDP_all);
//tmpmat2 = Umu(x-nu)
QDP_M_eq_sM(tmpmat2, fblink[mu], QDP_neighbor[nu], QDP_backward, QDP_all);
QDP_M_eq_M_times_M(Amu[i+3], fblink[OPP_DIR(nu)], tmpmat2, QDP_all);
//tmpmat = U_{nu}(x+mu)
QDP_M_eq_sM(tmpmat, fblink[nu], QDP_neighbor[mu], QDP_forward, QDP_all);
QDP_M_eq_M_times_Ma(staples, Amu[i], tmpmat, QDP_all);
QDP_M_peq_r_times_M(tempmom_qdp[mu], &Plaq, staples, QDP_all);
//tmpmat = U_{-nu}(x+mu)
QDP_M_eq_sM(tmpmat, fblink[OPP_DIR(nu)], QDP_neighbor[mu], QDP_forward, QDP_all);
QDP_M_eq_Ma_times_M(tmpmat3, fblink[OPP_DIR(nu)], staples, QDP_all);
QDP_M_eq_M_times_M(tmpmat4, tmpmat3, tmpmat, QDP_all);
QDP_M_eq_sM(tmpmat, tmpmat4, QDP_neighbor[nu], QDP_forward, QDP_all);
QDP_M_peq_r_times_M(tempmom_qdp[mu], &Rect, tmpmat, QDP_all);
QDP_M_eq_Ma_times_M(tmpmat4, tmpmat2, tmpmat3, QDP_all);
QDP_M_eq_sM(tmpmat, tmpmat4, QDP_neighbor[nu], QDP_forward, QDP_all);
QDP_M_eq_sM(tmpmat3, tmpmat, QDP_neighbor[mu], QDP_backward, QDP_all);
QDP_M_peq_r_times_M(tempmom_qdp[nu], &Rect, tmpmat3, QDP_all);
//tmpmat = U_{-nu}(x+mu)
QDP_M_eq_sM(tmpmat, fblink[OPP_DIR(nu)], QDP_neighbor[mu], QDP_forward, QDP_all);
QDP_M_eq_M_times_Ma(tmpmat3, tmpmat2, tmpmat, QDP_all);
QDP_M_eq_M_times_Ma(tmpmat, tmpmat3, staples, QDP_all);
QDP_M_eq_sM(tmpmat3, tmpmat, QDP_neighbor[nu], QDP_forward, QDP_all);
QDP_M_peq_r_times_M(tempmom_qdp[nu], &Rect, tmpmat3, QDP_all);
//tmpmat = U_{-nu}(x+mu)
QDP_M_eq_sM(tmpmat, fblink[OPP_DIR(nu)], QDP_neighbor[mu], QDP_forward, QDP_all);
QDP_M_eq_M_times_Ma(staples, Amu[i+3], tmpmat, QDP_all);
QDP_M_peq_r_times_M(tempmom_qdp[mu], &Plaq, staples, QDP_all);
QDP_M_eq_Ma_times_M(tmpmat3, fblink[nu], staples, QDP_all);
QDP_M_eq_sM(tmpmat, fblink[nu], QDP_neighbor[mu], QDP_forward, QDP_all);
QDP_M_eq_M_times_M(tmpmat4, tmpmat3, tmpmat, QDP_all);
QDP_M_eq_sM(tmpmat, tmpmat4, QDP_neighbor[nu], QDP_backward, QDP_all);
QDP_M_peq_r_times_M(tempmom_qdp[mu], &Rect, tmpmat, QDP_all);
QDP_M_eq_Ma_times_M(tmpmat, tmpmat3, tmpmat1, QDP_all);
QDP_M_eq_sM(tmpmat4, tmpmat, QDP_neighbor[mu], QDP_backward, QDP_all);
QDP_M_peq_r_times_M(tempmom_qdp[nu], &Rect, tmpmat4, QDP_all);
QDP_M_eq_sM(tmpmat, fblink[nu], QDP_neighbor[mu], QDP_forward, QDP_all);
QDP_M_eq_M_times_M(tmpmat3, staples, tmpmat, QDP_all);
QDP_M_eq_M_times_Ma(tmpmat4, tmpmat3, tmpmat1, QDP_all);
QDP_M_peq_r_times_M(tempmom_qdp[nu], &Rect, tmpmat4, QDP_all);
i++;
}
}
// Construct the pgm staples and add them to force
QDP_M_eq_zero(staples, QDP_all);
i=0;
for(nu=0; nu<4; nu++){
if(nu!=mu){
k=0;
for(sig=0; sig<4;sig ++){
if(sig!=mu && nu!=sig){
// the nu_sig_mu ... staple and 3 reflections
//tmpmat = Amu["sig"](x+nu)
QDP_M_eq_sM(tmpmat, Amu[j[i][k]], QDP_neighbor[nu], QDP_forward, QDP_all);
//tmpmat1 = Unu(x)*Amu["sig"](x+nu)
QDP_M_eq_M_times_M(tmpmat1, fblink[nu], tmpmat, QDP_all);
//tmpmat3 = Unu(x+mu+sig)
QDP_M_eq_sM(tmpmat, fblink[nu], QDP_neighbor[mu], QDP_forward, QDP_all);
QDP_M_eq_sM(tmpmat3, tmpmat, QDP_neighbor[sig], QDP_forward, QDP_all); // HERE?
//tmpmat2 = Unu(x)*Amu["sig"](x+nu)*adj(Unu(x+mu+sig))
QDP_M_eq_M_times_Ma(tmpmat2, tmpmat1, tmpmat3, QDP_all);
//tmpmat = Usig(x+mu)
QDP_M_eq_sM(tmpmat, fblink[sig], QDP_neighbor[mu], QDP_forward, QDP_all);
//tmpmat1 = Unu(x)*Amu["sig"](x+nu)*adj(Unu(x+mu+sig))*adj(Usig(x+mu))
QDP_M_eq_M_times_Ma(tmpmat1, tmpmat2, tmpmat, QDP_all);
QDP_M_peq_M(staples, tmpmat1, QDP_all);
//tmpmat = Amu["sig"](x-nu)
QDP_M_eq_sM(tmpmat, Amu[j[i][k]], QDP_neighbor[nu], QDP_backward, QDP_all);
//tmpmat1 = U_{-nu}(x)*Amu["sig"](x-nu)
QDP_M_eq_M_times_M(tmpmat1, fblink[OPP_DIR(nu)], tmpmat, QDP_all);
//tmpmat3 = U_{-nu}(x+mu+sig)
QDP_M_eq_sM(tmpmat, fblink[OPP_DIR(nu)], QDP_neighbor[mu], QDP_forward, QDP_all);
QDP_M_eq_sM(tmpmat3, tmpmat, QDP_neighbor[sig], QDP_forward, QDP_all); // HERE?
//tmpmat2 = U_{-nu}nu(x)*Amu["sig"](x-nu)*adj(Unu(x+mu+sig))
QDP_M_eq_M_times_Ma(tmpmat2, tmpmat1, tmpmat3, QDP_all);
//tmpmat = Usig(x+mu)
QDP_M_eq_sM(tmpmat, fblink[sig], QDP_neighbor[mu], QDP_forward, QDP_all);
//tmpmat1 = U_{-nu}(x)*Amu["sig"](x-nu)*adj(Unu(x+mu+sig))*adj(Usig(x+mu))
QDP_M_eq_M_times_Ma(tmpmat1, tmpmat2, tmpmat, QDP_all);
QDP_M_peq_M(staples, tmpmat1, QDP_all);
//tmpmat = Amu["-sig"](x-nu)
QDP_M_eq_sM(tmpmat, Amu[j[i][k]+3], QDP_neighbor[nu], QDP_backward, QDP_all);
//tmpmat1 = U_{-nu}(x)*Amu["-sig"](x-nu)
QDP_M_eq_M_times_M(tmpmat1, fblink[OPP_DIR(nu)], tmpmat, QDP_all);
//tmpmat = U_{-nu}(x+mu-sig)
QDP_M_eq_sM(tmpmat, fblink[OPP_DIR(nu)], QDP_neighbor[mu], QDP_forward, QDP_all);
QDP_M_eq_sM(tmpmat3, tmpmat, QDP_neighbor[sig], QDP_backward, QDP_all); // HERE?
//tmpmat2 = U_{-nu}nu(x)*Amu["-sig"](x-nu)*adj(Unu(x+mu-sig))
QDP_M_eq_M_times_Ma(tmpmat2, tmpmat1, tmpmat3, QDP_all);
//tmpmat = U_{-sig}(x+mu)
QDP_M_eq_sM(tmpmat, fblink[OPP_DIR(sig)], QDP_neighbor[mu], QDP_forward, QDP_all);
//tmpmat1 = U_{-nu}(x)*Amu["-sig"](x-nu)*adj(Unu(x+mu-sig))*adj(U_{-sig}(x+mu))
QDP_M_eq_M_times_Ma(tmpmat1, tmpmat2, tmpmat, QDP_all);
QDP_M_peq_M(staples, tmpmat1, QDP_all);
//tmpmat = Amu["-sig"](x+nu)
QDP_M_eq_sM(tmpmat, Amu[j[i][k]+3], QDP_neighbor[nu], QDP_forward, QDP_all);
//tmpmat1 = Unu(x)*Amu["-sig"](x+nu)
QDP_M_eq_M_times_M(tmpmat1, fblink[nu], tmpmat, QDP_all);
//tmpmat3 = Unu(x+mu-sig)
QDP_M_eq_sM(tmpmat, fblink[nu], QDP_neighbor[mu], QDP_forward, QDP_all);
QDP_M_eq_sM(tmpmat3, tmpmat, QDP_neighbor[sig], QDP_backward, QDP_all); // HERE?
//tmpmat2 = Unu(x)*Amu["-sig"](x+nu)*adj(Unu(x+mu-sig))
QDP_M_eq_M_times_Ma(tmpmat2, tmpmat1, tmpmat3, QDP_all);
//tmpmat = U_{-sig}(x+mu)
QDP_M_eq_sM(tmpmat, fblink[OPP_DIR(sig)], QDP_neighbor[mu], QDP_forward, QDP_all);
//tmpmat1 = Unu(x)*Amu["sig"](x+nu)*adj(Unu(x+mu+sig))*adj(Usig(x+mu))
QDP_M_eq_M_times_Ma(tmpmat1, tmpmat2, tmpmat, QDP_all);
QDP_M_peq_M(staples, tmpmat1, QDP_all);
k++;
}//close if sig!=nu ...
}//close sig loop
i++;
}// close if nu!=mu
}//close the pgm nu loop
QDP_M_peq_r_times_M(tempmom_qdp[mu], &Pgm, staples, QDP_all);
}// closes the mu loop
#ifdef CHKSUM
QLA_ColorMatrix qcm;
QLA_Complex det, chk;
QLA_c_eq_r(chk, 0);
#endif
for(mu=0; mu<4; mu++){
QDP_M_eq_M_times_Ma(tmpmat, fblink[mu], tempmom_qdp[mu], QDP_all); // HERE?
QDP_M_eq_r_times_M_plus_M( tempmom_qdp[mu], &eb3, tmpmat, force->force[mu], QDP_all);// HERE?
QDP_M_eq_antiherm_M(force->force[mu], tempmom_qdp[mu], QDP_all);// HERE
#ifdef CHKSUM
QDP_m_eq_sum_M(&qcm, force->force[mu], QDP_all);
QLA_C_eq_det_M(&det, &qcm);
QLA_c_peq_c(chk, det);
#endif
}
#ifdef CHKSUM
QOP_printf0("chksum: %g %g\n", QLA_real(chk), QLA_imag(chk));
#endif
//DESTROY various fields
QDP_destroy_M(tmpmat);
QDP_destroy_M(tmpmat1);
QDP_destroy_M(tmpmat2);
QDP_destroy_M(tmpmat3);
QDP_destroy_M(staples);
QDP_destroy_M(tmpmat4);
for(mu=0; mu<4; mu++){
QDP_destroy_M(tempmom_qdp[mu]);
}
for(i=0; i<6; i++) {
QDP_destroy_M(Amu[i]);
}
for(i=4; i<8; i++) {
QDP_destroy_M(fblink[i]);
}
dtime += QOP_time();
double nflop = 96720;
info->final_sec = dtime;
info->final_flop = nflop*QDP_sites_on_node;
info->status = QOP_SUCCESS;
//QOP_printf0("Time in slow g_force: %e\n", info->final_sec);
}
/* optimized version of building blocks
compute tr(B^+ \Gamma_n F) [n=0..15] and projects on n_qext momenta
select time interval [tsrc: tsnk] and does time reversal if time_rev==1
save results to aff_w[aff_kpath . 'g%d/qx%d_qy%d_qz%d']
Parameters:
csrc = { xsrc, ysrc, zsrc, tsrc }
tsnk
qext[4 * i_qext + dir] ext.mom components
time_rev ==0 for proton_3, ==1 for proton_negpar_3
bc_baryon_t =+/-1 boundary condition for baryon 2pt[sic!] function; =bc_quark^3
*/
const char *
save_bb(lua_State *L,
mLattice *S,
mAffWriter *aff_w,
const char *aff_kpath,
QDP_D3_DiracPropagator *F,
QDP_D3_DiracPropagator *B,
const int *csrc, /* [qRank] */
int tsnk,
int n_mom,
const int *mom, /* [n_mom][qRank] */
int time_rev, /* 1 to reverse, 0 to not */
int t_axis, /* 0-based */
double bc_baryon_t)
{
/* gamma matrix parameterization for left multiplication:
Gamma_n [i,j] = gamma_coeff[n][i] * \delta_{i,gamma_ind[n][i]}
v[0] a[0]*v[I[0]]
Gamma * v[1] = a[1]*v[I[1]]
v[2] a[2]*v[I[2]]
v[3] a[3]*v[I[3]]
or
(Gamma * X)_{ik} = a[i] * X[I[i],k]
*/
double complex gamma_left_coeff[16][4] = {
{ 1, 1, 1, 1 }, /* G0 = 1 */
{ I, I,-I,-I }, /* G1 = g1 */
{-1, 1, 1,-1 }, /* G2 = g2 */
{-I, I,-I, I }, /* G3 = g1 g2 */
{ I,-I,-I, I }, /* G4 = g3 */
{-1, 1,-1, 1 }, /* G5 = g1 g3 */
{-I,-I,-I,-I }, /* G6 = g2 g3 */
{ 1, 1,-1,-1 }, /* G7 = g1 g2 g3 */
{ 1, 1, 1, 1 }, /* G8 = g4 */
{ I, I,-I,-I }, /* G9 = g1 g4 */
{-1, 1, 1,-1 }, /* G10= g2 g4 */
{-I, I,-I, I }, /* G11= g1 g2 g4 */
{ I,-I,-I, I }, /* G12= g3 g4 */
{-1, 1,-1, 1 }, /* G13= g1 g3 g4 */
{-I,-I,-I,-I }, /* G14= g2 g3 g4 */
{ 1, 1,-1,-1 }, /* G15= g1 g2 g3 g4 */
};
int gamma_left_ind[16][4] = {
{ 0, 1, 2, 3 }, /* G0 = 1 */
{ 3, 2, 1, 0 }, /* G1 = g1 */
{ 3, 2, 1, 0 }, /* G2 = g2 */
{ 0, 1, 2, 3 }, /* G3 = g1 g2 */
{ 2, 3, 0, 1 }, /* G4 = g3 */
{ 1, 0, 3, 2 }, /* G5 = g1 g3 */
{ 1, 0, 3, 2 }, /* G6 = g2 g3 */
{ 2, 3, 0, 1 }, /* G7 = g1 g2 g3 */
{ 2, 3, 0, 1 }, /* G8 = g4 */
{ 1, 0, 3, 2 }, /* G9 = g1 g4 */
{ 1, 0, 3, 2 }, /* G10= g2 g4 */
{ 2, 3, 0, 1 }, /* G11= g1 g2 g4 */
{ 0, 1, 2, 3 }, /* G12= g3 g4 */
{ 3, 2, 1, 0 }, /* G13= g1 g3 g4 */
{ 3, 2, 1, 0 }, /* G14= g2 g3 g4 */
{ 0, 1, 2, 3 }, /* G15= g1 g2 g3 g4 */
};
#define get_mom(mom_list, i_mom) ((mom_list) + 4*(i_mom))
if (4 != S->rank ||
4 != QDP_Ns ||
3 != t_axis) {
return "not implemented for this dim, spin, color, or t-axis";
}
int latsize[4];
QDP_latsize_L(S->lat, latsize);
if (NULL == aff_w ||
NULL == aff_kpath ||
NULL == mom ||
n_mom < 0) {
return "incorrect pointer parameters";
}
int i;
for (i = 0 ; i < S->rank; i++) {
if (csrc[i] < 0 || latsize[i] <= csrc[i]) {
return "incorrect source coordinates";
}
}
if (tsnk < 0 || latsize[t_axis] <= tsnk) {
return "incorrect sink t-coordinate";
}
if (n_mom <= 0)
return NULL; /* relax */
int src_snk_dt = -1;
int lt = latsize[t_axis];
if (!time_rev) {
src_snk_dt = (lt + tsnk - csrc[t_axis]) % lt;
} else {
src_snk_dt = (lt + csrc[t_axis] - tsnk) % lt;
}
int bb_arr_size = 16 * n_mom * (src_snk_dt + 1) * 2 * sizeof(double);
double *bb_arr = qlua_malloc(L, bb_arr_size);
memset(bb_arr, 0, bb_arr_size);
#define bb_real(i_gamma, i_mom) ((bb_arr) + (src_snk_dt + 1) * (0 + 2 * ((i_mom) + n_mom * (i_gamma))))
#define bb_imag(i_gamma, i_mom) ((bb_arr) + (src_snk_dt + 1) * (1 + 2 * ((i_mom) + n_mom * (i_gamma))))
double complex *exp_iphase = qlua_malloc(L, n_mom * sizeof(double complex));
int coord[4];
double complex trc_FBd[4][4];
QLA_D3_DiracPropagator *F_exp = QDP_D3_expose_P(F);
QLA_D3_DiracPropagator *B_exp = QDP_D3_expose_P(B);
int i_site;
int sites = QDP_sites_on_node_L(S->lat);
for (i_site = 0; i_site < sites; i_site++) {
QDP_get_coords_L(S->lat, coord, QDP_this_node, i_site);
int t = -1;
if (!time_rev) {
t = (lt + coord[t_axis] - csrc[t_axis]) % lt;
} else {
t = (lt + csrc[t_axis] - coord[t_axis]) % lt;
}
if (src_snk_dt < t)
continue;
/* precalc phases for inner contraction loop */
int i_mom;
for (i_mom = 0 ; i_mom < n_mom ; i_mom++) {
exp_iphase[i_mom] = calc_exp_iphase(coord, csrc,
latsize, get_mom(mom, i_mom));
// printf("%e+I*%e\n", creal(exp_iphase[i_mom]), cimag(exp_iphase[i_mom]));
}
/* compute trace_{color} [ F * B^\dag]
[is,js] = sum_{ic,jc,ks} F[ic,is; jc,ks] * (B[ic,js; jc,ks])^*
is,js,ks - spin, ic,jc - color
*/
int is, js, ks, ic, jc;
for (is = 0; is < 4; is++) {
for (js = 0; js < 4; js++) {
QLA_D_Complex sum;
QLA_c_eq_r(sum, 0);
for (ks = 0; ks < 4; ks++) {
for (ic = 0; ic < 3 ; ic++)
for (jc = 0; jc < 3 ; jc++)
QLA_c_peq_c_times_ca(sum,
QLA_elem_P(F_exp[i_site], ic,is, jc,ks),
QLA_elem_P(B_exp[i_site], ic,js, jc,ks));
}
trc_FBd[is][js] = QLA_real(sum) + I*QLA_imag(sum);
}
}
/* cycle over Gamma */
int gn;
for (gn = 0; gn < 16 ; gn++) {
double complex sum = 0.;
/* compute contractions Gamma(n) */
for (is = 0; is < 4; is++)
sum += gamma_left_coeff[gn][is] * trc_FBd[gamma_left_ind[gn][is]][is];
/* mult. by phase and add to timeslice sum */
for (i_mom = 0; i_mom < n_mom; i_mom++) {
double complex aux = exp_iphase[i_mom] * sum;
bb_real(gn, i_mom)[t] += creal(aux);
bb_imag(gn, i_mom)[t] += cimag(aux);
}
}
}
qlua_free(L, exp_iphase);
/* global sum */
if (QMP_sum_double_array(bb_arr, bb_arr_size / sizeof(double))) {
qlua_free(L, bb_arr);
return "QMP_sum_double_array error";
}
/* save to AFF */
if (aff_w->master) {
struct AffNode_s *aff_top = NULL;
aff_top = aff_writer_mkpath(aff_w->ptr, aff_w->dir, aff_kpath);
if (NULL == aff_top) {
qlua_free(L, bb_arr);
return aff_writer_errstr(aff_w->ptr);
}
double complex *cplx_buf = qlua_malloc(L, (src_snk_dt + 1) * sizeof(double complex));
char buf[200];
int gn, i_mom, t;
for (gn = 0; gn < 16; gn++)
for (i_mom = 0; i_mom < n_mom; i_mom++) {
/* copy & mult by bc, if necessary */
const double *bb_re_cur = bb_real(gn, i_mom),
*bb_im_cur = bb_imag(gn, i_mom);
if (!time_rev) { /* no bc */
for (t = 0 ; t <= src_snk_dt; t++)
cplx_buf[t] = bb_re_cur[t] + I*bb_im_cur[t];
} else {
if (gn < 8) {
for (t = 0 ; t <= src_snk_dt; t++)
cplx_buf[t] = bc_baryon_t * (bb_re_cur[t] + I*bb_im_cur[t]);
} else {
for (t = 0 ; t <= src_snk_dt; t++)
cplx_buf[t] = -bc_baryon_t * (bb_re_cur[t] + I*bb_im_cur[t]);
}
}
/* write to AFF */
snprintf(buf, sizeof(buf), "g%d/qx%d_qy%d_qz%d",
gn, get_mom(mom, i_mom)[0],
get_mom(mom, i_mom)[1], get_mom(mom, i_mom)[2]);
struct AffNode_s *node = aff_writer_mkpath(aff_w->ptr, aff_top, buf);
if (NULL == node) {
qlua_free(L, bb_arr);
qlua_free(L, cplx_buf);
return aff_writer_errstr(aff_w->ptr);
}
if (aff_node_put_complex(aff_w->ptr, node, cplx_buf, src_snk_dt + 1)) {
qlua_free(L, bb_arr);
qlua_free(L, cplx_buf);
return aff_writer_errstr(aff_w->ptr);
}
}
qlua_free(L, cplx_buf);
}
#undef bb_real
#undef bb_imag
#undef get_mom
qlua_free(L, bb_arr);
QDP_D3_reset_P(F);
QDP_D3_reset_P(B);
return 0;
}
void
printc(QLA_Complex *c) {
printf("%f+i%f\n",QLA_real(*c), QLA_imag(*c));
}
/*
void
traceless_herm_M_evalues(QLA_ColorMatrix *Q, double *u, double *w,
double *q1, double *q2, double *q3) {
QLA_Complex c0, c1;
QLA_ColorMatrix Q2;
QLA_M_eq_M_times_M(&Q2, Q, Q);
printf("Q^2 = \n"); printm(&Q2);
QLA_C_eq_det_M (&c0, Q); // c0 = det(Q)
QLA_C_eq_trace_M (&c1, &Q2); // c1 = tr(Q^2)
double athird = 1.0/3.0;
double cc0, cc1, cc0max;
cc0 = QLA_real(c0);
cc1 = 0.5 * QLA_real(c1);
cc0max = 2*sqrt(cc1 * athird)*(cc1 * athird); //c_0^max = 2 * (c1/3)^{3/2}
printf("c0 = %f\n", cc0);
printf("c1 = %f\n", cc1);
printf("c0_max = %f\n", cc0max);
double theta;
theta =acos(cc0/cc0max);
*u = sqrt(athird * cc1) * cos(athird * theta);
*w = sqrt(cc1) * sin(athird * theta);
*q1 = 2 * *u;
*q2 = -*u + *w;
*q3 = -*u - *w;
printf("u = %f, w = %f, q1 = %f, q2 = %f, q3 = %f\n", *u, *w, *q1, *q2, *q3);
}
void
get_f_coeffs(QLA_ColorMatrix *Q, double _Complex *f0, double _Complex *f1, double _Complex *f2){
double u, w, q1, q2, q3;
traceless_herm_M_evalues(Q, &u, &w, &q1, &q2, &q3);
printf("q1=\n"); printc99(&q1);
double _Complex e2iu, e_iu;
e2iu = cexp(2 * _Complex_I * u);
e_iu = cexp(-1.0 * _Complex_I * u);
double u2 = u*u;
double w2 = w*w;
double _Complex zeta0w;
if (fabs(w) > 0.05) {
zeta0w = sin(w)/w;
}
else {
zeta0w = 1 - w2/6. * (1-w2/20. * (1 - w2/42.));
}
double _Complex h0, h1, h2;
h0 = (u2 - w2) * e2iu + e_iu * ( 8 * u2 *cos(w) + 2*_Complex_I*u * (3*u2+w2)*zeta0w);
h1 = 2*u*e2iu - e_iu * (2 * u * cos(w) - _Complex_I * (3*u2-w2)*zeta0w);
h2 = e2iu - e_iu * ( cos(w) + 3*_Complex_I*u * zeta0w);
double fac = 1.0/(9*u2-w2);
*f0 = h0 * fac;
*f1 = h1 * fac;
*f2 = h2 * fac;
}
void
get_Bs(QLA_ColorMatrix *Q, QLA_ColorMatrix *Q2, QLA_ColorMatrix *B1, QLA_ColorMatrix *B2, double _Complex *f0, double _Complex *f1, double _Complex *f2) {
double u, w, q1, q2, q3;
traceless_herm_M_evalues(Q, &u, &w, &q1, &q2, &q3);
printf("q1=\n"); printc99(&q1);
double _Complex e2iu, e_iu;
e2iu = cexp(2 * _Complex_I * u);
e_iu = cexp(-1.0 * _Complex_I * u);
double u2 = u*u;
double w2 = w*w;
double _Complex zeta0w, zeta1w;
if (fabs(w) > 0.05) {
zeta0w = sin(w)/w;
zeta1w = (cos(w)-zeta0w)/w2;
}
else {
zeta0w = 1 - w2/6. * (1-w2/20. * (1 - w2/42.));
zeta1w = -(1 - w2/10. * (1 - w2/28.*(1 - w2/54.)))/3.0;
}
double _Complex h0, h1, h2;
h0 = (u2 - w2) * e2iu + e_iu * ( 8 * u2 *cos(w) + 2*_Complex_I*u * (3*u2+w2)*zeta0w);
h1 = 2*u*e2iu - e_iu * (2 * u * cos(w) - _Complex_I * (3*u2-w2)*zeta0w);
h2 = e2iu - e_iu * ( cos(w) + 3*_Complex_I*u * zeta0w);
double fac = 1.0/(9*u2-w2);
*f0 = h0 * fac;
*f1 = h1 * fac;
*f2 = h2 * fac;
double _Complex r01, r11, r21, r02, r12, r22, iu;
double cosw = cos(w);
iu = _Complex_I * u;
r01 = 2*(u + _Complex_I * (u2 - w2)) * e2iu
+ 2 * e_iu * ( 4*u*(2 - iu) * cosw + _Complex_I * (9 * u2 + w2 - iu * (3*u2 + w2))*zeta0w);
r11 = 2*(1 + 2*iu) * e2iu
+ e_iu * ( -2 * (1-iu) * cosw + _Complex_I * (6*u + _Complex_I * (w2 - 3*u2)) * zeta0w);
r21 = 2 * _Complex_I * e2iu + _Complex_I * e_iu * (cosw - 3*(1-iu)*zeta0w);
r02 = -2 * e2iu + 2 * iu * e_iu * (cosw + (1+4*iu) * zeta0w + 3 * u2 * zeta1w);
r12 = -_Complex_I * e_iu * ( cosw + (1+2*iu) * zeta0w - 3*u2 * zeta1w);
r22 = e_iu * (zeta0w - 3 * iu * zeta1w);
double _Complex b10, b11, b12, b20, b21, b22;
double fac1, fac2, fac3;
double mult = 0.5 * fac * fac;
fac1 = 2 * u;
fac2 = 3*u2 - w2;
fac3 = 2*(15*u2+w2);
b10 = fac1 * r01 + fac2 * r02 - fac3 * (*f0);
b10 *= mult;
b11 = fac1 * r11 + fac2 * r12 - fac3 * (*f1);
b11 *= mult;
b12 = fac1 * r21 + fac2 * r22 - fac3 * (*f2);
b12 *= mult;
fac2 = 3*u;
fac3 = 24*u;
b20 = r01 - fac2 * r02 - fac3 * (*f0);
b20 *= mult;
b21 = r11 - fac2 * r12 - fac3 * (*f1);
b21 *= mult;
b22 = r21 - fac2 * r22 - fac3 * (*f2);
b22 *= mult;
QLA_Complex qb10, qb11, qb12, qb20, qb21, qb22;
QLA_c_eq_c99(qb10, b10);
QLA_c_eq_c99(qb11, b11);
QLA_c_eq_c99(qb12, b12);
QLA_c_eq_c99(qb20, b20);
QLA_c_eq_c99(qb21, b21);
QLA_c_eq_c99(qb22, b22);
QLA_M_eq_c(B1, &qb10);
QLA_M_peq_c_times_M(B1, &qb11, Q);
QLA_M_peq_c_times_M(B1, &qb12, Q2);
QLA_M_eq_c(B2, &qb20);
QLA_M_peq_c_times_M(B2, &qb21, Q);
QLA_M_peq_c_times_M(B2, &qb22, Q2);
}
*/
int
main(void) {
QLA_ColorMatrix O, iQ, matI;
QLA_M_eq_zero(&matI);
for(int i=0; i<QLA_Nc; i++) {
QLA_c_eq_r_plus_ir(QLA_elem_M(matI,i,i), 1.0, 0.0);
}
printm(&matI);
//QLA_Complex tr;
//QLA_Real half = 0.5;
for(int i=0; i<QLA_Nc; i++) {
for(int j=0; j<QLA_Nc; j++) {
QLA_c_eq_r_plus_ir(QLA_elem_M(O,i,j), i+1, QLA_Nc*(j+1));
}
QLA_c_eq_r_plus_ir(QLA_elem_M(O,i,i), 2+1, 1);
}
printm(&O);
#if QDP_Colors == 3
QLA_ColorMatrix A;
QLA_M_eq_zero(&A);
for ( int m = 0; m < QLA_Nc; m++) {
for ( int n = 0; n < QLA_Nc; n++) {
QLA_c_eq_r_plus_ir(QLA_elem_M(A, m, n), 3+m, 2-n);
}
QLA_c_eq_r_plus_ir(QLA_elem_M(A,m,m), 2+1, 1);
}
QLA_M_eq_antiherm_M(&A, &A);
printm(&A);
QLA_M_eq_zero(&A);
QLA_c_eq_r_plus_ir(QLA_elem_M(A,0,0),0,-1);
QLA_c_eq_r_plus_ir(QLA_elem_M(A,1,1),0,0.4);
QLA_c_eq_r_plus_ir(QLA_elem_M(A,2,2),0,0.6);
printm(&A);
QLA_Complex minus_i;
QLA_c_eq_r_plus_ir(minus_i, 0, -1);
QLA_ColorMatrix Q, Q2, expiQ, qla_expA;
QLA_M_eq_C_times_M(&Q, &minus_i, &matI);
QLA_M_eq_M_times_M(&Q2, &Q, &Q);
printf("Q=\n"); printm(&Q);
double _Complex f0, f1, f2;
QLA_ColorMatrix B1, B2;
get_Bs(&Q, &Q2, &B1, &B2, &f0, &f1, &f2);
printf("f0, f1, f2=\n");
printc99(&f0);
printc99(&f1);
printc99(&f2);
QLA_Complex qf0, qf1, qf2;
QLA_c_eq_c99(qf0, f0);
QLA_c_eq_c99(qf1, f1);
QLA_c_eq_c99(qf2, f2);
QLA_M_eq_c(&expiQ, &qf0);
QLA_M_peq_c_times_M(&expiQ, &qf1, &Q);
QLA_M_peq_c_times_M(&expiQ, &qf2, &Q2);
QLA_M_eq_exp_M(&qla_expA, &matI);
printf("my expiQ = \n");
printm(&expiQ);
printf("qla expA = \n");
printm(&qla_expA);
// derivative
QLA_Complex trB1M, trB2M;
QLA_ColorMatrix prod, deriv;
//tr(B_1 M)
QLA_M_eq_M_times_M (&prod, &B1, &matI); //B_1 M
QLA_C_eq_trace_M (&trB1M, &prod);
//tr(B_2 M);
QLA_M_eq_M_times_M (&prod, &B2, &matI); //B_2 M
QLA_C_eq_trace_M (&trB2M, &prod);
// deriv = Tr(B_1 M) Q
QLA_M_eq_c_times_M (&deriv, &trB1M, &Q);
// deriv += Tr(B_2 M) Q^2
QLA_M_peq_c_times_M (&deriv, &trB2M, &Q2);
// deriv += f1 M
QLA_M_peq_c_times_M (&deriv, &qf1, &matI);
// deriv += f2 Q M
QLA_M_eq_M_times_M (&prod, &Q, &matI); // Q M
QLA_M_peq_c_times_M (&deriv, &qf2, &prod);
// deriv += f2 M Q
QLA_M_eq_M_times_M (&prod, &matI, &Q); // M Q
QLA_M_peq_c_times_M (&deriv, &qf2, &prod);
QLA_M_eq_c_times_M (&deriv, &minus_i, &deriv);
printf("M = \n");
printm(&matI);
printf("deriv = \n");
printm(&deriv);
QLA_M_meq_M(&deriv, &expiQ);
printf("diff = \n");
printm(&deriv);
/*
printf("2/3f0 = \n");
f0 *= 2.0/3;
printc99(&f0);
printc(&qf0);
printc(&qf1);
printc(&qf2);
*/
#endif
#if QDP_Colors == 2
QLA_ColorMatrix expO;
QLA_Complex Tr, det;
QLA_c_eq_c_times_c(det, QLA_elem_M(O,0,0),QLA_elem_M(O,1,1));
QLA_c_meq_c_times_c(det, QLA_elem_M(O,0,1), QLA_elem_M(O,1,0));
QLA_C_eq_trace_M(&Tr, &O);
QLA_Complex qs, qt;
QLA_c_eq_r_times_c(qs, 0.5, Tr); // s=TrA/2
QLA_Complex qs2;
QLA_c_eq_c_times_c(qs2, qs, qs); //s2 = s^2
QLA_c_meq_c(qs2, det); //s2 = s^2 - detA
double _Complex t = QLA_real(qs2) + QLA_imag(qs2) * _Complex_I;
t = csqrt(t); // sqrt(s^2 - det A)
QLA_c_eq_r_plus_ir(qt, creal(t), cimag(t)); // t = sqrt(s^2 - det A)
printf(" Matrix O = \n"); printm(&O);
printf("TrO = "); printc(&Tr);
printf("detO = "); printc(&det);
printf("s = "); printc(&qs);
printf("t^2 = "); printc(&qs2);
printf("t = "); printc(&qt);
//use the QLA exp function
QLA_ColorMatrix qla_exp;
QLA_M_eq_exp_M(&qla_exp, &O); //exp(O)
double _Complex exps, cosht, sinht, sinht_t;
double _Complex s = QLA_real(qs) + QLA_imag(qs) * _Complex_I;
exps = cexp(s);
if(creal(t) == 0 && cimag(t) == 0) {
cosht = 1;
sinht = 0;
sinht_t = 1;
} else {
cosht = ccosh(t);
sinht = csinh(t);
sinht_t = sinht/t;
}
double _Complex f0, f1;
f1 = exps * sinht_t;
f0 = exps * cosht - s * f1;;
//derivative of the exponential
double _Complex f0s, f1s, f1t, f0t2, f1t2, t2;
t2 = t*t;
f0s = f0 - f1;
f1s = f1;
if (cabs(t) > 0.05) {
f1t = ((f0-f1) + s*f1)/t;
f1t2 = f1t/t;
}
else { //when |t| < 0.05, the error is O(10^{-14})
f1t = exps * t/3 * (1+t2/10*(1+t2/28));
f1t2 = exps / 3 * (1+t2/10*(1+t2/28));
}
// f0t = t * f1 - s * f1t;
f0t2 = f1 - s * f1t2;
printf("f0 = \n"); printc99(&f0);
printf("f1 = \n"); printc99(&f1);
printf("f0s = \n"); printc99(&f0s);
printf("f1s = \n"); printc99(&f1s);
printf("f1t = \n"); printc99(&f1t);
printf("f0t2 = \n"); printc99(&f0t2);
printf("f1t2 = \n"); printc99(&f1t2);
QLA_Complex qf0, qf1;
QLA_c_eq_r_plus_ir(qf0, creal(f0), cimag(f0));
QLA_c_eq_r_plus_ir(qf1, creal(f1), cimag(f1));
QLA_M_eq_c_times_M(&expO, &qf1, &O);
QLA_M_peq_c(&expO, &qf0);
printf("QLA exp = \n"); printm(&qla_exp);
printf("my expO = \n"); printm(&expO);
/*
QLA_Complex qf0s, qf0t, qf1s, qf1t;
QLA_c_eq_r_plus_ir(qf0s, creal(f0s), cimag(f0s));
QLA_c_eq_r_plus_ir(qf0t, creal(f0t), cimag(f0t));
QLA_c_eq_r_plus_ir(qf1s, creal(f1s), cimag(f1s));
QLA_c_eq_r_plus_ir(qf1t, creal(f1t), cimag(f1t));
*/
QLA_ColorMatrix deriv;
QLA_M_eq_zero(&deriv);
QLA_ColorMatrix B, AB;
QLA_M_eq_M(&B, &matI);
//QLA_c_eq_r_plus_ir(QLA_elem_M(B,1,0), 0.1, 0.2);
//QLA_c_eq_r_plus_ir(QLA_elem_M(B,0,1), 0.2, 0.1);
printf("B=\n"); printm(&B);
QLA_M_eq_M_times_M(&AB, &O, &B);
printf("AB=\n"); printm(&AB);
QLA_M_eq_c_times_M(&deriv, &qf1, &B); //f1 * B
printf("f1 B = \n"); printm(&deriv);
QLA_Complex trB, trAB;
QLA_C_eq_trace_M(&trB, &B);
QLA_C_eq_trace_M(&trAB, &AB);
double _Complex ctrB = QLA_real(trB) + _Complex_I * QLA_imag(trB);
double _Complex ctrAB = QLA_real(trAB) + _Complex_I * QLA_imag(trAB);
double _Complex coeff;
coeff = (f0s - f0t2 * s) * ctrB;
coeff += (f1s - f1t2 * s) * ctrAB;
coeff *= 0.5;
printf("coeff = "); printc99(&coeff);
QLA_Complex qc;
QLA_D_c_eq_c99(qc, coeff);
printc(&qc);
QLA_M_peq_c_times_M(&deriv, &qc, &matI); // f1 * B + () I
printf("f1B+()I=\n"); printm(&deriv);
coeff = 0.5 * (f0t2 * ctrB + f1t2 * ctrAB);
QLA_D_c_eq_c99(qc, coeff);
printc(&qc);
QLA_M_peq_c_times_M(&deriv, &qc, &O);
printm(&deriv);
exp_deriv_site(&deriv, &expO, &O, &B);
printm(&deriv);
#endif
return 0;
}
int
Rayleigh_min_qdp(QDP_ColorVector *vec, QDP_ColorVector **eigVec,
Real Tolerance, Real RelTol, int Nvecs, int MaxIter,
int Restart, QDP_Subset subset)
{
QLA_Complex cc;
QLA_Real beta, cos_theta, sin_theta;
QLA_Real quot, P_norm, theta, real_vecMp, pMp;
QLA_Real g_norm, old_g_norm, start_g_norm;
QDP_ColorVector *Mvec, *grad, *P, *MP;
int iter;
#ifdef DEBUG
if(QDP_this_node==0) printf("begin Rayleigh_min_qdp\n");
#endif
Mvec = QDP_create_V();
grad = QDP_create_V();
//oldgrad = QDP_create_V();
P = QDP_create_V();
MP = QDP_create_V();
project_out_qdp(vec, eigVec, Nvecs, subset);
normalize_qdp(vec, subset);
Matrix_Vec_mult_qdp(vec, Mvec, subset);
project_out_qdp(Mvec, eigVec, Nvecs, subset);
/* Compute the quotient quot=vev*M*vec */
QDP_r_eq_re_V_dot_V(", vec, Mvec, subset);
/* quot is real since M is hermitian. quot = vec*M*vec */
#ifdef DEBUG
if(QDP_this_node==0) printf("Rayleigh_min: Start -- quot=%g\n", quot);
#endif
/* Compute the grad=M*vec - quot*vec */
QDP_V_eq_V(grad, Mvec, QDP_all);
QDP_V_meq_r_times_V(grad, ", vec, subset);
/* set P (the search direction) equal to grad */
QDP_V_eq_V(P, grad, QDP_all);
/* compute the norms of P and grad */
QDP_r_eq_norm2_V(&P_norm, P, subset);
P_norm = sqrt(P_norm);
QDP_r_eq_norm2_V(&g_norm, grad, subset);
g_norm = sqrt(g_norm);
start_g_norm = g_norm;
//QDP_V_eq_V(oldgrad, grad, subset);
#ifdef DEBUG
if(QDP_this_node==0) printf("Rayleigh_min: Start -- g_norm=%g\n", g_norm);
#endif
iter = 0;
while( (g_norm>Tolerance*quot) &&
( ((iter<MaxIter)&&(g_norm/start_g_norm>RelTol)) || (iter<MINITER) )
) {
iter++;
Matrix_Vec_mult_qdp(P, MP, subset);
QDP_r_eq_re_V_dot_V(&real_vecMp, vec, MP, subset);
QDP_r_eq_re_V_dot_V(&pMp, P, MP, subset);
theta = 0.5*atan(2.0*real_vecMp/(quot*P_norm - pMp/P_norm));
sin_theta = sin(theta);
cos_theta = cos(theta);
if(sin_theta*cos_theta*real_vecMp>0) {
theta = theta - 0.5*M_PI; /* chose the minimum not the maximum */
sin_theta = sin(theta); /* the sin,cos calls can be avoided */
cos_theta = cos(theta);
}
sin_theta = sin_theta/P_norm;
/* vec = cos(theta)*vec +sin(theta)*P/p_norm */
//dax_p_by_qdp(cos_theta, vec, sin_theta, P, subset);
QDP_V_eq_r_times_V(vec, &cos_theta, vec, subset);
QDP_V_peq_r_times_V(vec, &sin_theta, P, subset);
/* Mvec = cos(theta)*Mvec +sin(theta)*MP/p_norm */
//dax_p_by_qdp(cos_theta, Mvec, sin_theta, MP, subset);
QDP_V_eq_r_times_V(Mvec, &cos_theta, Mvec, subset);
QDP_V_peq_r_times_V(Mvec, &sin_theta, MP, subset);
/* renormalize vec ... */
if( iter%Restart == 0 ) {
#ifdef DEBUG
{
QLA_Real vec_norm;
if(QDP_this_node==0) printf("Renormalizing...");
QDP_r_eq_norm2_V(&vec_norm, vec, subset);
if(QDP_this_node==0) printf(" norm: %g\n", sqrt(vec_norm));
}
#endif
/* Project vec on the orthogonal complement of eigVec */
project_out_qdp(vec, eigVec, Nvecs, subset);
normalize_qdp(vec, subset);
Matrix_Vec_mult_qdp(vec, Mvec, subset);
/* Recompute the quotient */
QDP_r_eq_re_V_dot_V(", vec, Mvec, subset);
/* Recompute the grad */
QDP_V_eq_V(grad, Mvec, QDP_all);
QDP_V_meq_r_times_V(grad, ", vec, subset);
//QDP_r_eq_norm2_V(&g_norm, grad, subset);
//printf("g_norm = %g\n", g_norm);
/* Project P on the orthogonal complement of eigVec */
//QDP_r_eq_norm2_V(&P_norm, P, subset);
//printf("P_norm = %g\n", P_norm);
project_out_qdp(P, eigVec, Nvecs, subset);
//QDP_r_eq_norm2_V(&P_norm, P, subset);
//printf("P_norm = %g\n", P_norm);
/* make P orthogonal to vec */
QDP_c_eq_V_dot_V(&cc, vec, P, subset);
//printf("cc = %g\n", QLA_real(cc));
QDP_V_meq_c_times_V(P, &cc, vec, subset);
//QDP_r_eq_norm2_V(&P_norm, P, subset);
//printf("P_norm = %g\n", P_norm);
/* make P orthogonal to grad */
QDP_c_eq_V_dot_V(&cc, grad, P, subset);
//printf("cc = %g\n", QLA_real(cc));
QDP_V_meq_c_times_V(P, &cc, grad, subset);
QDP_r_eq_norm2_V(&P_norm, P, subset);
P_norm = sqrt(P_norm);
}
QDP_r_eq_re_V_dot_V(", vec, Mvec, subset);
#ifdef DEBUG
node0_printf("Rayleigh_min: %i, quot=%8g g=%8g b=%6g P:%6g\n",
iter, quot, g_norm, beta, P_norm);
#endif
old_g_norm = g_norm;
QDP_V_eq_V(grad, Mvec, QDP_all);
QDP_V_meq_r_times_V(grad, ", vec, subset);
//QDP_V_meq_V(oldgrad, grad, subset);
//QDP_r_eq_re_V_dot_V(&g_norm, oldgrad, grad, subset);
//QDP_V_eq_V(oldgrad, grad, subset);
QDP_r_eq_norm2_V(&g_norm, grad, subset);
g_norm = sqrt(g_norm);
beta = cos_theta*g_norm*g_norm/(old_g_norm*old_g_norm);
if( beta>2.0 ) beta = 2.0; /* Cut off beta */
QDP_c_eq_V_dot_V(&cc, vec, P, subset);
QLA_real(cc) *= beta;
QLA_imag(cc) *= beta;
QDP_V_eq_r_times_V_plus_V(P, &beta, P, grad, subset);
QDP_V_meq_c_times_V(P, &cc, vec, subset);
QDP_r_eq_norm2_V(&P_norm, P, subset);
P_norm = sqrt(P_norm);
}
project_out_qdp(vec, eigVec, Nvecs, subset);
normalize_qdp(vec, subset);
QDP_destroy_V(MP);
QDP_destroy_V(P);
//QDP_destroy_V(oldgrad);
QDP_destroy_V(grad);
QDP_destroy_V(Mvec);
iter++;
#ifdef DEBUG
if(QDP_this_node==0) printf("end Rayleigh_min_qdp\n");
#endif
return iter;
}
