void populationconstraint(int timestep) {
int i;
double constraint = 0., inv;
if(noise == 2) {
update_u(timestep);
}
current_fixation_prob = 0;
popdens_0thmom = 0;
popdens_1stmom = 0;
popdens_2ndmom = 0;
subpop_popsize = 0;
for(i=0;i<space;i++) {
constraint += (ww[i] + vv[i])*u[i];
current_fixation_prob += ww[i]*u[i];
subpop_popsize += ww[i];
popdens_0thmom += ww[i] + vv[i];
popdens_1stmom += x[i]*(ww[i] + vv[i]);
popdens_2ndmom += x[i]*x[i]*(ww[i] + vv[i]);
}
if(constraint>0)inv = 1./constraint;
for(i=0;i<space;i++) {
ww[i] *= inv;
vv[i] *= inv;
}
current_fixation_prob *= inv;
popdens_0thmom *= inv;
popdens_1stmom *= inv;
popdens_2ndmom *= inv;
populationsize = popdens_0thmom;
populationvariance = popdens_2ndmom/popdens_0thmom - popdens_1stmom*popdens_1stmom/(popdens_0thmom*popdens_0thmom);
}
int main(void){
double *u_past;
double *u_present;
double delta_x=0.01;
int n_x = (int)(10.0/delta_x);
double delta_t = 1E-4;
int n_t = (int)(2.0/delta_t);
double c = 1.0;
int i;
/*reserva memoria*/
u_past = malloc(n_x * sizeof(double));
u_present = malloc(n_x * sizeof(double));
/*inicializacion*/
initial_condition(u_past, n_x, delta_x);
for(i=0;i<n_t;i++){
update_u(u_present, u_past, n_x,delta_x, delta_t, c);
copy(u_present, u_past, n_x);
}
/*imprime en pantalla*/
print_u(u_past, n_x);
return 0;
}
double populationconstraint(int timestep) {
int i;
double constraint = 0., inv = 1., sumxg = 0.0, sumg = 0.0;
double tmp;
if(noise == 2) {
update_u(timestep);
}
popdens_0thmom = 0;
popdens_1stmom = 0;
popdens_2ndmom = 0;
ucp = 0.;
for(i=0;i<space;i++) {
if(i>0) ucp -= nn[i-1]*u[i];
if(i<space-1)ucp += nn[i+1]*u[i];
constraint += nn[i]*u[i];
sumxg += (x[i] - current_mean_fitness)*nn[i]*u[i];
popdens_0thmom += nn[i];
popdens_1stmom += x[i]*nn[i];
popdens_2ndmom += x[i]*x[i]*nn[i];
}
ucp /= 2.*dx;
if(constraint>0)inv = 1./constraint;
if(noise==3) {
tmp = get_timetrace_popsize(timestep);
inv *= tmp;
}
if(windcontrolled) {
dv = -(1.-inv)/(ucp*epsilon);
}else{
for(i=0;i<space;i++) nn[i] *= inv;
}
popdens_0thmom *= inv;
popdens_1stmom *= inv;
popdens_2ndmom *= inv;
xg = sumxg/constraint;
populationsize = popdens_0thmom;
populationvariance = popdens_2ndmom/popdens_0thmom - popdens_1stmom*popdens_1stmom/(popdens_0thmom*popdens_0thmom);
return inv;
}
int main(){
double x_f = 1.0;
int n_x = 1000;
double delta_x = 0.001;
double delta_t = 5E-4;
int n_t = 350.0;
double c = 1.0;
double r = c * delta_t/delta_x;
double *u_past = malloc(n_x*sizeof(double));
double *u_present = malloc(n_x*sizeof(double));
double *u_future = malloc(n_x*sizeof(double));
initial_condition(u_past, n_x, delta_x);
/*print_u(u_past, n_x, delta_x);*/
u_past[0] = 0.0;
u_past[n_x-1] = 0.0;
u_present[0] = 0.0;
u_present[n_x-1] = 0.0;
first_iteration(u_present, u_past, n_x, r);
copy(u_present, u_past, n_x);
/*print_u(u_present, n_x, delta_x);*/
int i;
for(i=0;i<n_t;i++){
update_u(u_future, u_present, u_past, n_x, r);
copy(u_present, u_past, n_x);
copy(u_future, u_present, n_x);
}
print_u(u_present, n_x, delta_x);
return 0;
}
OBSOLETE! See update_rhmc.c
/********** update_rhmc_omelyan.c ******************************************/
/* MIMD version 7 */
/*
See Takaishi and de Forcrand hep-lat/-0505020
Update lattice.
compute PHI for both factors in fermion determinant at beginning
update U by (epsilon/2)*lambda
compute X for light and strange quarks for each term in rational
function (or "both factors in det")
update H, by epsilon
update U by epsilon * (2-lambda)
compute X for light and strange quarks for each term in rational
function
update H, by epsilon
update U by (epsilon/2)*lambda
This routine does not refresh the antihermitian momenta.
This routine begins at "integral" time, with H and U evaluated
at same time.
"lambda" is adjustable parameter. At lambda=1 this is just two
leapfrog steps of length epsilon. Note my lambda is 4X the lambda in
Takaishi and de Forcrand and my epsilon is 1/2 theirs. This makes
epsilon the same as for the leapfrog algorithm.
Omelyan "optimum lambda" is 4*0.1932
*/
#include "ks_imp_includes.h" /* definitions files and prototypes */
#define mat_invert mat_invert_uml
/**#define mat_invert mat_invert_cg**/
int update() {
int step, iters=0;
double startaction,endaction;
Real xrandom;
int i;
su3_vector **multi_x;
su3_vector *sumvec;
Real lambda;
int iphi;
lambda = 0.8;
node0_printf("Omelyan integration, steps= %d eps= %e lambda= %e\n",steps,epsilon,lambda);
if (steps %2 != 0 ){
node0_printf("BONEHEAD! need even number of steps\n");
exit(0);
}
/* allocate space for multimass solution vectors */
multi_x = (su3_vector **)malloc(max_rat_order*sizeof(su3_vector *));
if(multi_x == NULL){
printf("update: No room for multi_x\n");
terminate(1);
}
for(i=0;i<max_rat_order;i++)
multi_x[i]=(su3_vector *)malloc( sizeof(su3_vector)*sites_on_node );
sumvec = (su3_vector *)malloc( sizeof(su3_vector)*sites_on_node );
/* refresh the momenta */
ranmom();
/* generate a pseudofermion configuration only at start*/
for(iphi = 0; iphi < n_pseudo; iphi++){
grsource_imp_rhmc( F_OFFSET(phi[iphi]), &(rparam[iphi].GR), EVEN,
multi_x,sumvec, rsqmin_gr[iphi], niter_gr[iphi]);
}
/* find action */
startaction=d_action_rhmc(multi_x,sumvec);
/* copy link field to old_link */
gauge_field_copy( F_OFFSET(link[0]), F_OFFSET(old_link[0]));
/* do "steps" microcanonical steps (one "step" = one force evaluation)" */
for(step=2; step <= steps; step+=2){
/* update U's and H's - see header comment */
update_u(0.5*epsilon*lambda);
update_h_rhmc( epsilon, multi_x);
update_u(epsilon*(2.0-lambda));
update_h_rhmc( epsilon, multi_x);
update_u(0.5*epsilon*lambda);
/* reunitarize the gauge field */
rephase( OFF );
reunitarize();
rephase( ON );
/*TEMP - monitor action*/ //if(step%6==0)d_action_rhmc(multi_x,sumvec);
} /* end loop over microcanonical steps */
/* find action */
/* do conjugate gradient to get (Madj M)inverse * phi */
endaction=d_action_rhmc(multi_x,sumvec);
/* decide whether to accept, if not, copy old link field back */
/* careful - must generate only one random number for whole lattice */
#ifdef HMC
if(this_node==0)xrandom = myrand(&node_prn);
broadcast_float(&xrandom);
if( exp( (double)(startaction-endaction) ) < xrandom ){
if(steps > 0)
gauge_field_copy( F_OFFSET(old_link[0]), F_OFFSET(link[0]) );
#ifdef FN
invalidate_all_ferm_links(&fn_links);
invalidate_all_ferm_links(&fn_links_dmdu0);
#endif
node0_printf("REJECT: delta S = %e\n", (double)(endaction-startaction));
}
else {
node0_printf("ACCEPT: delta S = %e\n", (double)(endaction-startaction));
}
#else // not HMC
node0_printf("CHECK: delta S = %e\n", (double)(endaction-startaction));
#endif // HMC
/* free multimass solution vector storage */
for(i=0;i<max_rat_order;i++)free(multi_x[i]);
free(sumvec);
if(steps > 0)return (iters/steps);
else return(-99);
}
int init_subpopulation() {
int i,j;
int label_startindex = space;
double fixprob = 0.,frac_lastbin;
double subpop_crossover_step = dx;
double subpop_crossoverpoint = -space0*dx;
double subpop_last_fixationprob;
double subpop_current_fixationprob;
ww = (double*)calloc(space,sizeof(double));
vv = (double*)calloc(space,sizeof(double));
subpop_start_ww = (double*)malloc(space*sizeof(double));
subpop_start_vv = (double*)malloc(space*sizeof(double));
tmpw = (double*)malloc(space*sizeof(double));
tmpv = (double*)malloc(space*sizeof(double));
subpop_starting_mean_fitness = current_mean_fitness;
update_u(0);
initial_constraint();
switch(subpop_labeltype) {
case 0: label_startindex = space;
while (fixprob < subpop_expected_fixationprobability) {
label_startindex--;
fixprob += nn[label_startindex]*u[label_startindex];
}
if(label_startindex > space)print_error("subpop label threshold larger than simulationbox");
memcpy(&ww[label_startindex],&nn[label_startindex],(space-label_startindex)*sizeof(double));
memcpy(&vv[0],&nn[0],label_startindex*sizeof(double));
frac_lastbin = (fixprob - subpop_expected_fixationprobability)/(nn[label_startindex]*u[label_startindex]);
ww[label_startindex] = nn[label_startindex] * (1. - frac_lastbin);
vv[label_startindex] = nn[label_startindex] * frac_lastbin;
subpop_current_fixationprob = get_current_fixprob();
break;
case 1: for(i=0;i<space;i++) {
ww[i] = subpop_expected_fixationprobability * nn[i];
vv[i] = (1.-subpop_expected_fixationprobability) * nn[i];
}
subpop_current_fixationprob = get_current_fixprob();
break;
case 2: //fprintf(stderr,"# finding crossoverpoint\n");
j = 0;
if(subpop_labelparameter < 0)subpop_labelparameter = 10*dx; // default value
for(i=0;i<space;i++) {
ww[i] = cutoff_function((i-space0)*dx,subpop_crossoverpoint,subpop_labelparameter)*nn[i];
vv[i] = nn[i] - ww[i];
}
subpop_current_fixationprob = get_current_fixprob();
subpop_last_fixationprob = subpop_current_fixationprob;
while(fabs(subpop_current_fixationprob - subpop_expected_fixationprobability)>1e-10) {
subpop_crossoverpoint += subpop_crossover_step;
subpop_current_fixationprob = 0;
for(i=0;i<space;i++) {
ww[i] = cutoff_function((i-space0)*dx,subpop_crossoverpoint,subpop_labelparameter)*nn[i];
vv[i] = nn[i] - ww[i];
subpop_current_fixationprob += ww[i]*u[i];
}
//fprintf(stderr,"# %d %.10e %.10e %.10e\n",j++,subpop_current_fixationprob,subpop_crossover_step,subpop_crossoverpoint);
if( (subpop_current_fixationprob - subpop_expected_fixationprobability)*(subpop_last_fixationprob - subpop_expected_fixationprobability) < 0)subpop_crossover_step *= -.5;
subpop_last_fixationprob = subpop_current_fixationprob;
}
break;
default:print_error("label type not implemented");
break;
}
memcpy(subpop_start_ww,ww,space*sizeof(double));
memcpy(subpop_start_vv,vv,space*sizeof(double));
}
OBSOLETE! See update_rhmc.c
/********** update.c ****************************************************/
/* MIMD version 7 */
/*
Update lattice.
compute PHI for both factors in fermion determinant at beginning
update U by (epsilon/2)
compute X for light and strange quarks for each term in rational
function ( or "both factors in det.")
update H, full step
update U to next time needed
This routine does not refresh the antihermitian momenta.
This routine begins at "integral" time, with H and U evaluated
at same time.
*/
#include "ks_imp_includes.h" /* definitions files and prototypes */
#define mat_invert mat_invert_uml
/**#define mat_invert mat_invert_cg**/
int update() {
int step, iters=0;
double startaction,endaction;
#ifdef HMC
Real xrandom;
#endif
int i;
su3_vector **multi_x;
su3_vector *sumvec;
int iphi;
node0_printf("Leapfrog integration, steps= %d eps= %e\n",steps,epsilon);
/* allocate space for multimass solution vectors */
multi_x = (su3_vector **)malloc(max_rat_order*sizeof(su3_vector *));
if(multi_x == NULL){
printf("update: No room for multi_x\n");
terminate(1);
}
for(i=0;i<max_rat_order;i++){
multi_x[i]=(su3_vector *)malloc( sizeof(su3_vector)*sites_on_node );
if(multi_x[i] == NULL){
printf("update: No room for multi_x\n");
terminate(1);
}
}
sumvec = (su3_vector *)malloc( sizeof(su3_vector)*sites_on_node );
/* refresh the momenta */
ranmom();
/* generate a pseudofermion configuration only at start*/
// NOTE used to clear xxx here. May want to clear all solutions for reversibility
for(iphi = 0; iphi < n_pseudo; iphi++){
grsource_imp_rhmc( F_OFFSET(phi[iphi]), &(rparam[iphi].GR), EVEN,
multi_x,sumvec, rsqmin_gr[iphi], niter_gr[iphi]);
}
/* find action */
startaction=d_action_rhmc(multi_x,sumvec);
/* copy link field to old_link */
gauge_field_copy( F_OFFSET(link[0]), F_OFFSET(old_link[0]));
/* do "steps" microcanonical steps" */
for(step=1; step <= steps; step++){
/* update U's to middle of interval */
update_u(0.5*epsilon);
/* now update H by full time interval */
update_h_rhmc( epsilon, multi_x);
/* update U's by half time step to get to even time */
update_u(epsilon*0.5);
/* reunitarize the gauge field */
rephase( OFF );
reunitarize();
rephase( ON );
/*TEMP - monitor action*/if(step%4==0)d_action_rhmc(multi_x,sumvec);
} /* end loop over microcanonical steps */
/* find action */
/* do conjugate gradient to get (Madj M)inverse * phi */
endaction=d_action_rhmc(multi_x,sumvec);
/* decide whether to accept, if not, copy old link field back */
/* careful - must generate only one random number for whole lattice */
#ifdef HMC
if(this_node==0)xrandom = myrand(&node_prn);
broadcast_float(&xrandom);
if( exp( (double)(startaction-endaction) ) < xrandom ){
if(steps > 0)
gauge_field_copy( F_OFFSET(old_link[0]), F_OFFSET(link[0]) );
#ifdef FN
invalidate_fermion_links(fn_links);
// invalidate_all_ferm_links(&fn_links);
// invalidate_all_ferm_links(&fn_links_dmdu0);
#endif
node0_printf("REJECT: delta S = %e\n", (double)(endaction-startaction));
}
else {
node0_printf("ACCEPT: delta S = %e\n", (double)(endaction-startaction));
}
#else // not HMC
node0_printf("CHECK: delta S = %e\n", (double)(endaction-startaction));
#endif // HMC
/* free multimass solution vector storage */
for(i=0;i<max_rat_order;i++)free(multi_x[i]);
free(sumvec);
if(steps > 0)return (iters/steps);
else return(-99);
}
OBSOLETE!! multi_x is no longer sized correctly for more than one pseudofermion
/********** update_omelyan.c ****************************************************/
/* MIMD version 7 */
/*
See Takaishi and de Forcrand hep-lat/-0505020
Update lattice.
Two gauge steps for one fermion force step ("epsilon" is time for one fermion step)
update U to epsilon*(1/4-alpha/2)
Update H by epsilon*1/2*gauge_force
update U to epsilon*(1/2-beta)
Update H by epsilon*fermion_force
update U to epsilon*(3/4+alpha/2)
Update H by epsilon*1/2*gauge_force
update U to epsilon*(5/4-alpha/2)
Update H by epsilon*1/2*gauge_force
update U to epsilon*(3/2+beta)
Update H by epsilon*fermion_force
update U to epsilon*(7/4+alpha/2)
Update H by epsilon*1/2*gauge_force
update U to epsilon*(2)
This routine does not refresh the antihermitian momenta.
This routine begins at "integral" time, with H and U evaluated
at same time.
"alpha" and "beta" are adjustable parameters. At alpha=beta=0 this
is just leapfrog integration.
Omelyan "optimum alpha" is 2*(0.25-0.1932) ~ 0.1
*/
#include "ks_imp_includes.h" /* definitions files and prototypes */
#define mat_invert mat_invert_uml
/**#define mat_invert mat_invert_cg**/
int update() {
int step, iters=0;
Real final_rsq;
double startaction,endaction,d_action();
Real xrandom;
int i,j; site *s;
su3_vector *multi_x[MAX_RAT_ORDER];
su3_vector *sumvec;
Real alpha,beta;
int iphi;
alpha = 0.1;
beta = 0.1;
node0_printf("Omelyan integration, 2 gauge for one 1 fermion step, steps= %d eps= %e alpha= %e beta= %e\n",
steps,epsilon,alpha,beta);
if (steps %2 != 0 ){
node0_printf("BONEHEAD! need even number of steps\n");
exit(0);
}
/* allocate space for multimass solution vectors */
for(i=0;i<MAX_RAT_ORDER;i++) multi_x[i]=(su3_vector *)malloc( sizeof(su3_vector)*sites_on_node );
sumvec = (su3_vector *)malloc( sizeof(su3_vector)*sites_on_node );
/* refresh the momenta */
ranmom();
/* generate a pseudofermion configuration only at start*/
for(iphi = 0; iphi < nphi; iphi++){
grsource_imp_rhmc( F_OFFSET(phi[iphi]), &(rparam[iphi].GR), EVEN,
multi_x,sumvec, rsqmin_gr[iphi], niter_gr[iphi]);
}
/* find action */
startaction=d_action_rhmc(multi_x,sumvec);
/* copy link field to old_link */
gauge_field_copy( F_OFFSET(link[0]), F_OFFSET(old_link[0]));
/* do "steps" microcanonical steps (one "step" = one force evaluation)" */
for(step=2; step <= steps; step+=2){
/* update U's and H's - see header comment */
update_u( epsilon*( (0.25-0.5*alpha) ) );
update_h_gauge( 0.5*epsilon);
update_u( epsilon*( (0.5-beta)-(0.25-0.5*alpha) ) );
update_h_fermion( epsilon, multi_x);
update_u( epsilon*( (0.75+0.5*alpha)-(0.5-beta) ) );
update_h_gauge( 0.5*epsilon);
update_u( epsilon*( (1.25-0.5*alpha)-(0.75+0.5*alpha) ) );
update_h_gauge( 0.5*epsilon);
update_u( epsilon*( (1.5+beta)-(1.25-0.5*alpha) ) );
update_h_fermion( epsilon, multi_x);
update_u( epsilon*( (1.75+0.5*alpha)-(1.5+beta) ) );
update_h_gauge( 0.5*epsilon);
update_u( epsilon*( (2.0)-(1.75+0.5*alpha) ) );
/* reunitarize the gauge field */
rephase( OFF );
reunitarize();
rephase( ON );
/*TEMP - monitor action*/ //if(step%6==0)d_action_rhmc(multi_x,sumvec);
} /* end loop over microcanonical steps */
/* find action */
/* do conjugate gradient to get (Madj M)inverse * phi */
endaction=d_action_rhmc(multi_x,sumvec);
/* decide whether to accept, if not, copy old link field back */
/* careful - must generate only one random number for whole lattice */
#ifdef HMC
if(this_node==0)xrandom = myrand(&node_prn);
broadcast_float(&xrandom);
if( exp( (double)(startaction-endaction) ) < xrandom ){
if(steps > 0)
gauge_field_copy( F_OFFSET(old_link[0]), F_OFFSET(link[0]) );
#ifdef FN
invalidate_all_ferm_links(&fn_links);
invalidate_all_ferm_links(&fn_links_dmdu0);
#endif
node0_printf("REJECT: delta S = %e\n", (double)(endaction-startaction));
}
else {
node0_printf("ACCEPT: delta S = %e\n", (double)(endaction-startaction));
}
#else // not HMC
node0_printf("CHECK: delta S = %e\n", (double)(endaction-startaction));
#endif // HMC
/* free multimass solution vector storage */
for(i=0;i<MAX_RAT_ORDER;i++)free(multi_x[i]);
free(sumvec);
if(steps > 0)return (iters/steps);
else return(-99);
}
int update() {
int step, iters=0;
int n;
Real final_rsq;
#ifdef HMC_ALGORITHM
double startaction,endaction,d_action();
Real xrandom;
#endif
imp_ferm_links_t** fn;
/* refresh the momenta */
ranmom();
/* In this application, the number of naik terms is 1 or 2 only */
n = fermion_links_get_n_naiks(fn_links);
/* do "steps" microcanonical steps" */
for(step=1; step <= steps; step++){
#ifdef PHI_ALGORITHM
/* generate a pseudofermion configuration only at start*/
/* also clear xxx, since zero is our best guess for the solution
with a new random phi field. */
if(step==1){
restore_fermion_links_from_site(fn_links, PRECISION);
fn = get_fm_links(fn_links);
clear_latvec( F_OFFSET(xxx1), EVENANDODD );
grsource_imp( F_OFFSET(phi1), mass1, EVEN, fn[0]);
clear_latvec( F_OFFSET(xxx2), EVENANDODD );
grsource_imp( F_OFFSET(phi2), mass2, EVEN, fn[n-1]);
}
#ifdef HMC_ALGORITHM
/* find action */
/* do conjugate gradient to get (Madj M)inverse * phi */
if(step==1){
/* do conjugate gradient to get (Madj M)inverse * phi */
restore_fermion_links_from_site(fn_links, PRECISION);
fn = get_fm_links(fn_links);
iters += ks_congrad( F_OFFSET(phi1), F_OFFSET(xxx1), mass1,
niter, nrestart, rsqmin, PRECISION, EVEN,
&final_rsq, fn[0]);
restore_fermion_links_from_site(fn_links, PRECISION);
fn = get_fm_links(fn_links);
iters += ks_congrad( F_OFFSET(phi2), F_OFFSET(xxx2), mass2,
niter, nrestart, rsqmin, PRECISION, EVEN,
&final_rsq, fn[n-1]);
startaction=d_action();
/* copy link field to old_link */
gauge_field_copy( F_OFFSET(link[0]), F_OFFSET(old_link[0]));
}
#endif
/* update U's to middle of interval */
update_u(0.5*epsilon);
#else /* "R" algorithm */
/* first update the U's to special time interval */
/* and generate a pseudofermion configuration */
/* probably makes most sense if nflavors1 >= nflavors2 */
update_u(epsilon*(0.5-nflavors1/8.0));
clear_latvec( F_OFFSET(xxx1), EVENANDODD );
restore_fermion_links_from_site(fn_links, PRECISION);
fn = get_fm_links(fn_links);
grsource_imp( F_OFFSET(phi1), mass1, EVEN, fn[0]);
update_u(epsilon*((nflavors1-nflavors2)/8.0));
clear_latvec( F_OFFSET(xxx2), EVENANDODD );
restore_fermion_links_from_site(fn_links, PRECISION);
fn = get_fm_links(fn_links);
grsource_imp( F_OFFSET(phi2), mass2, EVEN, fn[n-1]);
/* update U's to middle of interval */
update_u(epsilon*nflavors2/8.0);
#endif
/* do conjugate gradient to get (Madj M)inverse * phi */
restore_fermion_links_from_site(fn_links, PRECISION);
fn = get_fm_links(fn_links);
if(n == 2){
iters += ks_congrad( F_OFFSET(phi1), F_OFFSET(xxx1), mass1,
niter, nrestart, rsqmin, PRECISION, EVEN, &final_rsq, fn[0] );
iters += ks_congrad( F_OFFSET(phi2), F_OFFSET(xxx2), mass2,
niter, nrestart, rsqmin, PRECISION, EVEN, &final_rsq, fn[1] );
} else {
iters += ks_congrad_two_src( F_OFFSET(phi1), F_OFFSET(phi2),
F_OFFSET(xxx1), F_OFFSET(xxx2),
mass1, mass2, niter, nrestart, rsqmin,
PRECISION, EVEN, &final_rsq,
fn[0]);
}
dslash_site( F_OFFSET(xxx1), F_OFFSET(xxx1), ODD, fn[0]);
dslash_site( F_OFFSET(xxx2), F_OFFSET(xxx2), ODD, fn[n-1]);
/* now update H by full time interval */
update_h(epsilon);
#if 0
#ifdef HAVE_QIO
{
char *filexml;
char recxml[] = "<?xml version=\"1.0\" encoding=\"UTF-8\"?><title>Test fermion force field</title>";
char ansfile[128];
char rootname[] = "fermion_force_dump";
/* Do this at the specified interval */
if(step%3 == 1){
/* Construct a file name */
sprintf(ansfile,"%s%02d",rootname,step);
/* Dump the computed fermion force from the site structure */
filexml = create_QCDML();
save_color_matrix_scidac_from_site(ansfile, filexml,
recxml, QIO_PARTFILE, F_OFFSET(mom[0]), 4, PRECISION);
free_QCDML(filexml);
}
}
#endif
#endif
/* update U's by half time step to get to even time */
update_u(epsilon*0.5);
/* reunitarize the gauge field */
rephase( OFF );
reunitarize();
rephase( ON );
} /* end loop over microcanonical steps */
#ifdef HMC_ALGORITHM
/* find action */
/* do conjugate gradient to get (Madj M)inverse * phi */
restore_fermion_links_from_site(fn_links, PRECISION);
fn = get_fm_links(fn_links);
iters += ks_congrad( F_OFFSET(phi1), F_OFFSET(xxx1), mass1,
niter, nrestart, rsqmin, PRECISION, EVEN,
&final_rsq, fn[0]);
iters += ks_congrad( F_OFFSET(phi2), F_OFFSET(xxx2), mass2,
niter, nrestart, rsqmin, PRECISION, EVEN,
&final_rsq, fn[n-1]);
endaction=d_action();
/* decide whether to accept, if not, copy old link field back */
/* careful - must generate only one random number for whole lattice */
if(this_node==0)xrandom = myrand(&node_prn);
broadcast_float(&xrandom);
if( exp( (double)(startaction-endaction) ) < xrandom ){
if(steps > 0)
gauge_field_copy( F_OFFSET(old_link[0]), F_OFFSET(link[0]) );
#ifdef FN
invalidate_fermion_links(fn_links);
#endif
node0_printf("REJECT: delta S = %e\n", (double)(endaction-startaction));
}
else {
node0_printf("ACCEPT: delta S = %e\n", (double)(endaction-startaction));
}
#endif
if(steps > 0)return (iters/steps);
else return(-99);
}
