ks_prop_field *reread_ksprop_to_ksp_field(int saveflag, char savefile[],
int nc){
char myname[] = "reread_ksprop_to_ksp_field";
quark_source dummy_ksqs;
ks_prop_field *ksprop;
int rereadflag = convert_outflag_to_inflag_ksprop(saveflag);
if(rereadflag == FRESH){
printf("%s(%d) Can't reread file %s when saveflag is %d\n",
myname, this_node, savefile, saveflag);
terminate(1);
}
ksprop = create_ksp_field(nc);
init_qs(&dummy_ksqs);
reload_ksprop_to_ksp_field(rereadflag, savefile, &dummy_ksqs, ksprop, 1);
clear_qs(&dummy_ksqs); /* Free any allocations */
return ksprop;
}
void dump_ksprop_from_ksp_field(int saveflag, char savefile[],
ks_prop_field *ksprop){
quark_source dummy_ksqs;
/* When we dump a propagator, we don't keep the source information.
Normally we want the source information for checking consistency
with the Dirac operator we are using, since if we know the
source, we can run the propagator through the solver to check it.
Here the propagator we are dumping is usually one that has
already had sink operators applied to it, so it won't satisfy the
Dirac equation, anyway.
So we take a default source type "UNKOWN". A minimal source
record is still written to the file, since we don't have any
propagator file formats without sources records. The minimal
source record is a null complex field on time slice zero. */
/* For clover_info.c */
init_qs(&dummy_ksqs);
ksqstmp = dummy_ksqs; /* For ksprop_info.c */
save_ksprop_from_ksp_field(saveflag, savefile, "", &dummy_ksqs, ksprop, 1);
clear_qs(&dummy_ksqs); /* Free any allocations */
}
MUST COMPILE WITH QIO FOR THE SCRATCH FILE
#endif
/* Comment these out if you want to suppress detailed timing */
/*#define IOTIME*/
/*#define PRTIME*/
int main(int argc, char *argv[])
{
int meascount;
int prompt;
Real avm_iters,avs_iters;
double starttime,endtime;
#ifdef IOTIME
double dtime;
int iotime = 1;
#else
int iotime = 0;
#endif
int MinCG,MaxCG;
Real RsdCG, RRsdCG;
int spin,color,j,k;
int flag;
int status;
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];
quark_source wqs_scr; /* scratch file */
char scratch_file[MAX_KAP][MAXFILENAME];
wilson_vector *psi = NULL;
wilson_prop_field *quark_propagator = NULL;
wilson_prop_field *quark_prop2 = NULL;
int cg_cl = CL_CG;
int source_type;
initialize_machine(&argc,&argv);
/* Remap standard I/O */
if(remap_stdio_from_args(argc, argv) == 1)terminate(1);
g_sync();
/* set up */
prompt = setup_cl();
/* loop over input sets */
psi = create_wv_field();
quark_propagator = create_wp_field(3);
quark_prop2 = create_wp_field(3);
while( readin(prompt) == 0)
{
starttime=dclock();
MaxCG=niter;
avm_iters=0.0;
meascount=0;
spectrum_cl_hl_init();
if( fixflag == COULOMB_GAUGE_FIX)
{
if(this_node == 0)
printf("Fixing to Coulomb gauge\n");
#ifdef IOTIME
dtime = -dclock();
#endif
gaugefix(TUP,(Real)1.5,500,GAUGE_FIX_TOL);
#ifdef IOTIME
dtime += dclock();
if(this_node==0)printf("Time to gauge fix = %e\n",dtime);
#endif
invalidate_this_clov(gen_clov);
}
else
if(this_node == 0)printf("COULOMB GAUGE FIXING SKIPPED.\n");
/* save lattice if requested */
if( saveflag != FORGET ){
savelat_p = save_lattice( saveflag, savefile, stringLFN );
}
if(this_node==0)printf("END OF HEADER\n");
/* if(this_node==0) printf("num_kap = %d\n", num_kap); */
/* Loop over kappas to compute and store quark propagator */
for(k=0;k<num_kap;k++){
kappa=kap[k];
RsdCG=resid[k];
RRsdCG=relresid[k];
if(this_node==0)printf("Kappa= %g r0= %g residue= %g rel= %g\n",
(double)kappa,(double)wqs.r0,(double)RsdCG,
(double)RRsdCG);
/* open files for wilson propagators */
#ifdef IOTIME
dtime = -dclock();
#endif
wqstmp = wqs; /* For clover_info.c */
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 IOTIME
dtime += dclock();
if(startflag_w[k] != FRESH)
node0_printf("Time to open prop = %e\n",dtime);
#endif
/* Open scratch file and write header */
sprintf(scratch_file[k],"%s_%02d",scratchstem_w,k);
source_type = UNKNOWN;
fp_scr[k] = w_open_wprop(scratchflag, scratch_file[k], source_type);
init_qs(&wqs_scr);
/* Loop over source spins */
for(spin=0;spin<4;spin++){
/* Loop over source colors */
for(color=0;color<3;color++){
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
{
copy_wv_from_wp(psi, quark_propagator, color, spin);
}
}
/* Saves one multiplication by zero in cgilu */
if(startflag_w[k] == FRESH)flag = 0;
else
flag = 1;
/* load psi if requested */
status = reload_wprop_sc_to_field( startflag_w[k], fp_in_w[k],
&wqs, spin, color, psi, iotime);
if(status != 0)
{
node0_printf("control_cl_hl: Recovering from error by resetting initial guess to zero\n");
reload_wprop_sc_to_field( FRESH, fp_in_w[k], &wqs,
spin, color, psi,0);
flag = 0;
}
/* Complete the source structure */
wqs.color = color;
wqs.spin = spin;
/* If we are starting afresh, we set a minimum number
of iterations */
if(startflag_w[k] == FRESH || status != 0)MinCG = nt/2;
else MinCG = 0;
/* Load inversion control structure */
qic.prec = PRECISION;
qic.min = 0;
qic.max = MaxCG;
qic.nrestart = nrestart;
qic.parity = EVENANDODD;
qic.start_flag = flag;
qic.nsrc = 1;
qic.resid = RsdCG;
qic.relresid = RRsdCG;
/* Load Dirac matrix parameters */
dcp.Kappa = kappa;
dcp.Clov_c = clov_c;
dcp.U0 = u0;
switch (cg_cl) {
case BICG:
avs_iters =
(Real)wilson_invert_field_wqs(&wqs, w_source_field, psi,
bicgilu_cl_field,
&qic,(void *)&dcp);
break;
case HOP:
avs_iters =
(Real)wilson_invert_field_wqs(&wqs, w_source_field, psi,
hopilu_cl_field,
&qic,(void *)&dcp);
break;
case MR:
avs_iters =
(Real)wilson_invert_field_wqs(&wqs, w_source_field, psi,
mrilu_cl_field,
&qic,(void *)&dcp);
break;
case CG:
avs_iters =
(Real)wilson_invert_field_wqs(&wqs, w_source_field, psi,
cgilu_cl_field,
&qic,(void *)&dcp);
break;
default:
node0_printf("main(%d): Inverter choice %d not supported\n",
cg_cl, this_node);
}
avm_iters += avs_iters;
copy_wp_from_wv(quark_propagator, psi, color, spin);
/* Write psi to scratch disk */
#ifdef IOTIME
dtime = -dclock();
#endif
save_wprop_sc_from_field(scratchflag, fp_scr[k], &wqs_scr,
spin, color, psi, "Scratch record", iotime);
#ifdef IOTIME
dtime += dclock();
if(this_node==0)
printf("Time to dump prop spin %d color %d %e\n",
spin,color,dtime);
#endif
/* save psi if requested */
save_wprop_sc_from_field( saveflag_w[k],fp_out_w[k], &wqs,
spin,color,psi,"", iotime);
} /* source colors */
} /* source spins */
/* Close and release scratch file */
w_close_wprop(scratchflag, fp_scr[k]);
/*if(this_node==0)printf("Dumped prop to file %s\n",
scratch_file[k]); */
/* close files for wilson propagators */
#ifdef IOTIME
dtime = -dclock();
#endif
r_close_wprop(startflag_w[k],fp_in_w[k]);
w_close_wprop(saveflag_w[k],fp_out_w[k]);
#ifdef IOTIME
dtime += dclock();
if(saveflag_w[k] != FORGET)
node0_printf("Time to close prop = %e\n",dtime);
#endif
} /* kappas */
/* Loop over heavy kappas for the point sink spectrum */
for(k=0;k<num_kap;k++){
/* Read the propagator from the scratch file */
#ifdef IOTIME
dtime = -dclock();
#endif
kappa=kap[k];
init_qs(&wqs_scr);
reload_wprop_to_wp_field(scratchflag, scratch_file[k], &wqs_scr,
quark_propagator, iotime);
#ifdef IOTIME
dtime += dclock();
if(this_node==0)
{
printf("Time to read 12 spin,color combinations %e\n",dtime);
fflush(stdout);
}
#endif
/*if(this_node==0)
printf("Closed scratch file %s\n",scratch_file[k]);
fflush(stdout); */
/* Diagonal spectroscopy */
spectrum_cl_hl_diag_baryon(quark_propagator, k);
spectrum_cl_hl_diag_meson(quark_propagator, k);
spectrum_cl_hl_diag_rot_meson(quark_propagator, k);
if(strstr(spectrum_request,",sink_smear,") != NULL){
spectrum_cl_hl_diag_smeared_meson(quark_propagator, k);
}
/* Heavy-light spectroscopy */
/* Loop over light kappas for the point sink spectrum */
for(j=k+1;j<num_kap;j++){
#ifdef IOTIME
dtime = -dclock();
#endif
/* Read the propagator from the scratch file */
kappa=kap[j];
init_qs(&wqs_scr);
reload_wprop_to_wp_field(scratchflag, scratch_file[j], &wqs_scr,
quark_prop2, iotime);
#ifdef IOTIME
dtime += dclock();
if(this_node==0)
{
printf("Time to read 12 spin,color combinations %e\n",dtime);
fflush(stdout);
}
#endif
#ifdef PRTIME
dtime = -dclock();
#endif
spectrum_cl_hl_offdiag_baryon( quark_propagator, quark_prop2,
j, k);
spectrum_cl_hl_offdiag_meson( quark_propagator, quark_prop2,
j, k);
spectrum_cl_hl_offdiag_rot_meson( quark_propagator, quark_prop2,
j, k);
#ifdef PRTIME
dtime = -dclock();
#endif
} /* light kappas */
/* Smear the heavy propagator in place */
sink_smear_prop( quark_propagator );
/* Write the smeared propagator to the scratch file (overwriting)*/
kappa=kap[k];
#ifdef IOTIME
dtime = -dclock();
#endif
save_wprop_from_wp_field(scratchflag, scratch_file[k], &wqs_scr,
quark_propagator, "Scratch propagator",
iotime);
#ifdef IOTIME
dtime += dclock();
if(this_node==0)
{
printf("Time to dump convolution %d %e\n",k,dtime);
fflush(stdout);
}
#endif
} /* heavy kappas */
/* Loop over heavy kappas for the shell sink spectrum */
if(strstr(spectrum_request,",sink_smear,") != NULL)
for(k=0;k<num_kap;k++){
#ifdef IOTIME
dtime = -dclock();
#endif
/* Read the propagator from the scratch file */
kappa=kap[k];
init_qs(&wqs_scr);
reload_wprop_to_wp_field(scratchflag, scratch_file[k], &wqs_scr,
quark_propagator, iotime);
#ifdef IOTIME
dtime += dclock();
if(this_node==0)
{
printf("Time to read convolution %d %e\n",k,dtime);
fflush(stdout);
}
#endif
/* Diagonal spectroscopy */
spectrum_cl_hl_diag_smeared_meson(quark_propagator, k);
/* Heavy-light spectroscopy */
/* Loop over light kappas for the shell sink spectrum */
for(j=k+1;j<num_kap;j++){
#ifdef PRTIME
dtime = -dclock();
#endif
/* Read the propagator from the scratch file */
kappa=kap[j];
init_qs(&wqs_scr);
reload_wprop_to_wp_field(scratchflag, scratch_file[j], &wqs_scr,
quark_prop2, iotime);
/* Compute the spectrum */
spectrum_cl_hl_offdiag_smeared_meson( quark_propagator,
quark_prop2, j, k);
#ifdef PRTIME
dtime += dclock();
if(this_node==0)
{
printf("Time to read and do off diagonal mesons %d %d %e\n",
j,k,dtime);
fflush(stdout);
}
#endif
} /* light kappas */
} /* heavy kappas */
spectrum_cl_hl_print(wqs.t0);
spectrum_cl_hl_cleanup();
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);
}
destroy_wv_field(psi);
destroy_wp_field(quark_propagator);
return 0;
}
/* read in parameters and coupling constants */
int readin(int prompt) {
/* read in parameters for su3 monte carlo */
/* argument "prompt" is 1 if prompts are to be given for input */
int status;
char savebuf[128];
int i;
int ipair;
int max_cg_iterations, max_cg_restarts;
Real bdry_phase[4];
#ifdef PRTIME
double dtime;
#endif
STARTTIME;
/* On node zero, read parameters and send to all other nodes */
if(this_node==0){
printf("\n\n");
status=0;
/*------------------------------------------------------------*/
/* Gauge configuration section */
/*------------------------------------------------------------*/
IF_OK status += ask_starting_lattice(stdin, prompt, ¶m.startflag,
param.startfile );
IF_OK status += get_f(stdin, prompt,"u0", ¶m.u0 );
IF_OK if (prompt==1)
printf("enter 'no_gauge_fix', or 'coulomb_gauge_fix'\n");
IF_OK scanf("%s",savebuf);
IF_OK printf("%s\n",savebuf);
IF_OK {
if(strcmp("coulomb_gauge_fix",savebuf) == 0 ){
param.fixflag = COULOMB_GAUGE_FIX;
}
else if(strcmp("no_gauge_fix",savebuf) == 0 ) {
param.fixflag = NO_GAUGE_FIX;
}
else{
printf("error in input: fixing_command %s is invalid\n",savebuf); status++;
}
}
/* find out what to do with lattice at end */
IF_OK status += ask_ending_lattice(stdin, prompt, &(param.saveflag),
param.savefile );
IF_OK status += ask_ildg_LFN(stdin, prompt, param.saveflag,
param.stringLFN );
/* APE smearing parameters (if needed) */
/* Zero suppresses APE smearing */
IF_OK status += get_f(stdin, prompt, "staple_weight",
¶m.staple_weight);
IF_OK status += get_i(stdin, prompt, "ape_iter",
¶m.ape_iter);
/* Coordinate origin for KS phases and antiperiodic boundary condition */
IF_OK status += get_vi(stdin, prompt, "coordinate_origin", param.coord_origin, 4);
/*------------------------------------------------------------*/
/* Propagator inversion control */
/*------------------------------------------------------------*/
/* maximum no. of conjugate gradient iterations */
IF_OK status += get_i(stdin,prompt,"max_cg_iterations",
&max_cg_iterations );
/* maximum no. of conjugate gradient restarts */
IF_OK status += get_i(stdin,prompt,"max_cg_restarts",
&max_cg_restarts );
/*------------------------------------------------------------*/
/* Base sources */
/*------------------------------------------------------------*/
IF_OK status += get_i(stdin,prompt,"number_of_base_sources",
¶m.num_base_source);
IF_OK {
if(param.num_base_source > MAX_SOURCE){
printf("Exceeded dimension %d\n",MAX_SOURCE);
status++;
}
}
for(i = 0; i < param.num_base_source; i++){
IF_OK init_qs(¶m.base_src_qs[i]);
IF_OK status += get_wv_quark_source( stdin, prompt,
¶m.base_src_qs[i]);
/* Base sources have no parents or ops */
IF_OK param.parent_source[i] = BASE_SOURCE_PARENT;
IF_OK init_qss_op(¶m.src_qs_op[i]);
IF_OK set_qss_op_offset(¶m.src_qs_op[i], param.coord_origin);
/* Get optional file for saving the base source */
IF_OK {
int source_type, saveflag_s;
char descrp[MAXDESCRP];
char savefile_s[MAXFILENAME];
status +=
ask_output_quark_source_file( stdin, prompt, &saveflag_s,
&source_type, NULL, descrp,
savefile_s );
IF_OK {
param.base_src_qs[i].savetype = source_type;
param.base_src_qs[i].saveflag = saveflag_s;
strcpy(param.base_src_qs[i].save_file, savefile_s);
if(saveflag_s != FORGET && source_type != DIRAC_FIELD_FILE
&& source_type != VECTOR_FIELD_FILE){
printf("Unsupported output source type\n");
status++;
}
} /* OK */
} /* OK */
}
/*------------------------------------------------------------*/
/* Modified sources */
/*------------------------------------------------------------*/
IF_OK status += get_i(stdin,prompt,"number_of_modified_sources",
¶m.num_modified_source);
IF_OK {
if(param.num_base_source + param.num_modified_source > MAX_SOURCE){
printf("Total including base sources exceeds dimension %d\n",
MAX_SOURCE);
status++;
}
}
for(i = 0; i < param.num_modified_source; i++){
/* We append the modified sources to the list of base sources */
int is = param.num_base_source + i;
IF_OK status += get_i(stdin,prompt,"source", ¶m.parent_source[is]);
IF_OK {
if( param.parent_source[is] >= is){
printf("Source index must be less than %d here\n",is);
status++;
}
}
IF_OK init_qss_op(¶m.src_qs_op[is]);
set_qss_op_offset(¶m.src_qs_op[is], param.coord_origin);
/* Get source operator attributes */
IF_OK status += get_wv_field_op( stdin, prompt, ¶m.src_qs_op[is]);
/* Copy parent source attributes to the derived source structure */
IF_OK {
int p = param.parent_source[is];
param.base_src_qs[is] = param.base_src_qs[p];
param.base_src_qs[is].op = copy_qss_op_list(param.base_src_qs[p].op);
/* Add the new operator to the linked list */
insert_qss_op(¶m.base_src_qs[is], ¶m.src_qs_op[is]);
/* Append the operator info to the description if the operator
is nontrivial, but simply copy the label */
if(param.src_qs_op[is].type != IDENTITY){
char *descrp = param.base_src_qs[is].descrp;
char *op_descrp = param.src_qs_op[is].descrp;
char *label = param.base_src_qs[is].label;
char *op_label = param.src_qs_op[is].label;
strncat(descrp, "/", MAXDESCRP-strlen(descrp)-1);
strncat(descrp, op_descrp, MAXDESCRP-strlen(descrp)-1);
strncpy(label, op_label, MAXSRCLABEL-strlen(label)-1);
}
}
/* Get optional file for saving the modified source */
IF_OK {
int source_type, saveflag_s;
char descrp[MAXDESCRP];
char savefile_s[MAXFILENAME];
status +=
ask_output_quark_source_file( stdin, prompt, &saveflag_s,
&source_type, NULL, descrp,
savefile_s );
IF_OK {
param.base_src_qs[is].savetype = source_type;
param.base_src_qs[is].saveflag = saveflag_s;
strcpy(param.base_src_qs[is].save_file, savefile_s);
if(saveflag_s != FORGET && source_type != DIRAC_FIELD_FILE &&
source_type != VECTOR_FIELD_FILE){
printf("Unsupported output source type\n");
status++;
}
} /* OK */
} /* OK */
}
/*------------------------------------------------------------*/
/* Propagators and their sources */
/*------------------------------------------------------------*/
/* Number of propagators */
IF_OK status += get_i(stdin,prompt,"number_of_propagators",
¶m.num_prop );
if( param.num_prop>MAX_PROP ){
printf("num_prop = %d must be <= %d!\n", param.num_prop, MAX_PROP);
status++;
}
/* Get propagator parameters */
IF_OK for(i = 0; i < param.num_prop; i++){
/* Initialize dependency */
param.prop_dep_qkno[i] = 0;
/* Type of propagator */
IF_OK status += get_s(stdin, prompt,"propagator_type", savebuf );
IF_OK {
/* Standard clover */
if(strcmp(savebuf,"clover") == 0)param.prop_type[i] = CLOVER_TYPE;
/* Standard staggered (asqtad or HISQ) to be converted to naive */
else if(strcmp(savebuf,"KS") == 0)param.prop_type[i] = KS_TYPE;
/* Same as standard staggered, but conversion to naive is based on hypercube offset 0 */
else if(strcmp(savebuf,"KS0") == 0)param.prop_type[i] = KS0_TYPE;
/* Staggered propagator originating from an extended Dirac source */
else if(strcmp(savebuf,"KS4") == 0)param.prop_type[i] = KS4_TYPE;
/* Improved fermion lattice action (OK action) */
else if(strcmp(savebuf,"ifla") == 0 )param.prop_type[i] = IFLA_TYPE;
else {
printf("Unknown quark type %s\n",savebuf);
status++;
}
}
/* Mass parameters, etc */
if(param.prop_type[i] == CLOVER_TYPE){
IF_OK status += get_s(stdin, prompt,"kappa", param.kappa_label[i]);
IF_OK param.dcp[i].Kappa = atof(param.kappa_label[i]);
IF_OK status += get_f(stdin, prompt,"clov_c", ¶m.dcp[i].Clov_c );
param.dcp[i].U0 = param.u0;
} else if(param.prop_type[i] == IFLA_TYPE) {
printf("Ifla Type Fermion\n");
#ifndef HAVE_QOP
printf("Compilation with the QOP package is required for this fermion type\n");
terminate(1);
#endif
IF_OK status += get_s(stdin,prompt,"kapifla",param.kappa_label[i]);
IF_OK param.nap[i].kapifla = atof(param.kappa_label[i]);
IF_OK status += get_f(stdin, prompt, "kappa_s", ¶m.nap[i].kappa_s);
IF_OK status += get_f(stdin, prompt, "kappa_t", ¶m.nap[i].kappa_t);
IF_OK status += get_f(stdin, prompt, "r_s", ¶m.nap[i].r_s);
IF_OK status += get_f(stdin, prompt, "r_t", ¶m.nap[i].r_t);
IF_OK status += get_f(stdin, prompt, "zeta", ¶m.nap[i].zeta);
IF_OK status += get_f(stdin, prompt, "c_E", ¶m.nap[i].c_E);
IF_OK status += get_f(stdin, prompt, "c_B", ¶m.nap[i].c_B);
IF_OK status += get_f(stdin, prompt, "c_1", ¶m.nap[i].c_1);
IF_OK status += get_f(stdin, prompt, "c_2", ¶m.nap[i].c_2);
IF_OK status += get_f(stdin, prompt, "c_3", ¶m.nap[i].c_3);
IF_OK status += get_f(stdin, prompt, "c_4", ¶m.nap[i].c_4);
IF_OK status += get_f(stdin, prompt, "c_5", ¶m.nap[i].c_5);
IF_OK status += get_f(stdin, prompt, "c_EE", ¶m.nap[i].c_EE);
param.nap[i].u0 = param.u0;
} else { /* KS_TYPE || KS0_TYPE || KS4_TYPE */
IF_OK status += get_s(stdin, prompt,"mass", param.mass_label[i] );
IF_OK param.ksp[i].mass = atof(param.mass_label[i]);
#if FERM_ACTION == HISQ
IF_OK status += get_f(stdin, prompt, "naik_term_epsilon",
¶m.ksp[i].naik_term_epsilon);
#else
IF_OK param.ksp[i].naik_term_epsilon = 0.0;
#endif
}
/* Should we solve for the propagator? */
IF_OK status += get_s(stdin, prompt,"check", savebuf);
IF_OK {
/* Should we be checking the propagator by running the solver? */
if(strcmp(savebuf,"no") == 0)param.check[i] = CHECK_NO;
else if(strcmp(savebuf,"yes") == 0)
param.check[i] = CHECK_YES;
else if(strcmp(savebuf,"sourceonly") == 0)
param.check[i] = CHECK_SOURCE_ONLY;
else{
printf("Unrecognized 'check' option. Wanted 'no', 'yes', or 'sourceonly'\n");
status++;
}
}
/* Error for propagator conjugate gradient or bicg */
IF_OK status += get_f(stdin, prompt,"error_for_propagator",
¶m.qic[i].resid );
IF_OK status += get_f(stdin, prompt,"rel_error_for_propagator",
¶m.qic[i].relresid );
IF_OK status += get_i(stdin, prompt,"precision", ¶m.qic[i].prec );
#if ! defined(HAVE_QOP) && ! defined(USE_CG_GPU)
if(param.qic[i].prec != PRECISION){
node0_printf("WARNING: Compiled precision %d overrides request\n",PRECISION);
node0_printf("QOP or CG_GPU compilation is required for mixed precision\n");
param.qic[i].prec = PRECISION;
}
#endif
param.qic[i].max = max_cg_iterations;
param.qic[i].nrestart = max_cg_restarts;
param.qic[i].parity = EVENANDODD;
param.qic[i].min = 0;
param.qic[i].start_flag = 0;
param.qic[i].nsrc = 1;
/* Momentum twist and time boundary condition */
IF_OK status += get_vf(stdin, prompt, "momentum_twist",
bdry_phase, 3);
IF_OK status += get_s(stdin, prompt,"time_bc", savebuf);
if(param.prop_type[i] == CLOVER_TYPE || param.prop_type[i] == IFLA_TYPE){
/* NOTE: The Dirac built-in bc is periodic. */
IF_OK {
if(strcmp(savebuf,"antiperiodic") == 0)bdry_phase[3] = 1;
else if(strcmp(savebuf,"periodic") == 0)bdry_phase[3] = 0;
else{
node0_printf("Expecting 'periodic' or 'antiperiodic' but found %s\n",
savebuf);
status++;
}
}
} else { /* KS_TYPE || KS0_TYPE || KS4_TYPE */
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 main(int argc, char **argv)
{
int meascount[MAX_NKAP];
int prompt, count1, count2;
Real avm_iters[MAX_NKAP];
double starttime, endtime;
int MaxMR, restart_flag;
Real RsdMR; /******/
int spin, color, nk; /******/
int max_prop;
int cl_cg = CL_CG;
double ssplaq, stplaq;
FILE *fp_m_out = NULL; /*** meson IO stuff **/
int fb_m_out = 0; /*** meson IO stuff **/
w_prop_file *fp_in_w[MAX_NKAP]; /* For propagator files */
w_prop_file *fp_out_w[MAX_NKAP]; /* For propagator files */
double g_time ;
int i ;
int MinMR;
/*** variables required for the static variational code ***/
int nodata = 0 ;
complex *meson = NULL;
/****** start of the execution of the code ************/
initialize_machine(&argc, &argv);
/* Remap standard I/O */
if(remap_stdio_from_args(argc, argv) == 1)terminate(1);
g_sync();
/* set up */
prompt = setup_h();
/**DEBUG***/
#ifdef DEBUGDEF
light_quark_pion(0) ;
#endif
/* loop over input sets */
while( readin(prompt) == 0)
{
if( fixflag == COULOMB_GAUGE_FIX)
{
if(this_node == 0)
printf("Fixing to Coulomb gauge\n");
g_time = -dclock();
gaugefix(TUP,(Real)1.5,500,GAUGE_FIX_TOL);
g_time += dclock();
if(this_node==0)printf("Time to gauge fix = %e\n",g_time);
invalidate_this_clov(gen_clov);
}
else
if(this_node == 0)printf("COULOMB GAUGE FIXING SKIPPED.\n");
/* save lattice if requested */
if( saveflag != FORGET )
{
save_lattice( saveflag, savefile, stringLFN );
}
/* call plaquette measuring process */
d_plaquette(&ssplaq, &stplaq);
if (this_node == 0)
printf("START %e %e\n",(double) ssplaq, (double) stplaq);
/******* set up code for the static variational calculation *****/
if( nkap == 1 )
{
nodata = nt*nosmear*144 ;
/** reserve memory for the smeared meson correlators on each node ****/
if( ( meson = (complex *) calloc( (size_t) nodata, sizeof(complex) ) ) == NULL )
{
printf("ERROR: could not reserve buffer space for the meson smearing functions\n");
terminate(1);
}
/** call a number of set up routines for the static variational code ***/
setup_vary(meson, nodata);
} /*** end of set up section for the static-variational calculation ***/
/***DEBUG check_calc_matrix() ; ****/
starttime=dclock();
MaxMR = niter;
RsdMR = (Real) sqrt((double) rsqprop);
if (this_node == 0)
printf("Residue=%e\n",(double) RsdMR);
for (nk = 0; nk < nkap; nk++)
{
avm_iters[nk] = 0.0;
meascount[nk] = 0;
}
max_prop = 12;
count1 = 0;
count2 = 0;
for (spin = start_spin; spin < 4; spin++)
{
for (color = 0; color < 3; color++)
{
count1++;
if (count1 == 1)
color += start_color;
for (nk = 0; nk < nkap; nk++)
{
count2++;
if (count2 == 1)
nk += start_kap;
kappa = cappa[nk];
meascount[nk]++;
/* open file for wilson propagators */
fp_in_w[nk] = r_open_wprop(startflag_w[nk], startfile_w[nk]);
if ((spin + color) == 0)
{
/*** first pass of the code **/
fp_out_w[nk] = w_open_wprop(saveflag_w[nk], savefile_w[nk],
wqs.type);
/* open file for meson output and write the header */
if (saveflag_m == SAVE_MESON_ASCII)
{
fp_m_out = w_ascii_m_i(savefile_m[nk], max_prop);
fb_m_out = -1; /* i.e. file is NOT binary */
}
else if (saveflag_m == SAVE_MESON_BINARY)
{
fb_m_out = w_binary_m_i(savefile_m[nk], max_prop);
fp_m_out = NULL; /* i.e. file is NOT ascii */
}
else
{
if( this_node == 0 )
printf("ERROR in main saveflag_m = %d is out of range in initial opening\n",saveflag_m) ;
terminate(1);
}
} /*** end of spin =0 && color == 0 **/
else
{
fp_out_w[nk] = w_open_wprop(saveflag_w[nk], savefile_w[nk],
wqs.type);
/* open file for meson output for appending output*/
if (saveflag_m == SAVE_MESON_ASCII)
{
fp_m_out = a_ascii_m_i(savefile_m[nk], max_prop);
fb_m_out = -1; /* i.e. file is NOT binary */
}
if (saveflag_m == SAVE_MESON_BINARY)
{
fb_m_out = a_binary_m_i(savefile_m[nk], max_prop);
fp_m_out = NULL; /* i.e. file is NOT ascii */
}
else
{
if( this_node == 0 )
printf("ERROR in main saveflag_m = %d is out of range in appending opening\n",saveflag_m) ;
terminate(1);
}
} /*** end of spin && color not equal to zero ***/
if (this_node == 0)
printf("color=%d spin=%d kappa=%f nk=%d\n", color, spin, (double) kappa, nk);
/* load psi if requested */
init_qs(&wqstmp2);
reload_wprop_sc_to_site(startflag_w[nk], fp_in_w[nk],&wqstmp2,
spin, color, F_OFFSET(psi),1);
if (nk == 0 || count2 == 1)
restart_flag = flag;
else
restart_flag = 1;
/* Conjugate gradient inversion uses site structure
temporary"chi" */
/* Complete the source structure */
wqs.color = color;
wqs.spin = spin;
wqs.parity = EVENANDODD;
/* For wilson_info */
wqstmp = wqs;
/* If we are starting fresh, we want to set a mininum number of
iterations */
if(startflag_w[nk] == FRESH)MinMR = nt/2; else MinMR = 0;
/* Load inversion control structure */
qic.prec = PRECISION;
qic.min = MinMR;
qic.max = MaxMR;
qic.nrestart = nrestart;
qic.parity = EVENANDODD;
qic.start_flag = restart_flag;
qic.nsrc = 1;
qic.resid = RsdMR;
qic.relresid = 0;
/* Load Dirac matrix parameters */
dwp.Kappa = kappa;
switch (cl_cg) {
case CG:
/* Load temporaries specific to inverter */
/* compute the propagator. Result in psi. */
avm_iters[nk] +=
(Real)wilson_invert_site_wqs(F_OFFSET(chi),F_OFFSET(psi),
w_source_h,&wqs,
cgilu_w_site,&qic,(void *)&dwp);
break;
case MR:
/* Load temporaries specific to inverter */
/* compute the propagator. Result in psi. */
avm_iters[nk] +=
(Real)wilson_invert_site_wqs(F_OFFSET(chi),F_OFFSET(psi),
w_source_h,&wqs,
mrilu_w_site,&qic,(void *)&dwp);
break;
default:
node0_printf("main(%d): Inverter choice %d not supported\n",
this_node,cl_cg);
}
/* save psi if requested */
save_wprop_sc_from_site( saveflag_w[nk],fp_out_w[nk], &wqstmp2,
spin,color,F_OFFSET(psi),1);
light_meson(F_OFFSET(psi), color, spin, wqs.type, fp_m_out, fb_m_out);
if (this_node == 0)
printf("Light mesons found\n");
/*** calculate the correlators required for the static variational code **/
if( nkap == 1 )
{
/** calculate the smeared meson correlators required for Bparam **/
calc_smeared_meson(meson, F_OFFSET(psi) , F_OFFSET(mp), color, spin);
/** calculate the object required for the 2-pt variational calculation ***/
buildup_strip(F_OFFSET(psi) , color, spin);
} /** end of the partial calculations for the variationl project ***/
/*
* find source again since mrilu overwrites it; for hopping
* expansion
*/
/* source must be of definite parity */
wqs.parity = source_parity;
w_source_h(F_OFFSET(chi), &wqs);
hopping(F_OFFSET(chi), F_OFFSET(mp), F_OFFSET(psi), nhop,
kappa_c, wqs.parity, color, spin, wqs.type,
fp_m_out, fb_m_out);
/* close files */
r_close_wprop(startflag_w[nk], fp_in_w[nk]);
w_close_wprop(saveflag_w[nk],fp_out_w[nk]);
if (saveflag_m == SAVE_MESON_ASCII)
w_ascii_m_f(fp_m_out, savefile_m[nk]);
else if (saveflag_m == SAVE_MESON_BINARY)
w_binary_m_f(fb_m_out, savefile_m[nk]);
if (spin == end_spin && color == end_color && nk == end_kap)
goto end_of_loops;
}
}
} /* end of loop over spin, color, kappa */
end_of_loops:
if (this_node == 0)
printf("RUNNING COMPLETED\n");
/**DEBUG***/
#ifdef DEBUGDEF
light_quark_pion(2) ;
#endif
for (nk = 0; nk < nkap; nk++)
{
if (meascount[nk] > 0)
{
if (this_node == 0)
printf("total mr iters for measurement= %e\n",
(double) avm_iters[nk]);
if (this_node == 0)
printf("average mr iters per spin-color= %e\n",
(double) avm_iters[nk] / (double) meascount[nk]);
}
}
endtime=dclock();
node0_printf("Time = %e seconds\n", (double) (endtime - starttime));
fflush(stdout);
/*** calculation section for the variational code *****/
if( nkap == 1 )
{
/** sum up the smeared meson correlators over all the nodes ***/
for(i=0 ; i < nodata ;++i)
{
g_complexsum(meson + i) ;
}
/* write the smeared correlators to a single disk file ***/
IF_MASTER
write_smear_mesonx(meson);
free(meson); /*** free up the memory for the b-parameter correlators ***/
calc_vary_matrix() ; /** calculate the static variational matrix **/
node0_printf(">> The end of the static variational code <<<<\n");
}/** end of the final static variational code *****/
node0_printf("Time = %e seconds\n",(double)(endtime-starttime));
fflush(stdout);
} /* end of while(prompt) */
return 0;
} /* end of main() */
