/* dest <- dest + sum_i eigVec[i]*H^{-1}*eigVec[i].resid,
resid = src - (-Dslash^2 + 4*mass^2)*dest
*/
static void initCG(su3_vector *src, su3_vector *dest, int Nvecs_curr, int Nvecs_max,
su3_vector **eigVec, double_complex *H, Real mass, int parity,
imp_ferm_links_t *fn){
/* Constants */
int ione = 1;
int otherparity = (parity == EVEN) ? ODD : EVEN;
Real msq_x4 = 4.0*mass*mass;
double dzero = (double)0.0;
double_complex zzero = dcmplx(dzero, dzero);
register int i;
int j, info;
double_complex cc;
double_complex *c, *H2;
su3_vector *resid;
c = (double_complex *)malloc(Nvecs_curr*sizeof(double_complex));
resid = (su3_vector *)malloc(sites_on_node*sizeof(su3_vector));
/* resid <- src - (-Dslash^2 + 4*mass^2)*dest */
dslash_fn_field(dest, resid, otherparity, fn);
dslash_fn_field(resid, resid, parity, fn);
FORSOMEFIELDPARITY_OMP(i, parity, default(shared)){
scalar_mult_sum_su3_vector(resid+i, dest+i, -msq_x4);
add_su3_vector(resid+i, src+i, resid+i);
} END_LOOP_OMP
/* c[i] = eigVec[i].resid */
for(j = 0; j < Nvecs_curr; j++){
// c[j] = zzero;
// FORSOMEFIELDPARITY_OMP(i, parity, private(cc) reduction(+:c[j])){
// cc = su3_dot(eigVec[j]+i, resid+i);
// CSUM(c[j], cc);
// } END_LOOP_OMP
double cctotr=0., cctoti=0.;
FORSOMEFIELDPARITY_OMP(i, parity, private(cc) reduction(+:cctotr,cctoti)){
cc = su3_dot(eigVec[j]+i, resid+i);
cctotr += cc.real;
cctoti += cc.imag;
} END_LOOP_OMP;
c[j].real = cctotr;
c[j].imag = cctoti;
}
g_vecdcomplexsum(c, Nvecs_curr);
free(resid);
H2 = (double_complex *)malloc(Nvecs_curr*Nvecs_curr*sizeof(double_complex));
/* H2 = H + 4*mass^2*I */
for(j = 0; j < Nvecs_curr; j++){
zcopy_(&Nvecs_curr, H+Nvecs_max*j, &ione, H2+Nvecs_curr*j, &ione);
CSUM(H2[(Nvecs_curr+1)*j], dcmplx(msq_x4, dzero));
}
/* Compute H^{-1}*c = H^{-1}*eigVec.resid with Cholesky decomposition */
zpotrf_("U", &Nvecs_curr, H2, &Nvecs_curr, &info);
zpotrs_("U", &Nvecs_curr, &ione, H2, &Nvecs_curr, c, &Nvecs_curr, &info);
free(H2);
/* dest <- dest + sum_j c[i]*eigVec[i] = dest + sum_i eigVec[i]*H^{-1}*eigVec[i].resid */
for(j = 0; j < Nvecs_curr; j++){
FORSOMEFIELDPARITY_OMP(i, parity, default(shared)){
c_scalar_mult_add_su3vec(dest+i, c+j, eigVec[j]+i);
} END_LOOP_OMP
}
free(c);
}
int main( int argc, char **argv ){
register site *s;
int i,si;
int prompt;
double dtime;
su3_vector **eigVec ;
su3_vector *tmp ;
double *eigVal ;
int total_R_iters ;
double chirality ;
initialize_machine(&argc,&argv);
#ifdef HAVE_QDP
QDP_initialize(&argc, &argv);
#ifndef QDP_PROFILE
QDP_profcontrol(0);
#endif
#endif
/* Remap standard I/O */
if(remap_stdio_from_args(argc, argv) == 1)terminate(1);
g_sync();
/* set up */
prompt = setup();
/* loop over input sets */
while( readin(prompt) == 0){
dtime = -dclock();
invalidate_all_ferm_links(&fn_links);
make_path_table(&ks_act_paths, &ks_act_paths_dmdu0);
/* Load fat and long links for fermion measurements if needed */
load_ferm_links(&fn_links, &ks_act_paths);
/* call fermion_variable measuring routines */
/* results are printed in output file */
f_meas_imp( F_OFFSET(phi), F_OFFSET(xxx), mass,
&fn_links, &fn_links_dmdu0);
eigVal = (double *)malloc(Nvecs*sizeof(double));
eigVec = (su3_vector **)malloc(Nvecs*sizeof(su3_vector*));
for(i=0;i<Nvecs;i++)
eigVec[i]=
(su3_vector*)malloc(sites_on_node*sizeof(su3_vector));
total_R_iters=Kalkreuter(eigVec, eigVal, eigenval_tol,
error_decr, Nvecs, MaxIter, Restart,
Kiters, EVEN, &fn_links) ;
tmp = (su3_vector*)malloc(sites_on_node*sizeof(su3_vector));
for(i=0;i<Nvecs;i++)
{
/* Construct to odd part of the vector. *
* Note that the true odd part of the eigenvector is *
* i/sqrt(eigVal) Dslash Psi. But since I only compute *
* the chirality the i factor is irrelevant (-i)*i=1!! */
dslash_fn_field(eigVec[i], tmp, ODD, &fn_links) ;
FORSOMEPARITY(si,s,ODD){
scalar_mult_su3_vector( &(tmp[si]),
1.0/sqrt(eigVal[i]),
&(eigVec[i][si]) ) ;
}
measure_chirality(eigVec[i], &chirality, EVENANDODD);
/* Here I divide by 2 since the EVEN vector is normalized to
* 1. The EVENANDODD vector is normalized to 2. I could have
* normalized the EVENANDODD vector to 1 and then not devide
* by to. The measure_chirality routine assumes vectors
* normalized to 1. */
node0_printf("Chirality(%i): %g\n",i,chirality/2) ;
}
free(tmp);
/**
for(i=0;i<Nvecs;i++)
{
sprintf(label,"DENSITY(%i)",i) ;
print_densities(eigVec[i], label, ny/2,nz/2,nt/2, EVEN) ;
}
**/
for(i=0;i<Nvecs;i++)
free(eigVec[i]) ;
free(eigVec) ;
free(eigVal) ;
#ifdef FN
invalidate_all_ferm_links(&fn_links);
#endif
fflush(stdout);
node0_printf("RUNNING COMPLETED\n"); fflush(stdout);
dtime += dclock();
if(this_node==0){
printf("Time = %e seconds\n",dtime);
printf("total_iters = %d\n",total_iters);
printf("total Rayleigh iters = %d\n",total_R_iters);
}
fflush(stdout);
}
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 */
