EXPORT void print_linked_node_list(
INTERFACE *intfc)
{
NODE **n, *m;
int i, node_count;
n = intfc->nodes;
if (! n)
{
(void) printf("NULL node list on intfc\n");
return;
}
(void) printf("\tnode list - intfc %llu\n",(long long unsigned int)interface_number(intfc));
for (node_count = 0; n && *n; ++n, ++node_count)
;
m = first_node(intfc);
for (i = 0; i <= node_count + 2; ++i)
{
if (m != NULL)
{
(void) printf("prev %llu m %llu next %llu ",
(long long unsigned int)node_number(prev_node(m)),
(long long unsigned int)node_number(m),
(long long unsigned int)node_number(next_node(m)));
print_propagation_status(m);
}
else
break;
m = next_node(m);
}
} /*end print_linked_node_list*/
LOCAL bool i_consistent_interface2d(
INTERFACE *intfc)
{
CURVE **c;
NODE **n;
bool status = YES;
const char *warn = "WARNING in i_consistent_interface(), ";
/* Check Nodes */
for (n = intfc->nodes; n && *n; ++n)
{
if ((*n)->interface != intfc)
{
(void) printf("%s n = %llu n->interface (%llu) != intfc (%llu)\n",
warn,node_number(*n),
interface_number((*n)->interface),
interface_number(intfc));
status = NO;
}
for (c = (*n)->in_curves; c && *c; ++c)
{
if ((*c)->end != *n)
{
(void) printf("%s inconsistent node (%llu) "
"curve (%llu) pair, "
"curve->end != n\n",
warn,node_number(*n),curve_number(*c));
status = NO;
}
}
for (c = (*n)->out_curves; c && *c; ++c)
{
if ((*c)->start != *n)
{
(void) printf("%s inconsistent node (%llu) "
"curve (%llu) pair, "
"curve->start != n\n",
warn,node_number(*n),curve_number(*c));
status = NO;
}
}
}
/* Check Curves */
for (c = intfc->curves; c && *c; c++)
{
if (!check_curve2d(*c,intfc))
{
(void) printf("%s inconsistency in curve (%llu) found\n",
warn,curve_number(*c));
status = NO;
}
}
return status;
} /* end i_consistent_interface2d */
/*----------------------------------------------------------------------*/
void make_lattice(){
register int i; /* scratch */
int x,y,z,t; /* coordinates */
/* allocate space for lattice, fill in parity, coordinates and index. */
lattice = (site *)malloc( sites_on_node * sizeof(site) );
if(lattice==NULL){
printf("NODE %d: no room for lattice\n",this_node);
terminate(1);
}
/* Allocate address vectors */
for(i=0;i<8;i++){
/**gen_pt[i] = (char **)malloc(sites_on_node*sizeof(char *) );
if(gen_pt[i]==NULL){
printf("NODE %d: no room for pointer vector\n",this_node);
terminate(1);
} **/
gen_pt[i] = NULL;
}
for(t=0;t<nt;t++)for(z=0;z<nz;z++)for(y=0;y<ny;y++)for(x=0;x<nx;x++){
if(node_number(x,y,z,t)==mynode()){
i=node_index(x,y,z,t);
lattice[i].x=x; lattice[i].y=y; lattice[i].z=z; lattice[i].t=t;
lattice[i].index = x+nx*(y+ny*(z+nz*t));
if( (x+y+z+t)%2 == 0)lattice[i].parity=EVEN;
else lattice[i].parity=ODD;
#ifdef SITERAND
initialize_prn( &(lattice[i].site_prn) , iseed, lattice[i].index);
#endif
}
}
}
void delta_prop(int c0,int c1,int c2,int perm,int t,double *delprop)
/* Calculates the contribution to the delta propagator at time t */
/* With source colors c0, c1, c2 */
/* perm specifies the sign of the contribution to be calculated */
{
register int i;
register complex cc;
int x,y,z;
int c[3];
c[0] = c0;
c[1] = c1;
c[2] = c2;
for(x=0;x<nx;x+=2)for(y=0;y<ny;y+=2)for(z=0;z<nz;z+=2) {
if( node_number(x,y,z,t) != mynode() )continue;
i=node_index(x,y,z,t);
/* Calculate for the cube origin only */
accum_delta_prop(i,c);
cc = det_su3( &lattice[i].tempmat1 );
if(perm>0)*delprop += cc.real;
else *delprop -= cc.real;
}
}
/* Map node number and index to coordinates */
void get_coords(int coords[], int node, int index){
int mc[4];
int ir;
int eo;
int k = node;
/* Compute machine coordinates for node */
lex_coords(mc, 4, machine_dimensions, k);
/* Lexicographic index on node rounded to even */
ir = 2*index;
if(ir >= sites_on_node){
ir -= sites_on_node;
eo = 1;
}
else
eo = 0;
/* Convert to coordinates - result is two-fold ambiguous */
lex_coords(coords, 4, sub_lattice_dimensions, ir);
/* Adjust coordinate according to parity (assumes even sites_on_node) */
if( (coords[0] + coords[1] + coords[2] + coords[3]) % 2 != eo){
coords[0]++;
if(coords[0] >= sub_lattice_dimensions[0]){
coords[0] -= sub_lattice_dimensions[0];
coords[1]++;
if(coords[1] >= sub_lattice_dimensions[1]){
coords[1] -= sub_lattice_dimensions[1];
coords[2]++;
if(coords[2] >= sub_lattice_dimensions[2]){
coords[2] -= sub_lattice_dimensions[2];
coords[3]++;
}
}
}
}
/* Add offset for hypercube */
coords[0] += mc[0]*sub_lattice_dimensions[0];
coords[1] += mc[1]*sub_lattice_dimensions[1];
coords[2] += mc[2]*sub_lattice_dimensions[2];
coords[3] += mc[3]*sub_lattice_dimensions[3];
/* Consistency checks for debugging */
if((k = node_number(coords[0], coords[1], coords[2], coords[3]))
!= node){
printf("get_coords: coords %d %d %d %d for node %d map to wrong node %d\n",
coords[0], coords[1], coords[2], coords[3], node, k);
terminate(1);
}
if((k = node_index(coords[0], coords[1], coords[2], coords[3]))
!= index){
printf("get_coords: coords %d %d %d %d for index %d map to wrong index %d\n",
coords[0], coords[1], coords[2], coords[3], index, k);
terminate(1);
}
}
void make_lattice() {
register int i;
int x, y, z, t;
// Allocate space for lattice
node0_printf("Mallocing %.1f MBytes per core for lattice\n",
(double)sites_on_node * sizeof(site) / 1e6);
lattice = malloc(sites_on_node * sizeof(*lattice));
if (lattice == NULL) {
printf("node%d: no room for lattice\n", this_node);
terminate(1);
}
// Allocate address vectors
for (i = 0; i < N_POINTERS; i++) {
gen_pt[i] = malloc(sites_on_node * sizeof(char *));
if (gen_pt[i] == NULL) {
printf("node%d: no room for pointer array\n", this_node);
terminate(1);
}
}
// Fill in parity, coordinates and index
for (t = 0; t < nt; t++) {
for (z = 0; z < nz; z++) {
for (y = 0; y < ny; y++) {
for (x = 0; x < nx; x++) {
if (node_number(x, y, z, t) == mynode()) {
i = node_index(x, y, z, t);
lattice[i].x = x;
lattice[i].y = y;
lattice[i].z = z;
lattice[i].t = t;
lattice[i].index = x + nx * (y + ny * (z + nz * t));
if ((x + y + z + t) % 2 == 0)
lattice[i].parity = EVEN;
else
lattice[i].parity = ODD;
#ifdef SITERAND
initialize_prn(&(lattice[i].site_prn), iseed, lattice[i].index);
#endif
}
}
}
}
}
}
void vset_M(suN_matrix *field[], int count)
{
int x[4];
int index,i;
for(i = 0; i < count; i++)
for(x[3] = 0; x[3] < lattice_size[3]; x[3]++)
for(x[2] = 0; x[2] < lattice_size[2]; x[2]++)
for(x[1] = 0; x[1] < lattice_size[1]; x[1]++)
for(x[0] = 0; x[0] < lattice_size[0]; x[0]++)
{
if(node_number(x) == this_node){
index = node_index(x);
vfill_m(field[i] + index, x, i);
}
}
}
int spectrum_nd( Real mass1, Real mass2, Real tol, ferm_links_t *fn ){
/* arguments are light and heavy quark masses, return C.G. iteration number */
int cgn;
register int i,j,x,y,z,t,t_off;
register site* s;
register complex cc;
register int t_source;
int color; /* color for source */
int src_count; /* number of source time slices used */
complex **props; /* arrays of propagators */
su3_matrix tmat;
Real finalrsq;
cgn=0; /* number of CG iterations */
/* allocate arrays to accumulate propagators */
props = (complex **)malloc(nprops*sizeof(complex *));
props[0] = (complex *)malloc(nprops*nt*sizeof(complex));
for(i=1;i<nprops;i++)props[i]=props[i-1]+nt;
/* set propagators to zero */
for(cc.real=cc.imag=0.0,i=0;i<nprops;i++)for(j=0;j<nt;j++){
props[i][j]=cc;
}
/* allocate light and heavy quark propagators for each color */
for( color=0; color<3; color++){
lightprop[color] = (su3_vector *)malloc( sizeof(su3_vector)*sites_on_node );
heavyprop[color] = (su3_vector *)malloc( sizeof(su3_vector)*sites_on_node );
}
/* loop over "source" time slice */
for(src_count=0,t_source=source_start; t_source<nt && src_count<n_sources;
t_source += source_inc,src_count++){
/* Corner wall source */
/* Use quark_source for quark source */
if(this_node==0)printf("spectrum_nd(): source time = %d\n",t_source);
for(color=0;color<3;color++){
clear_latvec( F_OFFSET(quark_source), EVENANDODD );
for(x=0;x<nx;x+=2)for(y=0;y<ny;y+=2)for(z=0;z<nz;z+=2) {
if( node_number(x,y,z,t_source) != mynode() )continue;
i=node_index(x,y,z,t_source);
lattice[i].quark_source.c[color].real = -1.0;
}
/* do a C.G. (source in quark_source, result in g_rand) */
if(t_source%2 == 0) {
cgn += ks_congrad( F_OFFSET(quark_source), F_OFFSET(g_rand),
mass1, niter, nrestart, rsqprop, PRECISION,
EVEN, &finalrsq, fn);
/* Multiply by -Madjoint */
dslash_site( F_OFFSET(g_rand), F_OFFSET(quark_prop), ODD, fn);
scalar_mult_latvec( F_OFFSET(g_rand), -2.0*mass1, F_OFFSET(quark_prop),EVEN);
}
else {
cgn += ks_congrad( F_OFFSET(quark_source), F_OFFSET(g_rand),
mass1, niter, nrestart, rsqprop, PRECISION,
ODD, &finalrsq, fn);
/* Multiply by -Madjoint */
dslash_site( F_OFFSET(g_rand), F_OFFSET(quark_prop), EVEN, fn);
scalar_mult_latvec( F_OFFSET(g_rand), -2.0*mass1, F_OFFSET(quark_prop),ODD);
}
FORALLSITES(i,s){ lightprop[color][i] = lattice[i].quark_prop; }
scalar_mult_latvec( F_OFFSET(quark_prop), -1.0, F_OFFSET(g_rand), EVENANDODD );
check_invert( F_OFFSET(g_rand), F_OFFSET(quark_source), mass1, tol, fn);
/* repeat for heavy quark */
if(t_source%2 == 0) {
cgn += ks_congrad( F_OFFSET(quark_source), F_OFFSET(g_rand),
mass2, niter, nrestart, rsqprop, PRECISION,
EVEN, &finalrsq, fn);
/* Multiply by -Madjoint */
dslash_site( F_OFFSET(g_rand), F_OFFSET(quark_prop), ODD, fn);
scalar_mult_latvec( F_OFFSET(g_rand), -2.0*mass2, F_OFFSET(quark_prop),EVEN);
}
else {
cgn += ks_congrad( F_OFFSET(quark_source), F_OFFSET(g_rand),
mass2, niter, nrestart, rsqprop, PRECISION,
ODD, &finalrsq, fn);
/* Multiply by -Madjoint */
dslash_site( F_OFFSET(g_rand), F_OFFSET(quark_prop), EVEN, fn);
scalar_mult_latvec( F_OFFSET(g_rand), -2.0*mass2, F_OFFSET(quark_prop),ODD);
}
FORALLSITES(i,s){ heavyprop[color][i] = lattice[i].quark_prop; }
/* TEMP: test inversion, */
scalar_mult_latvec( F_OFFSET(quark_prop), -1.0, F_OFFSET(g_rand), EVENANDODD );
check_invert( F_OFFSET(g_rand), F_OFFSET(quark_source), mass2, tol, fn);
} /* end color loop*/
/* add contributions into propagators */
/* measure the meson propagator */
for(t=0; t<nt; t++){
/* define the time value offset t from t_source */
t_off = (t+t_source)%nt;
for(x=0;x<nx;x++)for(y=0;y<ny;y++)for(z=0;z<nz;z++)
for(color=0;color<3;color++) {
if( node_number(x,y,z,t_off) != mynode() )continue;
i=node_index(x,y,z,t_off);
/* light-light mesons */
cc = su3_dot( &lightprop[color][i],
&lightprop[color][i] );
CSUM( props[prop_pion5_ll][t], cc )
if( (x+y)%2==0)CSUM( props[prop_rhoi0_ll][t], cc )
else CSUB( props[prop_rhoi0_ll][t], cc, props[prop_rhoi0_ll][t] )
if( (y+z)%2==0)CSUM( props[prop_rhoi0_ll][t], cc )
else CSUB( props[prop_rhoi0_ll][t], cc, props[prop_rhoi0_ll][t] )
if( (z+x)%2==0)CSUM( props[prop_rhoi0_ll][t], cc )
else CSUB( props[prop_rhoi0_ll][t], cc, props[prop_rhoi0_ll][t] )
if( x%2==0)CSUM( props[prop_rhoi_ll][t], cc )
else CSUB( props[prop_rhoi_ll][t], cc, props[prop_rhoi_ll][t] )
if( y%2==0)CSUM( props[prop_rhoi_ll][t], cc )
else CSUB( props[prop_rhoi_ll][t], cc, props[prop_rhoi_ll][t] )
if( z%2==0)CSUM( props[prop_rhoi_ll][t], cc )
else CSUB( props[prop_rhoi_ll][t], cc, props[prop_rhoi_ll][t] )
if( (x+y+z)%2==0)CSUM( props[prop_pion05_ll][t], cc )
else CSUB( props[prop_pion05_ll][t], cc, props[prop_pion05_ll][t] )
/* light-heavy mesons */
cc = su3_dot( &lightprop[color][i],
&heavyprop[color][i] );
CSUM( props[prop_pion5_lh][t], cc )
if( (x+y)%2==0)CSUM( props[prop_rhoi0_lh][t], cc )
else CSUB( props[prop_rhoi0_lh][t], cc, props[prop_rhoi0_lh][t] )
if( (y+z)%2==0)CSUM( props[prop_rhoi0_lh][t], cc )
else CSUB( props[prop_rhoi0_lh][t], cc, props[prop_rhoi0_lh][t] )
if( (z+x)%2==0)CSUM( props[prop_rhoi0_lh][t], cc )
else CSUB( props[prop_rhoi0_lh][t], cc, props[prop_rhoi0_lh][t] )
if( x%2==0)CSUM( props[prop_rhoi_lh][t], cc )
else CSUB( props[prop_rhoi_lh][t], cc, props[prop_rhoi_lh][t] )
if( y%2==0)CSUM( props[prop_rhoi_lh][t], cc )
else CSUB( props[prop_rhoi_lh][t], cc, props[prop_rhoi_lh][t] )
if( z%2==0)CSUM( props[prop_rhoi_lh][t], cc )
else CSUB( props[prop_rhoi_lh][t], cc, props[prop_rhoi_lh][t] )
if( (x+y+z)%2==0)CSUM( props[prop_pion05_lh][t], cc )
else CSUB( props[prop_pion05_lh][t], cc, props[prop_pion05_lh][t] )
/* heavy-heavy mesons */
cc = su3_dot( &heavyprop[color][i],
&heavyprop[color][i] );
CSUM( props[prop_pion5_hh][t], cc )
if( (x+y)%2==0)CSUM( props[prop_rhoi0_hh][t], cc )
else CSUB( props[prop_rhoi0_hh][t], cc, props[prop_rhoi0_hh][t] )
if( (y+z)%2==0)CSUM( props[prop_rhoi0_hh][t], cc )
else CSUB( props[prop_rhoi0_hh][t], cc, props[prop_rhoi0_hh][t] )
if( (z+x)%2==0)CSUM( props[prop_rhoi0_hh][t], cc )
else CSUB( props[prop_rhoi0_hh][t], cc, props[prop_rhoi0_hh][t] )
if( x%2==0)CSUM( props[prop_rhoi_hh][t], cc )
else CSUB( props[prop_rhoi_hh][t], cc, props[prop_rhoi_hh][t] )
if( y%2==0)CSUM( props[prop_rhoi_hh][t], cc )
else CSUB( props[prop_rhoi_hh][t], cc, props[prop_rhoi_hh][t] )
if( z%2==0)CSUM( props[prop_rhoi_hh][t], cc )
else CSUB( props[prop_rhoi_hh][t], cc, props[prop_rhoi_hh][t] )
if( (x+y+z)%2==0)CSUM( props[prop_pion05_hh][t], cc )
else CSUB( props[prop_pion05_hh][t], cc, props[prop_pion05_hh][t] )
} /* color */
} /* nt-loop */
/* measure the baryon propagator */
for(t=0; t<nt; t++) {
/* define the time value offset t from t_source */
t_off = (t+t_source)%nt;
for(x=0;x<nx;x+=2)for(y=0;y<ny;y+=2)for(z=0;z<nz;z+=2) {
if( node_number(x,y,z,t_off) != mynode() )continue;
i=node_index(x,y,z,t_off);
/* three light quarks */
for(color=0;color<3;color++){
(tmat.e[0][color]) = lightprop[0][i].c[color];
(tmat.e[1][color]) = lightprop[1][i].c[color];
(tmat.e[2][color]) = lightprop[2][i].c[color];
}
cc = det_su3( &tmat );
/* must get sign right. This looks to see if we have
wrapped around the lattice. "t" is the distance
from the source to the measurement, so we are
trying to find out if t_source+t is greater than
or equal to nt. the "-tsource/nt" is in there
so that it will work correctly with tsource=nt. */
if( (((t+t_source)/nt-t_source/nt)%2) == 0 )
CSUM( props[prop_nuc_lll][t], cc )
else /* change sign because antiperiodic b.c. sink point
should really be in a copy of the lattice */
CSUB( props[prop_nuc_lll][t], cc, props[prop_nuc_lll][t] )
/* two lights and one heavy */
for(color=0;color<3;color++){
(tmat.e[0][color]) = lightprop[0][i].c[color];
(tmat.e[1][color]) = lightprop[1][i].c[color];
(tmat.e[2][color]) = heavyprop[2][i].c[color];
}
cc = det_su3( &tmat );
if( (((t+t_source)/nt-t_source/nt)%2) == 0 )
CSUM( props[prop_nuc_llh][t], cc )
else CSUB( props[prop_nuc_llh][t], cc, props[prop_nuc_llh][t] )
/* now repeat for hhl baryon */
for(color=0;color<3;color++){
(tmat.e[0][color]) = lightprop[0][i].c[color];
(tmat.e[1][color]) = heavyprop[1][i].c[color];
(tmat.e[2][color]) = heavyprop[2][i].c[color];
}
cc = det_su3( &tmat );
if( (((t+t_source)/nt-t_source/nt)%2) == 0 )
CSUM( props[prop_nuc_lhh][t], cc )
else CSUB( props[prop_nuc_lhh][t], cc, props[prop_nuc_lhh][t] )
/* and hhh baryon (nonexistent particle!!) */
for(color=0;color<3;color++){
(tmat.e[0][color]) = heavyprop[0][i].c[color];
(tmat.e[1][color]) = heavyprop[1][i].c[color];
(tmat.e[2][color]) = heavyprop[2][i].c[color];
}
cc = det_su3( &tmat );
if( (((t+t_source)/nt-t_source/nt)%2) == 0 )
CSUM( props[prop_nuc_hhh][t], cc )
else CSUB( props[prop_nuc_hhh][t], cc, props[prop_nuc_hhh][t] )
}
} /* nt-loop */
} /* end loop on t_source */
/* Sum propagator arrays over nodes */
/* print out propagators */
g_veccomplexsum( props[0], nprops*nt );
for(i=0;i<nprops;i++)for(j=0;j<nt;j++){
CDIVREAL(props[i][j],n_sources,props[i][j]);
}
if(this_node==0){
/*meson propagators*/
printf("STARTPROP\n");
printf("MASSES: %e %e\n",mass1,mass1 );
printf("SOURCE: CORNER\n");
printf("SINKS: PION_5 PION_05 RHO_i RHO_i0 \n");
for(j=0;j<nt;j++){
printf("%d %e %e %e %e %e %e %e %e\n",j,
props[prop_pion5_ll][j].real, props[prop_pion5_ll][j].imag,
props[prop_pion05_ll][j].real, props[prop_pion05_ll][j].imag,
props[prop_rhoi_ll][j].real, props[prop_rhoi_ll][j].imag,
props[prop_rhoi0_ll][j].real, props[prop_rhoi0_ll][j].imag);
}
printf("ENDPROP\n");
printf("STARTPROP\n");
printf("MASSES: %e %e\n",mass1,mass2 );
printf("SOURCE: CORNER\n");
printf("SINKS: PION_5 PION_05 RHO_i RHO_i0 \n");
for(j=0;j<nt;j++){
printf("%d %e %e %e %e %e %e %e %e\n",j,
props[prop_pion5_lh][j].real, props[prop_pion5_lh][j].imag,
props[prop_pion05_lh][j].real, props[prop_pion05_lh][j].imag,
props[prop_rhoi_lh][j].real, props[prop_rhoi_lh][j].imag,
props[prop_rhoi0_lh][j].real, props[prop_rhoi0_lh][j].imag);
}
printf("ENDPROP\n");
printf("STARTPROP\n");
printf("MASSES: %e %e\n",mass2,mass2 );
printf("SOURCE: CORNER\n");
printf("SINKS: PION_5 PION_05 RHO_i RHO_i0 \n");
for(j=0;j<nt;j++){
printf("%d %e %e %e %e %e %e %e %e\n",j,
props[prop_pion5_hh][j].real, props[prop_pion5_hh][j].imag,
props[prop_pion05_hh][j].real, props[prop_pion05_hh][j].imag,
props[prop_rhoi_hh][j].real, props[prop_rhoi_hh][j].imag,
props[prop_rhoi0_hh][j].real, props[prop_rhoi0_hh][j].imag);
}
printf("ENDPROP\n");
/* Baryon propagators */
printf("STARTPROP\n");
printf("MASSES: %e %e %e\n",mass1,mass1,mass1);
printf("SOURCE: CORNER\n"); printf("SINKS: NUCLEON \n");
for(j=0;j<nt;j++){
printf("%d %e %e\n",j,
props[prop_nuc_lll][j].real, props[prop_nuc_lll][j].imag);
}
printf("ENDPROP\n");
printf("STARTPROP\n");
printf("MASSES: %e %e %e\n",mass1,mass1,mass2);
printf("SOURCE: CORNER\n"); printf("SINKS: NUCLEON \n");
for(j=0;j<nt;j++){
printf("%d %e %e\n",j,
props[prop_nuc_llh][j].real, props[prop_nuc_llh][j].imag);
}
printf("ENDPROP\n");
printf("STARTPROP\n");
printf("MASSES: %e %e %e\n",mass1,mass2,mass2);
printf("SOURCE: CORNER\n"); printf("SINKS: NUCLEON \n");
for(j=0;j<nt;j++){
printf("%d %e %e\n",j,
props[prop_nuc_lhh][j].real, props[prop_nuc_lhh][j].imag);
}
printf("ENDPROP\n");
printf("STARTPROP\n");
printf("MASSES: %e %e %e\n",mass2,mass2,mass2);
printf("SOURCE: CORNER\n"); printf("SINKS: NUCLEON \n");
for(j=0;j<nt;j++){
printf("%d %e %e\n",j,
props[prop_nuc_hhh][j].real, props[prop_nuc_hhh][j].imag);
}
printf("ENDPROP\n");
fflush(stdout);
} /* end if(this_node==0) */
/* free arrays */
free(props[0]); free(props);
for(color=0;color<3;color++){
free( lightprop[color] );
free( heavyprop[color] );
}
return(cgn);
} /* spectrum_nd */
static int milc_node_number(int coords[], int dirp[], int squaresize[],
int nsquares[]) {
return node_number(coords[0], coords[1], coords[2], coords[3]);
}
LOCAL bool i_consistent_interface3d(
INTERFACE *intfc)
{
HYPER_SURF_ELEMENT *hse;
HYPER_SURF *hs;
CURVE **c;
NODE **n;
POINT *p;
SURFACE **ss, *s;
TRI *tri;
bool status = YES;
const char *warn = "WARNING in i_consistent_interface(), ";
/* Check Nodes */
for (n = intfc->nodes; n && *n; ++n)
{
if ((*n)->interface != intfc)
{
(void) printf("%s n = %llu n->interface (%llu) != intfc (%llu)\n",
warn,node_number(*n),
interface_number((*n)->interface),
interface_number(intfc));
status = NO;
}
for (c = (*n)->in_curves; c && *c; ++c)
{
if ((*c)->end != *n)
{
(void) printf("%s inconsistent node (%llu) "
"curve (%llu) pair, "
"curve->end != n\n",
warn,node_number(*n),curve_number(*c));
status = NO;
}
}
for (c = (*n)->out_curves; c && *c; ++c)
{
if ((*c)->start != *n)
{
(void) printf("%s inconsistent node (%llu) "
"curve (%llu) pair, "
"curve->start != n\n",
warn,node_number(*n),curve_number(*c));
status = NO;
}
}
}
/* Check Curves */
for (c = intfc->curves; c && *c; c++)
{
if (!check_curve3d(*c,intfc))
{
(void) printf("%s inconsistency in curve (%llu) found\n",
warn,curve_number(*c));
status = NO;
}
}
for (ss = intfc->surfaces; ss && *ss; ++ss)
{
if (!check_consistency_of_tris_on_surface(*ss))
{
(void) printf("%s inconsistency in surface (%llu) found\n",
warn,surface_number(*ss));
status = NO;
}
}
(void) next_point(intfc,NULL,NULL,NULL);
while (next_point(intfc,&p,&hse,&hs))
{
BOND *b = NULL, *bb;
BOND_TRI **bts;
CURVE **c;
TRI **tris;
int i, ntris;
int v, pside, nside;
tri = Tri_of_hse(hse);
s = Surface_of_hs(hs);
if ((v = Vertex_of_point(tri,p)) == ERROR)
{
(void) printf("%s point not on tri, s = %llu\n",
warn,surface_number(s));
(void) printf("p(%llu) - (%g, %g, %g), ",
point_number(p),
Coords(p)[0],Coords(p)[1],Coords(p)[2]);
print_tri(tri,hs->interface);
status = NO;
}
if (!Boundary_point(p))
{
ntris = set_tri_list_around_point(p,tri,&tris,intfc);
if ((tri != tris[0]) ||
(tri != Prev_tri_at_vertex(tris[ntris-1],p)))
{
bool consistent_tri_list = NO;
if (allow_null_sides)
{
if ((Next_tri_at_vertex(tris[0],p) == NULL) &&
(Prev_tri_at_vertex(tris[ntris-1],p) == NULL))
consistent_tri_list = YES;
}
if (!consistent_tri_list)
{
(void) printf("\n%s Corrupt tri list s (%llu) "
"p(%llu) - (%g, %g, %g)\n",
warn,surface_number(s),
point_number(p),
Coords(p)[0],Coords(p)[1],Coords(p)[2]);
print_tri(tri,hs->interface);
(void) printf("%d tris about point\n",ntris);
for (i = 0; i < ntris; ++i)
{
(void) printf("tris[%d] - ",i);
print_tri(tris[i],hs->interface);
}
(void) printf("End printout of "
"Corrupt tri list s (%llu) "
"p(%llu) - (%g, %g, %g)\n\n",
surface_number(s),point_number(p),
Coords(p)[0],Coords(p)[1],Coords(p)[2]);
status = NO;
}
}
continue;
}
nside = v;
pside = Prev_m3(v);
if (is_side_bdry(tri,nside))
b = Bond_on_side(tri,nside);
else if (is_side_bdry(tri,pside))
b = Bond_on_side(tri,pside);
else //#bjet2
{
ntris = set_tri_list_around_point(p,tri,&tris,intfc);
v = Vertex_of_point(tris[0],p);
nside = v;
pside = Prev_m3(v);
if (is_side_bdry(tris[0],nside))
b = Bond_on_side(tris[0],nside);
else if (is_side_bdry(tris[0],pside))
b = Bond_on_side(tris[0],pside);
else
{
int i;
(void) printf("%s Boundary_point has no adjacent "
"tri with a bond\n",warn);
(void) printf("p(%llu) - (%g, %g, %g), ",
point_number(p),
Coords(p)[0],Coords(p)[1],Coords(p)[2]);
print_tri(tri,hs->interface);
for (i = 0; i < ntris; ++i)
{
(void) printf("tris[%d] - ",i);
print_tri(tris[i],hs->interface);
}
status = NO;
}
tri = tris[0];
}
for (bts = Btris(b); bts && *bts; ++bts)
if ((*bts)->tri == tri)
break;
if ((bts == NULL) || (*bts == NULL))
{
(void) printf("%s bond tri for tri not found\n",warn);
(void) printf("p(%llu) - (%g, %g, %g), ",point_number(p),
Coords(p)[0],Coords(p)[1],Coords(p)[2]);
print_tri(tri,hs->interface);
print_bond(b);
status = NO;
}
else
{
if ((*bts)->bond != b)
{
(void) printf("%s (*bts)->bond != b\n",warn);
(void) printf("p(%llu) - (%g, %g, %g), ",point_number(p),
Coords(p)[0],Coords(p)[1],Coords(p)[2]);
print_tri(tri,hs->interface);
print_bond(b);
status = NO;
}
if ((*bts)->surface != s)
{
(void) printf("%s inconsistent surfaces at bond tri\n",
warn);
(void) printf("p(%llu) - (%g, %g, %g), ",point_number(p),
Coords(p)[0],Coords(p)[1],Coords(p)[2]);
print_tri(tri,hs->interface);
print_bond(b);
status = NO;
}
if (orientation_of_bond_at_tri(b,tri) != (*bts)->orient)
{
(void) printf("%s inconsistent orientation at bond tri\n",
warn);
(void) printf("p(%llu) - (%g, %g, %g), ",point_number(p),
Coords(p)[0],Coords(p)[1],Coords(p)[2]);
print_tri(tri,hs->interface);
print_bond(b);
status = NO;
}
switch ((*bts)->orient)
{
case POSITIVE_ORIENTATION:
for (c = s->pos_curves; c && *c; c++)
if ((*c) == (*bts)->curve)
break;
break;
case NEGATIVE_ORIENTATION:
for (c = s->neg_curves; c && *c; c++)
if ((*c) == (*bts)->curve)
break;
break;
case ORIENTATION_NOT_SET:
c = NULL;
(void) printf("%s undetermined orientation at "
"bond on tri\n",warn);
(void) printf("p(%llu) - (%g, %g, %g), ",point_number(p),
Coords(p)[0],Coords(p)[1],Coords(p)[2]);
print_tri(tri,hs->interface);
print_bond(b);
status = NO;
break;
}
if ((c == NULL) || (*c == NULL))
{
(void) printf("%s curve with bond on tri not found\n",warn);
(void) printf("p(%llu) - (%g, %g, %g), ",point_number(p),
Coords(p)[0],Coords(p)[1],Coords(p)[2]);
print_tri(tri,hs->interface);
print_bond(b);
status = NO;
}
else
{
for (bb = (*c)->first; bb != NULL; bb = bb->next)
if (bb == b)
break;
if (bb == NULL)
{
(void) printf("%s bond not on curve\n",warn);
(void) printf("p(%llu) - (%g, %g, %g), ",point_number(p),
Coords(p)[0],Coords(p)[1],Coords(p)[2]);
print_tri(tri,hs->interface);
print_bond(b);
print_curve(*c);
status = NO;
}
}
}
}
if (status == NO)
{
(void) printf("WARNING in i_consistent_interface(), "
"Inconsistent interface found\n");
print_interface(intfc);
}
allow_null_sides = NO;
return status;
} /*end i_consistent_interface*/
static void
r_source_cmplx_fm(cmplx_source_file *csf,
field_offset dest_site,
complex *dest_field, int t0)
{
int rcv_rank, rcv_coords, status;
int destnode;
int x,y,z,t,i=0, byterevflag,a;
int tmin, tmax;
struct {
fcomplex q;
char pad[PAD_SEND_BUF]; /* Introduced because some switches
perform better if message lengths
are longer */
} cmsg;
int buf_length=0, where_in_buf=0;
fcomplex *cbuff=NULL;
complex *c;
fcomplex cfix;
int vol3 = nx*ny*nz;
int source_type;
byterevflag = csf->byterevflag;
source_type = csf->type;
if(this_node == 0)
{
if(source_type == COMPLEX_FIELD_FM_FILE)
cbuff = (fcomplex *)malloc(MAX_BUF_LENGTH*sizeof(fcomplex));
else {
printf("r_source_cmplx_fm: Unknown source type %d\n", source_type);
fflush(stdout);
terminate(1);
}
buf_length = 0;
where_in_buf = 0;
} /* end of if(this_node == 0)*/
g_sync();
/* If requested, we replicate the source function on ALL time slices */
/* Otherwise we read only to time slice t0 */
if(t0 == ALL_T_SLICES){ tmin = 0; tmax = nt-1; }
else { tmin = t0; tmax = t0; }
/* Node 0 reads and deals out the values */
status = 0;
/* Iterate only over timeslice t0 */
for(rcv_rank=0; rcv_rank<vol3; rcv_rank++)
{
/* We do only natural (lexicographic) order here */
rcv_coords = rcv_rank;
x = rcv_coords % nx; rcv_coords /= nx;
y = rcv_coords % ny; rcv_coords /= ny;
z = rcv_coords % nz;
if(this_node==0){
/* Node 0 fills its buffer, if necessary */
if(where_in_buf == buf_length)
{ /* get new buffer */
/* new buffer length = remaining sites, but never bigger
than MAX_BUF_LENGTH */
buf_length = vol3 - rcv_rank;
if(buf_length > MAX_BUF_LENGTH) buf_length = MAX_BUF_LENGTH;
/* then do read */
a=(int)g_read(cbuff,sizeof(fcomplex),buf_length,csf->fp);
if( a != buf_length)
{
if(status == 0)
printf(" node %d source file read error %d file %s\n",
this_node, errno, csf->filename);
fflush(stdout);
status = 1;
}
where_in_buf = 0; /* reset counter */
} /*** end of the buffer read ****/
/* Save data in msg.q for further processing */
cmsg.q = cbuff[where_in_buf];
}
/* Loop either over all time slices or just one time slice */
for(t = tmin; t <= tmax; t++){
destnode=node_number(x,y,z,t);
if(this_node == 0){
/* node 0 doesn't send to itself */
if(destnode != 0){
/* send to correct node */
send_field((char *)&cmsg, sizeof(cmsg), destnode);
}
} /* if(this_node==0) */
else { /* for all nodes other than node 0 */
if(this_node==destnode){
get_field((char *)&cmsg, sizeof(cmsg),0);
}
}
/* The receiving node does the byte reversal. At this point msg
contains the input vectors and i points to the destination
site structure */
if(this_node==destnode)
{
/* Byte reverse a copy, since we may need to reuse cmsg.q */
cfix = cmsg.q;
if(byterevflag==1){
byterevn((int32type *)&cfix,
sizeof(fcomplex)/sizeof(int32type));
}
/* Now copy the site data into the destination converting
to generic precision if needed */
i = node_index(x,y,z,t);
if(dest_site == (field_offset)(-1))
c = dest_field + i;
else
c = (complex *)F_PT(&lattice[i],dest_site);
c->real = cfix.real;
c->imag = cfix.imag;
//printf("C %d %d %d %g %g\n",
// x, y, z, cmsg.q.real, cmsg.q.imag);
} /* if this_node == destnode */
} /* t */
where_in_buf++;
} /* rcv_rank, irecord */
if(cbuff != NULL)free(cbuff); cbuff = NULL;
}
void nl_meson_prop (int t,double *nlpiprop,double *nlpi2prop,
double *ckpiprop,double *ckpi2prop,
field_offset temp1, field_offset temp2)
/* Calculates non-local pion propagator pi_3 and pi_3 tilde */
/* and local pion propagators for a check */
/* temp1 and temp2 are scratch space */
{
int x,y,z,i,icol;
int coord;
register su3_matrix *tmp1, *tmp2;
complex cc;
/* Sum over all x,y z */
for(x=0;x<nx;x++)for(y=0;y<ny;y++)for(z=0;z<nz;z++) {
if( node_number(x,y,z,t) != mynode() )continue;
i=node_index(x,y,z,t);
coord = get_coord(i,NL_PI_DIR);
if(coord%2 == 0)accum_nl_meson_prop(i,NL_PI_DIR,temp1,temp2);
for(icol=0;icol<3;icol++) {
/* Calculate non-local propagator only on even coordinate */
if(coord%2 ==0) {
/* propmat contains "q" and temp1 contains "Dq" */
/* q^adj D q */
tmp1 = (su3_matrix *)F_PT(&lattice[i],temp1);
cc = su3_dot( &lattice[i].propmat[icol],
(su3_vector *)(tmp1->e[icol]) );
*nlpiprop += cc.real;
/* propmat2 contains "o" and temp2 contains "Do" */
/* q^adj D q - o^adj D o */
tmp2 = (su3_matrix *)F_PT(&lattice[i],temp2);
cc = su3_dot( &(lattice[i].propmat2[icol]),
(su3_vector *)(tmp2->e[icol]) );
*nlpiprop -= cc.real;
/* o^adj D q */
cc = su3_dot( &lattice[i].propmat2[icol],
(su3_vector *)(tmp1->e[icol]) );
if((x+y+z)%2 == 0)*nlpi2prop += cc.real;
else *nlpi2prop -= cc.real;
/* o^adj D q - q^adj D o */
cc = su3_dot( &(lattice[i].propmat[icol]),
(su3_vector *)(tmp2 ->e[icol]) );
if((x+y+z)%2 == 0)*nlpi2prop -= cc.real;
else *nlpi2prop += cc.real;
}
/* Calculate local check for all z */
/* q^adj q */
cc = su3_dot( &lattice[i].propmat[icol],
&lattice[i].propmat[icol] );
*ckpiprop += cc.real;
/* q^adj q + o^adj o */
cc = su3_dot( &lattice[i].propmat2[icol],
&lattice[i].propmat2[icol] );
*ckpiprop += cc.real;
/* q^adj o */
cc = su3_dot( &lattice[i].propmat[icol],
&lattice[i].propmat2[icol] );
if( (x+y+z)%2==0)*ckpi2prop += cc.real;
else *ckpi2prop -= cc.real;
}
}
}
static int milc_node_number(const int coords[]){
return node_number(coords[0],coords[1],coords[2],coords[3]);
}
// -----------------------------------------------------------------
// Only node 0 reads the gauge configuration gf from a binary file
static void r_serial(gauge_file *gf) {
FILE *fp = gf->fp;
gauge_header *gh = gf->header;
char *filename = gf->filename;
int byterevflag = gf->byterevflag;
off_t offset = 0; // File stream pointer
off_t gauge_check_size; // Size of gauge configuration checksum record
off_t coord_list_size; // Size of coordinate list in bytes
off_t head_size; // Size of header plus coordinate list
off_t checksum_offset = 0; // Where we put the checksum
int rcv_rank, rcv_coords, destnode, stat, idest = 0;
int k, x, y, z, t;
int buf_length = 0, where_in_buf = 0;
gauge_check test_gc;
u_int32type *val;
int rank29, rank31;
fmatrix *lbuf = NULL; // Only allocate on node0
fmatrix tmat[4];
if (this_node == 0) {
// Compute offset for reading gauge configuration
if (gh->magic_number == GAUGE_VERSION_NUMBER)
gauge_check_size = sizeof(gf->check.sum29) + sizeof(gf->check.sum31);
else
gauge_check_size = 0;
if (gf->header->order == NATURAL_ORDER)
coord_list_size = 0;
else
coord_list_size = sizeof(int32type) * volume;
checksum_offset = gf->header->header_bytes + coord_list_size;
head_size = checksum_offset + gauge_check_size;
// Allocate single-precision read buffer
if (gf->parallel)
printf("r_serial: Attempting serial read from parallel file\n");
lbuf = malloc(MAX_BUF_LENGTH * 4 * sizeof(*lbuf));
if (lbuf == NULL) {
printf("r_serial: node%d can't malloc lbuf\n", this_node);
fflush(stdout);
terminate(1);
}
/* Position file for reading gauge configuration */
offset = head_size;
if (g_seek(fp, offset, SEEK_SET) < 0) {
printf("r_serial: node0 g_seek %lld failed error %d file %s\n",
(long long)offset, errno, filename);
fflush(stdout);
terminate(1);
}
buf_length = 0;
where_in_buf = 0;
}
// All nodes initialize checksums
test_gc.sum29 = 0;
test_gc.sum31 = 0;
// Count 32-bit words mod 29 and mod 31 in order of appearance on file
// Here all nodes see the same sequence because we read serially
rank29 = 0;
rank31 = 0;
g_sync();
// node0 reads and deals out the values
for (rcv_rank = 0; rcv_rank < volume; rcv_rank++) {
/* If file is in coordinate natural order, receiving coordinate
is given by rank. Otherwise, it is found in the table */
if (gf->header->order == NATURAL_ORDER)
rcv_coords = rcv_rank;
else
rcv_coords = gf->rank2rcv[rcv_rank];
x = rcv_coords % nx;
rcv_coords /= nx;
y = rcv_coords % ny;
rcv_coords /= ny;
z = rcv_coords % nz;
rcv_coords /= nz;
t = rcv_coords % nt;
// The node that gets the next set of gauge links
destnode = node_number(x, y, z, t);
// node0 fills its buffer, if necessary
if (this_node == 0) {
if (where_in_buf == buf_length) { /* get new buffer */
/* new buffer length = remaining sites, but never bigger
than MAX_BUF_LENGTH */
buf_length = volume - rcv_rank;
if (buf_length > MAX_BUF_LENGTH)
buf_length = MAX_BUF_LENGTH;
// Now do read
stat = (int)g_read(lbuf, 4 * sizeof(fmatrix), buf_length, fp);
if (stat != buf_length) {
printf("r_serial: node%d gauge configuration read error %d file %s\n",
this_node, errno, filename);
fflush(stdout);
terminate(1);
}
where_in_buf = 0; // Reset counter
} // End of the buffer read
if (destnode == 0) { // Just copy links
idest = node_index(x, y, z, t);
// Save 4 matrices in tmat for further processing
memcpy(tmat, &lbuf[4 * where_in_buf], 4 * sizeof(fmatrix));
}
else { // Send to correct node
send_field((char *)&lbuf[4 * where_in_buf],
4 * sizeof(fmatrix), destnode);
}
where_in_buf++;
}
// The node that contains this site reads the message
else { // All nodes other than node 0
if (this_node == destnode) {
idest = node_index(x, y, z, t);
// Receive 4 matrices in temporary space for further processing
get_field((char *)tmat, 4 * sizeof(fmatrix), 0);
}
}
/* The receiving node does the byte reversal and then checksum,
if needed. At this point tmat contains the input matrices
and idest points to the destination site structure. */
if (this_node == destnode) {
if (byterevflag == 1)
byterevn((int32type *)tmat,
4 * sizeof(fmatrix) / sizeof(int32type));
// Accumulate checksums
for (k = 0, val = (u_int32type *)tmat;
k < 4*(int)sizeof(fmatrix) / (int)sizeof(int32type);
k++, val++) {
test_gc.sum29 ^= (*val)<<rank29 | (*val)>>(32 - rank29);
test_gc.sum31 ^= (*val)<<rank31 | (*val)>>(32 - rank31);
rank29++;
if (rank29 >= 29)
rank29 = 0;
rank31++;
if (rank31 >= 31)
rank31 = 0;
}
// Copy 4 matrices to generic-precision lattice[idest]
f2d_4mat(tmat, &lattice[idest].link[0]);
}
else {
rank29 += 4 * sizeof(fmatrix) / sizeof(int32type);
rank31 += 4 * sizeof(fmatrix) / sizeof(int32type);
rank29 %= 29;
rank31 %= 31;
}
}
// -----------------------------------------------------------------
// Only node0 writes the gauge configuration to a binary file gf
static void w_serial(gauge_file *gf) {
register int i, j;
int rank29, rank31, buf_length, tbuf_length;
int x, y, z, t, currentnode, newnode;
FILE *fp = NULL;
gauge_header *gh = NULL;
fmatrix *lbuf = NULL;
fmatrix *tbuf = malloc(nx * 4 * sizeof(*tbuf));
off_t offset; // File stream pointer
off_t coord_list_size; // Size of coordinate list in bytes
off_t head_size; // Size of header plus coordinate list
off_t checksum_offset = 0; // Location of checksum
off_t gauge_check_size; // Size of checksum record
// tbuf holds message buffer space for the x dimension
// of the local hypercube (needs at most 4nx matrices)
if (tbuf == NULL) {
printf("w_serial: node%d can't malloc tbuf\n", this_node);
terminate(1);
}
// Only allocate lbuf on node0
if (this_node == 0) {
if (gf->parallel)
printf("w_serial: Attempting serial write to parallel file\n");
lbuf = malloc(MAX_BUF_LENGTH * 4 * sizeof(*lbuf));
if (lbuf == NULL) {
printf("w_serial: Node 0 can't malloc lbuf\n");
fflush(stdout);
terminate(1);
}
fp = gf->fp;
gh = gf->header;
// No coordinate list written
// Fields to be written in standard coordinate list order
coord_list_size = 0;
head_size = gh->header_bytes + coord_list_size;
checksum_offset = head_size;
gauge_check_size = sizeof(gf->check.sum29) + sizeof(gf->check.sum31);
offset = head_size + gauge_check_size;
if (fseeko(fp, offset, SEEK_SET) < 0) {
printf("w_serial: node%d g_seek %lld failed error %d file %s\n",
this_node, (long long)offset, errno, gf->filename);
fflush(stdout);
terminate(1);
}
}
// Buffered algorithm for writing fields in serial (lexicographic) order
// Initialize checksums
gf->check.sum31 = 0;
gf->check.sum29 = 0;
// Count 32-bit words mod 29 and mod 31 in order of appearance on file
// Here only node 0 uses these values -- both start at 0
i = 4 * sizeof(fmatrix) / sizeof(int32type) * sites_on_node * this_node;
rank29 = i % 29;
rank31 = i % 31;
g_sync();
currentnode = 0; // The node delivering data
buf_length = 0;
tbuf_length = 0;
for (j = 0, t = 0; t < nt; t++) {
for (z = 0; z < nz; z++) {
for (y = 0; y < ny; y++) {
for (x = 0; x < nx; x++, j++) {
// The node providing the next site
newnode = node_number(x, y, z, t);
if (newnode != currentnode || x == 0) {
// We are switching to a new node or have exhausted a line of nx
// Sweep any data in the retiring node's tbuf to the node0 lbuf
if (tbuf_length > 0) {
if (currentnode != 0)
send_buf_to_node0(tbuf, tbuf_length, currentnode);
// node0 flushes tbuf, accumulates checksum
// and writes lbuf if it is full
if (this_node == 0) {
flush_tbuf_to_lbuf(gf, &rank29, &rank31, lbuf, &buf_length,
tbuf, tbuf_length);
if (buf_length > MAX_BUF_LENGTH - nx)
flush_lbuf_to_file(gf, lbuf, &buf_length);
}
tbuf_length = 0;
}
// node0 sends a few bytes to newnode as a clear to send signal
if (newnode != currentnode) {
if (this_node == 0 && newnode != 0)
send_field((char *)tbuf, 32, newnode);
if (this_node == newnode && newnode != 0)
get_field((char *)tbuf, 32, 0);
currentnode = newnode;
}
}
// The node with the data just appends to its tbuf
if (this_node == currentnode) {
i = node_index(x, y, z, t);
d2f_4mat(&lattice[i].link[0], &tbuf[4 * tbuf_length]);
}
if (this_node == currentnode || this_node == 0)
tbuf_length++;
}
}
}
}
// Purge any remaining data
if (tbuf_length > 0) {
if (currentnode != 0)
send_buf_to_node0(tbuf, tbuf_length, currentnode);
}
if (this_node == 0) {
flush_tbuf_to_lbuf(gf, &rank29, &rank31, lbuf, &buf_length,
tbuf, tbuf_length);
flush_lbuf_to_file(gf, lbuf, &buf_length);
}
g_sync();
free(tbuf);
if (this_node == 0) {
free(lbuf);
printf("Saved gauge configuration serially to binary file %s\n",
gf->filename);
printf("Time stamp %s\n", gh->time_stamp);
// Write checksum
// Position file pointer
if (g_seek(fp, checksum_offset, SEEK_SET) < 0) {
printf("w_serial: node%d g_seek %lld failed error %d file %s\n",
this_node, (long long)checksum_offset, errno, gf->filename);
fflush(stdout);
terminate(1);
}
write_checksum(SERIAL, gf);
}
}
/* Map node number and index to coordinates */
void get_coords(int coords[], int node, int index){
int mc[4];
int ir,kr,d,eo;
int k = node;
/* Compute machine coordinates for node */
lex_coords(mc, 4, nsquares, k);
/* Lexicographic index of hypercube, rounded to even */
ir = 2*(index % subl_sites_on_node);
/* "32-color" index */
kr = index/subl_sites_on_node;
if(kr >= 16){
kr -= 16;
eo = 1;
}
else
eo = 0;
/* First get sublattice coordinates */
for(d = XUP; d <= TUP; d++){
coords[d] = ir % (squaresize[d]/2);
ir /= (squaresize[d]/2);
}
/* Adjust sublattice coordinates according to its parity */
if( (coords[XUP] + coords[YUP] + coords[ZUP] + coords[TUP]) % 2 != eo){
coords[XUP]++;
if(coords[XUP] >= squaresize[XUP]/2){
coords[XUP] -= squaresize[XUP]/2; coords[YUP]++;
if(coords[YUP] >= squaresize[YUP]/2){
coords[YUP] -= squaresize[YUP]/2; coords[ZUP]++;
if(coords[ZUP] >= squaresize[ZUP]/2){
coords[ZUP] -= squaresize[ZUP]/2; coords[TUP]++;
}
}
}
}
/* Next convert to the site coordinate relative to the origin of the
node hypercube */
for(d = XUP; d <= TUP; d++){
coords[d] = 2*coords[d] + kr % 2;
kr /= 2;
}
/* Finally add offset for node hypercube origin */
coords[XUP] += mc[XUP]*squaresize[XUP];
coords[YUP] += mc[YUP]*squaresize[YUP];
coords[ZUP] += mc[ZUP]*squaresize[ZUP];
coords[TUP] += mc[TUP]*squaresize[TUP];
/* Consistency checks for debugging */
if((k = node_number(coords[0], coords[1], coords[2], coords[3]))
!= node){
printf("get_coords: coords %d %d %d %d for node %d index %d map to wrong node %d\n",
coords[0], coords[1], coords[2], coords[3], node, index, k);
terminate(1);
}
if((k = node_index(coords[0], coords[1], coords[2], coords[3]))
!= index){
printf("get_coords: coords %d %d %d %d for node %d index %d map to wrong index %d\n",
coords[0], coords[1], coords[2], coords[3], node, index, k);
terminate(1);
}
}
LOCAL bool check_curve3d(
CURVE *c,
INTERFACE *intfc)
{
BOND *b;
BOND_TRI **bts, **bts0;
NODE *ns, *ne;
SURFACE *s, **ss;
TRI *tri, **tris;
bool status = YES;
char warn[1024];
int nsides, nbts, i;
int ntris;
(void) sprintf(warn,"WARNING in check_curve3d(), curve %llu inconsistent ",
curve_number(c));
if (c->interface != intfc)
{
(void) printf("%s c->interface (%llu) != intfc (%llu)\n",
warn,interface_number(c->interface),
interface_number(intfc));
status = NO;
}
ns = c->start;
if (!pointer_is_in_array(c,ns->out_curves))
{
(void) printf("%s curve in not in start node (%llu) "
"out_curves\n",warn,node_number(ns));
status = NO;
}
ne = c->end;
if (!pointer_is_in_array(c,ne->in_curves))
{
(void) printf("%s curve in not in end node (%llu) "
"in_curves\n",warn,node_number(ne));
status = NO;
}
if (ns->posn != c->first->start)
{
(void) printf("%s ns->posn != c->first->start\n"
"c->first->start = %llu, "
"ns = %llu, ns->posn = %llu\n",
warn,point_number(c->first->start),
node_number(ns),point_number(ns->posn));
status = NO;
}
if (ne->posn != c->last->end)
{
(void) printf("%s ne->posn != c->last->end\n"
"c->last->end = %llu, "
"ne = %llu, ne->posn = %llu\n",
warn,point_number(c->last->end),
node_number(ne),point_number(ne->posn));
print_general_vector("c->last->end", Coords(c->last->end), 3, "\n");
print_general_vector("ne->posn", Coords(ne->posn), 3, "\n");
print_curve(c);
status = NO;
}
if (!Boundary_point(ns->posn))
{
(void) printf("%s ns->posn (ns = %llu, ns->posn = %llu) is not a "
"boundary point\n",
warn,node_number(ns),point_number(ns->posn));
status = NO;
}
if (!Boundary_point(ne->posn))
{
(void) printf("%s ne->posn (ne = %llu, ne->posn = %llu) is not a "
"boundary point\n",
warn,node_number(ne),point_number(ne->posn));
status = NO;
}
if (!Boundary_point(c->first->start))
{
(void) printf("%s c->first->start = %llu is not a "
"boundary point\n",
warn,point_number(c->first->start));
status = NO;
}
if (!Boundary_point(c->last->end))
{
(void) printf("%s c->last->end = %llu is not a "
"boundary point\n",
warn,point_number(c->last->end));
status = NO;
}
for (ss = c->pos_surfaces; ss && *ss; ++ss)
{
if (!pointer_is_in_array(c,(*ss)->pos_curves))
{
(void) printf("%s curve in not s->pos_curves "
" s = %llu but s is in c->neg_surfaces\n",
warn,surface_number(*ss));
status = NO;
}
}
for (ss = c->neg_surfaces; ss && *ss; ++ss)
{
if (!pointer_is_in_array(c,(*ss)->neg_curves))
{
(void) printf("%s curve in not s->neg_curves "
" s = %llu but s is in c->neg_surfaces\n",
warn,surface_number(*ss));
status = NO;
}
}
b = c->first;
bts0 = Btris(b);
for (nbts = 0, bts = Btris(b); bts && *bts; ++nbts, ++bts);
if (nbts == 0)
{
if (c->pos_surfaces || c->neg_surfaces)
{
(void) printf("%s curve has no bond tris but is "
"connected to some surface\n",warn);
status = NO;
}
}
if (c->first->prev != NULL)
{
(void) printf("%s c->first->prev != NULL\n",warn);
print_bond(c->first);
print_bond(c->first->prev);
status = NO;
}
if (c->last->next != NULL)
{
(void) printf("%s c->last->next != NULL\n",warn);
print_bond(c->last);
print_bond(c->last->next);
status = NO;
}
for (b = c->first; b != NULL; b = b->next)
{
if (b->next && b->next->start != b->end)
{
(void) printf("%s bond pair (%llu -> %llu) point pointers "
"inconsistent\n",
warn,bond_number(b,intfc),
bond_number(b->next,intfc));
print_bond(b);
print_bond(b->next);
status = NO;
}
if (!Boundary_point(b->start))
{
(void) printf("%s b->start = %llu is not a "
"boundary point\n",
warn,point_number(b->start));
print_bond(b);
status = NO;
}
if (!Boundary_point(b->end))
{
(void) printf("%s b->end = %llu is not a "
"boundary point\n",
warn,point_number(b->end));
print_bond(b);
status = NO;
}
for (i = 0, bts = Btris(b); bts && *bts; ++i, ++bts)
{
if ((i < nbts) &&
!(((*bts)->surface == bts0[i]->surface) &&
((*bts)->orient == bts0[i]->orient)))
{
(void) printf("%s inconsistent surface numbers on "
"bond tri\n",warn);
(void) printf("surface = %llu surface[%d] = %llu\n",
surface_number((*bts)->surface),i,
surface_number(bts0[i]->surface));
(void) printf("orient = %s orient[%d] = %s\n",
orientation_name((*bts)->orient),i,
orientation_name(bts0[i]->orient));
print_bond(b);
status = NO;
}
}
if (i != nbts)
{
(void) printf("%s inconsistent %d != %d number of bond tris "
"on bond\n",warn,i,nbts);
print_bond(b);
status = NO;
}
for (bts = Btris(b); bts && *bts; ++bts)
{
if ((*bts)->curve != c)
{
(void) printf("%s bond tri curve field (%llu) != c\n",
warn,curve_number((*bts)->curve));
print_bond(b);
status = NO;
}
if ((*bts)->bond != b)
{
(void) printf("%s bond tri bond field (%llu) != b (%llu)\n",
warn,bond_number((*bts)->bond,intfc),
bond_number(b,intfc));
print_bond(b);
status = NO;
}
tri = (*bts)->tri;
s = Surface_of_tri(tri);
if ((*bts)->surface != s)
{
(void) printf("%s bond tri surface field (%llu)"
"!= Surface_of_tri(tri) (%llu)\n",
warn,surface_number((*bts)->surface),
surface_number(s));
print_bond(b);
status = NO;
}
for (nsides = 0, i = 0; i < 3; ++i)
{
if (is_side_bdry(tri,i) && (b==Bond_on_side(tri,i)))
++nsides;
}
if (nsides == 0)
{
(void) printf("%s bond not found on tri side\n",warn);
print_bond(b);
print_tri(tri,intfc);
status = NO;
}
else if (nsides > 1)
{
(void) printf("%s bond found on multiple tri sides\n",warn);
print_bond(b);
print_tri(tri,intfc);
status = NO;
}
else
{
if (orientation_of_bond_at_tri(b,tri) != (*bts)->orient)
{
(void) printf("%s inconsistent orientation at "
"bond tri\n",warn);
print_tri(tri,intfc);
print_bond(b);
status = NO;
}
switch ((*bts)->orient)
{
case POSITIVE_ORIENTATION:
if (!pointer_is_in_array(c,s->pos_curves))
{
(void) printf("%s curve in not s->pos_curves "
" s = %llu\n",
warn,surface_number(s));
print_bond(b);
print_tri(tri,intfc);
status = NO;
}
if (!pointer_is_in_array(s,c->pos_surfaces))
{
(void) printf("%s surface in not c->pos_surfaces "
" s = %llu\n",
warn,surface_number(s));
print_bond(b);
print_tri(tri,intfc);
status = NO;
}
break;
case NEGATIVE_ORIENTATION:
if (!pointer_is_in_array(c,s->neg_curves))
{
(void) printf("%s curve in not s->neg_curves "
" s = %llu\n",
warn,surface_number(s));
print_bond(b);
print_tri(tri,intfc);
status = NO;
}
if (!pointer_is_in_array(s,c->neg_surfaces))
{
(void) printf("%s surface in not c->neg_surfaces "
" s = %llu\n",
warn,surface_number(s));
print_bond(b);
print_tri(tri,intfc);
status = NO;
}
break;
case ORIENTATION_NOT_SET:
(void) printf("%s inconsistent point and tri "
"points\n",warn);
print_bond(b);
print_tri(tri,intfc);
status = NO;
break;
}
}
if (b->prev)
{
TRI *t0, *t1;
ntris = set_tri_list_around_point(b->start,tri,&tris,intfc);
t0 = tris[0]; t1 = tris[ntris-1];
if (!(((side_of_tri_with_bond(b,t0) < 3) &&
(side_of_tri_with_bond(b->prev,t1) < 3))
||
((side_of_tri_with_bond(b,t1) < 3) &&
(side_of_tri_with_bond(b->prev,t0) < 3)))
)
{
(void) printf("%s, corrupt tri list at b->start\n",
warn);
(void) printf("Bond b\n"); print_bond(b);
(void) printf("Bond b->prev\n"); print_bond(b->prev);
print_tri(tri,intfc);
(void) printf("number of tris at point = %d\n",ntris);
for (i = 0; i < ntris; ++i)
{
(void) printf("tris[%d] - ",i);
print_tri(tris[i],intfc);
}
status = NO;
}
}
}
}
return status;
} /*end check_curve3d*/
void r_check(gauge_file *gf, float *max_deviation)
{
/* gf = gauge configuration file structure */
FILE *fp;
gauge_header *gh;
char *filename;
int byterevflag;
off_t offset ; /* File stream pointer */
off_t gauge_check_size; /* Size of gauge configuration checksum record */
off_t coord_list_size; /* Size of coordinate list in bytes */
off_t head_size; /* Size of header plus coordinate list */
off_t checksum_offset; /* Where we put the checksum */
int rcv_rank, rcv_coords;
int destnode;
int i,k;
int x,y,z,t;
int buf_length,where_in_buf;
gauge_check test_gc;
u_int32type *val;
int rank29,rank31;
su3_matrix *lbuf;
su3_matrix work[4];
float deviation;
char myname[] = "r_check";
fp = gf->fp;
gh = gf->header;
filename = gf->filename;
byterevflag = gf->byterevflag;
if(this_node == 0)
{
/* Compute offset for reading gauge configuration */
/* (1996 gauge configuration files had a 32-bit unused checksum
record before the gauge link data) */
if(gh->magic_number == GAUGE_VERSION_NUMBER)
gauge_check_size = sizeof(gf->check.sum29) +
sizeof(gf->check.sum31);
else if(gh->magic_number == GAUGE_VERSION_NUMBER_1996)
gauge_check_size = 4;
else
gauge_check_size = 0;
if(gf->header->order == NATURAL_ORDER)coord_list_size = 0;
else coord_list_size = sizeof(int32type)*volume;
checksum_offset = gf->header->header_bytes + coord_list_size;
head_size = checksum_offset + gauge_check_size;
/* Allocate space for read buffer */
if(gf->parallel)
printf("%s: Attempting serial read from parallel file \n",myname);
lbuf = (su3_matrix *)malloc(MAX_BUF_LENGTH*4*sizeof(su3_matrix));
if(lbuf == NULL)
{
printf("%s: Node %d can't malloc lbuf\n",myname,this_node);
fflush(stdout);
terminate(1);
}
/* Position file for reading gauge configuration */
offset = head_size;
if( g_seek(fp,offset,SEEK_SET) < 0 )
{
printf("%s: Node 0 g_seek %ld failed error %d file %s\n",
myname,(long)offset,errno,filename);
fflush(stdout);terminate(1);
}
buf_length = 0;
where_in_buf = 0;
}
/* all nodes initialize checksums */
test_gc.sum29 = 0;
test_gc.sum31 = 0;
/* counts 32-bit words mod 29 and mod 31 in order of appearance
on file */
/* Here all nodes see the same sequence because we read serially */
rank29 = 0;
rank31 = 0;
*max_deviation = 0;
g_sync();
/* Node 0 reads and deals out the values */
for(rcv_rank=0; rcv_rank<volume; rcv_rank++)
{
/* If file is in coordinate natural order, receiving coordinate
is given by rank. Otherwise, it is found in the table */
if(gf->header->order == NATURAL_ORDER)
rcv_coords = rcv_rank;
else
rcv_coords = gf->rank2rcv[rcv_rank];
x = rcv_coords % nx; rcv_coords /= nx;
y = rcv_coords % ny; rcv_coords /= ny;
z = rcv_coords % nz; rcv_coords /= nz;
t = rcv_coords % nt;
/* The node that gets the next set of gauge links */
destnode=node_number(x,y,z,t);
if(this_node==0){
/* Node 0 fills its buffer, if necessary */
if(where_in_buf == buf_length)
{ /* get new buffer */
/* new buffer length = remaining sites, but never bigger
than MAX_BUF_LENGTH */
buf_length = volume - rcv_rank;
if(buf_length > MAX_BUF_LENGTH)buf_length = MAX_BUF_LENGTH;
/* then do read */
if( (int)g_read(lbuf,4*sizeof(su3_matrix),buf_length,fp) != buf_length)
{
printf("%s: node %d gauge configuration read error %d file %s\n",
myname,this_node,errno,filename);
fflush(stdout); terminate(1);
}
where_in_buf = 0; /* reset counter */
} /*** end of the buffer read ****/
if(destnode==0){ /* just copy links */
i = node_index(x,y,z,t);
memcpy((void *)&work[0],
(void *)&lbuf[4*where_in_buf], 4*sizeof(su3_matrix));
}
else { /* send to correct node */
send_field((char *)&lbuf[4*where_in_buf],
4*sizeof(su3_matrix),destnode);
}
where_in_buf++;
}
/* The node which contains this site reads message */
else { /* for all nodes other than node 0 */
if(this_node==destnode){
i = node_index(x,y,z,t);
get_field((char *)&work[0],4*sizeof(su3_matrix),0);
}
}
/* The receiving node does the byte reversal and then checksum,
if needed */
if(this_node==destnode)
{
if(byterevflag==1)
byterevn((int32type *)&work[0],
4*sizeof(su3_matrix)/sizeof(int32type));
/* Accumulate checksums */
for(k = 0, val = (u_int32type *)&work[0];
k < 4*(int)sizeof(su3_matrix)/(int)sizeof(int32type); k++, val++)
{
test_gc.sum29 ^= (*val)<<rank29 | (*val)>>(32-rank29);
test_gc.sum31 ^= (*val)<<rank31 | (*val)>>(32-rank31);
rank29++; if(rank29 >= 29)rank29 = 0;
rank31++; if(rank31 >= 31)rank31 = 0;
}
deviation = ck_unitarity(work,x,y,z,t);
if(deviation > *max_deviation)*max_deviation = deviation;
}
else
{
rank29 += 4*sizeof(su3_matrix)/sizeof(int32type);
rank31 += 4*sizeof(su3_matrix)/sizeof(int32type);
rank29 %= 29;
rank31 %= 31;
}
}
static int QPHIX_node_number_raw(int coords[]){
return node_number(coords[0],coords[1],coords[2],coords[3]);
}
int nl_spectrum( Real vmass, field_offset temp1, field_offset temp2 ) {
/* return the C.G. iteration number */
double *piprop,*pi2prop,*rhoprop,*rho2prop,*barprop;
double *nlpiprop,*nlpi2prop,*ckpiprop,*ckpi2prop;
double *delprop,*ckbarprop;
Real vmass_x2;
site* s;
register complex cc;
Real finalrsq;
register int i,x,y,z,t,icol,cgn;
register int t_source,t_off;
int dir,isrc;
msg_tag *mtag[16];
piprop = (double *)malloc( nt*sizeof(double) );
pi2prop = (double *)malloc( nt*sizeof(double) );
rhoprop = (double *)malloc( nt*sizeof(double) );
rho2prop = (double *)malloc( nt*sizeof(double) );
barprop = (double *)malloc( nt*sizeof(double) );
nlpiprop = (double *)malloc( nt*sizeof(double) );
nlpi2prop = (double *)malloc( nt*sizeof(double) );
ckpiprop = (double *)malloc( nt*sizeof(double) );
ckpi2prop = (double *)malloc( nt*sizeof(double) );
delprop = (double *)malloc( nt*sizeof(double) );
ckbarprop = (double *)malloc( nt*sizeof(double) );
for( t=0; t<nt; t++ ){
piprop[t]=0.0; pi2prop[t]=0.0; rhoprop[t]=0.0; rho2prop[t]=0.0;
nlpiprop[t]=0.0; nlpi2prop[t]=0.0;
ckpiprop[t]=0.0; ckpi2prop[t]=0.0;
barprop[t]=0.0; delprop[t]=0.0; ckbarprop[t]=0.0;
}
vmass_x2 = 2.*vmass;
cgn=0;
/* Fix TUP Coulomb gauge - gauge links only*/
rephase( OFF );
gaugefix(TUP,(Real)1.8,500,(Real)GAUGE_FIX_TOL);
rephase( ON );
#ifdef FN
invalidate_all_ferm_links(&fn_links);
#endif
/* Unlike spectrum.c, here we calculate only with wall sources */
for(t_source=source_start, isrc=0; t_source<2*nt && isrc < n_sources;
++isrc, t_source += source_inc ) {
/* Only work for even source slices */
if( t_source%2 != 0 ){
printf("DUMMY: Use even time slices for nl_spectrum()\n");
terminate(0);
}
/* Compute propagator from even wall sites */
/* Sources are normalized to 1/8 to make them comparable to */
/* propagators from a wall with ones on the cube origin. */
/* Put result in propmat */
for(icol=0; icol<3; icol++) {
/* initialize temp1 and temp2 */
clear_latvec( temp1, EVEN);
clear_latvec( temp2, EVEN);
for(x=0;x<nx;x++)for(y=0;y<ny;y++)for(z=0;z<nz;z++) {
if((x+y+z) % 2 == 0) {
if( node_number(x,y,z,t_source) != mynode() )continue;
i=node_index(x,y,z,t_source);
((su3_vector *)(F_PT(&lattice[i],temp1)))->c[icol].real =
-0.25;
}
}
/* do a C.G. */
load_ferm_links(&fn_links);
cgn += congrad(niter,rsqprop,EVEN,&finalrsq, &fn_links);
/* Multiply by -Madjoint */
dslash_site( temp2, temp2, ODD, &fn_links);
scalar_mult_latvec( temp2, -vmass_x2, temp2, EVEN);
/* fill the hadron matrix */
copy_latvec( temp2, F_OFFSET(propmat[icol]), EVENANDODD);
} /* end loop on icol */
/* Compute propagator from odd wall sites */
/* Put result in propmat2 */
for(icol=0; icol<3; icol++) {
/* initialize temp1 and temp2 */
clear_latvec( temp1, ODD);
clear_latvec( temp2, ODD);
for(x=0;x<nx;x++)for(y=0;y<ny;y++)for(z=0;z<nz;z++) {
if((x+y+z) % 2 == 1) {
if( node_number(x,y,z,t_source) != mynode() )continue;
i=node_index(x,y,z,t_source);
((su3_vector *)(F_PT(&lattice[i],temp1)))->c[icol].real =
-0.25;
}
}
/* do a C.G. */
load_ferm_links(&fn_links);
cgn += congrad(niter,rsqprop,ODD,&finalrsq,&fn_links);
/* Multiply by -Madjoint */
dslash_site( temp2, temp2, EVEN, &fn_links);
scalar_mult_latvec( temp2, -vmass_x2, temp2, ODD);
/* fill the hadron matrix */
copy_latvec( temp2, F_OFFSET(propmat2[icol]), EVENANDODD);
} /* end loop on icol */
/* cgn now gives the sum for both inversions */
/* measure the meson propagator for the E wall source */
for(t=0; t<nt; t++) {
/* define the time value offset t from t_source */
t_off = (t+t_source)%nt;
for(x=0;x<nx;x++)for(y=0;y<ny;y++)for(z=0;z<nz;z++)
for(icol=0;icol<3;icol++) {
if( node_number(x,y,z,t_off) != mynode() )continue;
i=node_index(x,y,z,t_off);
cc = su3_dot( &lattice[i].propmat[icol],
&lattice[i].propmat[icol] );
piprop[t] += cc.real;
/* (rhoprop and rho2prop are not generated by this source) */
if( (x+y+z)%2==0)pi2prop[t] += cc.real;
else pi2prop[t] -= cc.real;
}
} /* nt-loop */
/* measure the baryon propagator for the E wall source */
for(t=0; t<nt; t++) {
/* define the time value offset t from t_source */
t_off = (t+t_source)%nt;
for(x=0;x<nx;x+=2)for(y=0;y<ny;y+=2)for(z=0;z<nz;z+=2) {
if( node_number(x,y,z,t_off) != mynode() )continue;
i=node_index(x,y,z,t_off);
cc = det_su3( (su3_matrix *)(lattice[i].propmat) );
barprop[t] += cc.real;
}
/* must get sign right. This looks to see if we have
wrapped around the lattice. "t" is the distance
from the source to the measurement, so we are
trying to find out if t_source+t is greater than
or equal to nt. */
if( (((t+t_source)/nt-t_source/nt)%2) == 1 )barprop[t] *= -1.0;
/* change sign because antiperiodic b.c. sink point
should really be in a copy of the lattice */
} /* nt-loop */
/* Measure nonlocal (and some local for checking) propagators */
/* These propagators include the delta and some nonlocal mesons */
/* The method for the delta is described in M.F.L. Golterman and */
/* J. Smit, Nucl. Phys. B 255, 328 (1985) */
/* Equation (6.3) defines the sink operator for the delta */
/* The method for the mesons is described in M.F.L. Golterman */
/* Nucl. Phys. B 273, 663 (1986) */
/* The treatment of the source wall is described in Gupta, */
/* Guralnik, Kilcup, and Sharpe, (GGKS) NSF-ITP-90-172 (1990) */
/* To get the delta propagator, we take the "q" propagator */
/* matrices for each of the wall colors and antisymmetrize over */
/* wall color as well as s */
/* First construct the "q" and "o" propagators */
/* Put q = E + O in propmat and o = E - O in propmat2 */
FORALLSITES(i,s) {
for(icol=0; icol<3; icol++) {
add_su3_vector (&(s->propmat[icol]), &(s->propmat2[icol]),
(su3_vector *)(s->tempmat1.e[icol]) );
sub_su3_vector (&(s->propmat[icol]), &(s->propmat2[icol]),
&(s->propmat2[icol]) );
su3vec_copy( (su3_vector *)(s->tempmat1.e[icol]),
&(s->propmat[icol]) );
}
}
/* Next gather the propagators in preparation for calculating */
/* shifted propagators Dq and Do */
FORALLUPDIRBUT(TUP,dir) {
/* Start bringing "q" = propmat from forward sites */
mtag[dir] = start_gather_site(F_OFFSET(propmat[0]),
sizeof(su3_matrix), dir, EVENANDODD, gen_pt[dir]);
/* Start bringing "q" from backward neighbors */
mtag[dir+4] = start_gather_site(F_OFFSET(propmat[0]),
sizeof(su3_matrix), OPP_DIR(dir), EVENANDODD,
gen_pt[dir+4]);
wait_gather(mtag[dir]);
wait_gather(mtag[dir+4]);
/* Start bringing "o" = propmat2 from forward sites */
mtag[8+dir] = start_gather_site(F_OFFSET(propmat2[0]),
sizeof(su3_matrix), dir, EVENANDODD, gen_pt[8+dir]);
/* Start bringing "o" from backward neighbors */
mtag[8+dir+4] = start_gather_site(F_OFFSET(propmat2[0]),
sizeof(su3_matrix), OPP_DIR(dir), EVENANDODD,
gen_pt[8+dir+4]);
wait_gather(mtag[8+dir]);
wait_gather(mtag[8+dir+4]);
}
/* Calculate and dump delta propagator */
for(t=0; t<nt; t++) {
/* define the time value offset t from t_source */
t_off = (t+t_source)%nt;
/* Calculate contribution for each permutation of source color */
delta_prop (0,1,2, 1, t_off, &delprop[t]);
delta_prop (1,2,0, 1, t_off, &delprop[t]);
delta_prop (2,0,1, 1, t_off, &delprop[t]);
delta_prop (1,0,2,-1, t_off, &delprop[t]);
delta_prop (0,2,1,-1, t_off, &delprop[t]);
delta_prop (2,1,0,-1, t_off, &delprop[t]);
if( (((t+t_source)/nt-t_source/nt)%2) == 1 ) delprop[t] *= -1;
} /* nt-loop */
/* Calculate the "q" source nucleon as a check */
/* Calculate and dump nucleon check propagator */
for(t=0; t<nt; t++) {
/* define the time value offset t from t_source */
t_off = (t+t_source)%nt;
for(x=0;x<nx;x+=2)for(y=0;y<ny;y+=2)for(z=0;z<nz;z+=2) {
if( node_number(x,y,z,t_off) != mynode() )continue;
i=node_index(x,y,z,t_off);
/* The q propagator is in propmat */
cc = det_su3( (su3_matrix *)(lattice[i].propmat) );
ckbarprop[t] += cc.real;
}
if( (((t+t_source)/nt-t_source/nt)%2) == 1 )ckbarprop[t]*= -1.0;
/* change sign because antiperiodic b.c. sink point
should really be in a copy of the lattice */
} /* nt-loop */
/* Calculate nonlocal meson propagators and local check */
for(t=0; t<nt; t++) {
/* Calculate two nonlocal pion propagators */
/* These are pi_1 and pi_1 tilde of Gupta et al */
/* Also calculate two local propagators as a check */
/* define the time value offset t from t_source */
t_off = (t+t_source)%nt;
nl_meson_prop(t_off,&nlpiprop[t],&nlpi2prop[t],&ckpiprop[t],
&ckpi2prop[t]);
} /* nt-loop */
/* Clean up gathers */
FORALLUPDIRBUT(TUP,dir) {
cleanup_gather(mtag[dir]);
cleanup_gather(mtag[dir+4]);
cleanup_gather(mtag[8+dir]);
cleanup_gather(mtag[8+dir+4]);
}
int qio_node_number(const int x[]){
return node_number(x[0],x[1],x[2],x[3]);
}
void load_smearing(field_offset where_smear, char filename[])
{
Real *wave_func ;
complex lbuf ;
int nxyz = nx*ny*nz ;
int x,y,z,t ;
int newnode , currentnode ;
int where ;
int where_space ;
int i ;
double starttime,endtime ;
/****---------------------------------------*****/
starttime = dclock() ;
/** Reserve space for the smearing function on the master node ***/
if(mynode()==0)
{
if( (wave_func = (Real *) calloc( (size_t) nxyz, sizeof(Real) ) ) == NULL )
{
printf("ERROR: load_smearing: could not reserve buffer space for wave function on the master node \n");
terminate(1);
}
}
/** load in the smearing function into the master node buffer **/
if(mynode()==0)
{
/** load the smearing function ****/
load_scalar_smear(wave_func, nxyz, filename);
}
g_sync();
currentnode = 0 ;
/*** send the smearing function to the correct nodes **/
for(t=0;t<nt;t++)
for(z=0;z<nz;z++)
for(y=0;y<ny;y++)
for(x=0;x<nx;x++)
{
where = x + nx*(y + ny*( z + nz*t)) ;
where_space = x + nx*(y + ny*z) ;
newnode=node_number(x,y,z,t);
if(newnode != currentnode)
{
g_sync();
currentnode=newnode;
}
/* Node 0 reads, and sends site to correct node */
if(this_node==0)
{
lbuf.real = *(wave_func + where_space ) ;
lbuf.imag = 0.0 ;
if(currentnode==0)
{ /* just copy links */
i = node_index(x,y,z,t);
*( (complex *)F_PT( &(lattice[i]), where_smear ) )=lbuf;
}
else
{ /* send to correct node */
send_field((char *)&lbuf,sizeof(complex),currentnode);
}
}
/* The node which contains this site reads message */
else
{
/* for all nodes other than node 0 */
if(this_node==currentnode)
{
get_field((char *)&lbuf,sizeof(complex),0);
i = node_index(x,y,z,t);
*( (complex *)F_PT( &(lattice[i]), where_smear ) )=lbuf;
}
}
} /** end the loop over the spatial lattice ****/
/** free up the memory buffer on the master node ***/
if(mynode()==0)
free(wave_func);
endtime = dclock() - starttime ;
node0_printf("Time to load smearing functions = %g sec \n",endtime );
}
void r_prop_w_fm(char *filename, field_offset dest)
{
FILE *fp;
int destnode;
int x,y,z,t,i, byterevflag, c0,s0,c1,s1;
wilson_matrix q;
int32type tmp, magic_number,elements_per_site;
int32type size_of_element, order, dims[4];
int32type t_stamp;
site *s;
wilson_propagator *qp;
/*READING FILE HEADER*/
if(this_node==0){
fp = fopen(filename,"rb");
if(fp==NULL){
printf("Can't open propagator file %s, error %d\n",filename,errno);
terminate(1);
}
if(fread(&magic_number,sizeof(int32type),1,fp) != 1)
{
printf("error in reading magic number from file %s\n", filename);
terminate(1);
}
tmp=magic_number;
if(magic_number == IO_UNI_MAGIC) byterevflag=0;
else
{
byterevn((int32type *)&magic_number,1);
if(magic_number == IO_UNI_MAGIC)
{
byterevflag=1;
printf("Reading with byte reversal\n");
if( sizeof(float) != sizeof(int32type)) {
printf("%s: Can't byte reverse\n", filename);
printf("requires size of int32type(%d) = size of float(%d)\n",
(int)sizeof(int32type),(int)sizeof(float));
terminate(1);
}
}
else
{
/* Restore magic number as originally read */
magic_number = tmp;
/* End of the road. */
printf("%s: Unrecognized magic number in prop file header.\n",
filename);
printf("Expected %x but read %x\n",
IO_UNI_MAGIC,tmp);
terminate(1);
}
};
if(fread(&t_stamp,sizeof(t_stamp),1,fp) != 1)
{
printf("error in reading time stamp from file %s\n", filename);
terminate(1);
}
if(fread(&size_of_element,sizeof(int32type),1,fp) != 1)
{
printf("error in reading size of element from file %s\n", filename);
terminate(1);
}
if(fread(&elements_per_site,sizeof(int32type),1,fp) != 1)
{
printf("error in reading elements per site from file %s\n", filename);
terminate(1);
}
if(psread_byteorder(byterevflag,0,fp,dims,sizeof(dims),
filename,"dimensions")!=0) terminate(1);
if( dims[0]!=nx || dims[1]!=ny ||
dims[2]!=nz || dims[3]!=nt )
{
printf(" Incorrect lattice size %d,%d,%d,%d\n",
dims[0], dims[1], dims[2], dims[3]);
terminate(1);
}
if( size_of_element != sizeof(float) ||
elements_per_site != 288 /* wilson_propagator */)
{
printf(" file %s is not a wilson propagator in arch_fm format\n",
filename);
terminate(1);
}
if(psread_byteorder(byterevflag,0,fp,&order,sizeof(int32type),
filename,"order parameter")!=0) terminate(1);
} /*if this_node==0*/
printf("fm prop header\n magic number %x\n timestamp %x\n size of elem %d\n el per site %d\n dim %d, %d, %d, %d\n order %d\nbyterevflag %d\n\n", magic_number, t_stamp, size_of_element, elements_per_site,
dims[0],dims[1],dims[2],dims[3], order,byterevflag);
for(t=0;t<nt;t++)for(z=0;z<nz;z++)for(y=0;y<ny;y++)for(x=0;x<nx;x++){
destnode=node_number(x,y,z,t);
/* Node 0 reads, and sends site to correct node */
if(this_node==0){
if(psread_byteorder(byterevflag,0,fp,&q,sizeof(wilson_matrix),
filename,"reading the wilson propagator\n")!=0) terminate(1);
if(destnode==0){ /* just copy links */
i = node_index(x,y,z,t);
for(s0=0;s0<4;s0++)for(c0=0;c0<3;c0++)
for(s1=0;s1<4;s1++)for(c1=0;c1<3;c1++)
{
s = &lattice[i];
qp = (wilson_propagator *)F_PT(s,dest);
qp->c[c0].d[s0].d[s1].c[c1].real
= q.d[s0].c[c0].d[s1].c[c1].real;
qp->c[c0].d[s0].d[s1].c[c1].imag
= q.d[s0].c[c0].d[s1].c[c1].imag;
}
}
else { /* send to correct node */
send_field((char *)&q, sizeof(wilson_matrix),destnode);
}
}
/* The node which contains this site reads message */
else { /* for all nodes other than node 0 */
if(this_node==destnode){
get_field((char *)&q, sizeof(wilson_matrix),0);
i = node_index(x,y,z,t);
for(s0=0;s0<4;s0++)for(c0=0;c0<3;c0++)
for(s1=0;s1<4;s1++)for(c1=0;c1<3;c1++)
{
s = &lattice[i];
qp = (wilson_propagator *)F_PT(s,dest);
qp->c[c0].d[s0].d[s1].c[c1].real
= q.d[s0].c[c0].d[s1].c[c1].real;
qp->c[c0].d[s0].d[s1].c[c1].imag
= q.d[s0].c[c0].d[s1].c[c1].imag;
}
}
}
}
g_sync();
if(this_node==0){
printf("Restored wilson propagator from binary file %s, magic number %x\n",
filename, IO_UNI_MAGIC);
fclose(fp);
fflush(stdout);
}
}
int quark_renorm( void ) {
register int i, dir;
register site *s;
int j, cgn;
Real mass_x2, finalrsq;
Real pix, piy, piz, pit;
Real sin_pmu, q_mu, prop_a, prop_b, z_fac, m_func, ftmp = 0;
Real r1, r2, r3;
int pmu, px, py, pz, pt;
int pxn, pyn, pzn, ptn;
int currentnode;
int j1, jm2, k, dirs[4];
msg_tag *mtag[2];
int j_mass;
su3_vector **psim = NULL;
int xi, j2, j3, j4, parity;
int multiflag;
FILE *fp_mom_ks[MAX_NUM_MASS]; /* for writing mom propagator files */
char filename[50];
int prec = PRECISION; /* Make internal precision for CG the same as
the prevailing precision */
pix = 2.*PI / (Real)nx;
piy = 2.*PI / (Real)ny;
piz = 2.*PI / (Real)nz;
pit = 2.*PI / (Real)nt;
cgn = 0;
if( num_mass == 1){
multiflag = 0;
}
else{
multiflag = 1;
psim = (su3_vector **)malloc(num_mass*sizeof(su3_vector *));
for(j=0; j<num_mass; j++){
psim[j] = (su3_vector *)malloc(sites_on_node*sizeof(su3_vector));
}
}
/* Open the momentum propagator files */
if(this_node == 0){
for(j=0; j<num_mass; j++){
sprintf(filename,"mom_pt_prop.m_%d",j);
fp_mom_ks[j] = fopen(filename, "ab");
if(fp_mom_ks[j] == NULL){
printf("quark_renorm: Node %d can't open file %s, error %d\n",
this_node,filename,errno);fflush(stdout);
terminate(1);
}
}
}
rephase( ON ); /* Turn staggered phases on */
/* Create fat and long links */
load_ferm_links(&fn_links, &ks_act_paths);
/* Loop over the 16 source points */
for(xi=0; xi<16; xi++){
/* Initialize color trace of the propagator */
FORALLSITES(i,s){
for(j=0; j<num_mass; j++){
s->trace_prop[j].real = 0.0;
s->trace_prop[j].imag = 0.0;
}
}
j1 = xi%2;
k = xi/2;
j2 = k%2;
k /= 2;
j3 = k%2;
k /= 2;
j4 = k%2;
parity = (j1+j2+j3+j4)%2;
/* dirs[XUP] = j1;
dirs[YUP] = j2;
dirs[ZUP] = j3;
dirs[TUP] = j4; */
/* Loop over colors of source vector */
for(j=0; j<3; j++){
/* initialize the source in phi */
FORALLSITES(i,s){
clearvec( &(s->phi));
}
/* Point source at site xi in the hypercube at origin */
if( node_number(j1,j2,j3,j4) == this_node ){
i=node_index(j1,j2,j3,j4);
lattice[i].phi.c[j].real = -1.0;
}
if( multiflag == 0){
for(j_mass=0; j_mass<num_mass; j_mass++){
FORALLSITES(i,s){
clearvec( &(s->xxx1));
}
if(parity == 0){
/* do a C.G. (source in phi, result in xxx1) */
cgn += ks_congrad( F_OFFSET(phi), F_OFFSET(xxx1),
mass[j_mass], niter, nrestart,
rsqprop, PRECISION,
EVEN, &finalrsq, &fn_links);
/* Multiply by -Madjoint */
dslash_site( F_OFFSET(xxx1), F_OFFSET(ttt), ODD,
&fn_links);
mass_x2 = 2.*mass[j_mass];
FOREVENSITES(i,s){
scalar_mult_su3_vector( &(s->xxx1), -mass_x2,
&(s->ttt));
}
}
else{
LOCAL bool check_curve2d(
CURVE *c,
INTERFACE *intfc)
{
BOND *b;
NODE *ns, *ne;
bool status = YES;
char warn[1024];
(void) sprintf(warn,"WARNING in check_curve(), curve %llu inconsistent ",
curve_number(c));
if (c->interface != intfc)
{
(void) printf("%s c->interface (%llu) != intfc (%llu)\n",
warn,interface_number(c->interface),
interface_number(intfc));
status = NO;
}
ns = c->start;
if (!pointer_is_in_array(c,ns->out_curves))
{
(void) printf("%s curve in not in start node (%llu) "
"out_curves\n",warn,node_number(ns));
status = NO;
}
ne = c->end;
if (!pointer_is_in_array(c,ne->in_curves))
{
(void) printf("%s curve in not in end node (%llu) "
"in_curves\n",warn,node_number(ne));
status = NO;
}
if (ns->posn != c->first->start)
{
(void) printf("%s ns->posn != c->first->start\n"
"c->first->start = %llu, "
"ns = %llu, ns->posn = %llu\n",
warn,point_number(c->first->start),
node_number(ns),point_number(ns->posn));
status = NO;
}
if (ne->posn != c->last->end)
{
(void) printf("%s ne->posn != c->last->end\n"
"c->last->end = %llu, "
"ne = %llu, ne->posn = %llu\n",
warn,point_number(c->last->end),
node_number(ne),point_number(ne->posn));
status = NO;
}
if (c->first->prev != NULL)
{
(void) printf("%s c->first->prev != NULL\n",warn);
print_bond(c->first);
print_bond(c->first->prev);
status = NO;
}
if (c->last->next != NULL)
{
(void) printf("%s c->last->next != NULL\n",warn);
print_bond(c->last);
print_bond(c->last->next);
status = NO;
}
for (b = c->first; b != NULL; b = b->next)
{
if (b->next && b->next->start != b->end)
{
(void) printf("%s bond pair (%llu -> %llu) point pointers "
"inconsistent\n",
warn,bond_number(b,intfc),
bond_number(b->next,intfc));
print_bond(b);
print_bond(b->next);
status = NO;
}
if ((b->next && b->next->prev != b) ||
(b->prev && b->prev->next != b) ||
b->next == b || b->prev == b)
{
(void) printf("%s bond pair (%llu -> %llu) link pointers "
"inconsistent\n",
warn,bond_number(b,intfc),
bond_number(b->next,intfc));
print_bond(b);
print_bond(b->next);
return NO; /* this is a potential deadloop, so exit */
}
}
return status;
} /*end check_curve2d*/
