void w_source_sf_site(field_offset src, wilson_quark_source *wqs)
{
register int i,j;
register site *s;
msg_tag *tag0;
int color, spin, source_type;
Real Kappa;
/* Unpack structure */
color = wqs->color;
spin = wqs->spin;
source_type = wqs->type;
Kappa = wqs->r0;
/*printf("WSOURCE: source = %d\n",source); */
/* zero src to be safe */
FORALLSITES(i,s) {
clear_wvec((wilson_vector *)F_PT(s,src));
}
void smeared_sequential_source(field_offset ans,
field_offset hqet_prop,
int tB, int v_pt)
{
complex z_tmp ;
register int i;
int j;
register site *s;
complex phase_fact ;
double theta ;
double fact = 2.0*PI/(1.0*nx) ;
int sink_spin ;
wilson_vector gammafive_quark ;
Real scale =1.0/((Real) nx*ny*nz ) ;
double t_total , t_hqet , t_smear ;
/********** ----------------------------------------*********/
t_total = dclock() ;
/**** use the input quark propagator as the source ***/
FORALLSITES(i,s)
{
if( s->t == tB)
{
mult_by_gamma((wilson_vector *)F_PT(s,ans),
&gammafive_quark , GAMMAFIVE );
*((wilson_vector *)F_PT(s,ans)) = gammafive_quark ;
}
else
{
clear_wvec((wilson_vector *)F_PT(s,ans));
}
}
t_hqet = dclock() ;
/*** generate the HQET propagator over all space ****/
for(sink_spin = 0 ; sink_spin < 4 ; ++sink_spin )
{
/*** create the source for the HQET inversion ********/
wilson_vector_hqet_src(hqet_prop , ans, sink_spin, tB) ;
/**** generate the HQET propagator *****/
evolve_hqet_forwards_and_backwards(hqet_prop,tB, v_pt);
/***** put the HQET propagator in the correct part of the propagator ***/
get_wilson_vector_from_hqet_prop(ans , hqet_prop, sink_spin);
} /*** end of the loop over sink_spin ****/
IF_VERBOSE_ON(1)
printf("smeared_sequential_source::Time for HQET inversion = %g sec\n",dclock() - t_hqet );
/*** multiply the (1 + i v_slash)/2 operator into the propagator ***/
apply_hqet_proj(ans, v_pt) ;
IF_VERBOSE_ON(1)
printf("smeared_sequential_source::Total time for HQET sequential inversion = %g sec\n",dclock() - t_total );
} /*** end of the HQET sequential source function *****/
void calc_smeared_meson(complex *meson,
field_offset quark,field_offset quark_smear,
int colour, int spin)
{
int ismear ;
wilson_vector prod ;
int ic,ispin ;
int i ;
int t;
register site *s ;
wilson_vector *smear_qrk_origin ;
Real ts,te ;
/****..................................................**/
ts = dclock();
if( (smear_qrk_origin = (wilson_vector *) calloc( (size_t) nt, sizeof(wilson_vector) ) ) == NULL )
{
printf("ERROR: could not reserve space in calc_smeared_meson\n");
terminate(1);
}
/**** complex conjugate the quark propagator ****/
dagger_quark_prop(quark_smear , quark);
for(ismear=0 ; ismear < nosmear ; ++ismear)
{
/*** smear the light quark *************/
for(t=0 ;t < nt ;++t)
clear_wvec(&smear_qrk_origin[t]);
FORALLSITES(i,s)
{
c_scalar_mult_add_wvec(&smear_qrk_origin[s->t], (wilson_vector *)F_PT(s,quark_smear) ,
&s->smear_func[ismear] ,&smear_qrk_origin[s->t]) ;
}
/*** sum up the smeared quark propagator at the origin over all the nodes *******/
g_veccomplexsum(&(smear_qrk_origin[0].d[0].c[0]), nt*12 );
/** calculate the smeared meson operator ****/
FORALLSITES(i,s)
{
if( s->x == 0 && s->y == 0 && s->z == 0 )
{
mult_wilson_vec_matdag(&prod,&smear_qrk_origin[s->t],&(s->w_line));
t = s->t ;
for(ispin = 0 ; ispin < 4 ;++ispin)
for(ic=0 ; ic < 3 ;++ic)
{
CADD(*(meson + MESON_WHERE ),prod.d[ispin].c[ic] , *(meson + MESON_WHERE ));
}
} /** end the loop over the spatial origin ***/
} /** end the loop over sites *****/
} /** end of the loop over the smearing functions ***/
void zv_meas(
field_offset src1, /* src1 is type wilson_propagator (forward) */
field_offset src2, /* src2 is type wilson_propagator (backward) */
Real *f_1, complex *f_V, Real Kappa)
{
register int i;
register site *s;
int my_t, src_s, src_c, si, ci;
Real ftmp;
complex cc;
half_wilson_vector hwv1, hwv2;
wilson_vector *K_prop[3][4], *K_tmp, wv1, wtmp;
for(ci=0;ci<3;ci++) for(si=0;si<4;si++){
K_prop[ci][si] = (wilson_vector *)malloc(sizeof(wilson_vector));
}
K_tmp = (wilson_vector *)malloc(sizeof(wilson_vector));
/* Construct K, gamma_5*K and f_1 */
ftmp = Kappa / (Real)(nx*ny*nz);
*f_1 = 0.0;
for(src_c=0;src_c<3;src_c++) for(src_s=0;src_s<4;src_s++){
clear_wvec( K_tmp);
FORALLSITES(i,s) if(s->t == (nt-1)){
wp_shrink(
&(((wilson_propagator *)F_PT(s,src1))->c[src_c].d[src_s]),
&hwv1, TUP, MINUS);
mult_adj_su3_mat_hwvec( &(s->link[TUP]), &hwv1, &hwv2);
wp_grow_add( &hwv2, K_tmp, TUP, MINUS);
}
g_wvectorsumfloat( K_tmp);
scalar_mult_wvec( K_tmp, ftmp, K_tmp);
*f_1 += magsq_wvec( K_tmp);
mult_by_gamma( K_tmp, K_prop[src_c][src_s], GAMMAFIVE);
}
*f_1 /= 8.0*Kappa*Kappa;
FORALLSITES(i,s) if(s->t > 0){
my_t = s->t;
for(src_c=0;src_c<3;src_c++) for(src_s=0;src_s<4;src_s++){
/* K_tmp = src2 * gamma_5 * K_prop */
clear_wvec( K_tmp);
for(ci=0;ci<3;ci++) for(si=0;si<4;si++){
c_scalar_mult_add_wvec( K_tmp,
&(((wilson_propagator *)F_PT(s,src2))->c[ci].d[si]),
&K_prop[src_c][src_s]->d[si].c[ci], K_tmp);
/* &((wilson_vector *)(K_prop[src_c][src_s])->d[si].c[ci]), K_tmp); */
/* K_prop[src_c][src_s]->d[si].c[ci], K_tmp); */
}
/* wv1 = gamma_5 * gamma_0 * src1 */
mult_by_gamma(
&(((wilson_propagator *)F_PT(s,src1))->c[src_c].d[src_s]),
&wtmp, TUP);
mult_by_gamma( &wtmp, &wv1, GAMMAFIVE);
/* Now construct f_V */
/* gamma_0 is negative of usual chiral basis */
cc = wvec2_dot( K_tmp, &wv1);
f_V[my_t].real -= cc.real;
f_V[my_t].imag -= cc.imag;
}
}
/* Normalize f_V */
ftmp = 4.0 * Kappa;
for(my_t=0; my_t<nt; my_t++){
f_V[my_t].real /= ftmp;
f_V[my_t].imag /= ftmp;
}
for(ci=0;ci<3;ci++) for(si=0;si<4;si++){
free(K_prop[ci][si]);
}
free(K_tmp);
} /* zv_meas */
int congrad_xxx(
field_offset src, /* type wilson_vector (where source is to be created)*/
Real cgmass, /* unused here*/
int source_chirality /* chirality sector for inversion (NOT USED) */
)
{
register int i;
register site *s;
int j,k, avs_iters, avm_iters,status,flag;
int MaxCG;
int ksource, spin,color,my_chirality,chb,che,chbo,cheo,ii,jj;
Real *RsdCG;
Real size_r,one_minus_m,r02inv;
wilson_vector **psim;
void setup_multi();
w_prop_file *fp_out_w[MAX_MASSES]; /* For propagator files */
w_prop_file *fp_in_w[MAX_MASSES]; /* For propagator files */
w_prop_file *h0_out_w[MAX_MASSES]; /* For intermediate propagator files */
#ifdef EIGO
wilson_vector wproj;
complex ctmp,cd,*cproj;
int l;
int icount, ivec;
int *chiral_check;
Real cdp, cdm;
Real *ca, *cb;
Real eps, mu, denom;
#endif
double source_norm;
RsdCG=resid;
MaxCG=niter;
avs_iters=0;
r02inv= -0.5/R0;
#ifdef MINN
do_minn=1;
#endif
setup_multi();
#ifdef EIGO
if(Nvecs_hov != 0)cproj = (complex *)malloc(Nvecs_hov*sizeof(complex));
/* check chirality of your modes (to identify zero modes) */
if(Nvecs_hov != 0)chiral_check= (int *)malloc(Nvecs_hov*sizeof(int));
for(j=0;j<Nvecs_hov;j++){
cdp=0.0;
cdm=0.0;
FORALLSITES(i,s){
for(l=0;l<2;l++)for(k=0;k<3;k++){
cdp += cabs_sq(&(eigVec[j][i].d[l].c[k]));
}
for(l=2;l<4;l++)for(k=0;k<3;k++){
cdm += cabs_sq(&(eigVec[j][i].d[l].c[k]));
}
}
g_floatsum(&cdp);
g_floatsum(&cdm);
if(cdm< 1.e-6 && cdp >1.e-6)
chiral_check[j] =1;
else if (cdm >1.e-6 && cdp < 1.e-6)
chiral_check[j] = -1;
else if (cdm >1.e-6 && cdp > 1.e-6)
chiral_check[j] =0;
else{
node0_printf("eigVec0[%d] is a null vector!\n",j);
exit(1);
}
}
/* the mode propagator matrix */
/* I am stupid--how to do this in a 2-d array?? */
if(Nvecs_hov != 0){
ca= (Real *)malloc(num_masses*Nvecs_hov*sizeof(Real));
cb= (Real *)malloc(num_masses*Nvecs_hov*sizeof(Real));
}
/* initialize the coefficients of the propagator matrix for modes */
for(k=0;k<num_masses;k++)for(ivec=0;ivec<Nvecs_hov;ivec++){
icount=Nvecs_hov*k + ivec;
if(chiral_check[ivec]==0){
mu=mass[k]/(2.0*R0);
eps= sqrt(eigVal[ivec])/(2.0*R0);
denom= (mu*mu+eps*eps*(1.0-mu*mu))*2.0*R0;
ca[icount]= mu*(1.0-eps*eps)/denom;
cb[icount]= eps*sqrt(1.0-eps*eps)/denom;
}
else{
ca[icount]= 1.0/mass[k];
cb[icount]= 0.0;
}
node0_printf("mass %e mode %d %d %e %e\n",mass[k],ivec,
chiral_check[ivec],ca[icount],cb[icount]);
}
#endif
/* open the prop files */
for(k=0;k<num_masses;k++){
fp_in_w[k] = r_open_wprop(startflag_w[k], startfile_w[k]);
fp_out_w[k] = w_open_wprop(saveflag_w[k], savefile_w[k], wqs.type);
#ifdef H0INV
h0_out_w[k] = w_open_wprop(saveflag_w3[k], savefile_w3[k], wqs.type);
#endif
}
for(ksource = 0; ksource < wqs.nsource; ksource++){
spin = convert_ksource_to_spin(ksource);
color = convert_ksource_to_color(ksource);
// /* Loop over source spins */
// for(spin=0;spin<4;spin++){
// /* Loop over source colors */
// for(color=0;color<3;color++){
node0_printf("Propagator color %d spin %d\n",color,spin);
if(startflag_w[0] == FRESH){flag=0;}
else{
/* check if there's a propagator already there--Do for all masses */
flag=1;
for(k=0;k<num_masses && flag==1 ;k++){
#ifdef IOTIME
status = reload_wprop_sc_to_site( startflag_w[k], fp_in_w[k],
&wqs, spin, color, F_OFFSET(psi),1);
#else
status = reload_wprop_sc_to_site( startflag_w[k], fp_in_w[k],
&wqs, spin, color, F_OFFSET(psi),0);
#endif
if(status != 0){
node0_printf("congrad_outer_p: computing prop\n");
/*
reload_wprop_sc_to_site( FRESH, fp_in_w[k],
&wqs, spin, color, F_OFFSET(psi),0);
*/
flag = 0;
}
else{ /* status = 1--put the propagator in the new output file
so all the elements are in one place. This will fail if
the propagator generation did not write the same number of elements
for each mass value propagator */
#ifdef IOTIME
save_wprop_sc_from_site( saveflag_w[k],fp_out_w[k],
&wqs, spin,color,F_OFFSET(psi),1);
#else
save_wprop_sc_from_site( saveflag_w[k],fp_out_w[k],
&wqs, spin,color,F_OFFSET(psi),0);
#endif
}
} /* k loop */
} /*startflag_w != FRESH */
if(flag==0){ /* proceed to inversion */
if(spin<2){my_chirality=1;chb=0;che=2;chbo=2;cheo=4;}
else {my_chirality= -1;chb=2,che=4;chbo=0;cheo=2;}
chirality_flag=my_chirality;
/* Make source */
/* Complete the source structure */
/* NEEDS FIXING!! */
// wqs.color = color;
// wqs.spin = spin;
/* For wilson_info */
wqstmp = wqs;
// status = w_source_site(src,&wqs);
status = wv_source_site(src,&wqs);
/* check original source size... */
source_norm=0.0;
FORALLSITES(i,s){
source_norm += (double)magsq_wvec(((wilson_vector *)F_PT(s,src)) );
}
g_doublesum( &source_norm );
if(this_node==0){
printf("Original: source_norm = %e\n",source_norm);
fflush(stdout);
}
FORALLSITES(i,s) copy_wvec((wilson_vector *)F_PT(s,src),&(s->chi0));
#ifdef EIGO
/* project out the eigenvectors from the source */
node0_printf("removing %d modes from source\n",Nvecs_hov);
for(j=0;j<Nvecs_hov;j++){
cd=cmplx(0.0,0.0);
FORALLSITES(i,s){
/* wproj will hold the chiral projections--
recall we have ``packed'' two chiralities into eigVec */
clear_wvec(&wproj);
for(ii=chb;ii<che;ii++)for(jj=0;jj<3;jj++){
wproj.d[ii].c[jj]=eigVec[j][i].d[ii].c[jj];
}
ctmp = wvec_dot( &(wproj),(wilson_vector *)F_PT(s,src));
CSUM(cd,ctmp);
}
g_complexsum(&cd);
cproj[j]=cd;
node0_printf("projector %d %e %e\n",j,cproj[j].real,cproj[j].imag);
CMULREAL(cd,-1.0,cd);
FORALLSITES(i,s){
clear_wvec(&wproj);
for(ii=chb;ii<che;ii++)for(jj=0;jj<3;jj++){
wproj.d[ii].c[jj]=eigVec[j][i].d[ii].c[jj];
}
c_scalar_mult_add_wvec(&(s->chi0), &(wproj),
&cd, &(s->chi0) );
}
}
