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
}
void
QOP_hisq_force_multi_fnmat2_qdp(QOP_info_t *info,
QOP_FermionLinksHisq *flh,
QDP_ColorMatrix *force[],
QOP_hisq_coeffs_t *hisq_coeff,
REAL *residues,
QDP_ColorVector *x[],
int *n_orders_naik)
{
#define NC QDP_get_nc(force[0])
double dtime = QOP_time();
QDP_ColorMatrix *deriv[4];
for(int mu=0; mu<4; mu++) {
deriv[mu] = QDP_create_M();
QDP_M_eq_zero(deriv[mu], QDP_all);
}
QOP_hisq_deriv_multi_fnmat2_qdp(info, flh, deriv, hisq_coeff, residues, x, n_orders_naik);
// contraction with the link in question should be done here,
// after contributions from all levels of smearing are taken into account
// Put antihermitian traceless part into momentum
// add force to momentum
QDP_ColorMatrix *mtmp = QDP_create_M();
for(int dir=0; dir<4; dir++) {
QDP_M_eq_M_times_Ma(mtmp, flh->U_links[dir], deriv[dir], QDP_all);
QDP_M_eq_antiherm_M(deriv[dir], mtmp, QDP_all);
QDP_M_peq_M(force[dir], deriv[dir], QDP_all);
}
info->final_flop += (4.*(198+24+18))*QDP_sites_on_node;
QDP_destroy_M(mtmp);
for(int mu=0; mu<4; mu++) {
QDP_destroy_M(deriv[mu]);
}
info->final_sec = QOP_time() - dtime;
//QOP_printf0("HISQ force flops = %g\n", info->final_flop);
#undef NC
}
void
QOP_asqtad_force_multi_asvec_qdp(QOP_info_t *info, QDP_ColorMatrix *links[],
QDP_ColorMatrix *force[], QOP_asqtad_coeffs_t *coef,
REAL eps[], QDP_ColorVector *xin[], int nsrc)
{
#define NC QDP_get_nc(xin[0])
REAL coeff[nsrc];
REAL OneLink[nsrc], Lepage[nsrc], Naik[nsrc], FiveSt[nsrc], ThreeSt[nsrc], SevenSt[nsrc];
REAL mNaik[nsrc], mLepage[nsrc], mFiveSt[nsrc], mThreeSt[nsrc], mSevenSt[nsrc];
QDP_ColorVector *P3[8][nsrc];
QDP_ColorVector *P5[8][nsrc];
QDP_ColorVector *P5tmp[8][8][nsrc];
QDP_ColorVector *P5s[4][nsrc];
QDP_ColorVector *P5tmps[4][8][nsrc];
//QDP_ColorVector *xin[nsrc];
QDP_ColorVector *xintmp[8][nsrc];
QDP_ColorVector *Pmu[nsrc];
QDP_ColorVector *Pmutmp[8][nsrc];
QDP_ColorVector *Pnumu[nsrc];
QDP_ColorVector *Pnumutmp[8][nsrc];
QDP_ColorVector *Prhonumu[nsrc];
QDP_ColorVector *Prhonumutmp[8][nsrc];
QDP_ColorVector *P7[nsrc];
QDP_ColorVector *P7tmp[8][nsrc];
QDP_ColorVector *P7rho[nsrc];
QDP_ColorVector *ttv[nsrc];
int i, dir;
int mu, nu, rho, sig;
double nflop1 = 253935;
double nflop2 = 433968;
double nflop = nflop1 + (nflop2-nflop1)*(nsrc-1);
double dtime;
dtime = -QOP_time();
ASQTAD_FORCE_BEGIN;
QOP_trace("test 1\n");
/* setup parallel transport */
QDP_ColorMatrix *tmpmat = QDP_create_M();
for(i=0; i<QOP_common.ndim; i++) {
fbshift[i] = QDP_neighbor[i];
fbshiftdir[i] = QDP_forward;
fblink[i] = links[i];
fbshift[OPP_DIR(i)] = QDP_neighbor[i];
fbshiftdir[OPP_DIR(i)] = QDP_backward;
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);
}
tv = ttv;
for(i=0; i<nsrc; i++) {
tv[i] = QDP_create_V();
}
QOP_trace("test 2\n");
/* Allocate temporary vectors */
for(i=0; i<nsrc; i++) {
Pmu[i] = QDP_create_V();
Pnumu[i] = QDP_create_V();
Prhonumu[i] = QDP_create_V();
P7[i] = QDP_create_V();
P7rho[i] = QDP_create_V();
for(dir=0; dir<8; dir++) {
xintmp[dir][i] = QDP_create_V();
Pmutmp[dir][i] = QDP_create_V();
Pnumutmp[dir][i] = QDP_create_V();
Prhonumutmp[dir][i] = QDP_create_V();
P7tmp[dir][i] = QDP_create_V();
}
#if 1
for(mu=0; mu<4; mu++) {
P5s[mu][i] = QDP_create_V();
for(dir=0; dir<8; dir++) {
P5tmps[mu][dir][i] = QDP_create_V();
}
}
#else
for(mu=0; mu<8; mu++) {
P5[mu][i] = QDP_create_V();
for(dir=0; dir<8; dir++) {
P5tmp[mu][dir][i] = QDP_create_V();
//printf("%p %p\n", P5tmp[mu][dir][i], &(P5tmp[mu][dir][i])); fflush(stdout);
if(P5tmp[mu][dir][i]==NULL) {
fprintf(stderr, "error: can't create V\n");
QDP_abort();
}
}
}
#endif
}
//printf("%p\n", P5tmp[0][4][0]); fflush(stdout);
for(mu=0; mu<8; mu++) {
for(i=0; i<nsrc; i++) {
P3[mu][i] = QDP_create_V();
//P5[mu][i] = QDP_create_V();
}
}
for(mu=0; mu<4; mu++) {
tempmom_qdp[mu] = force[mu];
QDP_M_eqm_M(tempmom_qdp[mu], tempmom_qdp[mu], QDP_odd);
}
/* Path coefficients times fermion epsilon */
/* Load path coefficients from table */
for(i=0; i<nsrc; i++) {
OneLink[i] = coef->one_link * eps[i];
Naik[i] = coef->naik * eps[i]; mNaik[i] = -Naik[i];
ThreeSt[i] = coef->three_staple * eps[i]; mThreeSt[i] = -ThreeSt[i];
FiveSt[i] = coef->five_staple * eps[i]; mFiveSt[i] = -FiveSt[i];
SevenSt[i] = coef->seven_staple * eps[i]; mSevenSt[i] = -SevenSt[i];
Lepage[i] = coef->lepage * eps[i]; mLepage[i] = -Lepage[i];
}
#if 0
printf("nsrc = %i\n", nsrc);
printf("coeffs = %g %g %g %g %g %g\n", OneLink[0], ThreeSt[0], FiveSt[0],
SevenSt[0], Lepage[0], Naik[0]);
#endif
/* *************************************** */
QOP_trace("start force loop\n");
for(mu=0; mu<8; mu++) {
//u_shift_hw_fermion(temp_x_qdp, Pmu, OPP_DIR(mu), temp_hw[OPP_DIR(mu)]);
u_shift_color_vecs(xin, Pmu, OPP_DIR(mu), nsrc, xintmp[OPP_DIR(mu)]);
for(sig=0; sig<8; sig++) if( (sig!=mu)&&(sig!=OPP_DIR(mu)) ) {
//u_shift_hw_fermion(Pmu, P3[sig], sig, temp_hw[sig]);
u_shift_color_vecs(Pmu, P3[sig], sig, nsrc, Pmutmp[sig]);
if(GOES_FORWARDS(sig)) {
/* Add the force F_sig[x+mu]: x--+ *
* | | *
* o o *
* the 1 link in the path: - (numbering starts form 0) */
add_forces_to_mom(P3[sig], Pmu, sig, mThreeSt, nsrc);
}
}
for(nu=0; nu<8; nu++) if( (nu!=mu)&&(nu!=OPP_DIR(mu)) ) {
int nP5 = 0;
//Pnumu = hw_qdp[OPP_DIR(nu)];
//u_shift_hw_fermion(Pmu, Pnumu, OPP_DIR(nu), temp_hw[OPP_DIR(nu)]);
u_shift_color_vecs(Pmu, Pnumu, OPP_DIR(nu), nsrc, Pmutmp[OPP_DIR(nu)]);
//QDP_V_veq_V(Pnumu, P3[OPP_DIR(nu)], QDP_all, nsrc);
for(sig=0; sig<8; sig++) if( (sig!=mu)&&(sig!=OPP_DIR(mu)) &&
(sig!=nu)&&(sig!=OPP_DIR(nu)) ) {
#if 1
for(i=0; i<nsrc; i++) {
P5[sig][i] = P5s[nP5][i];
for(dir=0; dir<8; dir++) P5tmp[sig][dir][i] = P5tmps[nP5][dir][i];
}
#endif
nP5++;
//u_shift_hw_fermion(Pnumu, P5[sig], sig, temp_hw[sig]);
u_shift_color_vecs(Pnumu, P5[sig], sig, nsrc, Pnumutmp[sig]);
if(GOES_FORWARDS(sig)) {
/* Add the force F_sig[x+mu+nu]: x--+ *
* | | *
* o o *
* the 2 link in the path: + (numbering starts form 0) */
add_forces_to_mom(P5[sig], Pnumu, sig, FiveSt, nsrc);
}
}
QOP_trace("test 4\n");
for(rho=0; rho<8; rho++) if( (rho!=mu)&&(rho!=OPP_DIR(mu)) &&
(rho!=nu)&&(rho!=OPP_DIR(nu)) ) {
//Prhonumu = hw_qdp[OPP_DIR(rho)];
//u_shift_hw_fermion(Pnumu, Prhonumu, OPP_DIR(rho),
// temp_hw[OPP_DIR(rho)] );
u_shift_color_vecs(Pnumu, Prhonumu, OPP_DIR(rho), nsrc,
Pnumutmp[OPP_DIR(rho)]);
//QDP_V_veq_V(Prhonumu, P5[OPP_DIR(rho)], QDP_all, nsrc);
for(sig=0; sig<8; sig++) if( (sig!=mu )&&(sig!=OPP_DIR(mu )) &&
(sig!=nu )&&(sig!=OPP_DIR(nu )) &&
(sig!=rho)&&(sig!=OPP_DIR(rho)) ) {
/* Length 7 paths */
//P7 = hw_qdp[sig];
//u_shift_hw_fermion(Prhonumu, P7, sig, temp_hw[sig] );
QOP_trace("test 43\n");
u_shift_color_vecs(Prhonumu, P7, sig, nsrc, Prhonumutmp[sig]);
QOP_trace("test 44\n");
//QDP_V_eq_r_times_V(P7[0], &SevenSt[0], P7[0], QDP_all);
//QDP_V_eq_r_times_V(P7[1], &SevenSt[1], P7[1], QDP_all);
if(GOES_FORWARDS(sig)) {
/* Add the force F_sig[x+mu+nu+rho]: x--+ *
* | | *
* o o *
* the 3 link in the path: - (numbering starts form 0) */
QOP_trace("test 45\n");
add_forces_to_mom(P7, Prhonumu, sig, mSevenSt, nsrc);
QOP_trace("test 46\n");
//mom_meq_force(P7, Prhonumu, sig);
}
/* Add the force F_rho the 2(4) link in the path: + */
//P7rho = hw_qdp[rho];
//u_shift_hw_fermion(P7, P7rho, rho, temp_hw[rho]);
QOP_trace("test 47\n");
u_shift_color_vecs(P7, P7rho, rho, nsrc, P7tmp[rho]);
QOP_trace("test 48\n");
side_link_forces(rho,sig,SevenSt,Pnumu,P7,Prhonumu,P7rho, nsrc);
QOP_trace("test 49\n");
//side_link_3f_force2(rho,sig,Pnumu,P7,Prhonumu,P7rho);
/* Add the P7rho vector to P5 */
for(i=0; i<nsrc; i++) {
if(FiveSt[i]!=0) coeff[i] = SevenSt[i]/FiveSt[i];
else coeff[i] = 0;
QOP_trace("test 410\n");
QDP_V_peq_r_times_V(P5[sig][i], &coeff[i], P7rho[i], QDP_all);
QOP_trace("test 411\n");
}
} /* sig */
} /* rho */
QOP_trace("test 5\n");
#define P5nu P7
for(sig=0; sig<8; sig++) if( (sig!=mu)&&(sig!=OPP_DIR(mu)) &&
(sig!=nu)&&(sig!=OPP_DIR(nu)) ) {
/* Length 5 paths */
/* Add the force F_nu the 1(3) link in the path: - */
//P5nu = hw_qdp[nu];
//u_shift_hw_fermion(P5[sig], P5nu, nu, temp_hw[nu]);
u_shift_color_vecs(P5[sig], P5nu, nu, nsrc, P5tmp[sig][nu]);
side_link_forces(nu, sig, mFiveSt, Pmu, P5[sig], Pnumu, P5nu, nsrc);
/* Add the P5nu vector to P3 */
for(i=0; i<nsrc; i++) {
if(ThreeSt[i]!=0) coeff[i] = FiveSt[i]/ThreeSt[i];
else coeff[i] = 0;
QDP_V_peq_r_times_V(P3[sig][i], &coeff[i], P5nu[i], QDP_all);
}
} /* sig */
} /* nu */
#define Pmumu Pnumu
#define Pmumutmp Pnumutmp
#define P5sig Prhonumu
#define P5sigtmp Prhonumutmp
#define P3mu P7
#define Popmu P7
#define Pmumumu P7
/* Now the Lepage term... It is the same as 5-link paths with
nu=mu and FiveSt=Lepage. */
//u_shift_hw_fermion(Pmu, Pmumu, OPP_DIR(mu), temp_hw[OPP_DIR(mu)] );
u_shift_color_vecs(Pmu, Pmumu, OPP_DIR(mu), nsrc, Pmutmp[OPP_DIR(mu)]);
for(sig=0; sig<8; sig++) if( (sig!=mu)&&(sig!=OPP_DIR(mu)) ) {
//P5sig = hw_qdp[sig];
//u_shift_hw_fermion(Pmumu, P5sig, sig, temp_hw[sig]);
u_shift_color_vecs(Pmumu, P5sig, sig, nsrc, Pmumutmp[sig]);
if(GOES_FORWARDS(sig)) {
/* Add the force F_sig[x+mu+nu]: x--+ *
* | | *
* o o *
* the 2 link in the path: + (numbering starts form 0) */
add_forces_to_mom(P5sig, Pmumu, sig, Lepage, nsrc);
}
/* Add the force F_nu the 1(3) link in the path: - */
//P5nu = hw_qdp[mu];
//u_shift_hw_fermion(P5sig, P5nu, mu, temp_hw[mu]);
u_shift_color_vecs(P5sig, P5nu, mu, nsrc, P5sigtmp[mu]);
side_link_forces(mu, sig, mLepage, Pmu, P5sig, Pmumu, P5nu, nsrc);
/* Add the P5nu vector to P3 */
for(i=0; i<nsrc; i++) {
if(ThreeSt[i]!=0) coeff[i] = Lepage[i]/ThreeSt[i];
else coeff[i] = 0;
QDP_V_peq_r_times_V(P3[sig][i], &coeff[i], P5nu[i], QDP_all);
}
/* Length 3 paths (Not the Naik term) */
/* Add the force F_mu the 0(2) link in the path: + */
if(GOES_FORWARDS(mu)) {
//P3mu = hw_qdp[mu]; /* OK to clobber P5nu */
//u_shift_hw_fermion(P3[sig], P3mu, mu, temp_hw[mu]);
//u_shift_color_vecs(P3[sig], P3mu, mu, 2, temp_hw[mu]);
for(i=0; i<nsrc; i++) {
QDP_V_eq_V(P5sig[i], P3[sig][i], QDP_all);
}
u_shift_color_vecs(P5sig, P3mu, mu, nsrc, P5sigtmp[mu]);
}
/* The above shift is not needed if mu is backwards */
side_link_forces(mu, sig, ThreeSt, xin, P3[sig], Pmu, P3mu, nsrc);
}
/* Finally the OneLink and the Naik term */
if(GOES_BACKWARDS(mu)) {
/* Do only the forward terms in the Dslash */
/* Because I have shifted with OPP_DIR(mu) Pmu is a forward *
* shift. */
/* The one link */
add_forces_to_mom(Pmu, xin, OPP_DIR(mu), OneLink, nsrc);
/* For the same reason Pmumu is the forward double link */
/* Popmu is a backward shift */
//Popmu = hw_qdp[mu]; /* OK to clobber P3mu */
//u_shift_hw_fermion(xin, Popmu, mu, temp_hw[mu]);
u_shift_color_vecs(xin, Popmu, mu, nsrc, xintmp[mu]);
/* The Naik */
/* link no 1: - */
add_forces_to_mom(Pmumu, Popmu, OPP_DIR(mu), mNaik, nsrc);
/* Pmumumu can overwrite Popmu which is no longer needed */
//Pmumumu = hw_qdp[OPP_DIR(mu)];
//u_shift_hw_fermion(Pmumu, Pmumumu, OPP_DIR(mu), temp_hw[OPP_DIR(mu)]);
u_shift_color_vecs(Pmumu, Pmumumu, OPP_DIR(mu), nsrc, Pmumutmp[OPP_DIR(mu)]);
/* link no 0: + */
add_forces_to_mom(Pmumumu, xin, OPP_DIR(mu), Naik, nsrc);
} else {
/* The rest of the Naik terms */
//Popmu = hw_qdp[mu]; /* OK to clobber P3mu */
//u_shift_hw_fermion(xin, Popmu, mu, temp_hw[mu]);
u_shift_color_vecs(xin, Popmu, mu, nsrc, xintmp[mu]);
/* link no 2: + */
/* Pmumu is double backward shift */
add_forces_to_mom(Popmu, Pmumu, mu, Naik, nsrc);
}
/* Here we have to do together the Naik term and the one link term */
}/* mu */
QOP_trace("test 6\n");
QOP_trace("test 7\n");
for(mu=0; mu<4; mu++) {
QDP_M_eq_M(tmpmat, tempmom_qdp[mu], QDP_even);
QDP_M_eqm_M(tmpmat, tempmom_qdp[mu], QDP_odd);
QDP_M_eq_antiherm_M(tempmom_qdp[mu], tmpmat, QDP_all);
}
QDP_destroy_M(tmpmat);
//printf("%p\n", P5tmp[0][4][0]); fflush(stdout);
//if(QDP_this_node==0) { printf("line %i\n",__LINE__); fflush(stdout); }
/* Free temporary vectors */
for(i=0; i<nsrc; i++) {
QDP_destroy_V(Pmu[i]);
QDP_destroy_V(Pnumu[i]);
QDP_destroy_V(Prhonumu[i]);
QDP_destroy_V(P7[i]);
QDP_destroy_V(P7rho[i]);
//if(QDP_this_node==0) { printf("line %i\n",__LINE__); fflush(stdout); }
for(dir=0; dir<8; dir++) {
QDP_destroy_V(xintmp[dir][i]);
QDP_destroy_V(Pmutmp[dir][i]);
QDP_destroy_V(Pnumutmp[dir][i]);
QDP_destroy_V(Prhonumutmp[dir][i]);
QDP_destroy_V(P7tmp[dir][i]);
}
//if(QDP_this_node==0) { printf("line %i\n",__LINE__); fflush(stdout); }
for(mu=0; mu<4; mu++) {
//if(QDP_this_node==0) { printf("line %i\n",__LINE__); fflush(stdout); }
QDP_destroy_V(P5s[mu][i]);
//QDP_destroy_V(P5[mu][i]);
//if(QDP_this_node==0) { printf("line %i\n",__LINE__); fflush(stdout); }
for(dir=0; dir<8; dir++) {
//if(QDP_this_node==0) { printf("line %i\n",__LINE__); fflush(stdout); }
QDP_destroy_V(P5tmps[mu][dir][i]);
//printf("%p\n", P5tmp[mu][dir][i]); fflush(stdout);
//QDP_destroy_V(P5tmp[mu][dir][i]);
//if(QDP_this_node==0) { printf("line %i\n",__LINE__); fflush(stdout); }
}
//if(QDP_this_node==0) { printf("line %i\n",__LINE__); fflush(stdout); }
}
//if(QDP_this_node==0) { printf("line %i\n",__LINE__); fflush(stdout); }
}
//if(QDP_this_node==0) { printf("here3\n"); fflush(stdout); }
for(mu=0; mu<8; mu++) {
for(i=0; i<nsrc; i++) {
QDP_destroy_V(P3[mu][i]);
}
//QDP_destroy_V(P5[mu][0]);
//QDP_destroy_V(P5[mu][1]);
}
for(i=0; i<nsrc; i++) {
QDP_destroy_V(tv[i]);
}
//if(QDP_this_node==0) { printf("here4\n"); fflush(stdout); }
for(i=4; i<8; i++) {
QDP_destroy_M(fblink[i]);
}
dtime += QOP_time();
info->final_sec = dtime;
info->final_flop = nflop*QDP_sites_on_node;
info->status = QOP_SUCCESS;
ASQTAD_FORCE_END;
#undef NC
}
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);
}
void
QOP_hisq_force_multi_wrapper_fnmat(QOP_info_t *info,
QOP_FermionLinksHisq *flh,
QOP_Force *Force,
QOP_hisq_coeffs_t *hisq_coeff,
REAL *residues,
QDP_ColorVector *x[],
int *n_orders_naik)
{
double dtime = QDP_time();
int i, ipath, dir;
REAL coeff_mult;
double *eps_naik = hisq_coeff->eps_naik;
int n_naiks = hisq_coeff->n_naiks;
QOP_hisq_unitarize_method_t umethod = hisq_coeff->umethod;
// Quark paths sorted by net displacement and last directions
static Q_path *q_paths_sorted_1 = NULL;
static Q_path *q_paths_sorted_2 = NULL;
static Q_path *q_paths_sorted_3 = NULL;
static int *netbackdir_table_1 = NULL;
static int *netbackdir_table_2 = NULL;
static int *netbackdir_table_3 = NULL;
static int first_force = 1;
if(first_force == 1)
QOP_make_paths_and_dirs_hisq(hisq_coeff, umethod);
int num_q_paths_1 = qop_get_num_q_paths_1();
int num_q_paths_2 = qop_get_num_q_paths_2();
int num_q_paths_3 = qop_get_num_q_paths_3();
Q_path *q_paths_1 = qop_get_q_paths_1();
Q_path *q_paths_2 = qop_get_q_paths_2();
Q_path *q_paths_3 = qop_get_q_paths_3();
Q_path *q_paths_sorted_current = NULL;
int *netbackdir_table_current = NULL;
int inaik;
int n_naik_shift;
double final_flop = 0.;
size_t nflops = 0;
QDP_ColorMatrix * force[4] = {Force->force[0], Force->force[1],
Force->force[2], Force->force[3]};
int num_q_paths_current,n_orders_naik_current;//==nterms
QDP_ColorMatrix *force_accum_0[4];
QDP_ColorMatrix *force_accum_0_naik[4];
QDP_ColorMatrix *force_accum_1[4];
QDP_ColorMatrix *force_accum_1u[4];
QDP_ColorMatrix *force_accum_2[4];
QDP_ColorMatrix *force_final[4];
QDP_ColorMatrix *Ugf[4], *Vgf[4], *Wgf[4];
int nterms = 0, n_order_naik_total;
for(inaik = 0; inaik < n_naiks; inaik++)
nterms += n_orders_naik[inaik];
n_order_naik_total = nterms;
for(i=0;i<4;i++) {
Ugf[i] = flh->U_links[i];
Vgf[i] = flh->V_links[i];
Wgf[i] = flh->W_unitlinks[i];
}
QDP_ColorMatrix *tmat;
QDP_ColorMatrix *mat_tmp0;
REAL treal;
if( first_force==1 ){
if( q_paths_sorted_1==NULL )
q_paths_sorted_1 = (Q_path *)malloc( num_q_paths_1*sizeof(Q_path) );
if(netbackdir_table_1==NULL )
netbackdir_table_1 = (int *)malloc( num_q_paths_1*sizeof(int) );
if( q_paths_sorted_2==NULL )
q_paths_sorted_2 = (Q_path *)malloc( num_q_paths_2*sizeof(Q_path) );
if(netbackdir_table_2==NULL )
netbackdir_table_2 = (int *)malloc( num_q_paths_2*sizeof(int) );
if( q_paths_sorted_3==NULL )
q_paths_sorted_3 = (Q_path *)malloc( num_q_paths_3*sizeof(Q_path) );
if(netbackdir_table_3==NULL )
netbackdir_table_3 = (int *)malloc( num_q_paths_3*sizeof(int) );
else{QOP_printf0("WARNING: remaking sorted path tables\n"); exit(0); }
// make sorted tables
sort_quark_paths_hisq( q_paths_1, q_paths_sorted_1, num_q_paths_1, 8 );
for( ipath=0; ipath<num_q_paths_1; ipath++ )
netbackdir_table_1[ipath] =
find_backwards_gather( &(q_paths_sorted_1[ipath]) );
sort_quark_paths_hisq( q_paths_2, q_paths_sorted_2, num_q_paths_2, 16 );
for( ipath=0; ipath<num_q_paths_2; ipath++ )
netbackdir_table_2[ipath] =
find_backwards_gather( &(q_paths_sorted_2[ipath]) );
sort_quark_paths_hisq( q_paths_3, q_paths_sorted_3, num_q_paths_3, 16 );
for( ipath=0; ipath<num_q_paths_3; ipath++ )
netbackdir_table_3[ipath] =
find_backwards_gather( &(q_paths_sorted_3[ipath]) );
first_force=0;
}
tmat = QDP_create_M();
mat_tmp0 = QDP_create_M();
for(i=XUP;i<=TUP;i++){
force_accum_0[i] = QDP_create_M();
force_accum_0_naik[i] = QDP_create_M();
force_accum_1[i] = QDP_create_M();
force_accum_1u[i] = QDP_create_M();
force_accum_2[i] = QDP_create_M();
force_final[i] = QDP_create_M();
}
for(dir=XUP;dir<=TUP;dir++)
QDP_M_eq_zero(force_accum_2[dir], QDP_all);
// loop on different naik masses
n_naik_shift = 0;
for( inaik=0; inaik<n_naiks; inaik++ ) {
// smearing level 0
if( 0==inaik ) {
n_orders_naik_current = n_order_naik_total;
}
else {
n_orders_naik_current = n_orders_naik[inaik];
}
QOP_hisq_force_multi_smearing0_fnmat(info,residues+n_naik_shift,
x+n_naik_shift, n_orders_naik_current,
force_accum_0, force_accum_0_naik);
final_flop += info->final_flop;
// smearing level 2
if( 0==inaik ) {
q_paths_sorted_current = q_paths_sorted_2;
num_q_paths_current = num_q_paths_2;
netbackdir_table_current = netbackdir_table_2;
}
else {
q_paths_sorted_current = q_paths_sorted_3;
num_q_paths_current = num_q_paths_3;
netbackdir_table_current = netbackdir_table_3;
}
QOP_hisq_force_multi_smearing_fnmat( info,Wgf,residues+n_naik_shift,
x+n_naik_shift,
n_orders_naik_current,
force_accum_1,
force_accum_0, force_accum_0_naik,
num_q_paths_current,
q_paths_sorted_current,
netbackdir_table_current );
//QOP_printf0("HISQ smear0 flops = %g\n", info->final_flop);
final_flop += info->final_flop;
if( 0==inaik ) {
coeff_mult = 1.0;
}
else {
coeff_mult = eps_naik[inaik];
}
for(dir=XUP;dir<=TUP;dir++) {
QDP_M_peq_r_times_M(force_accum_2[dir],&coeff_mult,
force_accum_1[dir],QDP_all);
nflops += 36;
}
n_naik_shift += n_orders_naik[inaik];
}
if ( umethod==QOP_UNITARIZE_NONE ){
// smearing level 1
QOP_hisq_force_multi_smearing_fnmat( info,Ugf,residues,
x,
nterms, force_accum_1,
force_accum_2, NULL,
num_q_paths_1,
q_paths_sorted_1,
netbackdir_table_1 );
final_flop += info->final_flop;
}
else if ( umethod==QOP_UNITARIZE_RATIONAL ){
// reunitarization
QOP_hisq_force_multi_reunit(info,Vgf,force_accum_1u,
force_accum_2);
//QOP_printf0("reunit flops = %g\n", info->final_flop);
final_flop += info->final_flop;
// smearing level 1
QOP_hisq_force_multi_smearing_fnmat( info,Ugf,residues,
x,
nterms, force_accum_1,
force_accum_1u, NULL,
num_q_paths_1,
q_paths_sorted_1,
netbackdir_table_1 );
//QOP_printf0("HISQ smear1 flops = %g\n", info->final_flop);
final_flop += info->final_flop;
}
else
{
QOP_printf0("Unknown or unsupported unitarization method\n");
exit(1);
}
// contraction with the link in question should be done here,
// after contributions from all levels of smearing are taken into account
for(dir=XUP;dir<=TUP;dir++){
QDP_M_eq_M_times_M(force_final[dir],Ugf[dir],force_accum_1[dir],QDP_all);
nflops += 198;
}
// take into account even/odd parity (it is NOT done in "smearing" routine)
//eps multiplication done outside QOP
for(dir=XUP;dir<=TUP;dir++){
QDP_M_eq_M(tmat,force_final[dir],QDP_all);
treal = 2.0;
QDP_M_eq_r_times_M(force_final[dir],&treal,tmat,QDP_even);
treal = -2.0;
QDP_M_eq_r_times_M(force_final[dir],&treal,tmat,QDP_odd);
nflops += 18;
}
// Put antihermitian traceless part into momentum
// add force to momentum
for(dir=XUP; dir<=TUP; dir++){
QDP_M_eq_antiherm_M(mat_tmp0, force_final[dir], QDP_all);
QDP_M_peq_M(force[dir], mat_tmp0, QDP_all);
nflops += 24+18;
//QDP_M_peq_M(force_final[dir], force[dir], QDP_all);
//QDP_M_eq_antiherm_M(force[dir], force_final[dir], QDP_all);
}
for(i=XUP;i<=TUP;i++){
QDP_destroy_M( force_accum_0[i] );
QDP_destroy_M( force_accum_0_naik[i] );
QDP_destroy_M( force_accum_1[i] );
QDP_destroy_M( force_accum_1u[i] );
QDP_destroy_M( force_accum_2[i] );
QDP_destroy_M( force_final[i] );
}
QDP_destroy_M( tmat );
QDP_destroy_M( mat_tmp0 );
final_flop += ((double)nflops)*QDP_sites_on_node;
info->final_sec = QDP_time() - dtime;
info->final_flop = final_flop;
info->status = QOP_SUCCESS;
//QOP_printf0("HISQ force flops = %g\n", info->final_flop);
} //hisq_force_multi_wrapper_fnmat