void hoverlap(field_offset src,
field_offset dest)
{
register int i;
register site *s;
wilson_vector wtmp;
Real term1,term2;
/*
term1=R0*(1.0-m0);
term2=m0+R0*(1.0-m0);
*/
/* massless overlap */
term1=term2=R0;
/* compute the step function term */
step(src,dest);
/* and add in the ''gamma-5'' term, multiply sum by R0 */
FORALLSITES(i,s){
mult_by_gamma((wilson_vector *)F_PT(s,src),&wtmp,
GAMMAFIVE);
scalar_mult_wvec(&(wtmp),term2,&wtmp);
scalar_mult_wvec((wilson_vector *)F_PT(s,dest),term1,
(wilson_vector *)F_PT(s,dest) );
add_wilson_vector((wilson_vector *)F_PT(s,dest),
&wtmp,(wilson_vector *)F_PT(s,dest));
}
void delta0(field_offset src,field_offset dest, int isign)
{
register int i;
register site *s;
msg_tag *tag[2];
wilson_vector wvec1,wvec2;
int ipath,n[4],k,mu;
Real inr[4];
/* begin with the origin */
FORALLSITES(i,s) {
scalar_mult_wvec((wilson_vector *)F_PT(s,src), lambda[0],
(wilson_vector *)F_PT(s,dest));
}
static int
bicgilu_cl_qop(quark_invert_control *qic, Real clov,
MYREAL *kappas[], int nkappa[],
wilson_vector *milc_srcs[],
wilson_vector **milc_sols[],
int nsrc, int *final_restart,
Real* final_rsq_ptr, int milc_parity )
{
int isrc, ikappa;
QOP_FermionLinksWilson *qop_links;
QOP_DiracFermion **qop_sol[MAXSRC], *qop_src[MAXSRC];
int iterations_used = 0;
QOP_invert_arg_t qop_invert_arg;
QOP_resid_arg_t ***qop_resid_arg;
double remaptime;
int i;
site *s;
if(nsrc > MAXSRC){
printf("bicgilu_cl_qop: too many sources\n");
terminate(1);
}
/* Initialize QOP */
if(initialize_qop() != QOP_SUCCESS){
printf("bicbilu_cl_qop: Error initializing QOP\n");
terminate(1);
}
/* Create QOP links object */
qop_links = create_qop_wilson_fermion_links( clov );
/* Set qop_invert_arg */
set_qop_invert_arg( & qop_invert_arg, qic, milc_parity );
/* Pointers for residual errors */
qop_resid_arg = create_qop_resid_arg( nsrc, nkappa, (qic->resid)*(qic->resid));
remaptime = -dclock();
/* Pointers for solution vectors */
for(isrc = 0; isrc < nsrc; isrc++){
qop_sol[isrc] =
(QOP_DiracFermion **)malloc(sizeof(QOP_DiracFermion *)*nkappa[isrc]);
if(qop_sol[isrc] == NULL){
printf("bicgilu_cl_qop: Can't allocate qop_sol\n");
terminate(1);
}
}
/* Map MILC source and sink to QOP fields */
for(isrc = 0; isrc < nsrc; isrc++){
gamma5_flip(milc_srcs[isrc], milc_parity); /* compensate for QOP gamma */
qop_src[isrc] = create_D_from_field( milc_srcs[isrc], milc_parity);
gamma5_flip(milc_srcs[isrc], milc_parity); /* restore the source */
for(ikappa = 0; ikappa < nkappa[isrc]; ikappa++){
/* Adjust normalization for MILC conventions */
gamma5_flip(milc_sols[isrc][ikappa], milc_parity); /* compensate for QOP gamma */
FORALLSITES(i,s){
scalar_mult_wvec( milc_sols[isrc][ikappa]+i, 2.*kappas[isrc][ikappa],
milc_sols[isrc][ikappa]+i);
}
qop_sol[isrc][ikappa] =
create_D_from_field( milc_sols[isrc][ikappa], milc_parity);
}
}
void zv_meas(
field_offset src1, /* src1 is type wilson_propagator (forward) */
field_offset src2, /* src2 is type wilson_propagator (backward) */
Real *f_1, complex *f_V, Real Kappa)
{
register int i;
register site *s;
int my_t, src_s, src_c, si, ci;
Real ftmp;
complex cc;
half_wilson_vector hwv1, hwv2;
wilson_vector *K_prop[3][4], *K_tmp, wv1, wtmp;
for(ci=0;ci<3;ci++) for(si=0;si<4;si++){
K_prop[ci][si] = (wilson_vector *)malloc(sizeof(wilson_vector));
}
K_tmp = (wilson_vector *)malloc(sizeof(wilson_vector));
/* Construct K, gamma_5*K and f_1 */
ftmp = Kappa / (Real)(nx*ny*nz);
*f_1 = 0.0;
for(src_c=0;src_c<3;src_c++) for(src_s=0;src_s<4;src_s++){
clear_wvec( K_tmp);
FORALLSITES(i,s) if(s->t == (nt-1)){
wp_shrink(
&(((wilson_propagator *)F_PT(s,src1))->c[src_c].d[src_s]),
&hwv1, TUP, MINUS);
mult_adj_su3_mat_hwvec( &(s->link[TUP]), &hwv1, &hwv2);
wp_grow_add( &hwv2, K_tmp, TUP, MINUS);
}
g_wvectorsumfloat( K_tmp);
scalar_mult_wvec( K_tmp, ftmp, K_tmp);
*f_1 += magsq_wvec( K_tmp);
mult_by_gamma( K_tmp, K_prop[src_c][src_s], GAMMAFIVE);
}
*f_1 /= 8.0*Kappa*Kappa;
FORALLSITES(i,s) if(s->t > 0){
my_t = s->t;
for(src_c=0;src_c<3;src_c++) for(src_s=0;src_s<4;src_s++){
/* K_tmp = src2 * gamma_5 * K_prop */
clear_wvec( K_tmp);
for(ci=0;ci<3;ci++) for(si=0;si<4;si++){
c_scalar_mult_add_wvec( K_tmp,
&(((wilson_propagator *)F_PT(s,src2))->c[ci].d[si]),
&K_prop[src_c][src_s]->d[si].c[ci], K_tmp);
/* &((wilson_vector *)(K_prop[src_c][src_s])->d[si].c[ci]), K_tmp); */
/* K_prop[src_c][src_s]->d[si].c[ci], K_tmp); */
}
/* wv1 = gamma_5 * gamma_0 * src1 */
mult_by_gamma(
&(((wilson_propagator *)F_PT(s,src1))->c[src_c].d[src_s]),
&wtmp, TUP);
mult_by_gamma( &wtmp, &wv1, GAMMAFIVE);
/* Now construct f_V */
/* gamma_0 is negative of usual chiral basis */
cc = wvec2_dot( K_tmp, &wv1);
f_V[my_t].real -= cc.real;
f_V[my_t].imag -= cc.imag;
}
}
/* Normalize f_V */
ftmp = 4.0 * Kappa;
for(my_t=0; my_t<nt; my_t++){
f_V[my_t].real /= ftmp;
f_V[my_t].imag /= ftmp;
}
for(ci=0;ci<3;ci++) for(si=0;si<4;si++){
free(K_prop[ci][si]);
}
free(K_tmp);
} /* zv_meas */
static int
bicgilu_cl_qop_qdp(int prop_type, int nsrc, int nkappa[],
quark_invert_control *qic,
void *dmps[], wilson_vector *milc_srcs[],
wilson_vector **milc_sols[],
int *final_restart,
Real* final_rsq_ptr, int milc_parity )
{
int isrc, ikappa;
QOP_FermionLinksWilson *qop_links;
QOP_DiracFermion **qop_sol[MAXSRC], *qop_src[MAXSRC];
int iterations_used = 0;
double remaptime;
int i;
site *s;
static float t_kappa;
float *kappas[1] = { &t_kappa };
char myname[] = "bicgilu_cl_qop_qdp";
/* Check dimension */
if(nsrc > MAXSRC){
printf("%s: too many sources\n",myname);
terminate(1);
}
/* Initialize QOP */
if(initialize_qop() != QOP_SUCCESS){
printf("%s: Error initializing QOP\n",myname);
terminate(1);
}
/* Create QOP links object (double precision) and extract kappa */
if(prop_type == CLOVER_TYPE){
/* If there are multiple kappas, we assume that the Clov_c and u0
are the same for all kappas in this solve */
dirac_clover_param *dcp
= (dirac_clover_param *)dmps[0]; /* Cast pass-through pointer */
Real Clov_c = dcp->Clov_c; /* Perturbative clover coeff */
Real U0 = dcp->U0; /* Tadpole correction to Clov_c */
Real clov = Clov_c/(U0*U0*U0); /* Full clover coefficient */
t_kappa = dcp->Kappa;
qop_links = create_qop_wilson_fermion_links( clov );
} else { /* IFLA (OK) type */
newaction_ifla_param *nap
= (newaction_ifla_param *)dmps[0]; /* Cast pass-through pointer */
t_kappa = nap->kapifla;
qop_links = create_qop_wilson_fermion_links( 0 );
}
remaptime = -dclock();
/* Pointers for solution vectors */
for(isrc = 0; isrc < nsrc; isrc++){
qop_sol[isrc] =
(QOP_DiracFermion **)malloc(sizeof(QOP_DiracFermion *)*nkappa[isrc]);
if(qop_sol[isrc] == NULL){
printf("bicgilu_cl_qop_qdp: Can't allocate qop_sol\n");
terminate(1);
}
}
/* Map MILC source and sink to double-precision QOP fields */
for(isrc = 0; isrc < nsrc; isrc++){
gamma5_flip(milc_srcs[isrc], milc_parity); /* compensate for QOP gamma */
qop_src[isrc] = create_D_from_field( milc_srcs[isrc], milc_parity);
gamma5_flip(milc_srcs[isrc], milc_parity); /* restore the source */
for(ikappa = 0; ikappa < nkappa[isrc]; ikappa++){
/* Adjust normalization for MILC conventions */
gamma5_flip(milc_sols[isrc][ikappa], milc_parity); /* compensate for QOP gamma */
FORALLSITES(i,s){
scalar_mult_wvec( milc_sols[isrc][ikappa]+i, 2.*kappas[isrc][ikappa],
milc_sols[isrc][ikappa]+i);
}
qop_sol[isrc][ikappa] =
create_D_from_field( milc_sols[isrc][ikappa], milc_parity);
}
}
