// residues, roots and order define rational function approximation for
// x^(nf/8)
void grsource_imp_rhmc( field_offset dest, params_ratfunc *rf,
int parity, su3_vector **multi_x, su3_vector *sumvec,
Real my_rsqmin, int my_niter, int my_prec,
ferm_links_t *fn)
{
register int i,j;
register site *s;
Real final_rsq;
int order = rf->order;
Real *residues = rf->res;
Real *roots = rf->pole;
/*TEMP*/ double sum;
sum=0.0;
FORSOMEPARITY(i,s,parity){
for(j=0;j<3;j++){
#ifdef SITERAND
s->g_rand.c[j].real = gaussian_rand_no(&(s->site_prn));
s->g_rand.c[j].imag = gaussian_rand_no(&(s->site_prn));
#else
s->g_rand.c[j].real = gaussian_rand_no(&node_prn);
s->g_rand.c[j].imag = gaussian_rand_no(&node_prn);
#endif
}
/*TEMP*/ sum += (double)magsq_su3vec( &(s->g_rand) );
}
/*TEMP*/g_doublesum( &sum); node0_printf("GRSOURCE: sum = %.10e\n",sum);
ks_ratinv( F_OFFSET(g_rand), multi_x, roots, order, my_niter,
my_rsqmin, my_prec, parity, &final_rsq, fn );
ks_rateval( sumvec, F_OFFSET(g_rand), multi_x, residues, order, parity );
FORSOMEPARITY(i,s,parity){ *(su3_vector *)F_PT(s,dest) = sumvec[i]; }
static void chem_pot_print2(double MidM_MidM, int jpbp_reps, int npbp_reps,
Real mass){
g_doublesum( &MidM_MidM );
MidM_MidM = MidM_MidM*(1.0/(double)volume) ;
node0_printf("TR_MidM_MidM: mass %e, %e ( %d of %d )\n", mass,
MidM_MidM, jpbp_reps+1, npbp_reps);
}
/* The Fermilab relative residue */
static Real my_relative_residue(su3_vector *p, su3_vector *q, int parity){
register int i;
double residue, num, den;
residue = (double)0.0;
FORSOMEFIELDPARITY_OMP(i, parity, private(num,den) reduction(+:residue)){
num = (double)magsq_su3vec(p+i);
den = (double)magsq_su3vec(q+i);
residue += (den==0) ? 1.0 : (num/den);
} END_LOOP_OMP
g_doublesum(&residue);
if(parity == EVENANDODD)
return sqrt(residue/volume);
else
return sqrt(2*residue/volume);
}
void hvy_pot(int do_det) {
register int i;
register site *s;
int t_dist, x_dist;
double wloop;
complex tc;
matrix tmat, tmat2;
msg_tag *mtag = NULL;
node0_printf("hvy_pot: MAX_T = %d, MAX_X = %d\n", MAX_T, MAX_X);
// Use staple to hold product of t_dist links at each point
for (t_dist = 1; t_dist <= MAX_T; t_dist++) {
if (t_dist == 1) {
FORALLSITES(i, s)
mat_copy(&(s->link[TUP]), &(staple[i]));
}
else {
mtag = start_gather_field(staple, sizeof(matrix),
goffset[TUP], EVENANDODD, gen_pt[0]);
// Be careful about overwriting staple;
// gen_pt may just point to it for on-node "gathers"
wait_gather(mtag);
FORALLSITES(i, s)
mult_nn(&(s->link[TUP]), (matrix *)gen_pt[0][i], &(tempmat2[i]));
cleanup_gather(mtag);
FORALLSITES(i, s)
mat_copy(&(tempmat2[i]), &(staple[i]));
}
// Copy staple to tempmat
// Will shoft at end of loop
FORALLSITES(i, s)
mat_copy(&(staple[i]), &(tempmat[i]));
for (x_dist = 0; x_dist <= MAX_X; x_dist++) {
// Evaluate potential at this separation
wloop = 0.0;
FORALLSITES(i, s) {
// Compute the actual Coulomb gauge Wilson loop product
mult_na(&(staple[i]), &(tempmat[i]), &tmat);
if (do_det == 1)
det_project(&tmat, &tmat2);
else
mat_copy(&tmat, &tmat2);
tc = trace(&tmat2);
wloop += tc.real;
}
g_doublesum(&wloop);
if (do_det == 1) { // Braces fix compiler error
node0_printf("D_LOOP ");
}
else
node0_printf("POT_LOOP ");
node0_printf("%d %d %.6g\n", x_dist, t_dist, wloop / volume);
// As we increment x, shift in x direction
shiftmat(tempmat, tempmat2, goffset[XUP]);
} // x_dist
} // t_dist
int
ks_congrad_parity_cpu( su3_vector *t_src, su3_vector *t_dest,
quark_invert_control *qic, Real mass,
imp_ferm_links_t *fn){
register int i;
register site *s;
int iteration; /* counter for iterations */
Real a,b; /* Sugar's a,b */
#ifdef FEWSUMS
double actual_rsq = 999.; /* rsq from actual summation of resid */
double c_tr,c_tt,tempsum[4]; /* Re<resid|ttt>, <ttt|ttt> */
#endif
double rsq = 0,relrsq = 1.; /* resid**2, rel resid*2 */
double oldrsq,pkp; /*last resid*2,pkp = cg_p.K.cg_p */
Real msq_x4; /* 4*mass*mass */
double source_norm; /* squared magnitude of source vector */
int otherparity = 0; /* the other parity */
msg_tag * tags1[16], *tags2[16]; /* tags for gathers to parity and opposite */
int special_started = 0; /* 1 if dslash_fn_field_special has been called */
int nrestart; /* Restart counter */
su3_vector *ttt, *cg_p, *resid;
#ifdef CGTIME
double nflop = 1187;
#endif
double dtimec;
char myname[] = "ks_congrad_parity_cpu";
/* Unpack structure */
int niter = qic->max; /* maximum number of iters per restart */
int max_restarts = qic->nrestart; /* maximum restarts */
Real rsqmin = qic->resid * qic->resid; /* desired residual -
normalized as sqrt(r*r)/sqrt(src_e*src_e) */
Real relrsqmin = qic->relresid * qic->relresid; /* desired relative residual (FNAL)*/
int parity = qic->parity; /* EVEN, ODD */
int max_cg = max_restarts*niter; /* Maximum number of iterations */
if(fn == NULL){
printf("%s(%d): Called with NULL fn\n", myname, this_node);
terminate(1);
}
dtimec = -dclock();
msq_x4 = 4.0*mass*mass;
switch(parity){
case(EVEN): otherparity=ODD; break;
case(ODD): otherparity=EVEN; break;
}
/* Source norm */
source_norm = 0.0;
FORSOMEFIELDPARITY_OMP(i,parity,reduction(+:source_norm)){
source_norm += (double)magsq_su3vec( &t_src[i] );
} END_LOOP_OMP
g_doublesum( &source_norm );
#ifdef CG_DEBUG
node0_printf("congrad: source_norm = %e\n", (double)source_norm);
#endif
/* Start CG iterations */
nrestart = 0;
iteration = 0;
qic->size_r = 0;
qic->size_relr = 1.;
qic->final_iters = 0;
qic->final_restart = 0;
qic->converged = 1;
qic->final_rsq = 0.;
qic->final_relrsq = 0.;
/* Provision for trivial solution */
if(source_norm == 0.0){
/* Zero the solution, free space, and return zero iterations */
FORSOMEFIELDPARITY_OMP(i,parity,default(shared)){
memset(t_dest + i, 0, sizeof(su3_vector));
} END_LOOP_OMP
dtimec += dclock();
#ifdef CGTIME
if(this_node==0){
printf("CONGRAD5: time = %e (fn %s) masses = 1 iters = %d mflops = %e\n",
dtimec, prec_label[PRECISION-1], qic->final_iters,
((double)nflop*volume*qic->final_iters)/(1.0e6*dtimec*numnodes()) );
fflush(stdout);}
#endif
return 0;
}
/* Assume the first Nvecs_curr eigenvectors have been already orthonormalized.
If norm of an eigenvector is less than ORTHO_EPS, remove it.
Rturn the number of new eigenvectors to be added.
*/
static int orthogonalize(int Nvecs, int Nvecs_curr, su3_vector **eigVec, int parity){
register int i;
int j, k, Nvecs_add, n;
double norm;
double_complex cc;
double_complex *c;
j = Nvecs_curr;
Nvecs_add = Nvecs;
n = Nvecs_curr + Nvecs_add;
c = (double_complex *)malloc(n*sizeof(double_complex));
while(j < n){
/* Modified Gram-Schmidt
Orthogonality is better but more communications are needed */
for(k = 0; k < j; k++){
// c[k] = dcmplx((double)0.0,(double)0.0);
// FORSOMEFIELDPARITY_OMP(i, parity, private(cc) reduction(+:c[k])){
// cc = su3_dot(eigVec[k]+i, eigVec[j]+i);
// CSUM(c[k], cc);
// } END_LOOP_OMP;
double cctotr=0., cctoti=0.;
FORSOMEFIELDPARITY_OMP(i, parity, private(cc) reduction(+:cctotr,cctoti)){
cc = su3_dot(eigVec[k]+i, eigVec[j]+i);
cctotr += cc.real;
cctoti += cc.imag;
} END_LOOP_OMP;
c[k].real = cctotr;
c[k].imag = cctoti;
g_dcomplexsum(c+k);
FORSOMEFIELDPARITY_OMP(i, parity, default(shared)){
c_scalar_mult_sub_su3vec(eigVec[j]+i, c+k, eigVec[k]+i);
} END_LOOP_OMP
}
/* Gram-Schmidt
Less communications but
poor orthogonality might happen if the number of vectors is too large. */
/*
for(k = 0; k < j; k++){
c[k] = dcmplx((double)0.0,(double)0.0);
FORSOMEFIELDPARITY_OMP(i, parity, private(cc) reduction(+:c[k])){
cc = su3_dot(eigVec[k]+i, eigVec[j]+i);
CSUM(c[k], cc);
} END_LOOP_OMP
}
g_vecdcomplexsum(c, j);
for(k = 0; k < j; k++){
FORSOMEFIELDPARITY_OMP(i, parity, default(shared)){
c_scalar_mult_sub_su3vec(eigVec[j]+i, c+k, eigVec[k]+i);
} END_LOOP_OMP
}
*/
norm = (double)0.0;
FORSOMEFIELDPARITY_OMP(i, parity, reduction(+:norm)){
norm += magsq_su3vec(eigVec[j]+i);
} END_LOOP_OMP
g_doublesum(&norm);
norm = sqrt(norm);
if( norm < ORTHO_EPS ){
Nvecs_add--;
n--;
for(k = j; k < n; k++){
FORSOMEFIELDPARITY_OMP(i, parity, default(shared)){
eigVec[k][i] = eigVec[k+1][i];
} END_LOOP_OMP
}
}
else{
void f_meas_imp_field( int npbp_reps, quark_invert_control *qic, Real mass,
int naik_term_epsilon_index, fermion_links_t *fl){
imp_ferm_links_t* fn = get_fm_links(fl)[naik_term_epsilon_index];
#ifdef DM_DU0
imp_ferm_links_t* fn_du0 = get_fm_du0_links(fl)[naik_term_epsilon_index];
#endif
#if ( FERM_ACTION == HISQ || FERM_ACTION == HYPISQ ) & defined(DM_DEPS)
imp_ferm_links_t *fn_deps = get_fn_deps_links(fl);
#endif
Real r_psi_bar_psi_even, i_psi_bar_psi_even;
Real r_psi_bar_psi_odd, i_psi_bar_psi_odd;
Real r_ferm_action;
/* local variables for accumulators */
register int i;
double rfaction;
double_complex pbp_e, pbp_o;
complex cc;
int jpbp_reps;
su3_vector *gr = NULL;
su3_vector *M_gr = NULL;
su3_vector *M_inv_gr = NULL;
#ifdef DM_DU0
double r_pb_dMdu_p_even, r_pb_dMdu_p_odd;
su3_vector *dMdu_x = NULL;
#endif
#if ( FERM_ACTION == HISQ || FERM_ACTION == HYPISQ ) & defined(DM_DEPS)
double r_pb_dMdeps_p_even, r_pb_dMdeps_p_odd;
su3_vector *dMdeps_x = NULL;
#endif
#ifdef CHEM_POT
double_complex pb_dMdmu_p_e, pb_dMdmu_p_o;
double_complex pb_d2Mdmu2_p_e, pb_d2Mdmu2_p_o;
double MidM_MidM;
su3_vector *dM_M_inv_gr = NULL;
su3_vector *d2M_M_inv_gr = NULL;
su3_vector *M_inv_dM_M_inv_gr = NULL;
su3_vector *dM_M_inv_dM_M_inv_gr = NULL;
#endif
/* Loop over random sources */
for(jpbp_reps = 0; jpbp_reps < npbp_reps; jpbp_reps++){
rfaction = (double)0.0;
pbp_e = pbp_o = dcmplx((double)0.0,(double)0.0);
/* Make random source, and do inversion */
/* generate gr random; M_gr = M gr */
gr = create_v_field();
#ifndef Z2RSOURCE
grsource_plain_field( gr, EVENANDODD );
#else
z2rsource_plain_field( gr, EVENANDODD );
#endif
/* The following operation is done in the prevailing
precision. The algorithm needs to be fixed! */
M_gr = create_v_field();
ks_dirac_adj_op( gr, M_gr, mass, EVENANDODD, fn );
/* M_inv_gr = M^{-1} gr */
M_inv_gr = create_v_field();
mat_invert_uml_field( gr, M_inv_gr, qic, mass, fn );
#ifdef DM_DU0
r_pb_dMdu_p_even = r_pb_dMdu_p_odd = (double)0.0;
/* dMdu_x = dM/du0 M^{-1} gr */
dMdu_x = create_v_field();
dslash_fn_field( M_inv_gr, dMdu_x, EVENANDODD, fn_du0 );
#endif
#if ( FERM_ACTION == HISQ || FERM_ACTION == HYPISQ ) & defined(DM_DEPS)
r_pb_dMdeps_p_even = r_pb_dMdeps_p_odd = (double)0.0;
/* dMdeps_x = dM/deps0 M^{-1} gr */
dMdeps_x = create_v_field();
dslash_fn_field( M_inv_gr, dMdeps_x, EVENANDODD, fn_deps );
#endif
#ifdef CHEM_POT
pb_dMdmu_p_e = pb_dMdmu_p_o = dcmplx((double)0.0,(double)0.0);
pb_d2Mdmu2_p_e = pb_d2Mdmu2_p_o = dcmplx((double)0.0,(double)0.0);
/* dM_M_inv_gr = dM/dmu * M_inv_gr */
/* d2M_M_inv_gr = d2M/dmu2 * M_inv_gr */
dM_M_inv_gr = create_v_field();
chem_pot_tshift(fn, dM_M_inv_gr, M_inv_gr, 3., -1.);
d2M_M_inv_gr = create_v_field();
chem_pot_tshift(fn, d2M_M_inv_gr, M_inv_gr, 9., 1.);
#endif
/* fermion action = M_gr.M_inv_gr */
/* psi-bar-psi on even sites = gr.M_inv_gr */
FOREVENFIELDSITES(i){
rfaction += su3_rdot( M_gr+i, M_inv_gr+i );
cc = su3_dot( gr+i, M_inv_gr+i );
CSUM(pbp_e, cc);
#ifdef DM_DU0
/* r_pb_dMdu_p_even = gr * dM/du0 M^{-1} gr |even*/
r_pb_dMdu_p_even += su3_rdot( gr+i, dMdu_x+i );
#endif
#if ( FERM_ACTION == HISQ || FERM_ACTION == HYPISQ ) & defined(DM_DEPS)
/* r_pb_dMdu_p_even = gr * dM/du0 M^{-1} gr |even*/
r_pb_dMdeps_p_even += su3_rdot( gr+i, dMdeps_x+i );
#endif
#ifdef CHEM_POT
/* Compute pb_dMdmu_p, pb_d2Mdmu2_p and dM_M_inv on even sites */
cc = su3_dot( gr+i, dM_M_inv_gr+i);
CSUM(pb_dMdmu_p_e, cc);
cc = su3_dot( gr+i, d2M_M_inv_gr+i);
CSUM(pb_d2Mdmu2_p_e, cc);
#endif
}
/* psi-bar-psi on odd sites */
FORODDFIELDSITES(i){
cc = su3_dot( gr+i, M_inv_gr+i );
CSUM(pbp_o, cc);
#ifdef DM_DU0
/* r_pb_dMdu_p_odd = gr * dM/du0 M^{-1} gr |odd*/
r_pb_dMdu_p_odd += su3_rdot( gr+i, dMdu_x+i );
#endif
#if ( FERM_ACTION == HISQ || FERM_ACTION == HYPISQ ) & defined(DM_DEPS)
/* r_pb_dMdu_p_odd = gr * dM/du0 M^{-1} gr |odd*/
r_pb_dMdeps_p_odd += su3_rdot( gr+i, dMdeps_x+i );
#endif
#ifdef CHEM_POT
/* Compute pb_dMdmu_P, pb_d2Mdmu2_p and dM_M_inv on odd sites */
cc = su3_dot( gr+i, dM_M_inv_gr+i);
CSUM(pb_dMdmu_p_o, cc);
cc = su3_dot( gr+i, d2M_M_inv_gr+i);
CSUM(pb_d2Mdmu2_p_o, cc);
#endif
}
#ifdef CHEM_POT
destroy_v_field(d2M_M_inv_gr); d2M_M_inv_gr = NULL;
#endif
destroy_v_field(M_gr); M_gr = NULL;
g_dcomplexsum( &pbp_o );
g_dcomplexsum( &pbp_e );
g_doublesum( &rfaction );
#ifdef DM_DU0
destroy_v_field( dMdu_x ); dMdu_x = NULL;
g_doublesum( &r_pb_dMdu_p_even );
g_doublesum( &r_pb_dMdu_p_odd );
r_pb_dMdu_p_even *= (2.0/(double)volume);
r_pb_dMdu_p_odd *= (2.0/(double)volume);
node0_printf("PB_DMDU_P: mass %e %e %e ( %d of %d )\n", mass,
r_pb_dMdu_p_even, r_pb_dMdu_p_odd, jpbp_reps+1, npbp_reps);
#endif
#if ( FERM_ACTION == HISQ || FERM_ACTION == HYPISQ ) & defined(DM_DEPS)
destroy_v_field( dMdeps_x ); dMdeps_x = NULL;
g_doublesum( &r_pb_dMdeps_p_even );
g_doublesum( &r_pb_dMdeps_p_odd );
r_pb_dMdeps_p_even *= (2.0/(double)volume);
r_pb_dMdeps_p_odd *= (2.0/(double)volume);
node0_printf("PB_DMDEPS_P: mass %e %e %e ( %d of %d )\n", mass,
r_pb_dMdeps_p_even, r_pb_dMdeps_p_odd, jpbp_reps+1, npbp_reps);
#endif
r_psi_bar_psi_odd = pbp_o.real*(2.0/(double)volume) ;
i_psi_bar_psi_odd = pbp_o.imag*(2.0/(double)volume) ;
r_psi_bar_psi_even = pbp_e.real*(2.0/(double)volume) ;
i_psi_bar_psi_even = pbp_e.imag*(2.0/(double)volume) ;
r_ferm_action = rfaction*(1.0/(double)volume) ;
node0_printf("PBP: mass %e %e %e %e %e ( %d of %d )\n", mass,
r_psi_bar_psi_even, r_psi_bar_psi_odd,
i_psi_bar_psi_even, i_psi_bar_psi_odd,
jpbp_reps+1, npbp_reps);
node0_printf("FACTION: mass = %e, %e ( %d of %d )\n", mass,
r_ferm_action, jpbp_reps+1, npbp_reps);
#ifdef CHEM_POT
/* Print results for pb_dMdmu_p and pb_d2Mdmu2_p */
chem_pot_print1(pb_dMdmu_p_e, pb_dMdmu_p_o, pb_d2Mdmu2_p_e, pb_d2Mdmu2_p_o,
mass, jpbp_reps, npbp_reps);
#endif
#ifdef TR_MM_INV
if(npbp_reps > 1){
su3_vector *MM_inv_gr = create_v_field();
double pbp_pbp = 0.0;
mat_invert_uml_field( M_inv_gr, MM_inv_gr, qic, mass, fn );
FORALLFIELDSITES(i){
pbp_pbp += su3_rdot( gr+i, MM_inv_gr+i );
}
g_doublesum( &pbp_pbp );
pbp_pbp = pbp_pbp*(1.0/(double)volume) ;
node0_printf("TR_MM_INV: mass %e, %e ( %d of %d )\n", mass,
pbp_pbp, jpbp_reps+1, npbp_reps);
destroy_v_field(MM_inv_gr);
}
#endif
destroy_v_field(M_inv_gr); M_inv_gr = NULL;
#ifdef CHEM_POT
/* M_inv_dM_M_inv_gr = M^{-1} dM_M_inv_gr */
M_inv_dM_M_inv_gr = create_v_field();
mat_invert_uml_field( dM_M_inv_gr, M_inv_dM_M_inv_gr, qic, mass, fn );
destroy_v_field(dM_M_inv_gr); dM_M_inv_gr = NULL;
/* dM_M_inv_dM_M_inv_gr = dM/dmu M_inv_dM_M_inv_gr */
dM_M_inv_dM_M_inv_gr = create_v_field();
chem_pot_tshift(fn, dM_M_inv_dM_M_inv_gr, M_inv_dM_M_inv_gr, 3., -1.);
destroy_v_field(M_inv_dM_M_inv_gr); M_inv_dM_M_inv_gr = NULL;
/* Compute MidM_MidM */
MidM_MidM = (double)0.0;
FORALLFIELDSITES(i){
MidM_MidM += su3_rdot( gr+i, dM_M_inv_dM_M_inv_gr+i);
}
destroy_v_field(dM_M_inv_dM_M_inv_gr); dM_M_inv_dM_M_inv_gr = NULL;
chem_pot_print2(MidM_MidM, jpbp_reps, npbp_reps, mass);
#endif
destroy_v_field(gr); gr = NULL;
} /* jpbp_reps */
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) );
}
}
