lattice_t *
qopqdp_lattice_wrap(lua_State *L, QDP_Lattice *qlat,
char *defPrec, int defNc, int doGC)
{
//lattice_t *lat = lua_newuserdata(L, sizeof(lattice_t));
//QHMC_USERTABLE_CREATE(L, -1);
QHMC_NEWUSERDATA(lattice_t, lat);
int nd = QDP_ndim_L(qlat);
lat->qlat = qlat;
lat->timeslices = NULL;
lat->staggered = NULL;
lat->eodir = malloc((nd+1)*sizeof(QDP_Subset *));
for(int i=0; i<=nd; i++) lat->eodir[i] = NULL;
lat->rs = NULL;
lat->nd = nd;
lat->ref = -1;
lat->defaultPrecision = defPrec;
lat->defaultNc = defNc;
lat->doGC = doGC;
if(luaL_newmetatable(L, mtname)) {
lua_pushvalue(L, -1);
lua_setfield(L, -2, "__index");
luaL_register(L, NULL, lattice_reg);
}
lua_setmetatable(L, -2);
return lat;
}
// creates shifts and maps for copying hypercubic region of size rlen
// from slat to rlat.
// the point soff in slat will get copied to roff in rlat.
// subsequent points in rlat will correspond to the permuted directions
// in slat given by sdir
// j = sdir[i]
// r[i] = ( roff[i] + (s[j]-soff[j]+ss[j])%ss[j] )%rs[i]
// s[j] = ( soff[j] + (r[i]-roff[i]+rs[i])%rs[i] )%ss[j]
void
qhmc_qopqdp_getCopyHyper(QDP_Shift *map, QDP_Subset **subset,
QDP_Lattice *rlat, int roff[], int rlen[], int sdir[],
QDP_Lattice *slat, int soff[], int num)
{
int rnd = QDP_ndim_L(rlat);
int snd = QDP_ndim_L(slat);
//int sublen[rnd], rof[rnd], rs[rnd], sd[rnd], sof[snd], ss[snd];
int sublen[4*rnd+2*snd], *rof, *rs, *sd, *sof, *ss, nsub[rnd], nsubs=1;
rof = sublen + rnd;
rs = rof + rnd;
sd = rs + rnd;
sof = sd + rnd;
ss = sof + snd;
QDP_latsize_L(rlat, rs);
QDP_latsize_L(slat, ss);
// get subvolume size
for(int i=0; i<rnd; i++) {
sd[i] = sdir[i];
int j = sdir[i];
sublen[i] = rlen[i];
if(sublen[i]>rs[i]) sublen[i] = rs[i];
if(j<0||j>=snd) sublen[i] = 1;
else if(sublen[i]>ss[j]) sublen[i] = ss[j];
nsub[i] = (rlen[i]+sublen[i]-1)/sublen[i];
nsubs *= nsub[i];
}
if(num<0||num>=nsubs) {
*map = NULL;
*subset = NULL;
return;
}
// calculate which subvolume we will work on and adjust size if necessary
int n = num;
for(int j=0; j<snd; j++) sof[j] = soff[j];
for(int i=0; i<rnd; i++) {
int j = sdir[i];
int k = n%nsub[i];
n = n/nsub[i];
int off = k*sublen[i];
rof[i] = (roff[i]+off)%rs[i];
if(j>=0&&j<snd) sof[j] = (sof[j]+off)%ss[j];
if(sublen[i]>(rlen[i]-off)) sublen[i] = rlen[i]-off;
}
*subset=QDP_create_subset_L(rlat,subCopyHyper,sublen,3*rnd*sizeof(int),2);
*map=QDP_create_map_L(rlat,slat,mapCopyHyper,rof,(3*rnd+2*snd)*sizeof(int));
}
QDP_Subset *
qhmcqdp_get_staggered(lattice_t *lat)
{
if(lat->staggered==NULL) {
int nd = QDP_ndim_L(lat->qlat);
int n = 1 << nd;
//printf("creating staggered: %i %i\n", nd, n);
lat->staggered =
QDP_create_subset_L(lat->qlat, staggered_func, (void*)&nd,sizeof(nd),n);
//printf("... done.\n");
}
return lat->staggered;
}
static void
path_prod(QDP_ColorMatrix *u[], QDP_ColorMatrix *m, int path[], int len,
int subl, QDP_Subset subset[], int (*neighsubl)(int subl, int dir))
{
QDP_ShiftDir fb;
QDP_ColorMatrix *p=NULL, *s=NULL;
QDP_Lattice *lat = QDP_get_lattice_M(m);
int nd = QDP_ndim_L(lat);
int sn = 0;
for(int i=0; i<len; i++) {
int dir = abs(path[i])-1;
// if the path moves in the + dir then we shift from the backward dir
fb = path[i]<0 ? QDP_forward : QDP_backward;
if(fb==QDP_backward) { // path is moving in + dir
if(i==0) {
QDP_M_eq_Ma(tm[sn], u[dir], subset[subl]);
} else {
QDP_M_eq_Ma_times_M(tm[sn], u[dir], p, subset[subl]);
QDP_discard_M(p);
}
subl = neighsubl(subl, path[i]);
s = sm[sn][nd+dir];
QDP_discard_M(s);
QDP_M_eq_sM(s, tm[sn], QDP_neighbor_L(lat)[dir], fb, eosub(subl));
//p = t1; t1 = t2; t2 = p;
sn = 1-sn;
p = s;
} else {
if(i==0) {
subl = neighsubl(subl, path[i]);
QDP_M_eq_M(tm[1-sn], u[dir], subset[subl]);
} else {
QDP_M_eq_M(tm[sn], p, subset[subl]);
QDP_discard_M(p);
subl = neighsubl(subl, path[i]);
s = sm[sn][dir];
QDP_discard_M(s);
QDP_M_eq_sM(s, tm[sn], QDP_neighbor_L(lat)[dir], fb, eosub(subl));
QDP_M_eq_M_times_M(tm[1-sn], u[dir], s, subset[subl]);
QDP_discard_M(s);
}
p = tm[1-sn];
}
}
QDP_M_eq_M(m, p, subset[subl]);
QDP_discard_M(p);
QDP_discard_M(s);
}
static int
qopqdp_lattice_call(lua_State *L)
{
BEGIN_ARGS;
GET_LATTICE(l);
OPT_INT(dim, 0);
END_ARGS;
if(dim>0) {
int s = QDP_coord_size_L(l->qlat, dim-1);
lua_pushinteger(L, s);
} else {
int nd = QDP_ndim_L(l->qlat);
int x[nd];
QDP_latsize_L(l->qlat, x);
qhmc_push_int_array(L, nd, x);
}
return 1;
}
static int
subCopyHyper(QDP_Lattice *rlat, int x[], void *args)
{
int color = 0;
int nd = QDP_ndim_L(rlat);
int *sublen = (int *)args;
int *rof = sublen + nd;
int *rls = rof + nd;
for(int i=0; i<nd; i++) {
int k = (x[i] - rof[i] + rls[i])%rls[i];
if(k>=sublen[i]) color = 1;
}
#if 0
if(color==0) {
printf("SUB:");
for(int i=0; i<nd; i++) printf(" %i", x[i]);
printf("\n");
}
#endif
return color;
}
QDP_Subset *
qhmc_qopqdp_qsubset_from_string(lua_State *L, lattice_t *lat,
const char *s, int *n)
{
*n = 0;
if(s==NULL) return NULL;
QDP_Subset *subs = NULL;
QDP_Lattice *qlat = lat->qlat;
switch(s[0]) {
case 'a':
subs = QDP_all_and_empty_L(qlat);
if(strcmp(s,"all")==0) *n = 1;
else *n = 2;
break;
case 'e':
*n = 1;
if(strncmp(s,"evenodd",7)==0 || strncmp(s,"evenandodd",10)==0) *n = 2;
subs = QDP_even_and_odd_L(qlat);
{
int t=0;
int nn = sscanf(s,"%*[^0-9]%i",&t);
if(nn && t>=1 && t<=lat->nd) {
subs = qhmcqdp_get_eodir(lat, t-1);
}
}
break;
case 'o':
*n = 1;
subs = 1 + QDP_even_and_odd_L(qlat);
{
int t=0;
int nn = sscanf(s,"%*[^0-9]%i",&t);
if(nn && t>=1 && t<=lat->nd) {
subs = 1 + qhmcqdp_get_eodir(lat, t-1);
}
}
break;
case 's':
if(strncmp(s,"staggered",9)==0) {
int ns = 1 << QDP_ndim_L(qlat);
if(strcmp(s+9,"")==0) {
subs = qhmcqdp_get_staggered(lat);
*n = ns;
} else {
int t=0;
int nn = sscanf(s+9,"%i",&t);
if(nn && t>=0 && t<ns) {
subs = &qhmcqdp_get_staggered(lat)[t];
*n = 1;
}
}
}
break;
case 't':
if(strncmp(s,"timeslice",9)==0) {
int nt = QDP_coord_size_L(qlat,QDP_ndim_L(qlat)-1);
if(strcmp(s+9,"s")==0) {
subs = qhmcqdp_get_timeslices(lat);
*n = nt;
} else {
int t=0;
int nn = sscanf(s+9,"%i",&t);
if(nn && t>=0 && t<nt) {
subs = &qhmcqdp_get_timeslices(lat)[t];
*n = 1;
}
}
}
break;
}
return subs;
}
void
QOP_symanzik_1loop_gauge_heatbath_qdp(QOP_info_t *info,
QDP_ColorMatrix *links[],
QLA_Real beta,
QOP_gauge_coeffs_t *coeffs,
QDP_RandomState *rs0,
int nup, int nhb, int nover)
{
#define NC QDP_get_nc(links[0])
double dtime = QOP_time();
double nflops = 0;
if(coeffs->adjoint_plaquette) {
QOP_error("%s: adj plaq not supported\n", __func__);
}
fac = beta/QLA_Nc;
int imp = (coeffs->rectangle!=0)||(coeffs->parallelogram!=0);
QDP_Lattice *lat = QDP_get_lattice_M(links[0]);
int nd = QDP_ndim_L(lat);
QDP_Subset *cbs=QDP_even_and_odd_L(lat);
int ncb = 2;
if(imp) {
ncb = 32;
cbs = QOP_get_sub32(lat);
}
QDP_ColorMatrix *staple = QDP_create_M_L(lat);
QDP_ColorMatrix *v = QDP_create_M_L(lat);
QDP_ColorMatrix *tmp = QDP_create_M_L(lat);
rs = QDP_expose_S(rs0);
for(int up=0; up<nup; up++) {
for(int hb=0; hb<nhb; hb++) {
for(int cb=0; cb<ncb; cb++) {
QDP_Subset subset = cbs[cb];
for(int mu=0; mu<nd; mu++) {
QDP_M_eq_zero(staple, subset);
QOP_symanzik_1loop_gauge_staple_qdp(info, links, staple, mu, coeffs, cbs, cb);
QDP_M_eq_M_times_Ma(v, links[mu], staple, subset);
QDP_M_eq_funcit(v, hb_func, subset);
QDP_M_eq_M_times_M(tmp, v, links[mu], subset);
QDP_M_eq_M(links[mu], tmp, subset);
}
}
}
for(int over=0; over<nover; over++) {
for(int cb=0; cb<ncb; cb++) {
QDP_Subset subset = cbs[cb];
for(int mu=0; mu<nd; mu++) {
QDP_M_eq_zero(staple, subset);
QOP_symanzik_1loop_gauge_staple_qdp(info, links, staple, mu, coeffs, cbs, cb);
QDP_M_eq_M_times_Ma(v, links[mu], staple, subset);
QDP_M_eq_funcit(v, over_func, subset);
QDP_M_eq_M_times_M(tmp, v, links[mu], subset);
QDP_M_eq_M(links[mu], tmp, subset);
}
}
}
}
QDP_reset_S(rs0);
QDP_destroy_M(tmp);
QDP_destroy_M(v);
QDP_destroy_M(staple);
info->final_sec = QOP_time() - dtime;
info->final_flop = nflops*QDP_sites_on_node;
info->status = QOP_SUCCESS;
#undef NC
}
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
}
static void
get_staple_imp(QDP_ColorMatrix *staple, int mu, QDP_ColorMatrix **u,
QOP_gauge_coeffs_t *coeffs,
int subl, QDP_Subset subs[], int (*neighsub)(int subl, int dir))
{
#define NC QDP_get_nc(staple)
QDP_Lattice *lat = QDP_get_lattice_M(staple);
int nd = QDP_ndim_L(lat);
int nd2 = 2*nd;
QLA_Real plaq = coeffs->plaquette;
QLA_Real rect = coeffs->rectangle;
QLA_Real pgm = coeffs->parallelogram;
QLA_Real adpl = coeffs->adjoint_plaquette;
QDP_ColorMatrix *sm0[2][nd2];
QDP_ColorMatrix *t = QDP_create_M_L(lat);
for(int i=0; i<2; i++) {
tm[i] = QDP_create_M_L(lat);
sm[i] = sm0[i];
for(int nu=0; nu<nd2; nu++) {
sm[i][nu] = QDP_create_M_L(lat);
}
}
QDP_Complex *tc = NULL;
if(adpl!=0) tc = QDP_create_C_L(lat);
int mup = 1 + mu;
int bsubl = neighsub(subl, mup);
int path[5];
QDP_Subset subset = subs[subl];
if(plaq!=0 || adpl!=0) {
for(int nu=-nd; nu<=nd; nu++) {
if ( nu==-mup || nu==0 || nu==mup ) continue;
path[0] = nu;
path[1] = -mup;
path[2] = -nu;
path_prod(u, t, path, 3, bsubl, subs, neighsub);
if(adpl==0) {
QDP_M_peq_r_times_M(staple, &plaq, t, subset);
} else {
QLA_Complex z;
QLA_c_eq_r(z, plaq/adpl);
QDP_C_eq_c(tc, &z, subset);
QDP_C_peq_M_dot_M(tc, t, u[mu], subset);
QDP_C_eq_r_times_C(tc, &adpl, tc, subset);
QDP_M_peq_C_times_M(staple, tc, t, subset);
}
}
}
if(rect) {
for(int nu=-nd; nu<=nd; nu++) {
if ( nu==-mup || nu==0 || nu==mup ) continue;
//s = QDP_create_M();
path[0] = nu;
path[1] = nu;
path[2] = -mup;
path[3] = -nu;
path[4] = -nu;
path_prod(u, t, path, 5, bsubl, subs, neighsub);
QDP_M_peq_r_times_M(staple, &rect, t, subset);
//QDP_destroy_M(s);
//s = QDP_create_M();
path[0] = nu;
path[1] = -mup;
path[2] = -mup;
path[3] = -nu;
path[4] = mup;
path_prod(u, t, path, 5, bsubl, subs, neighsub);
QDP_M_peq_r_times_M(staple, &rect, t, subset);
//QDP_destroy_M(s);
//s = QDP_create_M();
path[0] = mup;
path[1] = nu;
path[2] = -mup;
path[3] = -mup;
path[4] = -nu;
path_prod(u, t, path, 5, bsubl, subs, neighsub);
QDP_M_peq_r_times_M(staple, &rect, t, subset);
//QDP_destroy_M(s);
}
}
if(pgm) {
for(int nu=-nd; nu<=nd; nu++) {
if ( nu==-mup || nu==0 || nu==mup ) continue;
for(int rho=-nd; rho<=nd; rho++) {
if ( rho==-mup || rho==0 || rho==mup || rho==-nu || rho==nu ) continue;
path[0] = nu;
path[1] = rho;
path[2] = -mup;
path[3] = -nu;
path[4] = -rho;
path_prod(u, t, path, 5, bsubl, subs, neighsub);
QDP_M_peq_r_times_M(staple, &pgm, t, subset);
}
}
}
if(adpl!=0) QDP_destroy_C(tc);
QDP_destroy_M(t);
for(int i=0; i<2; i++) {
for(int nu=0; nu<nd2; nu++) {
QDP_destroy_M(sm[i][nu]);
}
QDP_destroy_M(tm[i]);
}
}
// shift map from slat into rlat with offsets passed in args
static void
mapCopyHyper(QDP_Lattice *rlat, QDP_Lattice *slat, int rx[], int sx[],
int *num, int idx, QDP_ShiftDir fb, void *args)
{
int rnd = QDP_ndim_L(rlat);
int snd = QDP_ndim_L(slat);
*num = 1;
if(fb==QDP_forward) {
int *rof = (int *)args;
int *rls = rof + rnd;
int *sd = rls + rnd;
int *sof = sd + rnd;
int *sls = sof + snd;
#if 0
{
printf("rof:");
for(int i=0; i<rnd; i++) printf(" %i", rof[i]);
printf("rls:");
for(int i=0; i<rnd; i++) printf(" %i", rls[i]);
printf("sd: ");
for(int i=0; i<rnd; i++) printf(" %i", sd[i]);
printf("sof:");
for(int i=0; i<snd; i++) printf(" %i", sof[i]);
printf("sls:");
for(int i=0; i<snd; i++) printf(" %i", sls[i]);
}
#endif
for(int j=0; j<snd; j++) sx[j] = sof[j];
for(int i=0; i<rnd; i++) {
int k = (rx[i] - rof[i] + rls[i])%rls[i];
int j = sd[i];
sx[j] = (k + sx[j])%sls[j];
if(k>=sls[j]) *num = 0;
}
#if 0
if(*num) {
printf("FWD:");
for(int i=0; i<rnd; i++) printf(" %i", rx[i]);
printf(" <-");
for(int i=0; i<snd; i++) printf(" %i", sx[i]);
printf("\n");
}
#endif
} else { // QDP_backward
int *sof = (int *)args;
int *sls = sof + snd;
int *sd = sls + snd;
int *rof = sd + snd;
int *rls = rof + rnd;
for(int j=0; j<snd; j++) {
int i = sd[j];
int k = 0;
if(i>=0&&i<rnd) k = (rx[i] - rof[i] + rls[i])%rls[i];
sx[j] = (k + sof[j])%sls[j];
if(k>=sls[j]) *num = 0;
}
#if 0
if(*num) {
printf("BCK:");
for(int i=0; i<snd; i++) printf(" %i", sx[i]);
printf(" ->");
for(int i=0; i<rnd; i++) printf(" %i", rx[i]);
printf("\n");
}
#endif
}
}
