static void make_vinf(void)
{
if(flag_12) writeF("static ");
writeF("char * varName_ext[%d]={\"P(cms)\"",nvars+nfunc+1);
scanvars(3);
writeF("};\n");
}
static void permRec(int ntot,int* np, int i0, int *pused, int *perm)
{
int i,j;
if(i0==ntot)
{
for(j=0;j<ntot;j++) if(perm[j]!=j)
{ int i;
writeF(",\n{");
for(i=0;i<ntot-1;i++)writeF("%d,",perm[i]+1);
writeF("%d}",perm[i]+1);
cPerm[ncPerm++]=makeCperm(ntot,np,perm);
break;
}
return;
}
for(j=0;j<ntot;j++) if(np[j]==np[i0] && !pused[j] )
{ perm[i0]=j;
pused[j]=1;
permRec(ntot,np,i0+1,pused,perm);
pused[j]=0;
}
}
static void scanvars(int mode)
{
int k;
for(k=1;k<=nmodelvar;k++)
{ varlist modl=modelvars+k;
if (vararr[k].used && !modl->func && !modl->pwidth)
{
switch(mode)
{
case 2: writeF("\n,%E",modl->varvalue); break;
case 3: writeF("\n,\"%s\"",modl->varname); break;
}
}
}
for(k=1;k<=nmodelvar;k++)
{ varlist modl=modelvars+k;
if (vararr[k].used && (modl->func || modl->pwidth ))
{
switch(mode)
{
case 2: if(modl->hidden) writeF("\n,1"); else writeF("\n,0"); break;
case 3: writeF("\n,\"%s\"",modl->varname); break;
}
}
}
}
static void sortvars(void)
{
int k;
for(k=4;k<=nmodelvar;k++) if(vararr[k].used && (k<=nCommonVars||modelvars[k].pub))
writeF("\n,\"%s\"",modelvars[k].varname);
for(k=1+nCommonVars;k<=nmodelvar;k++)if (vararr[k].used && !modelvars[k].pub)
writeF("\n,\"%s\"",modelvars[k].varname);
}
static void writpict(unsigned ndiagr)
{ vcsect vcs;
csdiagram csdiagr;
fseek(diagrq,ndiagr*sizeof(csdiagr),SEEK_SET);
FREAD1(csdiagr,diagrq);
transfdiagr(&csdiagr,&vcs);
writeF("/*\n");
DiagramToOutFile(&vcs,1,' ');
writeF("*/\n");
}
static void diagramReduce( vcsect * vcs, catrec * cr )
{
writeF("\n");
writeF("DiagrNumber:=\"%d_%d\"$\n",cr->nsub_,cr->ndiagr_);
writeF("\n");
if (vcs) DiagramToOutFile(vcs,0,'%');
emitexpression(cr);
writeF("\n\n");
writeF("addToSum()$\n");
}
static void diagramMath(vcsect * vcs,catrec * cr)
{
writeF("\n(*\n");
writeF(" Diagram %d in subprocess %d\n",cr->ndiagr_,cr->nsub_);
if (vcs != NULL) DiagramToOutFile(vcs,0,' ');
writeF("*)\n");
emitexpression(cr);
writeF("\naddToSum;\n");
}
static void writeparameters(int nsub)
{
int k;
char ch;
char s[STRSIZ];
writeF("%%\n");
writeF("parameters:={\n");
for(k=1,ch=' ';k<=nmodelvar;k++)if(vararr[k].used)
{ if(modelvars[k].func)
{
sscanf(modelvars[k].func,"%[^%|\n]",s);
if(!modifyF(s)) continue;
} else sprintf(s,"%E",vararr[k].tmpvalue);
writeF("%c%s=>%s\n",ch,vararr[k].alias,s); ch=',';
}
writeF("}$\n");
writeF("%%\n");
writeF("substitutions:={\n");
for(k=nmodelvar,ch = ' '; k ;k--) if(vararr[k].used && modelvars[k].func)
{
sscanf(modelvars[k].func,"%[^%|\n]",s);
if(modifyF(s)) continue;
writeF("%c%s=>%s\n",ch,vararr[k].alias,s);
ch=',';
}
writeF("}$\n");
}
static void emitindex(set *index)
{ int n,l;
l=set_first(index,1);
if(!l) return;
writeF(" Index ");
for(n=0;(n<4)&&l;n++)
{
if(n) writeF(",");
writeF("m%d",l);
set_del1(index,l);
l=set_first(index,1);
}
writeF("$\n");
}
static void writeDenominators(deninforec* dendescript)
{
int i,k;
int nden_t2=nden_t, nden_s2=nden_s;
for (i = 1; i <= dendescript->tot_den; i++)
{ int numm = dendescript->denarr[i-1].order_num;
if(dendescript->denarr[i-1].width==0) numm += nden_w; else
{ if(dendescript->denarr[i-1].stype) nden_s2--;
else { numm += nden_s; nden_t2--;}
}
if(dendescript->denarr[i-1].power == 1) writeF("*Q1[%d]",numm);
else writeF("*Q2[%d]",numm);
}
writeF(";\n");
if(nden_s2+nden_t2)
{
if(nden_s2)
{
writeF("if(gswidth_ext )");
writeF(" R=R");
for (k = 1; k <= nden_s; k++)
{ int addpr = 1;
for (i = 1; i <= dendescript->tot_den; i++)
if (dendescript->denarr[i-1].width && dendescript->denarr[i-1].stype&&
k == dendescript->denarr[i-1].order_num) addpr = 0;
if (addpr) writeF("*Q0[%d]",k);
}
writeF(";\n");
}
if(nden_t2)
{ writeF("if(gtwidth_ext) R=R");
for (k = nden_s+1; k <= nden_w; k++)
{ int addpr = 1;
for (i = 1; i <= dendescript->tot_den; i++)
if (dendescript->denarr[i-1].width && (!dendescript->denarr[i-1].stype) &&
k == dendescript->denarr[i-1].order_num+nden_s) addpr = 0;
if (addpr) writeF("*Q0[%d]",k);
}
writeF(";\n");
}
}
}
static void calcColor(long diag)
{
csdiagram csdiagr;
fseek(diagrq, (diag-1)*sizeof(csdiagr),SEEK_SET);
FREAD1(csdiagr,diagrq);
if(cBasisPower&&generateColorWeights(&csdiagr,cBasisPower,nC,cChains,cCoefN,cCoefD))
{ int k;
writeF(" if(cb_coeff_ext)\n {\n");
for(k=0; k<cBasisPower; k++)
if(cCoefN[k]) writeF(" cb_coeff_ext[%d] += (R*%d)/(%d);\n",k,
cCoefN[k],cCoefD[k]);
writeF(" }\n");
}
}
static void r_mult(int arg1,int arg2,set index1)
{ char name0[8],name1[8],name2[8];
set mind;
unsigned m,mm,maxmm;
int pstn[15];
int n,l;
set index;
index=index1;
sprintf(name1,"Vrt_%d",arg1);
sprintf(name2,"Vrt_%d",arg2);
if(arg1 < arg2) strcpy(name0,name1); else strcpy(name0,name2);
mind=set_and(index,setmassindex);
if(set_eq0(mind)) reducemult(name0,name1,name2,index); else
{
reducemult("Vrt_0",name1,name2,index);
l = 1; n = 0;
while (!set_eq0(mind))
{
if (set_in(l,mind)) pstn[n++] = l;
set_del1(&mind,l++);
}
maxmm = (1 << n) - 1 ;
for (mm = 1;mm <= maxmm ; mm++)
{
writeF(" Vrt_L:=%s$ Vrt_R:=%s$\n",name1,name2);
mind=set_constr(_E);
m = mm; n = 1;
while (m != 0)
{
if ((m & 1) != 0 && (l = pstn[n-1]) != 0)
{
writeF(" Vrt_L:=(Vrt_L where %s)$\n",subst(l,arg1));
writeF(" Vrt_R:=(Vrt_R where %s)$\n",subst(l,arg2));
set_add1(&mind,l);
}
++(n);
m >>= 1;
}
reducemult("Vrt_0","Vrt_0 + Vrt_L","Vrt_R",set_aun(index,mind));
writeF(" Clear Vrt_L $ Clear Vrt_R $\n");
}
writeF(" %s:=Vrt_0 $ Clear Vrt_0 $\n",name0);
}
if (arg1 < arg2)
{
writeF(" Clear %s$\n",name2);
for (n = 1; n <= vcs.sizet; n++)
if (vertmap[n-1] == arg2) vertmap[n-1] = arg1;
}
if (arg2 < arg1)
{
writeF(" Clear %s$\n",name1);
for (n = 1; n <= vcs.sizet; n++)
if (vertmap[n-1] == arg1) vertmap[n-1] = arg2;
}
} /* R_mult */
static void head(void)
{ int l;
writeF("%% ----------- VARIABLES ------------------ \n");
writeF(" vector A,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,ZERO_;\n");
writeF(" vector m1,m2,m3,m4,m5,m6,m7,m8,m9,m10,m11,m12,m13,m14,m15,m16;\n");
writeF("%%\n");
writeF("%%--------- Mass shell declarations -----------\n");
for (l = 1; l <= nin + nout; l++)
writeF(" MASS P%d = %s$ MSHELL P%d$\n",l,inoutmasses[l-1],l);
writeF("%%\n");
writeF("operator propDen$\n");
}
static void emitfactors(void)
{
int c, i, j, s, vln, pnum;
writeF("%%---------- Factors ---------------\n");
/* ------- Symmetry Factor ------- */
writeF(" SymmFact:=%d/%d$ %% Diagram symmerty factor\n",
vcs.symnum,vcs.symdenum);
/* ----- average factor --------- */
for (c=1,i=0; i < vcs.sizel; i++)
{
vln = vcs.valence[i];
for (j = 0; j < vln; j++)
if (IN_PRTCL & vcs.vertlist[i][j].prop)
{
pnum = vcs.vertlist[i][j].partcl;
s = prtclbase1[pnum].spin;
switch (s)
{
case 1: if(!strchr("LR",prtclbase1[pnum].hlp)) c*=2; break;
case 2: if(zeromass(pnum)) c*=2; else c*=3; break;
case 3: if(zeromass(pnum)) c*=2; else c*=4; break;
case 4: if(zeromass(pnum)) c*=2; else c*=5;
}
c *= abs(prtclbase1[pnum].cdim);
}
}
writeF(" AverFact:=1/%d$ %% Normalization factor of polarization average\n",c);
/* ----- Fermion factor --------- */
for (c=1,i= 0; i < vcs.sizel; i++)
for (j=0; j <vcs.valence[i]; j++)
{
pnum=vcs.vertlist[i][j].partcl;
if(prtclbase1[pnum].spin&1 && (IN_PRTCL & vcs.vertlist[i][j].prop))c*=-1;
}
writeF(" FermFact:=%d$ %% (-1)**(number of in-fermion particles)\n",c);
/* ----- Color factor --------- */
writeF(" ColorFact:=%d/%d$ %% QCD color weight of diagram \n%%\n",
vcs.clrnum,vcs.clrdenum);
}
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 void make_den_info(void)
{ int nden_s,nden_t,nden_0;
writeF("\n char * den_info_ext(int nsub,int n, int * mass, int * width)\n{\n");
writeF(" switch(nsub){\n");
for (nsub = 1; nsub <= subproc_sq; nsub++)
{ int n=1;
marktp mem_start;
denlist den_;
writeF(" case %d: switch(n){",nsub);
mark_(&mem_start);
denominatorStatistic(nsub, &nden_s, &nden_t, &nden_0, &den_, NULL);
for(n=1 ;den_;den_ = den_->next,n++)
{ int m=0;
writeF("\n case %d: *mass=%d; *width=%d; return \"",
n, vararr[den_->mass].num, vararr[den_->width].num);
while(den_->momStr[m]) fprintf(outFile,"\\%o",den_->momStr[m++]);
fprintf(outFile,"\";");
}
writeF("\n default:*mass=0; *width=0; return NULL;\n }\n");
release_(&mem_start);
}
writeF(" default: *mass=0; *width=0; return NULL;\n }\n}\n");
}
static void reducemult(char* nameres,char* name1,char* name2,set index)
{ int l, n;
set index1=index,index2=index;
emitindex(&index1);
writeF(" %s:=%s*%s$\n",nameres,name1,name2);
while (!set_eq0(index1))
{
emitindex(&index1);
writeF(" %s:=%s$\n",nameres,nameres);
}
if(!set_eq0(index2))
{
writeF(" RemInd ");
for(l=1,n=1;!set_eq0(index2);l++)
{
if(set_in(l,index2))
{
if (n != 1) writeF(",");
n++;
writeF("m%d",l);
}
set_del1(&index2,l);
}
writeF("$\n");
}
}
static char * writevardeg(int nv,int deg)
{
degreerec * p;
static char namest[21];
int k;
if (deg == 1) return vararr[nv].alias;
p = degnamesptr[nv];
while (p != NULL)
if (p->deg == deg) return p->name;
else p = p->next;
p = (degreerec *)m_alloc(sizeof(degreerec));
p->deg = deg;
sprintf(namest,"S[%d]",degnamecount++);
strcpy(p->name,namest);
p->next = degnamesptr[nv];
degnamesptr[nv] = p;
writeF("%s=%s",namest,vararr[nv].alias);
for(k=1;k<deg;k++) writeF("*%s",vararr[nv].alias);
writeF(";\n");
return namest;
}
static void emitreducecode(void)
{
int i, j, v1, v2;
set ind1, ind2;
for(i=0; i<vcs.sizet; i++) parsedverts[i]=parseVertex(i,1);
fermprgemit();
formblocks(&n_vrt);
makeprgcode();
for(i=0; i<vcs.sizet; i++) free(parsedverts[i]);
for (i = n_vrt - 1; i >= 1; i--)
{
v1 = prgcode[i-1][0];
v2 = prgcode[i-1][1];
ind1=vertinfo[v1-1].ind;
ind2=vertinfo[v2-1].ind;
r_mult(v1,v2,set_and(ind1,ind2));
vertinfo[MIN(v1,v2)-1].g5 = vertinfo[v1-1].g5 + vertinfo[v2-1].g5;
vertinfo[MIN(v1,v2)-1].ind=
set_aun(set_or(ind1,ind2),set_and(ind1,ind2));
}
for (i = 0; i < vcs.sizet; i++)
for (j = 0; j <vcs.valence[i]; j++)
{ int mom,np;
mom=vcs.vertlist[i][j].moment;
np =vcs.vertlist[i][j].partcl;
if (mom>0 && prtclbase1[np].hlp == 't')
{ writeF("Vrt_1:=Vrt_1*(%s**2",prtclbase1[np].massidnt);
if(prtclbase1[ghostmother(np)].hlp=='*') writeF(")$\n");
else writeF("-p%d.p%d)$\n",mom,mom);
}
}
writeF("%%\n");
}
void makeghostdiagr(int dnum,char * fname)
{csdiagram csd;
hlpcsptr gstlist, c;
vcsect vcs_copy;
FILE * diagrq;
diagrq=fopen(DIAGRQ_NAME,"rb");
fseek(diagrq,dnum*sizeof(csdiagram),SEEK_SET);
FREAD1(csd,diagrq);
{
outFileOpen(fname);
writeLabel('%');
transfdiagr(&csd,&vcs);
cwtarg(&vcs);
if (vcs.clrnum == 0) writeF("Color weight equal zero \n"); else
{
generateghosts(&vcs,&gstlist);
if (gstlist == NULL)
{
writeF(
"Diagrams of this type are absent\n");
csd.status = 2;
fseek(diagrq,dnum*sizeof(csdiagram),SEEK_SET);
FWRITE1(csd,diagrq);
}
else
{
emitfactors();
c = gstlist;
vcs_copy = vcs;
writeF(" total number diagrams of this type is %u\n",c->maxnum);
while (c != NULL)
{
coloringvcs(c);
{
writeF(" diagrams number = %u\n",c->num);
DiagramToOutFile(&vcs,0,' ');
}
writeF(" GhostFact:=%d$\n",c->sgn);
vcs = vcs_copy;
c = c->next;
}
}
eraseghosts(gstlist);
vcs = vcs_copy;
}
writeF("End$\n");
outFileClose();
if (escpressed()) goto exi;
}
exi:
fclose(diagrq);
}
static void emitdenoms(void)
{int j; /* 1..2 * maxvert */
int k; /* 1..4 */
int denrno;
/* EmitDenoms -- main */
for (j = 1; j <= vcs.sizet; j++)
for (k = 1; k <= vcs.valence[j-1]; k++)
{ edgeinvert *ln = &vcs.vertlist[j-1][k-1];
if(ln->moment>0)
{ char*mass= prtclbase1[ln->partcl].massidnt;
if(!(ln->prop&(IN_PRTCL|OUT_PRTCL)) && pseudop(ln->partcl))
writeF("totFactor_:=totFactor_/%s^2$\n",mass);
else
{ int spin=prtclbase1[ln->partcl].spin;
if(spin==3)writeF("totFactor_:=totFactor_/(3*%s^2)$\n",mass);
else if(spin==4)writeF("totFactor_:=totFactor_/(6*%s^4)$\n",mass);
}
}
}
writeF("denominator_:=");
denrno = 0;
for (j = 1; j <= vcs.sizet; j++)
for (k = 1; k <= vcs.valence[j-1]; k++)
{edgeinvert *ln = &vcs.vertlist[j-1][k-1];
if (ln->moment > 0 && !(ln->prop & (IN_PRTCL|OUT_PRTCL)) )
{
if (!pseudop(ln->partcl))
{ char width[10]="0";
if(denrno) writeF("*");
denrno++;
/* if(!ttypepropag(j,k))*/ strcpy(width,prtclbase1[ln->partcl].imassidnt);
writeF("propDen(p%d,%s,%s)",ln->moment,
prtclbase1[ln->partcl].massidnt,width);
}
}
}
if(!denrno) writeF("1");
writeF("$\n");
} /* EmitDenoms */
static void writeprocessname(int* prtclNum)
{ int i;
writeF(" process ");
for(i=1;i<=nin;i++)
{
writeF("%s(p%d)",prtclbase[prtclNum[i]-1].name,i);
if (i<nin) writeF("+"); else writeF("->");
}
for(i=nin+1;i<=nin+nout;i++)
{ writeF("%s(p%d)",prtclbase[prtclNum[i]-1].name,i);
if (i<nin+nout) writeF("+");else writeF("\n");
}
}
static void emitprocessname(int * prtclNum)
{
int i;
writeF("inParticles = {");
for(i=1;i<=nin;i++)
{
writeF("\"%s\"",prtclbase[prtclNum[i]-1].name);
if (i<nin) writeF(","); else writeF("}\n");
}
writeF("outParticles = {");
for(i=nin+1;i<=nin+nout;i++)
{ writeF("\"%s\"",prtclbase[prtclNum[i]-1].name);
if (i<nin+nout) writeF(",");else writeF("}\n");
}
}
static void writeprocessname(int * prtclNum)
{
int i;
writeF("inParticles:={");
for(i=1; i<=nin; i++)
if(i==nin) writeF("\"%s\"}$\n",prtclbase1[prtclNum[i]].name);
else writeF("\"%s\",",prtclbase1[prtclNum[i]].name);
writeF("outParticles:={");
for(i=nin+1; i<=nin+nout; i++)
if(i==nin+nout) writeF("\"%s\"}$\n",prtclbase1[prtclNum[i]].name);
else writeF("\"%s\",",prtclbase1[prtclNum[i]].name);
}
void symb_print(char* txt, symb_data m)
{ char s[5];
int n;
tensor p;
wrt_0(txt);
switch(m.type)
{ case numbertp:
case polytp : writepoly(m.expr.p); break;
case tenstp : writetens(m.expr.t); break;
case spintp : writespinor(m.expr.s);break;
case etenstp: writeEtens(m.expr.et);break;
default:
if(m.type == vectortp)
{
p=m.expr.t;
if(p == NULL) wrt_0("0");
else
for(;p;p=p->next)
{ n=-p->tens[0];
sprintf(s,"p%d*(",n);
wrt_0(s);
if(p->re) writepoly(p->re);
if(p->im)
{ wrt_0("i*("); writepoly(p->re);wrt_0(")");}
wrt_0(")");
if(p->next) wrt_0("+");
}
}
else
{
n = m.expr.t->tens[0];
if(!n) n = 1;
sprintf(s,"l%d",n);
wrt_0(s);
writetens(m.expr.t);
}
}
writeF(";\n");
}
static void startReduce(int nsub,int* prtclNum,int ncalc)
{
outputLanguage='R';
initvararray(nsub,outputLanguage,3);
outFileOpen("%sresults%csymb%d.red",pathtouser,f_slash,nsub);
writeLabel('%');
writeprocessname(prtclNum);
writeparameters(nsub);
writeF("\n\n");
writeF("vector p1,p2,p3,p4,p5,p6$\n");
emitconvlow(prtclNum);
writeF("\nvector !=p_,!=q_$\n");
writeF("operator propDen$\n");
writeF("for all p_,q_,m,w let propDen(0*p_+q_,m,w)=propDen(q_,m,w)$\n");
writeF("for all p_,m,w such that ordp(p_,-p_) "
"let propDen(p_,m,w)=propDen(-p_,m,w);$\n\n");
writeF("initSum();\n");
}
static void writesubst(void)
{ int i,j,l,c;
writeF("%%-------- Moment substitutions --------\n");
for (i = 0; i < 3 * maxvert; i++)
{ l = momdep[i][0]; /* For momdep this is a length V.E. */
if (l > 1)
{
writeF(" Let p%d = ",i+1);
for (j = 1; j <= l; j++)
{
c =momdep[i][j];
if (c > 0) writeF("+p%d",c); else writeF("-p%d",-c);
}
writeF("$\n");
}
}
writeF(" Let Sqrt2=sqrt(2)$\n");
writeF("%%\n");
}
static void writesubroutineinit(void)
{
int l;
char *ss;
ext_h=NULL;
writeF("double (*aWidth_ext)(char*)=NULL;\n");
writeF("static int calcFunc_stat(void)\n{\n");
writeF(" REAL * V=va_ext;\n");
writeF(" FError=0;\n");
for(l=nCommonVars+1;l<=nmodelvar;l++)
{
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);
/*
if(!modelvars[l].pwidth)
fprintf(outFile,"printf(\"%s= %%50.50s\\n\",\"%s\");\n",modelvars[l].varname, modelvars[l].func);
writeF("printf(\"%s=%%E\\n\",%s);\n",vararr[l].alias,vararr[l].alias);
*/
writeF(" if(!isfinite(%s) || FError){ return %d;}\n",vararr[l].alias,num);
}
}
}
writeF("return 0;\n}\n");
}
static void writesubroutineinit(void)
{
int l;
char *ss;
if(!flag_12) writeF("#include\"extern.h\"\n");
ext_h=fopen("results/extern.h","w");
fprintf(ext_h,"extern double width2_ext(char*,long );\n");
writeF("static int calcFunc_stat(void)\n{\n");
writeF(" double * V=va_ext;\n");
writeF(" FError=0;\n");
for(l=1;l<=nmodelvar;l++)
{
if (vararr[l].used && (modelvars[l].func||modelvars[l].pwidth))
{ int num;
checkNaN=0;
if(modelvars[l].pwidth)
{ writeF(" %s=width2_ext(\"%s\",%d);\n",vararr[l].alias,
prtclbase1[modelvars[l].pwidth].name, prtclbase1[modelvars[l].pwidth].N);
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(!finite(%s) || FError) return %d;\n",vararr[l].alias,num);
}
}
}
writeF("return 0;\n}\n");
fclose(ext_h);
}
static void calcColor(long diag)
{
csdiagram csdiagr;
fseek(diagrq, (diag-1)*sizeof(csdiagr),SEEK_SET);
FREAD1(csdiagr,diagrq);
if(cBasisPower&&generateColorWeights(&csdiagr,cBasisPower,nC,cChains,cCoefN,cCoefD))
{
int k;
writeF(" if(cb_coeff)\n {\n");
for(k=0; k<cBasisPower; k++) if(cCoefN[k])
{ int i;
writeF(" cb_coeff[%d] += (R*%d)/(%d); %s ",k, cCoefN[k],cCoefD[k],"/*");
for(i=0;i<nC;i++) if(cChains[4*(nC*k+i)]==2) writeF("(%d %d) ", cChains[4*(nC*k+i)+1], cChains[4*(nC*k+i)+2] );
else writeF("(%d %d %d) ", cChains[4*(nC*k+i)+1], cChains[4*(nC*k+i)+2],cChains[4*(nC*k+i)+3] );
writeF("*/\n");
}
writeF(" }\n");
}
}
