static int
qopqdp_force_random(lua_State *L)
{
#define NC QDP_get_nc(g->links[0])
BEGIN_ARGS;
GET_GAUGE(g);
END_ARGS;
QDP_RandomState *rs = g->lat->rs;
qassert(rs!=NULL);
if(QLA_Nc==3) { // use MILC conventions
QLA_RandomState *s = QDP_expose_S(rs);
for(int i=0; i<g->nd; i++) {
QDP_M_eq_funcia(g->links[i], randforce, s, QDP_all_L(g->qlat));
}
QDP_reset_S(rs);
} else {
QDP_ColorMatrix *m = QDP_create_M_L(g->qlat);
for(int i=0; i<g->nd; i++) {
QDP_M_eq_gaussian_S(m, rs, QDP_all_L(g->qlat));
QDP_M_eq_antiherm_M(g->links[i], m, QDP_all_L(g->qlat));
}
QDP_destroy_M(m);
}
return 0;
#undef NC
}
static int
qopqdp_gauge_zero(lua_State *L)
{
qassert(lua_gettop(L)==1);
gauge_t *g = qopqdp_gauge_check(L, -1);
for(int i=0; i<g->nd; i++) {
QDP_M_eq_zero(g->links[i], QDP_all_L(g->qlat));
}
return 0;
}
static int
qopqdp_gauge_unit(lua_State *L)
{
qassert(lua_gettop(L)==1);
gauge_t *g = qopqdp_gauge_check(L, -1);
QLA_Complex z;
QLA_c_eq_r(z, 1);
for(int i=0; i<g->nd; i++) {
QDP_M_eq_c(g->links[i], &z, QDP_all_L(g->qlat));
}
return 0;
}
void
packM(Layout *l, real *y, QDP_ColorMatrix *m)
{
QDP_Lattice *lat = QDP_get_lattice_M(m);
QDP_ColorMatrix *xx = QDP_create_M_L(lat);
//QDP_M_eq_M(xx, m, QDP_all_L(lat));
QDP_M_eq_transpose_M(xx, m, QDP_all_L(lat));
real *x = QDP_expose_M(xx);
int nelem = 2*QDP_Nc*QDP_Nc;
fromQDP_F(y, l, x, lat, nelem, 1);
QDP_reset_M(xx);
QDP_destroy_M(xx);
}
void
unpackM(Layout *l, QDP_ColorMatrix *m, real *y)
{
QDP_Lattice *lat = QDP_get_lattice_M(m);
QDP_ColorMatrix *xx = QDP_create_M_L(lat);
real *x = QDP_expose_M(xx);
int nelem = 2*QDP_Nc*QDP_Nc;
toQDP_F(x, lat, y, l, nelem, 1);
QDP_reset_M(xx);
//QDP_M_eq_M(m, xx, QDP_all_L(lat));
QDP_M_eq_transpose_M(m, xx, QDP_all_L(lat));
QDP_destroy_M(xx);
}
static int
qopqdp_gauge_random(lua_State *L)
{
BEGIN_ARGS;
GET_GAUGE(g);
END_ARGS;
QLA_RandomState *qrs = QDP_expose_S(g->lat->rs);
for(int i=0; i<g->nd; i++) {
QDP_M_eq_funcia(g->links[i], gauge_random, qrs, QDP_all_L(g->qlat));
}
QDP_reset_S(g->lat->rs);
return 0;
}
static int
qopqdp_gauge_call(lua_State *L)
{
BEGIN_ARGS;
GET_GAUGE(g);
GET_INT(dim);
OPT_QOPQDP_CMATRIX(m, NULL);
END_ARGS;
if(m==NULL) { // return colormatrix for direction
qopqdp_cmatrix_wrap(L, g->lat, g->links[dim-1], 0);
return 1;
}
// set direction
QDP_M_eq_M(g->links[dim-1], m->field, QDP_all_L(g->qlat));
return 0;
}
// 1: gauge
// 2: number or table of numbers
// 3: subset (optional)
static int
qopqdp_gauge_scale(lua_State *L)
{
BEGIN_ARGS;
GET_GAUGE(g);
GET_AS_DOUBLE_ARRAY(n,sa);
OPT_SUBSET(sub, g->lat, QDP_all_L(g->qlat));
END_ARGS;
int nd = g->nd;
QLA_Real s = 1;
for(int i=0; i<nd; i++) {
if(i<abs(n)) s = sa[i];
if(s!=1) QDP_M_eq_r_times_M(g->links[i],&s,g->links[i],sub);
}
return 0;
}
static int
qopqdp_lattice_seed(lua_State *L)
{
BEGIN_ARGS;
GET_LATTICE(l);
GET_INT(seed);
OPT_INT(uniform, -1);
OPT_SUBSET(sub, l, QDP_all_L(l->qlat));
END_ARGS;
if(l->rs==NULL) {
qopqdp_rstate_t *r = qopqdp_rstate_create(L, l);
l->rs = r->field;
QHMC_USERTABLE_SETFIELD(L, 1, "rs");
}
qhmc_qopqdp_seed_func(l->rs, seed, uniform, sub);
return 0;
}
static void
get_staple_plaq(QDP_ColorMatrix *staple, int mu, QDP_ColorMatrix *u[],
QOP_gauge_coeffs_t *coeffs,
QDP_Subset subset, QDP_Subset osubset)
{
#define NC QDP_get_nc(staple)
QDP_Lattice *lat = QDP_get_lattice_M(staple);
int nd = QDP_ndim_L(lat);
QDP_Shift *neighbor = QDP_neighbor_L(lat);
QLA_Real plaq = coeffs->plaquette;
QLA_Real adpl = coeffs->adjoint_plaquette;
#if 1
QDP_ColorMatrix *temp1, *temp2, *temp3, *temp4, *temp5, *temp6;
//temp1 = QDP_create_M();
temp2 = QDP_create_M_L(lat);
//temp3 = QDP_create_M();
temp4 = QDP_create_M_L(lat);
//temp5 = QDP_create_M();
temp6 = QDP_create_M_L(lat);
QDP_Complex *tc = NULL;
if(adpl!=0) tc = QDP_create_C_L(lat);
/* staple += u[nu](x) u[mu](x+nu) u*[nu](x+mu)
* + u*[nu](x-nu) u[mu](x-nu) u[nu](x-nu+mu) */
for(int nu=0; nu<nd; nu++) {
if (nu == mu) continue;
temp1 = QDP_create_M_L(lat);
temp3 = QDP_create_M_L(lat);
temp5 = QDP_create_M_L(lat);
QDP_M_eq_sM(temp1, u[nu], neighbor[mu], QDP_forward, QDP_all_L(lat));
QDP_M_eq_Ma_times_M(temp2, u[nu], u[mu], osubset);
QDP_M_eq_sM(temp3, u[mu], neighbor[nu], QDP_forward, subset);
QDP_M_eq_M_times_M(temp4, temp2, temp1, osubset);
QDP_M_eq_sM(temp5, temp4, neighbor[nu], QDP_backward, subset);
QDP_M_eq_M_times_M(temp6, u[nu], temp3, subset);
//QDP_M_peq_M_times_Ma(staple, temp6, temp1, subset);
//QDP_M_peq_M(staple, temp5, subset);
if(adpl==0) {
QDP_M_peq_M_times_Ma(temp5, temp6, temp1, subset);
QDP_M_peq_r_times_M(staple, &plaq, temp5, subset);
} else {
QLA_Complex z;
QLA_c_eq_r(z, plaq/adpl);
QDP_C_eq_c(tc, &z, subset);
QDP_M_eq_M_times_Ma(temp2, temp6, temp1, subset);
QDP_C_peq_M_dot_M(tc, temp2, u[mu], subset);
QDP_C_eq_r_times_C(tc, &adpl, tc, subset);
QDP_M_peq_C_times_M(staple, tc, temp2, subset);
QDP_C_eq_c(tc, &z, subset);
QDP_C_peq_M_dot_M(tc, temp5, u[mu], subset);
QDP_C_eq_r_times_C(tc, &adpl, tc, subset);
QDP_M_peq_C_times_M(staple, tc, temp5, subset);
}
//QDP_discard_M(temp1);
//QDP_discard_M(temp3);
//QDP_discard_M(temp5);
QDP_destroy_M(temp1);
QDP_destroy_M(temp3);
QDP_destroy_M(temp5);
} /* closes nu loop */
if(adpl!=0) QDP_destroy_C(tc);
//QDP_destroy_M(temp1);
QDP_destroy_M(temp2);
//QDP_destroy_M(temp3);
QDP_destroy_M(temp4);
//QDP_destroy_M(temp5);
QDP_destroy_M(temp6);
#else
QDP_ColorMatrix *t = QDP_create_M_L(lat);
int nu, path[3];
QDP_Subset subs[2];
subs[0] = subset;
subs[1] = osubset;
for(nu=0; nu<nd; nu++) {
if (nu == mu) continue;
path[0] = 1+nu;
path[1] = -(1+mu);
path[2] = -(1+nu);
path_prod(u, t, path, 3, 1, subs, neighsubeo);
QDP_M_peq_M(staple, t, subset);
path[0] = -(1+nu);
path[1] = -(1+mu);
path[2] = 1+nu;
path_prod(u, t, path, 3, 1, subs, neighsubeo);
QDP_M_peq_M(staple, t, subset);
}
QDP_destroy_M(t);
#endif
}