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; }
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); }
char* parseVertex(int v, int forReduce) { int j; int sgn=1; char *pstr, *pstr2; for (j = 0; j < MAX(1,vcs.valence[v]); j++) { momsubst[j]=vcs.vertlist[v][vertexes[v].subst[j]-1].moment; indsubst[j]=vcs.vertlist[v][vertexes[v].subst[j]-1].lorentz; } r_reading0=vertexes[v].r_vert; forR_code=forReduce; pstr = (char *) readExpression(vertexes[v].lgrnptr->description, rd_rcode, act_rcode, free); if(rderrcode) { if(forReduce) outFileClose(); finish(); sortie(60); } if (vcs.valence[v] == 3 && prtclbase1[vcs.vertlist[v][0].partcl].cdim == 8 && prtclbase1[vcs.vertlist[v][1].partcl].cdim == 8 && prtclbase1[vcs.vertlist[v][2].partcl].cdim == 8) { if (vertexes[v].subst[0] > vertexes[v].subst[1]) sgn = -sgn; if (vertexes[v].subst[1] > vertexes[v].subst[2]) sgn = -sgn; if (vertexes[v].subst[0] > vertexes[v].subst[2]) sgn = -sgn; } if(sgn==1) { pstr2=m_alloc(strlen(pstr)); strcpy(pstr2,pstr+2); } else { pstr2=m_alloc(strlen(pstr)+8); sprintf(pstr2,"(-1)*(%s)",pstr+2); } free(pstr); return pstr2; }
static void endMath(int * prtclNum) { writeF("\nfinishSum;\n"); outFileClose(); }
void mk_reduceprograms(void) { int ndel, ncalc, nrest, i; long nrecord, naxu; csdiagram csd; unsigned ncalctot; shortstr txt; hlpcsptr gstlist, c; vcsect vcs_copy; s_listptr d_facts, df; rmptr t_fact; goto_xy(1,21); scrcolor(Yellow,Blue); print(" REDUCE code generation \n"); scrcolor(Red,BGmain); print(" Generated........\n"); print(" current diagram :\n"); scrcolor(Yellow,Blue); print(" Press Esc to halt REDUCE codes generation "); scrcolor(FGmain,BGmain); diagrq=fopen(DIAGRQ_NAME,"rb"); ncalctot = 0; menuq=fopen(MENUQ_NAME,"rb"); for(nsub=1;nsub<=subproc_sq;nsub++) { rd_menu(2,nsub,txt,&ndel,&ncalc,&nrest,&nrecord); fseek(diagrq,nrecord*sizeof(csdiagram),SEEK_SET); naxu = ndel + ncalc + nrest; for (ndiagr = 1; ndiagr <= naxu; ndiagr++) { goto_xy(20,22); print("%u",ncalctot); goto_xy(20,23); print("%u",ndiagr); clr_eol(); FREAD1(csd,diagrq); if (csd.status != -1) { outFileOpen("%sresults%cp%d_%d.red",pathtouser,f_slash,nsub,ndiagr); writeLabel('%'); writeF("%%\n"); transfdiagr(&csd,&vcs); cwtarg(&vcs); if (vcs.clrnum == 0) { writeF( "%%------- Zero color factor --------\n"); writeF("totFactor_:=0$\n"); writeF("numerator_:=0$\n"); writeF("denominator_:=1$\n"); } else { generateghosts(&vcs,&gstlist); if (gstlist == NULL) { writeF( "%%------- non-existent diagram --------\n"); writeF("totFactor_:=0$\n"); writeF("numerator_:=0$\n"); writeF("denominator_:=1$\n"); } else { goto_xy(40,23); print("(%% %4d subdiagrams)",gstlist->maxnum); writeF("%% The total number of diagrams %d\n",gstlist->maxnum); preperdiagram(); head(); emitfactors(); diagramsrfactors(gstlist,&d_facts,&t_fact); writeF("totFactor_:=%s$\n",rmonomtxt(*t_fact)); writeF("totFactor_:=" "totFactor_*SymmFact*AverFact*FermFact*ColorFact$\n"); clrvm(t_fact->n.v); clrvm(t_fact->d.v); free(t_fact); writesubst(); writeF("numerator_:=0$\n"); c = gstlist; df = d_facts; vcs_copy = vcs; while (c != NULL) { coloringvcs(c); writeF("%% diagram number = %d\n", c->num); DiagramToOutFile(&vcs,1,'%'); {int k; int sgn=c->sgn; for(k=0;k<vcs.sizet;k++) sgn*=vertexes[k].lgrnptr->factor; writeF(" GhostFact:=%d$\n",sgn); } findReversVert(); attachvertexes(); emitreducecode(); writeF(" numerator_:=numerator_ +(%s)*GhostFact*Vrt_1 $\n", smonomtxt(df->monom)); writeF(" Clear Vrt_1,GhostFact$\n"); writeF("%%\n"); vcs = vcs_copy; c = c->next; df = df->next; } eraseslist(d_facts); eraseghosts(gstlist); vcs = vcs_copy; emitdenoms(); writeF(" Clear p%d",nin + nout + 1); for (i = nin + nout + 2; i <= 12; i++) writeF(",p%d",i); writeF("$\n"); writeF("%%\n"); } } writeF("End$\n"); outFileClose(); --(nrest); ++(ncalctot); if (escpressed()) goto exi; } } } exi: fclose(diagrq); fclose(menuq); clrbox(1,21,70,24); }
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); }
static void endReduce(int * prtclNum) { writeF("finishSum();\n"); writeF("End$\n"); outFileClose(); }