Exemplo n.º 1
0
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);
}
Exemplo n.º 2
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;
}
static void
over_func(NCPROT1 QLA_ColorMatrix(*m), int site)
{
  if(QLA_Nc==1) {
    QLA_Complex z, zs, t;
    QLA_C_eq_elem_M(&z, m, 0, 0);
    QLA_c_eq_ca(zs, z);
    QLA_C_eq_C_divide_C(&t, &zs, &z);
    QLA_M_eq_elem_C(m, &t, 0, 0);
  } else {
    QLA_ColorMatrix(s);
    QLA_ColorMatrix(t);
    QLA_ColorMatrix(tt);
    QLA_Complex one;
    QLA_c_eq_r(one, 1);
    QLA_M_eq_c(&s, &one);

    /* Loop over SU(2) subgroup index */
    for(int i = 0; i < QLA_Nc; ++i) {
      for(int j = i+1; j < QLA_Nc; ++j) {
	QLA_Real a[4], r[4], rn;
	su2_extract(NCARG r, m, i, j);
	rn = sqrt( r[0]*r[0] + r[1]*r[1] + r[2]*r[2] + r[3]*r[3] );
	if(rn<1e-10) {
	  a[0] = 1; a[1] = a[2] = a[3] = 0;
	} else {
	  rn = 1/rn;
	  a[0] =  rn*r[0];
	  a[1] = -rn*r[1];
	  a[2] = -rn*r[2];
	  a[3] = -rn*r[3];
	}
	r[0] = a[0]*a[0] - a[1]*a[1] - a[2]*a[2] - a[3]*a[3];
	a[0] *= 2;
	r[1] = a[0]*a[1];
	r[2] = a[0]*a[2];
	r[3] = a[0]*a[3];
	su2_fill(NCARG &t, r, i, j);
	QLA_M_eq_M_times_M(&tt, &t, &s);
	QLA_M_eq_M(&s, &tt);
	QLA_M_eq_M_times_M(&tt, &t, m);
	QLA_M_eq_M(m, &tt);
      }
    }
    QLA_M_eq_M(m, &s);
  }
}
static void
su2_fill(NCPROT QLA_ColorMatrix(*m), QLA_Real r[4], int i, int j)
{
  QLA_Complex z;
  QLA_c_eq_r(z, 1);
  QLA_M_eq_c(m, &z);

  QLA_c_eq_r_plus_ir(z, r[0], r[3]);
  QLA_M_eq_elem_C(m, &z, i, i);

  QLA_c_eq_r_plus_ir(z, r[2], r[1]);
  QLA_M_eq_elem_C(m, &z, i, j);

  r[2] = -r[2];
  QLA_c_eq_r_plus_ir(z, r[2], r[1]);
  QLA_M_eq_elem_C(m, &z, j, i);

  r[3] = -r[3];
  QLA_c_eq_r_plus_ir(z, r[0], r[3]);
  QLA_M_eq_elem_C(m, &z, j, j);
}
Exemplo n.º 5
0
static void
make_herm(NCPROT QLA_ColorMatrix(*m), int idx, void *args)
{
  QLA_Complex tr;
  QLA_c_eq_r(tr, 0);
  for(int i=0; i<QLA_Nc; i++) {
    for(int j=i; j<QLA_Nc; j++) {
      QLA_Complex t1, t2;
      QLA_c_eq_c(t1, QLA_elem_M(*m,i,j));
      QLA_c_eq_c(t2, QLA_elem_M(*m,j,i));
      QLA_c_peq_ca(t1, t2);
      QLA_c_eq_r_times_c(t1, 0.5, t1);
      QLA_c_eq_c(QLA_elem_M(*m,i,j), t1);
      QLA_c_eq_ca(QLA_elem_M(*m,j,i), t1);
    }
    QLA_c_peq_c(tr, QLA_elem_M(*m,i,i));
  }
  QLA_c_eq_r_times_c(tr, 1./QLA_Nc, tr);
  for(int i=0; i<QLA_Nc; i++) {
    QLA_c_meq_c(QLA_elem_M(*m,i,i), tr);
  }
}
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);
} 
Exemplo n.º 7
0
/* 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;
}
static void
hb_func(NCPROT1 QLA_ColorMatrix(*m), int site)
{
  QLA_RandomState *srs = rs + site;
  if(QLA_Nc==1) { // exp(-fac*Re[u*z]) = exp(-fac*|z|*cos(t))
    // call Wensley heatbath
    QLA_Complex cc;
    QLA_Real r, phi, g, theta;

    // *m contains r*exp(i*phi), extract r and phi
    // extract QLA matrix element as complex number
    QLA_c_eq_c(cc, QLA_elem_M(*m,0,0));
    // get norm and arg
    QLA_R_eq_norm_C( &r, &cc );
    QLA_R_eq_arg_C( &phi, &cc );
    g = fac*r;

    // generate theta with probability P(theta)=exp( g*cos(theta) )
    get_hb1( &theta, g, srs );

    // convert to real and imag
    //QLA_Real vr = cos( theta - phi );
    //QLA_Real vi = sin( theta - phi );
    // assemble QLA complex number and set QLA U(1) matrix to this
    //QLA_c_eq_r_plus_i_r( QLA_elem_M(*m,0,0), vr, vi );
    QLA_elem_M(*m,0,0) = QLAP(cexpi)(theta - phi);
  } else {
    QLA_ColorMatrix(s);
    QLA_ColorMatrix(t);
    QLA_ColorMatrix(tt);
    QLA_Complex one;
    QLA_c_eq_r(one, 1);
    QLA_M_eq_c(&s, &one);

    /* Loop over SU(2) subgroup index */
    for(int i=0; i<QLA_Nc; i++) {
      for(int j=i+1; j<QLA_Nc; j++) {
	QLA_Real a[4], b[4], r[4], rn, rl;

	su2_extract(NCARG r, m, i, j);
	rn = sqrt( r[0]*r[0] + r[1]*r[1] + r[2]*r[2] + r[3]*r[3] );
	rl = fac*rn;
	if(rn<1e-10) {
	  a[0] = 1; a[1] = a[2] = a[3] = 0;
	} else {
	  rn = 1/rn;
	  a[0] =  rn*r[0];
	  a[1] = -rn*r[1];
	  a[2] = -rn*r[2];
	  a[3] = -rn*r[3];
	}

	get_hb2(b, rl, srs);
	//b[0] = 1; b[1] = b[2] = b[3] = 0;

	r[0] = b[0]*a[0] - b[1]*a[1] - b[2]*a[2] - b[3]*a[3];
	r[1] = b[0]*a[1] + b[1]*a[0] - b[2]*a[3] + b[3]*a[2];
	r[2] = b[0]*a[2] + b[2]*a[0] - b[3]*a[1] + b[1]*a[3];
	r[3] = b[0]*a[3] + b[3]*a[0] - b[1]*a[2] + b[2]*a[1];

	su2_fill(NCARG &t, r, i, j);
	QLA_M_eq_M_times_M(&tt, &t, &s);
	QLA_M_eq_M(&s, &tt);
	QLA_M_eq_M_times_M(&tt, &t, m);
	QLA_M_eq_M(m, &tt);
      }
    }
    QLA_M_eq_M(m, &s);
  }
}
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]);
  }
}
Exemplo n.º 11
0
void
set_M(QLA_ColorMatrix *m, int i)
{
#if 0
  static QLA_ColorMatrix t;
  for(int j=0; j<QLA_Nc; j++) {
    for(int k=0; k<QLA_Nc; k++) {
      QLA_c_eq_r_plus_ir(QLA_elem_M(*m,j,k),
			 (((j-k+QLA_Nc+1)*(j+k+1))%19)+cos(i),
			 (((j+4)*(k+1))%17)+sin(i));
      //QLA_real(QLA_elem_M(*m,j,k)) = 1;
      //QLA_imag(QLA_elem_M(*m,j,k)) = 0;
    }
  }
#endif
  for(int j=0; j<QLA_Nc; j++) {
    for(int k=0; k<QLA_Nc; k++) {
      QLA_c_eq_r(QLA_elem_M(*m,j,k), 0);
    }
  }
  QLA_Real step = 1e-5;
  if(Mtype&MtypeNZ) {
    for(int j=0; j<QLA_Nc; j++) {
      QLA_c_peq_r_plus_ir(QLA_elem_M(*m,j,j), step, -step);
    }
  }
  int ii=i;
  if((Mtype&MtypeNN)==0) ii>>=QLA_Nc;
  for(int j=0,k=1; ii; ii>>=1,j++) {
    if(j>=QLA_Nc) { j=0; k*=2; }
    if(ii&1) QLA_c_peq_r_plus_ir(QLA_elem_M(*m,j,j), k*step, -k*step);
  }
  ii = i;
  if((Mtype&MtypeNN)==0) {
    for(int j=0; j<QLA_Nc; j++) {
      if(ii&1) QLA_c_eqm_c(QLA_elem_M(*m,j,j), QLA_elem_M(*m,j,j));
      ii >>= 1;
    }
  }
  if(Mtype&MtypeH) { // make Hermitian
    QLA_ColorMatrix m2;
    QLA_M_eq_M(&m2, m);
    QLA_M_peq_Ma(&m2, m);
    QLA_M_eq_M(m, &m2);
  }
  if((Mtype&MtypeP)&&(Mtype&MtypeH)) { // make positive Hermitian
    QLA_ColorMatrix m2;
    QLA_M_eq_M_times_Ma(&m2, m, m);
    QLA_M_eq_M(m, &m2);
  }
  if(Mtype&MtypeA) { // make anti-Hermitian
    QLA_ColorMatrix m2;
    QLA_M_eq_M(&m2, m);
    QLA_M_meq_Ma(&m2, m);
    QLA_M_eq_M(m, &m2);
  }
  if((Mtype&MtypeT)&&(Mtype&MtypeA)) { // make traceless anti-Hermitian
    QLA_ColorMatrix m2;
    QLA_M_eq_antiherm_M(&m2, m);
    QLA_M_eq_M(m, &m2);
  }
  //QLA_Real n2;
  //QLA_r_eq_norm2_M(&n2, m);
  //printf("%i\t%g\n", i, n2);
}