int c_prog(void)
{
int result;
catalog=fopen(CATALOG_NAME "2","rb");
if(catalog)
{
int nin_=nin,nout_=nout, subproc_sq_=subproc_sq;
/* archiv=fopen(ARCHIV_NAME "2","rb"); */
diagrq=fopen(DIAGRQ_NAME "2","rb");
menuq=fopen(MENUQ_NAME "2","rb");
nin=1; nout=2;
{ char txt[100]; int ndel, ncalc, nrest;
long recpos;
for(subproc_sq=0;rd_menu(2,subproc_sq+1,txt,&ndel,&ncalc,&nrest,&recpos); subproc_sq++);
}
outFileOpen("%sresults%cwidth_2.c",pathtouser,f_slash);
labl();
writeF("#include<math.h>\n");
writeF("#include<stdio.h>\n");
writeF("#include\"extern_2.h\"\n");
writeF("#include\"num_out.h\"\n");
writeF("#include\"num_in.h\"\n");
result=c_prog_int(1);
outFileClose();
system("cd results; sed s/_ext/_2/g width_2.c > width2.c; "
"cat width2.c $CALCHEP/include/width_2+ > width_2.c; rm width2.c; "
"mv extern.h extern_2.h");
fclose(catalog);
whichArchive(0,0,0);
fclose(diagrq);
fclose(menuq);
nin=nin_; nout=nout_;
subproc_sq=subproc_sq_;
} else if(nin+nout>3)
{ outFileOpen("%sresults%cwidth_2.c",pathtouser,f_slash);
writeF("extern double width2_ext(char * pname);\n");
writeF("double width2_ext(char * pname){return 0.;}\n");
outFileClose();
}
catalog=fopen(CATALOG_NAME,"rb");
diagrq=fopen(DIAGRQ_NAME,"rb");
menuq=fopen(MENUQ_NAME,"rb");
result=c_prog_int(0);
fclose(catalog);
whichArchive(0,0,0);
fclose(diagrq);
fclose(menuq);
return result;
}
static int c_prog_int(void)
{
int breaker;
int i;
long dfirst;
if(nin+nout<=4) sumDiag=1; else sumDiag=0;
memerror=zeroHeep;
mark_(&heapbeg);
initvararray(0,'c',3);
/* ======= Initialisation parth ======= */
firstVar=nmodelvar;
if(!strcmp( modelvars[firstVar].varname,strongconst)) firstVar--;
prepareprocinform();
calc_nvars_nfunc();
/* ======= End of Initialisation ====== */
{ outFileOpen("%sresults%cservice.c",pathtouser,f_slash);
labl();
writeF("#include<math.h>\n");
writeF("#include<complex.h>\n");
writeF("#include\"num_out.h\"\n");
writeF("#include\"num_in.h\"\n");
writeF("double BWrange_ext=2.7;\n");
writeF("int twidth_ext=0;\n");
writeF("int gtwidth_ext=0;\n");
writeF("int gswidth_ext=0;\n");
writeF(" REAL va_ext[%d]={0};\n",nvars+nfunc+1);
}
geninf("nin_ext",nin);
geninf("nout_ext",nout);
geninf("nprc_ext",subproc_sq);
make_pinf();
geninf("nvar_ext",nvars);
geninf("nfunc_ext",nfunc);
make_vinf();
{
make_den_info();
fprintf(outFile,"\nCalcHEP_interface interface_ext={ %d,\n\"%s\"\n,%d, %d, varName_ext,va_ext,"
"%d, %d, %d, &pinf_ext, &pinfAux_ext, polarized_ext, &calcFunc_ext, &BWrange_ext,&twidth_ext,"
">width_ext,&gswidth_ext, &aWidth_ext, &sqme_ext,&den_info_ext,&build_cb_ext, &cb_pow_ext,"
"&cb_nc_ext, &cb_chains_ext, &cb_coeff_ext, &destroy_cb_ext};\n",
forceUG, pathtocalchep,nvars, nfunc, nin,nout,subproc_sq);
writeF("\nCalcHEP_interface * PtrInterface_ext=&interface_ext;\n");
outFileClose();
outFileOpen("%sresults%csqme.c",pathtouser,f_slash);
labl();
writeF("#include<stdio.h>\n");
writeF("#include<math.h>\n");
writeF("#include<complex.h>\n");
writeF("#include\"num_out.h\"\n");
writeF("#include\"num_in.h\"\n");
}
writeF("static int calcall[%d];\n",subproc_sq+1);
{
writeF("static int particles[%d]={0",1+nin+nout);
for(i=0;i<nin+nout;i++) writeF(",0");
writeF("};\n");
}
writeF("extern DNN ");
for(i=1;i<subproc_sq;i++) writeF("S%d_ext,",i);
writeF("S%d_ext;\n",subproc_sq);
writeF("static DNN * darr[%d]={",subproc_sq);
for(i=1;i<subproc_sq;i++) writeF("&S%d_ext,",i);
writeF("&S%d_ext};\n",subproc_sq);
fseek(catalog,0,SEEK_END);
ndiagrtot = ftell(catalog)/sizeof(catrec);
writesubroutineinit();
{ make_infbasis();
writeF("#include\"sqme.inc\"\n");
outFileClose();
}
diagrcount = 0;
inftmp = inf;
init_stat();
for (nsub = 1,dfirst=1; nsub <= subproc_sq; nsub++)
{ int colors[MAXINOUT];
if (inftmp->tot != 0) /* this subprocess IN archive */
{
for(i=0;i<nin+nout;i++)
{ int l;
locateinbase(inftmp->p_name[i], &l);
colors[i]=prtclbase[l-1].cdim;
}
for(i=0;i<nin; i++)
if(colors[i]==3) colors[i]=-3; else if(colors[i]==-3) colors[i]=3;
if(noCChain) for(i=0;i<nin+nout; i++) colors[i]=1;
infCbases(nin+nout,colors,&nC,&cBasisPower,&cChains);
if(cBasisPower)
{
cCoefN=malloc(cBasisPower*sizeof(long));
cCoefD=malloc(cBasisPower*sizeof(long));
}
writesubprocess(nsub,dfirst,inftmp->tot, &breaker);
dfirst+=inftmp->tot;
if (breaker) goto exi;
if(cBasisPower)
{
if(cChains){free(cChains); cChains=NULL;}
free(cCoefN); free(cCoefD);
}
} else writesubprocess(nsub,dfirst,0, NULL);
inftmp = inftmp->next;
}
exi:
clearstatistic();
release_(&heapbeg);
return !breaker;
}
static void writesubprocess(int nsub,long firstDiag,long totDiag,int* breaker)
{ denlist den_;
int i;
deninforec dendescript;
FILE * fd; /* file of (deninforec) */
char fd_name[STRSIZ];
marktp mem_start;
nsub1 = nsub;
{ outFileOpen("%sresults%cd%d.c",pathtouser,f_slash,nsub);
labl();
writeF("#include\"num_in.h\"\n");
writeF("#include\"num_out.h\"\n");
}
if(totDiag==0)
{ writeF("extern DNN S%d_ext;\n",nsub);
writeF("REAL S%d_ext(double GG, REAL * momenta,int * err)\n{",nsub);
writeF(" return 0;\n}\n");
outFileClose();
return;
}
if(sumDiag) writeF("static void C%d(REAL *);\n",nsub); else
{ writeF("extern FNN F%d_ext",firstDiag);
for(i=1;i<totDiag;i++) writeF(",F%d_ext",i+firstDiag);
writeF(";\n");
writeF("static FNN *Farr[%d]={&F%d_ext",totDiag,firstDiag);
for(i=1;i<totDiag;i++) writeF(",&F%d_ext",i+firstDiag);
writeF("};\n");
}
writeF("extern DNN S%d_ext;\n",nsub);
writeF("REAL S%d_ext(double GG, REAL * momenta,int * err)\n{",nsub);
writeF("REAL ans=0;\n");
sprintf(fd_name,"%stmp%cden.inf",pathtouser,f_slash);
fd=fopen(fd_name,"wb");
mark_(&mem_start);
denominatorStatistic(nsub, &nden_s, &nden_t, &nden_0, &den_, fd);
fclose(fd);
nden_w=nden_s+nden_t;
writeF("REAL DP[%d];\n",((nin+nout)*(nin+nout-1))/2);
writeF("REAL* V=va_ext;\n");
if(nin+nout>3)
{ int nden= nden_w+nden_0+1;
writeF("REAL mass[%d],width[%d];\n",nden,nden);
writeF("char * Qtxt[%d];\n",nden);
writeF("REAL Q0[%d]; COMPLEX Q1[%d]; REAL Q2[%d];\n",nden_w+nden_0+1, nden_w+nden_0+1,nden_w+nden_0+1);
// writeF("sprod_(%d, momenta, DP);\n",nin+nout);
/* writeF(" for(i=0;i<nin_ext;i++) s0max+=momenta[4*i];\n"); */
for(;den_;den_ = den_->next)
{ int m=0;
i=den_->order_num;
if(den_->width)
{
if(den_->stype) fprintf(outFile,"width[%d]=%s; ",i,vararr[den_->width].alias);
else
{ i+=nden_s;
fprintf(outFile,"width[%d]=(twidth_ext)? %s : 0.; ",i,vararr[den_->width].alias);
}
}else
{ i+=nden_w;
fprintf(outFile,"width[%d]=0.; ",i);
}
fprintf(outFile,"mass[%d]=%s; ",i,vararr[den_->mass].alias);
fprintf(outFile," Qtxt[%d]=\"",i);
/* fprintf(outFile," Q[%d]=mass[%d]*mass[%d]-sqrMom(nin_ext,\"",i,i,i);*/
while(den_->momStr[m]) fprintf(outFile,"\\%o",den_->momStr[m++]);
fprintf(outFile,"\";\n");
/* fprintf(outFile,"\",momenta);\n"); */
}
writeF("*err=*err|prepDen(%d,nin_ext,BWrange_ext*BWrange_ext,mass,width,Qtxt,momenta,Q0,Q1,Q2);\n",
nden_w+nden_0);
}
writeF("sprod_(%d, momenta, DP);\n",nin+nout);
release_(&mem_start);
fd=fopen(fd_name,"rb");
if(sumDiag)
{
*breaker = alldiagrams(fd,nsub);
writestatistic();
outFileClose();
} else
{
writeF("{int i; for(i=0;i<%d;i++) \n",totDiag);
writeF(
"{ REAL r=Farr[i](GG,DP,Q0,Q1,Q2);\n"
" if(r>Fmax) Fmax=r;\n"
" ans+=r;\n"
"}}\n"
"return ans;\n}\n"
);
outFileClose();
*breaker = 0;
while(FREAD1(dendescript,fd) == 1)
{
if (escpressed())
{ *breaker = 1;
break;
}
onediagram(&dendescript);
writestatistic();
}
}
fclose(fd);
unlink(fd_name);
} /* WriteSubprocess */
static void onediagram(deninforec* dendescript)
{ catrec cr;
marktp bh;
varptr totnum, totdenum, rnum;
long pos_c;
int deg1,nConst;
mark_(&bh);
tmpNameMax=0;
initinfo();
initdegnames();
fseek(catalog,dendescript->cr_pos,SEEK_SET);
FREAD1(cr,catalog);
++(diagrcount);
whichArchive(cr.nFile,'r');
fseek(archiv,cr.factpos,SEEK_SET);
readvardef(archiv);
readpolynom(&totnum);
readpolynom(&totdenum);
clearvardef();
fseek(archiv,cr.rnumpos,SEEK_SET);
readvardef(archiv);
readpolynom(&rnum);
clearvardef();
{ outFileOpen("%sresults%cf%d.c",pathtouser,f_slash,diagrcount);
labl();
writeF("#include\"num_out.h\"\n");
writeF("#include\"num_in.h\"\n");
}
writeF("extern FNN F%d_ext;\n",diagrcount);
writeF("static void C%d(REAL * C)\n{\n",diagrcount);
writeF("REAL* V=va_ext;\n");
pos_c= ftell(outFile); writeF("%80s\n","");
nConst=write_const();
deg1=cleardegnames();
writeF("}\n");
fseek(outFile,pos_c,SEEK_SET);
if(deg1) writeF("REAL S[%d];",deg1);
if(tmpNameMax) writeF("REAL tmp[%d];",tmpNameMax );
fseek(outFile,0,SEEK_END);
tmpNameMax=0;
initdegnames();
writeF("REAL F%d_ext(double GG,REAL*DP,REAL*Q0,COMPLEX*Q1,REAL*Q2)\n{\n",diagrcount);
if(!noPict) writpict(cr.ndiagr_ + inftmp->firstdiagpos - 1);
writeF("REAL N,D,R; COMPLEX Prop;\n");
writeF("REAL * V=va_ext;\n");
pos_c= ftell(outFile); writeF("%80s\n","");
writeF("if(CalcConst) C%d(C);\n",diagrcount);
fortwriter("N",totnum);
fortwriter("D",totdenum);
fortwriter("R",rnum);
writeF("R*=(N/D);\n");
writeF("Prop=1");
writeDenominators(dendescript);
writeF("R*=creal(Prop);\n");
if(!noCChain)calcColor(cr.ndiagr_+inftmp->firstdiagpos);
writeF(" return R;\n");
writeF("}\n");
deg1=cleardegnames();
if(nConst==0) nConst=1;
fseek(outFile,pos_c,SEEK_SET);
writeF("static REAL C[%d];",nConst);
if(deg1) writeF("REAL S[%d];",deg1);
if(tmpNameMax) writeF("REAL tmp[%d];",tmpNameMax );
fseek(outFile,0,SEEK_END);
outFileClose();
release_(&bh);
}
int vert_code(polyvars * vardef_ext)
{
// outFile=stdout;
labl();
writeF("#include<stdlib.h>\n");
writeF("#include<math.h>\n");
writeF("#include<complex.h>\n");
initvararray(0,'c',vardef_ext);
firstVar=nmodelvar;
if(!strcmp( modelvars[firstVar].varname,strongconst)) firstVar--;
calc_nvars_nfunc();
// geninf(" nvar_ext",nvars);
// geninf(" nfunc_ext",nfunc);
// writeF(" static int nvars=%d;\n",nvars);
writeF("static char*varName[%d]={\"zero\"",nvars+nfunc+1);
sortvars();
writeF("};\n");
writeF(" static double V[%d];\n",nvars+nfunc+1);
writeF("static int vertexCoeff(double * coeff_out)\n{\n");
int l;
for(l=nCommonVars+1;l<=nmodelvar;l++)
{
char *ss;
if(vararr[l].used && ((modelvars[l].func && modelvars[l].pub==0) || modelvars[l].pwidth) )
{ int num;
checkNaN=0;
if(modelvars[l].pwidth)
{ writeF(" %s=aWidth_ext(\"%s\");\n",vararr[l].alias,
prtclbase1[modelvars[l].pwidth].name);
checkNaN=1;
} else
{
ss=(char *)readExpression(modelvars[l].func,rd_c,act_c,free);
/* writeF(" %s=%s;\n",vararr[l].alias,ss+3);*/
fprintf(outFile," %s=%s;\n",vararr[l].alias,ss+3);
free(ss);
}
if(checkNaN)
{
sscanf(vararr[l].alias,"V[%d]",&num);
writeF(" if(!isfinite(%s)){ return %d;}\n",vararr[l].alias,num);
}
}
}
for(l=0;l<vardef_ext->nvar;l++) if(!strchr( vardef_ext->vars[l].name,'.'))
strcpy(vardef_ext->vars[l].name,vararr[vardef_ext->vars[l].num].alias);
return nvars;
}
