static long find_tag_opt(char *tag)
{
int ie;
long tofs,lofs,ofs;
char *s,*pl,*pr;
ie=0;
tofs=-1L;
lofs=ftell(stdin);
rewind(stdin);
ofs=ftell(stdin);
s=get_line();
while (s!=NULL)
{
pl=strchr(line,'[');
pr=strchr(line,']');
if ((pl==(line+strspn(line," \t")))&&(pr>pl))
{
if (ofs<lofs)
{
ie=0;
tofs=-1L;
}
else
break;
}
else
{
pl=line+strspn(line," \t");
pr=pl+strcspn(pl," \t\n");
pr[0]='\0';
if (strcmp(pl,tag)==0)
{
if (tofs!=-1L)
ie=1;
tofs=ofs;
}
}
ofs=ftell(stdin);
s=get_line();
}
if (tofs==-1L)
return tofs;
else
{
error_root(ie!=0,1,"find_tag_opt [mutils.c]",
"Tag %s occurs more than once in the current section",tag);
ie=fseek(stdin,tofs,SEEK_SET);
error_root(ie!=0,1,"find_tag_opt [mutils.c]",
"Unable to go to line with tag %s",tag);
}
return tofs;
}
static int check_machine(void)
{
int ie;
error_root(sizeof(stdint_t)!=4,1,"check_machine [archive_ildg.c]",
"Size of a stdint_t integer is not 4");
error_root(sizeof(double)!=8,1,"check_machine [archive_ildg.c]",
"Size of a double is not 8");
ie=endianness();
error_root(ie==UNKNOWN_ENDIAN,1,"check_machine [archive_ildg.c]",
"Unkown endianness");
return ie;
}
/* long read_line_opt(char *tag,char *defaultline,char *format,...)
*
* On process 0, this program reads a line of text and data from stdin
* in a controlled manner. The tag cannot
* be the empty string "", the program searches
* for the tag in the current section. If the tag is not
* found, default values are assigned to the variables. The program returns
* the offset of the line from the beginning
* of the file and positions the file pointer to the next line. On
* processes other than 0, the program does nothing and returns -1L.
*
*/
long read_line_opt(char *tag,char *defaultline,char *format, ...)
{
int my_rank,is,ic;
long tofs;
char *pl,*p;
va_list args;
MPI_Comm_rank(MPI_COMM_WORLD,&my_rank);
if (my_rank==0)
{
check_tag(tag);
error_root(tag[0]=='\0',1,"read_line_opt [mutils.c]",
"optional parameters must have a non empty tag");
tofs=find_tag_opt(tag);
if(tofs != -1L)
{
get_line();
pl=line+strspn(line," \t");
pl+=strcspn(pl," \t\n");
}else
{
/* optional parameter gets default value */
error_root(strlen(defaultline)+strlen(tag)+1>NAME_SIZE,1,
"read_line_opt [mutils.c]",
"default line too long");
sprintf(line,"%s %s",tag,defaultline);
pl=line+strspn(line," \t");
pl+=strcspn(pl," \t\n");
}
va_start(args,format);
for (p=format;;)
{
p+=strspn(p," ");
ic=0;
is=2;
if ((p[0]=='\0')||(p[0]=='\n'))
break;
else if (p==strstr(p,"%s"))
ic=sscanf(pl,"%s",va_arg(args,char*));
else if (p==strstr(p,"%d"))
ic=sscanf(pl,"%d",va_arg(args,int*));
else if (p==strstr(p,"%f"))
/* this is an exact copy of /modules/utils/mutils.c's version */
static void check_tag(char *tag)
{
if (tag[0]=='\0')
return;
error_root((strspn(tag," 0123456789.")!=0L)||
(strcspn(tag," \n")!=strlen(tag)),1,
"check_tag [mutils.c]","Improper tag %s",tag);
}
/* this is an exact copy of /modules/utils/mutils.c's version */
static char *get_line(void)
{
char *s,*c;
s=fgets(line,NAME_SIZE+1,stdin);
if (s!=NULL)
{
error_root(strlen(line)==NAME_SIZE,1,"get_line [mutils.c]",
"Input line is longer than NAME_SIZE-1");
c=strchr(line,'#');
if (c!=NULL)
c[0]='\0';
}
return s;
}
void meson_ASCII_IO(char *filename, int rec_seek, int msg_seek)
{
int i,j,k=0,l=0;
char buf[MAXBUF];
LimeReader *r;
int status;
twopt_mom *corr;
n_uint64_t nbytes, bytes_left, bytes_to_copy, read_bytes;
int rec, msg;
char *lime_type;
size_t bytes_pad;
int MB_flag, ME_flag;
FILE *fin=NULL;
corr=malloc(NMOM_MAX*sizeof(twopt_mom));
fin=fopen(filename,"r");
error_root(fin == (FILE *)NULL,0,"meson_ASCII_IO [IOarchive.c]",
"IOarchive: Unable to open file %s for reading\n", filename);
/* Open LIME reader */
r = limeCreateReader(fin);
error_root(r == (LimeReader *)NULL,0,"meson_ASCII_IO [IOarchive.c]",
"Unable to open LimeReader\n");
/* Loop over records */
rec = 0;
msg = 0;
while( (status = limeReaderNextRecord(r)) != LIME_EOF ){
error_root(status != LIME_SUCCESS,0,"meson_ASCII_IO [IOarchive.c]",
"IOarchive: limeReaderNextRecord returned status = %d\n",status);
nbytes = limeReaderBytes(r);
lime_type = limeReaderType(r);
bytes_pad = limeReaderPadBytes(r);
MB_flag = limeReaderMBFlag(r);
ME_flag = limeReaderMEFlag(r);
/* Update message and record numbers */
if(MB_flag == 1){
msg++;
rec = 0;
}
rec++;
/* Skip to next record until target record is reached */
if (msg != msg_seek || rec != rec_seek) continue;
/* Buffered copy */
bytes_left = nbytes;
while(bytes_left > (n_uint64_t)0){
bytes_to_copy = mino((n_uint64_t)(NMOM_MAX*sizeof(twopt_mom)),bytes_left);
read_bytes = bytes_to_copy;
error_root((int)read_bytes>MAXBUF,0,"meson_ASCII_IO [IOarchive.c]",
"read_bytes exceeds MAXBUF");
status = limeReaderReadData((void *)buf, &read_bytes, r);
error_root(status<0 && status !=LIME_EOR,1,"meson_ASCII_IO [IOarchive.c]",
"LIME read error occurred: status= %d", status);
error_root(read_bytes != bytes_to_copy,1,"meson_ASCII_IO [IOarchive.c]",
"Read error %lld bytes wanted,%lld read\n",
(unsigned long long)nbytes, (unsigned long long)read_bytes);
/* Print to stdout */
corr=(twopt_mom*)buf;
l=0;
for(i=0;i<NMOM_MAX;i++){
for(j=0;j<TT;j++)
{
printf("%d %s %d %d %d %d %d %d %.16e %.16e\n",
k,lime_type,
(*(corr+l)).musrc,
(*(corr+l)).musnk,
(*(corr+l)).p[0],
(*(corr+l)).p[1],
(*(corr+l)).p[2],
j,
(*(corr+l)).corr[j].re,
(*(corr+l)).corr[j].im);
}
l++;
k++;
}
bytes_left -= bytes_to_copy;
}
/* Quit at this record */
break;
}
limeDestroyReader(r);
fclose(fin);
}
extern void import_cnfg_ildg(char *in)
{
int my_rank,np[4],n,ie,tag,status,prec=0;
int i,l,ix,iy,iz,it,ixx;
n_uint64_t read_bytes,nbytes=0;
double plaq1,eps;
MPI_Status stat;
LimeReader *reader=NULL;
FILE *fin;
char lime_type_target[100]="ildg-binary-data";
char *lime_type;
MPI_Comm_rank(MPI_COMM_WORLD,&my_rank);
/* allocate IO-buffers */
if (ubuf==NULL)
alloc_ubuf_ildg(my_rank);
error(pud[VOLUME/2][0]==NULL,1,"import_cnfg [archive_ildg.c]",
"Double-precision gauge field is not allocated");
ie=check_machine();
if (my_rank==0)
{
fin=fopen(in,"rb");
error_root(fin==NULL,1,"import_cnfg [archive_ildg.c]",
"Unable to open input file");
reader=limeCreateReader(fin);
error( reader == (LimeReader *)NULL ,1,"import_cnfg [archive_ildg.c]",
"Unable to open LimeReader");
nbytes = (n_uint64_t)0;
/* set the file-pointer to the beginning of the "ildg-binary-data" tag
* in the LIME file */
while( (status = limeReaderNextRecord(reader)) != LIME_EOF ){
nbytes = limeReaderBytes(reader);
lime_type = limeReaderType(reader);
error((status!=LIME_SUCCESS),1,"import_cnfg [archive_ildg.c]",
"limeReaderNextRecord returned status %d and LIME_SUCCESS %d\n",
status,LIME_SUCCESS);
if (strcmp(lime_type,lime_type_target) != 0) continue;
break;
}
/* Decide whether the gauge file is stored in single or
* double precision format */
if ((int)nbytes==8*VOLUME*NPROC*3*3*4*2){
prec=8;
message("ILDG-file contains double precision gauge field\n");
}
else if ((int)nbytes==4*VOLUME*NPROC*3*3*4*2){
prec=4;
message("ILDG-file contains single precision gauge field\n");
}
else
error(1!=0,1,"import_cnfg [archive_ildg]",
"Lattice geometry doesn't match size of gauge field %d %d\n");
}
/* Now read the gauge file in steps of 4 SU(3) matrices */
for (it=0;it<N0;it++){
for (iz=0;iz<N3;iz++){
for (iy=0;iy<N2;iy++){
for (ix=0;ix<N1;ix++){
if(my_rank==0){
if(prec==8){
read_bytes = (n_uint64_t)(4*18*sizeof(double));
status = limeReaderReadData((double *)vbuf,&read_bytes, reader);
bswap_double(4*18,(double *)(vbuf));/* ILDG always big endian */
}
else if(prec==4){
read_bytes = (n_uint64_t)(4*18*sizeof(float));
status = limeReaderReadData((void *)vbuf_s,&read_bytes, reader);
bswap_float(4*18,(float *)(vbuf_s)); /* ILDG always big endian */
for (i=0;i<4;i++)
su3_copy_singletodouble((vbuf_s+i),(vbuf+i));
}
}
np[0]=it;
np[1]=ix;
np[2]=iy;
np[3]=iz;
n=ipr_global(np);
MPI_Barrier(MPI_COMM_WORLD);
if (n>0)
{
tag=mpi_tag();
if (my_rank==0)
MPI_Send((double*)(vbuf),4*18,MPI_DOUBLE,n,tag,
MPI_COMM_WORLD);
if (my_rank==n)
MPI_Recv((double*)(ubuf),4*18,MPI_DOUBLE,0,tag,
MPI_COMM_WORLD,&stat);
}
else if (my_rank==0)
for (l=0;l<(4);l++)
ubuf[l]=vbuf[l];
ixx = ((iy%L2)*L3 + (ix%L1)*L3*L2 + (it%L0)*L1*L2*L3);
if (my_rank==n)
set_links_ildg(ixx,iz);
}
}
}
}
plaq1=plaq_sum_dble()/(double)(6*NPROC*VOLUME);
message("Plaquette %f\n",plaq1);
message("Plaquette/3 %f\n",plaq1/3);
message("Please check consistency of average plaquette by hand\n");
eps=sqrt((double)(6*NPROC*VOLUME))*DBL_EPSILON;
}
int main(int argc,char *argv[])
{
int irw,isp,ispp[2],status[6],mnkv;
int bs[4],Ns,nmx,nkv,nmr,ncy,ninv;
double kappa,m0,dm,mu0,mu,res,mres;
double sqne,sqnp[2];
complex_dble lnw1[2],lnr,dr,drmx;
solver_parms_t sp;
mrw_masses_t ms;
MPI_Init(&argc,&argv);
MPI_Comm_rank(MPI_COMM_WORLD,&my_rank);
if (my_rank==0)
{
flog=freopen("check2.log","w",stdout);
fin=freopen("check2.in","r",stdin);
printf("\n");
printf("Direct check of mrw2\n");
printf("----------------------\n\n");
printf("%dx%dx%dx%d lattice, ",NPROC0*L0,NPROC1*L1,NPROC2*L2,NPROC3*L3);
printf("%dx%dx%dx%d process grid, ",NPROC0,NPROC1,NPROC2,NPROC3);
printf("%dx%dx%dx%d local lattice\n\n",L0,L1,L2,L3);
}
mnkv=0;
mres=0.0;
for (isp=0;isp<3;isp++)
{
read_solver_parms(isp);
sp=solver_parms(isp);
if (sp.res>mres)
mres=sp.res;
if (sp.nkv>mnkv)
mnkv=sp.nkv;
}
read_bc_parms();
if (my_rank==0)
{
find_section("SAP");
read_line("bs","%d %d %d %d",bs,bs+1,bs+2,bs+3);
}
MPI_Bcast(bs,4,MPI_INT,0,MPI_COMM_WORLD);
set_sap_parms(bs,0,1,1);
if (my_rank==0)
{
find_section("Deflation subspace");
read_line("bs","%d %d %d %d",bs,bs+1,bs+2,bs+3);
read_line("Ns","%d",&Ns);
}
MPI_Bcast(bs,4,MPI_INT,0,MPI_COMM_WORLD);
MPI_Bcast(&Ns,1,MPI_INT,0,MPI_COMM_WORLD);
set_dfl_parms(bs,Ns);
if (my_rank==0)
{
find_section("Deflation subspace generation");
read_line("kappa","%lf",&kappa);
read_line("mu","%lf",&mu);
read_line("ninv","%d",&ninv);
read_line("nmr","%d",&nmr);
read_line("ncy","%d",&ncy);
}
MPI_Bcast(&kappa,1,MPI_DOUBLE,0,MPI_COMM_WORLD);
MPI_Bcast(&mu,1,MPI_DOUBLE,0,MPI_COMM_WORLD);
MPI_Bcast(&ninv,1,MPI_INT,0,MPI_COMM_WORLD);
MPI_Bcast(&nmr,1,MPI_INT,0,MPI_COMM_WORLD);
MPI_Bcast(&ncy,1,MPI_INT,0,MPI_COMM_WORLD);
set_dfl_gen_parms(kappa,mu,ninv,nmr,ncy);
if (my_rank==0)
{
find_section("Deflation projection");
read_line("nkv","%d",&nkv);
read_line("nmx","%d",&nmx);
read_line("res","%lf",&res);
fclose(fin);
}
MPI_Bcast(&nkv,1,MPI_INT,0,MPI_COMM_WORLD);
MPI_Bcast(&nmx,1,MPI_INT,0,MPI_COMM_WORLD);
MPI_Bcast(&res,1,MPI_DOUBLE,0,MPI_COMM_WORLD);
set_dfl_pro_parms(nkv,nmx,res);
set_lat_parms(6.0,1.0,0,NULL,1.234);
print_solver_parms(status,status+1);
print_sap_parms(0);
print_dfl_parms(0);
start_ranlux(0,1245);
geometry();
mnkv=2*mnkv+2;
if (mnkv<(Ns+2))
mnkv=Ns+2;
if (mnkv<5)
mnkv=5;
alloc_ws(mnkv);
alloc_wsd(7);
alloc_wv(2*nkv+2);
alloc_wvd(4);
drmx.re=0.0;
drmx.im=0.0;
for (irw=0;irw<3;irw++)
{
dm=1.0e-2;
for (isp=0;isp<3;isp++)
{
ispp[0]=isp;
ispp[1]=isp;
if (isp==0)
{
m0=1.0877;
mu0=0.1;
}
else if (isp==1)
{
m0=0.0877;
mu0=0.01;
}
else
{
m0=-0.0123;
mu0=0.001;
}
random_ud();
if (isp==2)
{
dfl_modes(status);
error_root(status[0]<0,1,"main [check2.c]",
"dfl_modes failed");
}
if (irw==0)
{
ms.m1=m0;
ms.d1=dm;
ms.mu1=mu0;
ms.m2=m0;
ms.d2=dm;
ms.mu2=mu0;
lnr=mrw2(ms,0,ispp,lnw1,sqnp,&sqne,status);
dr.re=fabs(lnw1[0].re-lnw1[1].re);
dr.im=fabs(lnw1[0].im-lnw1[1].im);
lnr=mrw2(ms,1,ispp,lnw1,sqnp,&sqne,status);
dr.re+=fabs(lnr.re-(2.0*mu0*dm+dm*dm)*sqnp[0]);
dr.re+=fabs(lnw1[0].re-lnw1[1].re);
dr.re+=fabs(sqnp[0]-sqnp[1]);
dr.im+=fabs(lnr.im);
dr.im+=fabs(lnw1[0].im-lnw1[1].im);
}
else if (irw==1)
{
ms.m1=m0;
ms.d1=dm;
ms.mu1=mu0;
ms.m2=m0;
ms.d2=-dm;
ms.mu2=mu0;
lnr=mrw2(ms,0,ispp,lnw1,sqnp,&sqne,status);
dr.re=fabs(lnw1[0].re+lnw1[1].re);
dr.im=fabs(lnw1[0].im+lnw1[1].im);
lnr=mrw2(ms,1,ispp,lnw1,sqnp,&sqne,status);
dr.re+=fabs(lnr.re+dm*dm*sqnp[0]);
dr.re+=fabs(lnw1[0].re+lnw1[1].re);
dr.re+=fabs(sqnp[0]-sqnp[1]);
dr.im+=fabs(lnr.im-2.0*lnw1[0].im);
dr.im+=fabs(lnw1[0].im+lnw1[1].im);
}
else
{
ms.m1=m0;
ms.d1=dm;
ms.mu1=mu0;
ms.m2=m0+dm;
ms.d2=-dm;
ms.mu2=mu0;
lnr=mrw2(ms,0,ispp,lnw1,sqnp,&sqne,status);
dr.re=fabs(lnr.re);
dr.im=fabs(lnr.im);
}
if (dr.re>drmx.re)
drmx.re=dr.re;
if (dr.im>drmx.im)
drmx.im=dr.im;
if (my_rank==0)
{
if (irw==0)
printf("mrw2(d2=d1): ");
else if (irw==1)
printf("mrw2(d2=-d1): ");
else
printf("mrw2(m2=m1+d1,d2=-d1): ");
if ((isp==0)||(isp==1))
printf("status = %d\n",status[0]);
else if (isp==2)
printf("status = (%d,%d,%d)\n",
status[0],status[1],status[2]);
printf("diff = %.1e + i%.1e\n\n",dr.re,dr.im);
}
error_chk();
}
}
if (my_rank==0)
{
printf("\n");
printf("max diff = %.1e + i%.1e\n",drmx.re,drmx.im);
printf("(should be smaller than %.1e)\n\n",mres*sqrt((double)(VOLUME*NPROC*24)));
fclose(flog);
}
MPI_Finalize();
exit(0);
}
extern void srcfld(spinor_dble *rnd, spinor_dble *sd, srcdef src, int idirac,
int icolor) {
int my_rank;
int i;
set_sd2zero(VOLUME, sd);
/***************************************************************************/
if (strcmp(src.type, "pt") == 0) {
/***************************************************************************/
pointsource(sd, src, idirac, icolor);
}
/***************************************************************************/
else if (strcmp(src.type, "Z4") == 0) {
/***************************************************************************/
int ix = 0;
double *in, *out;
spinor_dble *rpk;
MPI_Comm_rank(MPI_COMM_WORLD, &my_rank);
if (my_rank == 0)
message("Creating Z4 source on time-slice %d\n", src.pos[0]);
if (icolor == 1) {
for (rpk = sd; rpk < (sd + VOLUME); rpk++) {
if (coords[ix].t == src.pos[0]) {
in = (double *) (rnd + ix);
out = (double *) rpk;
for (i = 0; i < 24; i++) {
*(out + i) = *(in + i);
}
}
ix++;
}
}
} else if (strcmp(src.type, "Z2") == 0) {
/***************************************************************************/
int ix = 0;
double *in, *out;
spinor_dble *rpk;
MPI_Comm_rank(MPI_COMM_WORLD, &my_rank);
if (my_rank == 0)
message("Creating Z2 source on time-slice %d\n", src.pos[0]);
if (icolor == 1) {
for (rpk = sd; rpk < (sd + VOLUME); rpk++) {
if (coords[ix].t == src.pos[0]) {
in = (double *) (rnd + ix);
out = (double *) rpk;
for (i = 0; i < 24; i = i + 2) {
*(out + i) = *(in + i);
}
}
ix++;
}
}
}
/***************************************************************************/
else if (strcmp(src.type, "Z4spin") == 0) {
/***************************************************************************/
int ix = 0;
double *in, *out;
spinor_dble *rpk;
MPI_Comm_rank(MPI_COMM_WORLD, &my_rank);
if (my_rank == 0)
message("Creating Z4spin source on time-slice %d\n", src.pos[0]);
if (icolor == 1) {
for (rpk = sd; rpk < (sd + VOLUME); rpk++) {
if (coords[ix].t == src.pos[0]) {
in = (double *) (rnd + ix);
out = (double *) rpk;
for (i = 0; i < 6; i++) {
*(out + (idirac - 1) * 6 + i) = *(in + i);
}
}
ix++;
}
}
}
/***************************************************************************/
/***************************************************************************/
else if ((strcmp(src.type, "J_thin") == 0) || (strcmp(src.type, "J_HYP")
== 0) || (strcmp(src.type, "J_APE") == 0)) {
/***************************************************************************/
pointsource(sd, src, idirac, icolor);
/* transform_sd(sd,sd);
*/jacobi_source(sd, src, idirac, icolor);
}
/**************************************************************************/
else {
error_root(1, 1, "srcfld [source.c]",
"Couldn't find specified source type %s\n", src.type);
}
}
