void copy_site_wilson_vector(field_offset src, field_offset dest)
{
int i ;
register site *s;
/****** --------------------------------------------------*****/
FORALLSITES(i,s)
{
copy_wvec( (wilson_vector *)F_PT(s,src) , (wilson_vector *)F_PT(s,dest) ) ;
}
int bicgilu_cl_field_cpu( /* Return value is number of iterations taken */
wilson_vector *src, /* type wilson_vector (source vector - OVERWRITTEN!)*/
wilson_vector *dest, /* type wilson_vector (answer and initial guess )*/
quark_invert_control *qic, /* parameters controlling inversion */
void *dmp /* parameters defining the Dirac matrix */
)
{
/* Unpack required members of the structures */
int max_restarts = qic->nrestart; /* Number of restarts */
int nrestart = 0;
int restart = qic->max; /* Restart interval */
int MaxCG = restart*qic->max; /* maximum number of iterations */
Real RsdCG = qic->resid * qic->resid; /* desired residual -
normalized as (r*r)/(src_e*src_e) */
Real RRsdCG = qic->relresid * qic->relresid; /* desired relative residual - */
int flag = qic->start_flag; /* 0: use a zero initial guess;
1: use dest */
dirac_clover_param *dcp
= (dirac_clover_param *)dmp; /* Cast pass-through pointer */
Real Kappa = dcp->Kappa; /* hopping */
Real Clov_c = dcp->Clov_c; /* Perturbative clover coeff */
Real U0 = dcp->U0; /* Tadpole correction to Clov_c */
/* End of unpacking required members of structures */
wilson_vector *tmp=NULL,*mp=NULL,*rv=NULL,*sss=NULL,*r=NULL,
*p=NULL,*ttt=NULL;
int N_iter;
register int i;
register site *s;
Real size_src, size_src2;
double rsq, tsq;
complex ctmp, a, b;
complex omega, omegam;
double_complex tdots,rvro,rvv,rvr;
register Real MKsq = -Kappa*Kappa;
Real CKU0 = Kappa*Clov_c/(U0*U0*U0);
#ifdef CGTIME
double dtime;
#endif
msg_tag *tago[8],*tage[8];
int is_startedo, is_startede;
is_startedo = is_startede = 0;
qic->size_r = 0;
qic->size_relr = 0;
qic->final_rsq = 0;
qic->final_relrsq = 0;
qic->final_iters = 0;
qic->final_restart = 0;
/* Handle trivial case */
if(Kappa == 0.){
copy_wv_field(dest,src);
return 0;
}
// if(even_sites_on_node!=odd_sites_on_node){
// printf("Need same number of even and odd sites on each node\n");
// terminate(1);
// }
/* Compute R_e and R_o and put in "clov" and "clov_diag" */
compute_clov(gen_clov, CKU0);
/* Invert R_o only, leaving R_e on even sites and 1/R_o on odd sites
in "clov" and "clov_diag" */
compute_clovinv(gen_clov, ODD);
/* now we can allocate temporary variables and copy them */
/* PAD may be used to avoid cache trashing */
#define PAD 0
tmp = (wilson_vector *) malloc((sites_on_node+PAD)*sizeof(wilson_vector));
mp = (wilson_vector *) malloc((sites_on_node+PAD)*sizeof(wilson_vector));
rv = (wilson_vector *) malloc((sites_on_node+PAD)*sizeof(wilson_vector));
sss = (wilson_vector *) malloc((sites_on_node+PAD)*sizeof(wilson_vector));
r = (wilson_vector *) malloc((sites_on_node+PAD)*sizeof(wilson_vector));
p = (wilson_vector *) malloc((sites_on_node+PAD)*sizeof(wilson_vector));
ttt = (wilson_vector *) malloc((sites_on_node+PAD)*sizeof(wilson_vector));
if(tmp == NULL || mp == NULL || mp == NULL || rv == NULL ||
sss == NULL || r == NULL ){
printf("bicgilu_cl_field(%d): No room for temporaries\n",this_node);
terminate(1);
}
/* BiCGstab_ILU: */
/* Transform source - result is in r (even) - and dest (odd) */
#ifdef CGTIME
dtime = -dclock();
#endif
/* now we copy src to temporaries */
FORALLSITES(i,s) {
r[i] = src[i];
}
/* src = L^(-1)*src */
size_src = ilu_xfm_source(dest, r, mp, Kappa, &is_startede, tage);
size_src2 = size_src*size_src;
#if 0
mult_this_ldu_field(gen_clov, r, mp, ODD);
dslash_w_field_special(mp, mp, PLUS, EVEN, tage, is_startede);
is_startede = 1;
/* Normalization */
rsq = 0.0;
FOREVENSITESDOMAIN(i,s) {
scalar_mult_add_wvec( &(r[i]), &(mp[i]), Kappa, &(r[i]) );
rsq += (double)magsq_wvec( &(r[i]) );
/* Save transformed source: Overwrite src on even sites */
copy_wvec( &(r[i]), &(src[i]) );
}
int main(int argc,char *argv[])
{
int meascount;
int prompt;
Real avm_iters,avs_iters;
double starttime,endtime,dclock();
double dtime;
int MinCG,MaxCG;
Real RsdCG;
register int i;
register site *s;
int spinindex,spin,color,j,k,t,t_off;
int kh,kl;
int nr_fb;
char nr_fb_label[3][2] = { "0", "F", "B" };
int flag;
int kprop;
int num_prop;
Real space_vol;
int status;
propagator hdibar_prop[MAX_KAP][MAX_KAP][HDIPROPS];
propagator nrbar_prop[MAX_KAP][MAX_KAP][NRPROPS];
char scratch_file[MAX_KAP][MAXFILENAME];
Real norm_fac[10];
static char *mes_kind[10] = {"PION","PS505","PS055","PS0505",
"RHO33","RHO0303","SCALAR","SCALA0","PV35","B12"};
complex *pmes_prop[MAX_KAP][MAX_KAP][10];
int pmes_prop_done[MAX_KAP][MAX_KAP];
w_prop_file *fp_in_w[MAX_KAP]; /* For reading binary propagator files */
w_prop_file *fp_out_w[MAX_KAP]; /* For writing binary propagator files */
w_prop_file *fp_scr[MAX_KAP];
initialize_machine(&argc,&argv);
#ifdef HAVE_QDP
QDP_initialize(&argc, &argv);
#endif
/* Remap standard I/O */
if(remap_stdio_from_args(argc, argv) == 1)terminate(1);
g_sync();
/* set up */
prompt = setup_H_cl();
/* loop over input sets */
while( readin(prompt) == 0)
{
MaxCG = niter;
starttime=dclock();
avm_iters=0.0;
meascount=0;
/* Allocate space for relativistic meson propagator */
for(num_prop=0;num_prop<10;num_prop++)
for(i=0;i<num_kap;i++)for(j=0;j<=i;j++){
pmes_prop[i][j][num_prop] = (complex *)malloc(nt*sizeof(complex));
for(t=0;t<nt;t++){
pmes_prop[i][j][num_prop][t] = cmplx(0.0,0.0);
}
pmes_prop_done[i][j] = 0;
}
/* Allocate space for non relativistic baryon propagators */
for(kprop=0;kprop<NRPROPS;kprop++)
for(i=0;i<num_kap;i++)for(j=0;j<num_kap;j++){
nrbar_prop[i][j][kprop].c
= (complex *)malloc(nt*sizeof(complex));
if(nrbar_prop[i][j][kprop].c == NULL)
{
printf("control_H_cl: Can't malloc nrbar prop %d %d %d\n",
i,j,kprop);
terminate(1);
}
for(t=0;t<nt;t++)nrbar_prop[i][j][kprop].c[t]
= cmplx(0.0,0.0);
nrbar_prop[i][j][kprop].label
= (char *)malloc(10*sizeof(char));
if(nrbar_prop[i][j][kprop].c == NULL)
{
printf("control_H_cl: Can't malloc nrbar prop label %d %d %d\n",
i,j,kprop);
terminate(1);
}
}
/* Allocate space for H-dibaryon channel propagators */
for(kprop=0;kprop<HDIPROPS;kprop++)
for(kh=0;kh<num_kap_heavy;kh++)for(kl=0;kl<num_kap_light;kl++){
/* kappa indexing scheme is consistent with baryon propagator
even though we compute only the propagators with
one heavy (s) quark and two light (u,d) quarks */
i = kh; j = kl + num_kap_heavy;
hdibar_prop[i][j][kprop].c
= (complex *)malloc(nt*sizeof(complex));
if(hdibar_prop[i][j][kprop].c == NULL)
{
printf("control_H_cl: Can't malloc baryon prop %d %d %d\n",
i,j,kprop);
terminate(1);
}
for(t=0;t<nt;t++)hdibar_prop[i][j][kprop].c[t]
= cmplx(0.0,0.0);
hdibar_prop[i][j][kprop].label
= (char *)malloc(10*sizeof(char));
if(hdibar_prop[i][j][kprop].label == NULL)
{
printf("control_H_cl: Can't malloc baryon prop label %d %d %d\n",
i,j,kprop);
terminate(1);
}
}
if( fixflag == COULOMB_GAUGE_FIX)
{
if(this_node == 0)
printf("Fixing to Coulomb gauge\n");
STARTIOTIME;
gaugefix(TUP,(Real)1.5,500,GAUGE_FIX_TOL);
STOPIOTIME("gauge fix");
invalidate_this_clov(gen_clov);
}
else
if(this_node == 0)printf("COULOMB GAUGE FIXING SKIPPED.\n");
/* save lattice if requested */
if( saveflag != FORGET ){
/* Note: beta, kappa are kept only for save_old_binary */
STARTIOTIME;
savelat_p = save_lattice( saveflag, savefile, stringLFN );
STOPIOTIME("save lattice");
}
if(this_node==0)printf("END OF HEADER\n");
/* Loop over all kappas to compute and store quark propagator */
for(k=0;k<num_kap;k++){
kappa = kap[k];
source_r0=wqs[k].r0;
RsdCG=resid[k];
if(this_node==0)printf("Kappa=%e r0=%e residue=%e\n",
(double)kappa,(double)source_r0,(double)RsdCG);
/* open file for kth wilson propagator */
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[k].type);
/* Open scratch file and write header */
sprintf(scratch_file[k],"%s_%02d",scratchstem_w,k);
if(scratchflag == SAVE_CHECKPOINT)
{
fp_scr[k] = w_checkpoint_w_i(scratch_file[k]);
/* Close, temporarily */
w_checkpoint_w_c(fp_scr[k]);
}
else
/* If serial, write header and leave it open */
fp_scr[k] = w_serial_w_i(scratch_file[k]);
/* Loop over source colors */
for(color=0;color<3;color++){
for(spinindex=0;spinindex<n_spins;spinindex++){
spin = spins[spinindex];
meascount ++;
if(this_node==0)printf("color=%d spin=%d\n",color,spin);
if(startflag_w[k] == CONTINUE)
{
if(k == 0)
{
node0_printf("Can not continue propagator here! Zeroing it instead\n");
startflag_w[k] = FRESH;
}
else
{
FORALLSITES(i,s)
copy_wvec(&(s->quark_propagator.c[color].d[spin]),
&(s->psi));
}
}
/* Saves one multiplication by zero in cgilu */
if(startflag_w[k] == FRESH)flag = 0;
else
flag = 1;
/* load psi if requested */
#ifdef IOTIME
status = reload_wprop_sc_to_site( startflag_w[k], fp_in_w[k],
spin, color, F_OFFSET(psi),1);
#else
status = reload_wprop_sc_to_site( startflag_w[k], fp_in_w[k],
spin, color, F_OFFSET(psi),0);
#endif
if(status != 0)
{
node0_printf("control_H_cl: Recovering from error by resetting initial guess to zero\n");
reload_wprop_sc_to_site( FRESH, fp_in_w[k],
spin, color, F_OFFSET(psi),0);
flag = 0;
}
/* Invert to find propagator */
/* Complete the source structure */
wqs[k].color = color;
wqs[k].spin = spin;
/* For clover_info */
wqstmp = wqs[k];
/* If we are starting afresh, we set a minimum number
of iterations */
if(startflag_w[k] == FRESH || status != 0)MinCG = nt;
else MinCG = 0;
/* Load inversion control structure */
qic.prec = PRECISION;
qic.min = MinCG;
qic.max = MaxCG;
qic.nrestart = nrestart;
qic.resid = RsdCG;
qic.start_flag = flag;
/* Load Dirac matrix parameters */
dcp.Kappa = kappa;
dcp.Clov_c = clov_c;
dcp.U0 = u0;
#ifdef BI
/* compute the propagator. Result in psi. */
avs_iters
= (Real)wilson_invert_site_wqs(F_OFFSET(chi),F_OFFSET(psi),
w_source,&wqs[k],
bicgilu_cl_site,&qic,(void *)&dcp);
#else
/* compute the propagator. Result in psi. */
avs_iters =
(Real)wilson_invert_site_wqs(F_OFFSET(chi),F_OFFSET(psi),
w_source,&wqs[k],
cgilu_cl_site,&qic,(void *)&dcp);
#endif
avm_iters += avs_iters;
FORALLSITES(i,s)
copy_wvec(&(s->psi),
&(s->quark_propagator.c[color].d[spin]));
STARTIOTIME;
/* Write psi to scratch disk */
if(scratchflag == SAVE_CHECKPOINT)
{
w_checkpoint_w_o(fp_scr[k]);
w_checkpoint_w(fp_scr[k],spin,color,F_OFFSET(psi));
w_checkpoint_w_c(fp_scr[k]);
}
else
w_serial_w(fp_scr[k],spin,color,F_OFFSET(psi));
STOPIOTIME("do fast quark dump");
/* save psi if requested */
#ifdef IOTIME
save_wprop_sc_from_site( saveflag_w[k],fp_out_w[k],
spin,color,F_OFFSET(psi),1);
#else
save_wprop_sc_from_site( saveflag_w[k],fp_out_w[k],
spin,color,F_OFFSET(psi),0);
#endif
} /* source spins */
} /* source colors */
/* Close and release scratch file */
if(scratchflag == SAVE_CHECKPOINT)
w_checkpoint_w_f(fp_scr[k]);
else
w_serial_w_f(fp_scr[k]);
if(this_node==0)printf("Saved binary wilson_vector in file %s\n",
scratch_file[k]);
/* close files for wilson propagators */
r_close_wprop(startflag_w[k],fp_in_w[k]);
w_close_wprop(saveflag_w[k],fp_out_w[k]);
} /* kappas */
/* Loop over choice forward - backward for NR source and sink */
for(nr_fb = 1; nr_fb <= 2; nr_fb++)if(nr_fb & nr_forw_back)
{
/* Reset completion flags */
for(i=0;i<num_kap;i++)for(j=0;j<num_kap;j++){
for(kprop=0;kprop<NRPROPS;kprop++)
nrbar_prop[i][j][kprop].done = 0;
for(kprop=0;kprop<HDIPROPS;kprop++)
hdibar_prop[i][j][kprop].done = 0;
}
/* Loop over heavy kappas for the point sink spectrum */
for(k=0;k<num_kap_heavy;k++){
/* Read the kth heavy kappa propagator from the scratch file */
kappa = kappa_heavy = kap[k];
if(scratchflag == SAVE_CHECKPOINT)
fp_scr[k] = r_parallel_w_i(scratch_file[k]);
else
fp_scr[k] = r_serial_w_i(scratch_file[k]);
STARTIOTIME;
for(color=0;color<3;color++) for(spin=0;spin<4;spin++){
if(scratchflag == SAVE_CHECKPOINT)
r_parallel_w(fp_scr[k], spin, color,
F_OFFSET(quark_propagator.c[color].d[spin]));
else
r_serial_w(fp_scr[k], spin, color,
F_OFFSET(quark_propagator.c[color].d[spin]));
}
STOPIOTIME("to read 12 spin-color combinations");
if(scratchflag == SAVE_CHECKPOINT)
r_parallel_w_f(fp_scr[k]);
else
r_serial_w_f(fp_scr[k]);
/* Convert to NR propagator */
STARTPRTIME;
nr_propagator(F_OFFSET(quark_propagator),
F_OFFSET(nr_prop1), nr_fb);
diquarkprop(F_OFFSET(nr_prop1),
F_OFFSET(diquark_prop1));
STOPPRTIME("make nr and diquark");
/* Diagonal spectroscopy - not needed */
/** w_nrbaryon(F_OFFSET(nr_prop1), F_OFFSET(nr_prop1),
F_OFFSET(diquark_prop1), nrbar_prop[k][k]); **/
/** w_hdibaryon(F_OFFSET(diquark_prop1),
F_OFFSET(diquark_prop1), hdibar_prop[k][k]); **/
/* Heavy-light spectroscopy */
/* Loop over light kappas for the point sink spectrum */
for(j=num_kap_heavy;j<num_kap;j++){
/* Read the propagator from the scratch file */
kappa = kappa_light = kap[j];
if(scratchflag == SAVE_CHECKPOINT)
fp_scr[j] = r_parallel_w_i(scratch_file[j]);
else
fp_scr[j] = r_serial_w_i(scratch_file[j]);
STARTIOTIME;
for(color=0;color<3;color++) for(spin=0;spin<4;spin++){
if(scratchflag == SAVE_CHECKPOINT)
r_parallel_w(fp_scr[j], spin, color,
F_OFFSET(quark_prop2.c[color].d[spin]));
else
r_serial_w(fp_scr[j], spin, color,
F_OFFSET(quark_prop2.c[color].d[spin]));
}
STOPIOTIME("do fast quark read");
if(scratchflag == SAVE_CHECKPOINT)
r_parallel_w_f(fp_scr[j]);
else
r_serial_w_f(fp_scr[j]);
/* Convert to NR propagator */
STARTPRTIME;
nr_propagator(F_OFFSET(quark_prop2),
F_OFFSET(nr_prop2),nr_fb);
diquarkprop(F_OFFSET(nr_prop2),
F_OFFSET(diquark_prop2));
STOPPRTIME("make nr and diquark propagators");
/* Diagonal spectroscopy - baryons only - done if
any of them was not previously done */
for(kprop=0;kprop<NRPROPS;kprop++)
{
if(nrbar_prop[j][j][kprop].done == 0)
{
STARTPRTIME;
w_nrbaryon(F_OFFSET(nr_prop2), F_OFFSET(nr_prop2),
F_OFFSET(diquark_prop2), nrbar_prop[j][j]);
STOPPRTIME("do diagonal baryons");
break;
}
}
/* Heavy-light spectroscopy - baryons and H */
/* We don't do baryon heavy-light if the kappa values
are the same, since the result is the same as the
diagonal light propagator */
if(kappa_heavy != kappa_light)
{
/* Relativistic meson propagator: Do only once */
if(pmes_prop_done[j][k] == 0) {
STARTPRTIME;
for(color=0;color<3;color++){
w_meson_site(F_OFFSET(quark_propagator.c[color]),
F_OFFSET(quark_prop2.c[color]), pmes_prop[j][k]);
}
pmes_prop_done[j][k] = 1;
STOPPRTIME("do off-diagonal relativistic meson");
}
STARTPRTIME;
w_nrbaryon(F_OFFSET(nr_prop2),
F_OFFSET(nr_prop1),F_OFFSET(diquark_prop1),
nrbar_prop[j][k]);
w_nrbaryon(F_OFFSET(nr_prop1),
F_OFFSET(nr_prop2),F_OFFSET(diquark_prop2),
nrbar_prop[k][j]);
STOPPRTIME("do two sets of hl baryons");
}
/* For H we do only the case prop2 = u (light) index j
and prop1 = s (heavy) index k */
STARTPRTIME;
w_hdibaryon(F_OFFSET(diquark_prop2),
F_OFFSET(diquark_prop1), hdibar_prop[k][j]);
STOPPRTIME("do one set of hl H dibaryons");
} /* light kappas */
} /* heavy kappas */
/* Stick with same convention as clover_invert/control_cl_hl.c */
space_vol = (Real)(nx*ny*nz);
for(num_prop=0;num_prop<10;num_prop++) norm_fac[num_prop] = space_vol;
norm_fac[4] *= 3.0;
norm_fac[5] *= 3.0;
norm_fac[8] *= 3.0;
norm_fac[9] *= 3.0;
/* print relativistic meson propagators */
for(num_prop=0;num_prop<10;num_prop++)
for(i=0;i<num_kap;i++)
for(j=0;j<=i;j++)
if(pmes_prop_done[i][j] == 1){
for(t = 0; t < nt; t++){
t_off = (t + source_time)%nt;
g_floatsum( &pmes_prop[i][j][num_prop][t_off].real );
pmes_prop[i][j][num_prop][t_off].real /= norm_fac[num_prop];
g_floatsum( &pmes_prop[i][j][num_prop][t_off].imag );
pmes_prop[i][j][num_prop][t_off].imag /= norm_fac[num_prop];
if(this_node == 0)
printf("POINT%s %d %d %d %e %e\n",
mes_kind[num_prop],i,j,t,
(double)pmes_prop[i][j][num_prop][t_off].real,
(double)pmes_prop[i][j][num_prop][t_off].imag);
}
}
/* Once printed, this propagator should be neither
calculated nor printed again */
for(i=0;i<num_kap;i++)
for(j=0;j<=i;j++)
if(pmes_prop_done[i][j] == 1)
pmes_prop_done[i][j] = 2;
/* print non-relativistic baryon propagators */
if(this_node == 0)
for(kprop=0;kprop<NRPROPS;kprop++)
for(i=0;i<num_kap;i++){
for(j=0;j<i;j++)
if(nrbar_prop[i][j][kprop].done==1){
for(t = 0; t < nt; t++){
t_off = (t + source_time)%nt;
/* Periodic boundary conditions - no wraparound sign */
printf("%s_NR%s %d %d %d %d %e %e\n",
nr_fb_label[nr_fb],
nrbar_prop[i][j][kprop].label,i,j,j,t,
(double)nrbar_prop[i][j][kprop].c[t_off].real,
(double)nrbar_prop[i][j][kprop].c[t_off].imag);
}
}
if(nrbar_prop[i][i][kprop].done==1)
for(t = 0; t < nt; t++){
t_off = (t + source_time)%nt;
printf("%s_NR%s %d %d %d %d %e %e\n",
nr_fb_label[nr_fb],
nrbar_prop[i][j][kprop].label,i,i,i,t,
(double)nrbar_prop[i][i][kprop].c[t_off].real,
(double)nrbar_prop[i][i][kprop].c[t_off].imag);
}
for(j=i+1;j<num_kap;j++)
if(nrbar_prop[i][j][kprop].done==1)
for(t = 0; t < nt; t++){
t_off = (t + source_time)%nt;
printf("%s_NR%s %d %d %d %d %e %e\n",
nr_fb_label[nr_fb],
nrbar_prop[i][j][kprop].label,j,j,i,t,
(double)nrbar_prop[i][j][kprop].c[t_off].real,
(double)nrbar_prop[i][j][kprop].c[t_off].imag);
}
}
/* print H-dibaryon mixed channel propagators */
if(this_node == 0)
for(kprop=0;kprop<HDIPROPS;kprop++)
for(i=0;i<num_kap;i++){
for(j=0;j<num_kap;j++)if(hdibar_prop[i][j][kprop].done==1){
for(t = 0; t < nt; t++){
t_off = (t + source_time)%nt;
printf("%s_%s %d %d %d %d %e %e\n",
nr_fb_label[nr_fb],
hdibar_prop[i][j][kprop].label,i,j,j,t,
(double)hdibar_prop[i][j][kprop].c[t_off].real,
(double)hdibar_prop[i][j][kprop].c[t_off].imag);
}
}
}
} /* Loop over nr forward - backward */
/* Cleanup */
for(kprop=0;kprop<NRPROPS;kprop++)
for(i=0;i<num_kap;i++)for(j=0;j<num_kap;j++){
free(nrbar_prop[i][j][kprop].c);
free(nrbar_prop[i][j][kprop].label);
}
for(kprop=0;kprop<HDIPROPS;kprop++)
for(kh=0;kh<num_kap_heavy;kh++)for(kl=0;kl<num_kap_light;kl++){
i = kh; j = kl + num_kap_heavy;
free(hdibar_prop[i][j][kprop].c);
free(hdibar_prop[i][j][kprop].label);
}
if(this_node==0)printf("RUNNING COMPLETED\n");
if(meascount>0){
if(this_node==0)printf("total cg iters for measurement= %e\n",
(double)avm_iters);
if(this_node==0)printf("cg iters for measurement= %e\n",
(double)avm_iters/(double)meascount);
}
endtime=dclock();
if(this_node==0){
printf("Time = %e seconds\n",(double)(endtime-starttime));
printf("total_iters = %d\n",total_iters);
}
fflush(stdout);
}
return 0;
} /* control_H_cl */
int main(int argc, char *argv[])
{
int meascount;
int prompt;
Real avm_iters,avs_iters;
double ssplaq,stplaq;
double starttime,endtime;
double dtime;
int MinCG,MaxCG;
Real size_r,RsdCG;
register int i,j,l;
register site *s;
int spinindex,spin,color,k,kk,t;
int flag;
int ci,si,sf,cf;
int num_prop;
Real space_vol;
int status;
int source_chirality;
wilson_vector **eigVec ;
double *eigVal ;
int total_R_iters ;
double norm;
Real re,im,re5,im5;
complex cc;
char label[20] ;
double *grad, *err, max_error;
Matrix Array,V ;
int key[4];
#define restrict rstrict /* C-90 T3D cludge */
int restrict[4];
Real norm_fac[10];
static char *mes_kind[10] = {"PION","PS505","PS055","PS0505",
"RHO33","RHO0303","SCALAR","SCALA0","PV35","B12"};
static char *bar_kind[4] = {"PROTON","PROTON0","DELTA","DELTA0"};
complex *pmes_prop[MAX_MASSES][10];
complex *smes_prop[MAX_MASSES][10];
complex *bar_prop[MAX_MASSES][4];
w_prop_file *fp_in_w[MAX_MASSES]; /* For propagator files */
w_prop_file *fp_out_w[MAX_MASSES]; /* For propagator files */
initialize_machine(&argc,&argv);
/* Remap standard I/O */
if(remap_stdio_from_args(argc, argv) == 1)terminate(1);
g_sync();
/* set up */
prompt = setup_p();
/* loop over input sets */
while( readin(prompt) == 0)
{
starttime=dclock();
MaxCG=niter;
avm_iters=0.0;
meascount=0;
if(this_node==0)printf("END OF HEADER\n");
setup_offset();
/*
if(this_node==0)printf("warning--no fat link\n");
*/
monte_block_ape_b(1);
/* call plaquette measuring process */
d_plaquette(&ssplaq,&stplaq);
if(this_node==0)printf("FATPLAQ %e %e\n",
(double)ssplaq,(double)stplaq);
/* flip the time oriented fat links
if(this_node==0) printf("Periodic time BC\n");
*/
if(this_node==0) printf("AP time BC\n");
boundary_flip(MINUS);
setup_links(SIMPLE);
/* if(this_node==0) printf("num_masses = %d\n", num_masses); */
/* Loop over mass */
for(k=0;k<num_masses;k++){
m0=mass[k];
if(m0 <= -10.0) exit(1);
RsdCG=resid[k];
if(this_node==0)printf("mass= %g r0= %g residue= %g\n",
(double)m0,(double)wqs[k].r0,(double)RsdCG);
build_params(m0);
make_clov1();
eigVal = (double *)malloc(Nvecs*sizeof(double));
eigVec = (wilson_vector **)malloc(Nvecs*sizeof(wilson_vector*));
for(i=0;i<Nvecs;i++)
eigVec[i]=
(wilson_vector*)malloc(sites_on_node*sizeof(wilson_vector));
/* open files for wilson propagators */
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[k].type);
if(startflag_w[k] == FRESH)flag = 0;
else
flag = 1;
spin=color=0; /* needed by wilson writing routines */
/* initialize the CG vectors */
if(flag==0){
if(this_node==0) printf("random (but chiral) initial vectors\n");
/* Initiallize all the eigenvectors to a random vector */
for(j=0;j<Nvecs;j++)
{
if(j< Nvecs/2){ source_chirality=1;}
else{source_chirality= -1;}
printf("source chirality %d\n",source_chirality);
grsource_w();
FORALLSITES(i,s){
copy_wvec(&(s->g_rand),&(eigVec[j][i]));
if(source_chirality==1){
for(kk=2;kk<4;kk++)for(l=0;l<3;l++)
eigVec[j][i].d[kk].c[l]=cmplx(0.0,0.0);
}
if(source_chirality== -1){
for(kk=0;kk<2;kk++)for(l=0;l<3;l++)
eigVec[j][i].d[kk].c[l]=cmplx(0.0,0.0);
}
}
eigVal[j]=1.0e+16;
}
}
else{
if(this_node==0) printf("reading in %d wilson_vectors--must be <= 12\n",Nvecs);
/* load psi if requested */
for(j=0;j<Nvecs;j++){
printf("reading %d %d %d\n",j,spin,color);
#ifdef IOTIME
status = reload_wprop_sc_to_site( startflag_w[k], fp_in_w[k],
spin, color, F_OFFSET(psi),1);
#else
status = reload_wprop_sc_to_site( startflag_w[k], fp_in_w[k],
spin, color, F_OFFSET(psi),0);
#endif
/* compute eigenvalue */
herm_delt(F_OFFSET(psi),F_OFFSET(chi));
re=im=0.0;
FORALLSITES(i,s){
cc = wvec_dot( &(s->chi), &(s->psi) );
re += cc.real ;
}
g_floatsum(&re);
eigVal[j]=re;
printf("trial eigenvalue of state %d %e\n",j,eigVal[j]);
FORALLSITES(i,s){eigVec[j][i]=s->psi;}
spin++;
if((spin %4) == 0){spin=0;color++;}
}
}
/* set dest = src on odd sites, whatever else you do
(even if we restart with a nonzero solution vector, the end of the
subroutine rebuilds the odd component from the even one. The (trivial)
solution of the odd component of the equation is dest = src, before
we rotate back to the basis in which M is not checkerboard-diagonal) */
FORODDSITESDOMAIN(i,s) {
copy_wvec( &(r[i]), &(dest[i]) );
}
/* Save transformed source: Overwrite src on even sites */
FOREVENSITESDOMAIN(i,s) {
copy_wvec( &(r[i]), &(src[i]) );
}
int main(int argc,char *argv[])
{
int prompt , k, ns, i;
site *s;
double inv_space_vol;
int color,spin, color1, spin1;
int key[4];
int dummy[4];
FILE *corr_fp;
complex pr_tmp;
wilson_propagator *qdest;
wilson_propagator qtemp1;
wilson_vector *psi = NULL;
w_prop_file *wpf;
quark_source wqs;
key[XUP] = 1;
key[YUP] = 1;
key[ZUP] = 1;
key[TUP] = 0;
initialize_machine(&argc,&argv);
/* Remap standard I/O */
if(remap_stdio_from_args(argc, argv) == 1)terminate(1);
g_sync();
prompt = setup();
setup_restrict_fourier(key, dummy);
psi = create_wv_field();
/* Initialize the source type */
init_qs(&wqs);
while( readin(prompt) == 0) {
/**************************************************************/
/*load staggered propagator*/
reload_ksprop_to_site3(ks_prop_startflag,
start_ks_prop_file, &ksqs, F_OFFSET(prop), 1);
FORALLSITES(i,s) {
for(color = 0; color < 3; color++)for(k = 0; k < 3; k++)
s->stag_propagator.e[color][k] = s->prop[color].c[k];
}
/* Initialize FNAL correlator file */
corr_fp = open_fnal_meson_file(savefile_c);
/* Load Wilson propagator for each kappa */
for(k=0; k<num_kap; k++) {
kappa = kap[k];
wpf = r_open_wprop(startflag_w[k], startfile_w[k]);
for(spin=0; spin<4; spin++)
for(color=0; color<3; color++) {
if(reload_wprop_sc_to_field(startflag_w[k], wpf,
&wqs, spin, color, psi, 1) != 0)
terminate(1);
FORALLSITES(i,s) {
copy_wvec(&psi[i],&lattice[i].quark_propagator.c[color].d[spin]);
}
}
r_close_wprop(startflag_w[k],wpf);
/*******************************************************************/
/* Rotate the heavy quark */
rotate_w_quark(F_OFFSET(quark_propagator),
F_OFFSET(quark_propagator_copy), d1[k]);
// result in quark_propagator_copy
/**************************************************************/
/*Calculate and print out the spectrum with the rotated heavy
quark propagators*/
spectrum_hl_rot(corr_fp, F_OFFSET(stag_propagator),
F_OFFSET(quark_propagator_copy), k);
/**************************************************************/
/*Smear quarks, calculate and print out the spectrum with the
smeared heavy quark propagators*/
for(color=0; color<3; color++)for(spin=0; spin<4; spin++) {
restrict_fourier_site(F_OFFSET(quark_propagator.c[color].d[spin]),
sizeof(wilson_vector), FORWARDS);
}
for(ns=0; ns<num_smear; ns++) {
if(strcmp(smearfile[ns],"none")==0) continue;
inv_space_vol = 1./((double)nx*ny*nz);
/* Either read a smearing file, or take it to be a point sink */
if(strlen(smearfile[ns]) != 0) {
get_smearings_bi_serial(smearfile[ns]);
restrict_fourier_site(F_OFFSET(w),
sizeof(complex), FORWARDS);
FORALLSITES(i,s) {
for(color=0; color<3; color++)for(spin=0; spin<4; spin++)
for(color1=0; color1<3; color1++)for(spin1=0; spin1<4; spin1++) {
pr_tmp =
s->quark_propagator.c[color].d[spin].d[spin1].c[color1];
s->quark_propagator_copy.c[color].d[spin].d[spin1].c[color1].real =
pr_tmp.real * s->w.real - pr_tmp.imag * s->w.imag;
s->quark_propagator_copy.c[color].d[spin].d[spin1].c[color1].imag =
pr_tmp.real * s->w.imag + pr_tmp.imag * s->w.real;
}
}
} else { /* Point sink */
FORALLSITES(i,s) {
for(color=0; color<3; color++)for(spin=0; spin<4; spin++)
for(color1=0; color1<3; color1++)for(spin1=0; spin1<4; spin1++) {
pr_tmp =
s->quark_propagator.c[color].d[spin].d[spin1].c[color1];
s->quark_propagator_copy.c[color].d[spin].d[spin1].c[color1].real =
pr_tmp.real;
s->quark_propagator_copy.c[color].d[spin].d[spin1].c[color1].imag =
pr_tmp.imag;
}
}
}
for(color=0; color<3; color++)for(spin=0; spin<4; spin++) {
restrict_fourier_site(F_OFFSET(quark_propagator_copy.c[color].d[spin]),
sizeof(wilson_vector), BACKWARDS);
}
FORALLSITES(i,s)
{
qdest = &(s->quark_propagator_copy);
qtemp1 = s->quark_propagator_copy;
for(spin=0; spin<4; spin++)for(color=0; color<3; color++)
for(spin1=0; spin1<4; spin1++)for(color1=0; color1<3; color1++)
{
qdest->c[color].d[spin1].d[spin].c[color1].real =
qtemp1.c[color].d[spin].d[spin1].c[color1].real;
qdest->c[color].d[spin1].d[spin].c[color1].imag =
qtemp1.c[color].d[spin].d[spin1].c[color1].imag;
}
}
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) );
}
}
void build_hr0( int flag, int precflag )/* 0, fresh start, 1--restart with stored vectors,*/
{
register int i,j;
register site *s;
int total_R_iters ;
Real re,im;
complex cc;
int nn0;
Real eigenval_tol_save;
/* code for good h(-r0) eigenmodes */
int failed,ifailed,nextra;
double *MyeigVal0;
wilson_vector **MyeigVec0;
wilson_vector *tmpvec;
Real ftmp;
Real invp,invp5;
tmpvec=(wilson_vector*)malloc(sites_on_node*sizeof(wilson_vector));
nn0=-ndelta0;
if (precflag==HIGHP)
{
eigenval_tol=eigenval_tol_high;
error_decr=error_decr_high;
} else {
eigenval_tol=eigenval_tol_low;
error_decr=error_decr_low;
}
node0_printf("\n");
eigenval_tol_save=eigenval_tol;
build_params(-R0);
make_clov1();
kind_of_h0=HZERO;
if(Maxr0Iter != 0){
/*
FORALLSITES(i,s){
clear_wvec(&(eigVec0[0][i]));
if(s->x==0 && s->y==0 && s->z==0 && s->t==0) eigVec0[0][i].d[0].c[0].real=1.0;
}
delta0_field(eigVec0[0],eigVec0[1],PLUS);
FORALLSITES(i,s){
if(s->x ==0 && s ->y==0 && s->z==0){
node0_printf("DT %d %d %d %d\n",s->x,s->y,s->z,s->t);
dump_wvec(&(eigVec0[1][i]));
}
}
*/
/* initialize the CG vectors */
if(flag==0)
{
if(this_node==0) printf("random initial vectors for h(m0)\n");
/* Initiallize all the eigenvectors to a random vector */
for(j=0;j<Nvecs_h0r0;j++){
grsource_dirac(EVENANDODD);
FORSOMEPARITY(i,s,EVENANDODD){
copy_wvec(&(s->g_rand),&(eigVec0[j][i]));
}
eigVal0[j]=1.0e+16;
}
}
else
{
/* eigenvectors and eigenvalues of h(-r0) already exist, but we need eigenvalues of h^2 */
for(j=0;j<Nvecs_h0r0;j++){
