static Atom NewName(void) { Atom ret; do { sprintf(nnbuf,"~%c%c",ch1,ch2); ch2++; if(ch2-1=='9') ch2='A'; if(ch2-1=='Z') ch2='a'; if(ch2-1=='z') { ch2='0'; ch1++; if(ch1-1=='9') ch1='A'; if(ch1-1=='Z') ch1='a'; if(ch1-1=='z') { if(ch00=='~') puts("Internal error: too many im particles, output incorrect..."); ch1=ch2='0'; ch00--; } } ret=NewAtom(nnbuf,3); } while(is_particle(ret,NULL)); return ret; }
Term ProcMkProc(Term t, Term ind) { Atom prt[4]; Atom mass[4]; Term color[4]; int spin[4]; int i; int neufact=1; double thcut=0.0; int dec=0; char pname[128]; FILE *f; if(CompoundArity(t)==1) { List l,dlist; double m1; set_ppl(); l=GetAtomProperty(CompoundArg1(t),PROP_TYPE); if(!is_compound(l)||CompoundName(l)!=OPR_PARTICLE || CompoundArgN(l,5)==0) { ErrorInfo(0); WriteTerm(t); printf(" : decays are not generated.\n"); return 0; } m1=fabs(EvalParameter(CompoundArgN(l,5))); dlist=GetAtomProperty(CompoundArg1(t),PROP_PPL); for(l=dlist;l;l=ListTail(l)) { List pl=ListFirst(l); Atom prp,a; Atom ap1, ap2; double m2,m3; int is_neut; if(ListLength(pl)!=2) continue; prp=GetAtomProperty(ListFirst(pl),PROP_TYPE); if(!is_compound(prp)||CompoundName(prp)!=OPR_PARTICLE) continue; if(CompoundArgN(prp,7)==OPR_MLT) continue; a=CompoundArgN(prp,5); if(a==0) continue; else m2=fabs(EvalParameter(a)); prp=GetAtomProperty(ListFirst(ListTail(pl)),PROP_TYPE); if(!is_compound(prp)||CompoundName(prp)!=OPR_PARTICLE) continue; if(CompoundArgN(prp,7)==OPR_MLT) continue; a=CompoundArgN(prp,5); if(a==0) continue; else m3=fabs(EvalParameter(a)); if(m1<=m2+m3) continue; is_neut=(CompoundArg1(t)==GetAtomProperty(CompoundArg1(t),A_ANTI)); ap1=GetAtomProperty(ListFirst(pl),A_ANTI); ap2=GetAtomProperty(ListFirst(ListTail(pl)),A_ANTI); if(is_neut) { List l1; for(l1=dlist;l1!=l;l1=ListTail(l1)) { if( (ListFirst(ListFirst(l1))==ap1 && ListFirst(ListTail(ListFirst(l1)))==ap2) || (ListFirst(ListFirst(l1))==ap2 && ListFirst(ListTail(ListFirst(l1)))==ap1)) break; } if(l1!=l) continue; } /*WriteTerm(CompoundArg1(t));printf(" -> "); WriteTerm(pl);puts("");*/ prp=MakeCompound(A_I,4); SetCompoundArg(prp,1,CompoundArg1(t)); SetCompoundArg(prp,2,NewInteger(0)); SetCompoundArg(prp,3,is_neut?ListFirst(pl):ap1); SetCompoundArg(prp,4,is_neut?ListFirst(ListTail(pl)):ap2); ProcMkProc(prp,0); } return 0; } if(CompoundArity(t)<4) { ErrorInfo(2000); puts("mkProc: wrong argument number."); return 0; } for(i=5;i<=CompoundArity(t);i++) { Term t1=CompoundArgN(t,i); if(is_compound(t1) && is_atom(CompoundArg1(t1)) && strcmp(AtomValue(CompoundArg1(t1)),"THETACUT")==0) { if(is_integer(CompoundArg2(t1))) thcut=IntegerValue(CompoundArg2(t1)); else if(is_float(CompoundArg2(t1))) thcut=FloatValue(CompoundArg2(t1)); else { ErrorInfo(303);puts("wrong THETACUT value."); continue; } continue; } ErrorInfo(304); puts("wrong argument in mkProc."); } for(i=0;i<4;i++) { Term prp, t7; prt[i]=CompoundArgN(t,i+1); if(prt[i]==NewInteger(0)&&i==1) { dec=1;spin[i]=0;color[1]=0; continue; } if(!is_particle(prt[i],NULL)) { ErrorInfo(2001); WriteTerm(prt[i]); puts(": is not a particle."); return 0; } prp=GetAtomProperty(prt[i],PROP_TYPE); if(CompoundName(prp)!=OPR_PARTICLE) { ErrorInfo(2001); WriteTerm(prt[i]); puts(": is not a particle."); return 0; } if(prt[i]==CompoundArg2(prp)) prp=GetAtomProperty(CompoundArg1(prp),PROP_TYPE); spin[i]=IntegerValue(CompoundArgN(prp,4)); mass[i]=CompoundArgN(prp,5); color[i]=GetAtomProperty(prt[i],A_COLOR); t7=CompoundArgN(prp,7); if(i<2 && (t7==A_LEFT||t7==A_RIGHT)) neufact*=2; } if(dec==0) sprintf(pname,"%s%s__%s%s",AtomValue(prt[0]),AtomValue(prt[1]), AtomValue(prt[2]),AtomValue(prt[3])); else sprintf(pname,"%s__%s%s",AtomValue(prt[0]), AtomValue(prt[2]),AtomValue(prt[3])); for(i=0;pname[i];i++) { if(pname[i]=='~') pname[i]='_'; if(pname[i]=='+') pname[i]='p'; if(pname[i]=='-') pname[i]='m'; } f=fopen("scan.bat",inifile?"a":"w"); if(f==NULL) { ErrorInfo(2000); puts("mkProc: can not open scan.bat"); return 0; } if(!inifile) { fprintf(f,"#!/bin/sh\n\n"); inifile=1; } fprintf(f,"echo Generating process %s `date`\n\n",pname); fprintf(f,"echo Process %s: >> scan.log\n",pname); fprintf(f,"num0=`date +%%s`\n"); fprintf(f,"cat > proc.m <<END\n"); if(dec==0) fprintf(f,"process = {prt[\"%s\"],prt[\"%s\"]} ->", AtomValue(prt[0]),AtomValue(prt[1])); else fprintf(f,"process = {prt[\"%s\"]} ->", AtomValue(prt[0])); fprintf(f," {prt[\"%s\"],prt[\"%s\"]}\n", AtomValue(prt[2]),AtomValue(prt[3])); if(FAver==4) fprintf(f,"dir = SetupCodeDir[\"scan_%s\"]\n",pname); if(FAver>4) fprintf(f,"name = \"%s\"\n",pname); fprintf(f,"SetOptions[InsertFields,Model->model%d, GenericModel->model%d,\n", ModelNumber,ModelNumber); fprintf(f," ExcludeParticles->{ "); if(color[0]&&color[1]&&color[2]&&color[3]) { int glu=1,gno=1; if(GetAtomProperty(prt[0],A_ANTI)!=prt[1]) glu=0; if(spin[0]==0&&spin[1]==0&&spin[2]==0&&spin[3]==0) gno=0; if(glu) fprintf(f,"prt[\"G\"]%c ",gno?',':' '); if(gno) fprintf(f,"prt[\"~%c\"] ",ModelNumber>30?'G':'g'); } fprintf(f,"} ]\n"); fprintf(f,"END\n\n"); fprintf(f,"if test ! -d scan_%s/squaredme ;\n",pname); fprintf(f,"then math < %s.m;\n",dec?"scand":"scan"); fprintf(f,"fi\n\n"); fprintf(f,"num1=$((`date +%%s`-num0))\nnum0=`date +%%s`\n\n"); fprintf(f,"if test ! -d scan_%s/squaredme ;\n",pname); fprintf(f,"then echo Output directory is not created | tee -a scan.log && exit;\n"); fprintf(f,"fi\n\n"); fprintf(f,"if test ! -d drivers/F ;\n"); fprintf(f,"then cat > scan_%s/process.h <<END\n",pname); for(i=1;i<=4;i++) { int i1=i; if(dec&&i==2) continue; if(dec&&i>2) i1=i-1; fprintf(f,"#define TYPE%d %s\n",i1, spin[i-1]==0?"SCALAR":(spin[i-1]==1?"FERMION": (mass[i-1]==0?"PHOTON":"VECTOR"))); fprintf(f,"#define MASS%d %s\n",i1,mass[i-1]?AtomValue(mass[i-1]):"0"); fprintf(f,"#define CHARGE%d 0\n\n",i1); } fprintf(f,"#define IDENTICALFACTOR %s\n",(prt[2]==prt[3])?"0.5":"1"); fprintf(f,"#define COLOURFACTOR %dD0",neufact); if(color[0] && color[1]) fprintf(f,"/9D0"); else if(color[0] || color[1]) fprintf(f,"/3D0"); fprintf(f,"\n"); if(FAver>4) {fprintf(f,"#define SCALE sqrtS\n#define LUMI \"lumi_parton.F\"\n"); fprintf(f,"c#define FORCE_ONSHELL\n"); } fprintf(f,"#define NCOMP 2\n#include \"%cto2.F\"\nEND\n\nfi\n\n",dec?'1':'2'); /* fprintf(f,"cp model%d.h scan_%s/model.h\n",ModelNumber,pname); fprintf(f,"cp mdl_ini%d.F scan_%s/mdl_ini.F\n\n",ModelNumber,pname); */ if(FAver==4) fprintf(f,"cp main.F scan_%s/\n\n",pname); if(thcut!=0.0) { fprintf(f,"echo \"#define THETACUT (%f*degree)\" > scan_%s/run.F\n", thcut,pname); fprintf(f,"grep -v THETACUT drivers/run.F >> scan_%s/run.F\n",pname); } fprintf(f,"cd scan_%s\n",pname); fprintf(f,"sz0=`du -sm .`\n"); fprintf(f,"if test ! -f run ;\n"); fprintf(f,"then ./configure ;\n"); fprintf(f,"fi\n\n"); fprintf(f,"rm run ru*.01000*/*\n"); fprintf(f,"gmake\n"); fprintf(f,"if test ! -f run ;\n"); fprintf(f,"then echo Run file is not created | tee -a ../scan.log && exit;\n"); fprintf(f,"fi\n"); fprintf(f,"num2=$((`date +%%s`-num0))\nnum0=`date +%%s`\n\n"); fprintf(f,"sz1=`du -sm .`\n"); fprintf(f,"./run uuuu 1000,1000\n"); if(FAver>4) fprintf(f,"../exval6 ru*.01000*/* >> ../scan.log\n\n\n"); fprintf(f,"cd ..\n"); // fprintf(f,"grep \"| 1000.000\" scan_%s/ru*.01000*/* >> scan.log\n\n\n", // pname); if(FAver==4) fprintf(f,"./exval scan_%s/ru*.01000*/* >> scan.log\n\n\n",pname); fprintf(f,"num3=$((`date +%%s`-num0))\n\n"); fprintf(f,"echo $num1 + $num2 + $num3 = $(((num1+num2+num3)/60))"); fprintf(f," min \\\n $sz0/$sz1 MB >> scan.log\n"); fprintf(f,"rm -rf scan_%s\n\n",pname); fclose(f); return 0; }
Term ProcCoefVrt(Term t, List ind) { List l,pl,ml; int ii; Term a2; int g=0, g5=0, re=0, im=0, abbr=0, cmplx=0; if(!is_compound(t) || CompoundArity(t)>2 || !is_list(CompoundArg1(t))) { ErrorInfo(0); puts("wrong parameters of CoefVrt function."); return 0; } if(lagr_hash==NULL) { ErrorInfo(107); puts("CoefVrt: no vertices"); return 0; } mmm=0; if(CompoundArity(t)==2) { List ol=CompoundArg2(t); if(!is_list(ol)) { ErrorInfo(107); puts("CoefVrt: second argument is not a list."); return 0; } for(;ol;ol=ListTail(ol)) { Term o=ListFirst(ol); if(is_compound(o)) { o=CompoundArg1(o); if(!is_atom(o) || !is_particle(o,0)) { ErrorInfo(0); printf("CoefVrt: ");WriteTerm(o); puts(" is not a particle.\n"); return 0; } mmm=o; continue; } if(!is_atom(o)) { ErrorInfo(0); printf("CoefVrt: ");WriteTerm(o); puts(" is not an option.\n"); return 0; } if(strcmp("gamma",AtomValue(o))==0) { g++; continue; } if(strcmp("gamma5",AtomValue(o))==0) { g5++; continue; } if(strcmp("re",AtomValue(o))==0) { re++; continue; } if(strcmp("im",AtomValue(o))==0) { im++; continue; } if(strcmp("abbr",AtomValue(o))==0) { abbr++; continue; } { ErrorInfo(0); printf("CoefVrt: ");WriteTerm(o); puts(" is not an option.\n"); return 0; } } } if(re&&im) re=im=0; pl=ConsumeCompoundArg(t,1); for(l=pl;l;l=ListTail(l)) if(is_function(ListFirst(l),0)) ChangeList(l,CallFunction(ListFirst(l),0)); /* for(l=pl;l;l=ListTail(l)) { Term aa=ListFirst(l); if(is_compound(aa)&&CompoundName(aa)==A_ANTI) ChangeList(l,GetAtomProperty(CompoundArg1(aa),A_ANTI)); }*/ pl=SortedList(pl,acmp); l=finda2(pl,0); if(mmm && !mmmpos) { ErrorInfo(0); printf("CoefVrt: particle "); WriteTerm(mmm); puts(" not found in the vertex"); return 0; } if(is_empty_list(l)) { ErrorInfo(108); printf("CoefVrt: vertex "); WriteTerm(pl); puts(" not found"); return NewInteger(0); } a2=CopyTerm(ListFirst(l)); alg2_symmetrize(a2); alg2_common_n(a2); { int sv=kill_gamma_pm; kill_gamma_pm=1; alg2_red_1pm5(a2); kill_gamma_pm=sv; } alg2_recommon_n(a2); ml=ConsumeCompoundArg(a2,5); for(l=ml;l;l=ListTail(l)) { List l1,ll; int tg=0, tg5=0, tm=0; for(l1=CompoundArgN(ListFirst(l),3);l1;l1=ListTail(l1)) { Term tt=ListFirst(l1); if(CompoundName(tt)==OPR_SPECIAL && CompoundArg1(tt)==A_GAMMA) tg++; if(CompoundName(tt)==OPR_SPECIAL && CompoundArg1(tt)==A_GAMMA5) tg5++; if(CompoundName(tt)==A_MOMENT && CompoundArg1(tt)== NewInteger(mmmpos)) tm++; } if(g!=tg || g5!=tg5 || (mmm && !tm)) { SetCompoundArg(ListFirst(l),1,0); continue; } if(!re && !im) continue; for(l1=CompoundArg2(ListFirst(l));l1;l1=ListTail(l1)) if(GetAtomProperty(CompoundArg1(ListFirst(l1)),A_ANTI)) cmplx++; } if( (re||im) && !cmplx) for(l=ml;l;l=ListTail(l)) { List ll,l1; if(CompoundArg1(ListFirst(l))==0) continue; ll=ConsumeCompoundArg(ListFirst(l),2); for(l1=ll;l1;l1=ListTail(l1)) if(CompoundArg1(ListFirst(l1))==A_I) break; if( (re && l1) || (im && !l1) ) SetCompoundArg(ListFirst(l),1,0); if(im && l1) ll=CutFromList(ll,l1); SetCompoundArg(ListFirst(l),2,ll); } rpt: for(l=ml;l;l=ListTail(l)) if(CompoundArg1(ListFirst(l))==0) { ml=CutFromList(ml,l); break; } if(l) goto rpt; SetCompoundArg(a2,5,ml); alg2_recommon_n(a2); alg2_common_s(a2); alg2_red_cos(a2); alg2_red_orth(a2); alg2_red_sico(a2); alg2_red_comsico(a2); alg2_recommon_n(a2); if(abbr) { int trisv=opTriHeu; alg2_eval_vrt(a2); doing_abbr=0; opTriHeu=trisv; } { int n,d; Term cf; Term res; n=IntegerValue(CompoundArg1(CompoundArg2(a2))); d=IntegerValue(CompoundArg2(CompoundArg2(a2))); cf=l2expr(CompoundArgN(a2,3),n); ml=CompoundArgN(a2,5); if(ml==0) return NewInteger(0); res=l2expr(CompoundArg2(ListFirst(ml)), IntegerValue(CompoundArg1(ListFirst(ml)))); for(l=ListTail(ml);l;l=ListTail(l)) { Term ccc; n=IntegerValue(CompoundArg1(ListFirst(l))); ccc=l2expr(CompoundArg2(ListFirst(l)),n>0?n:-n); if(n>0) res=MakeCompound2(OPR_PLUS,res,ccc); else res=MakeCompound2(OPR_MINUS,res,ccc); } if(res==NewInteger(1)) res=cf; else res=MakeCompound2(OPR_MLT,cf,res); if(d!=1) res=MakeCompound2(OPR_DIV,res,NewInteger(d)); if( (im||re) && cmplx) res=MakeCompound1(NewAtom(re?"creal":"cimag",0),res); return res; } return a2; }
Term ProcLet(Term t, Term ind) { Term t1,nm,sub,kl=0; List il,ol,l1; int transf_fl=0; Atom anti1=0, anti2=0; ol=il=NewList(); t1=ConsumeCompoundArg(t,1); FreeAtomic(t); t1=ProcessAlias(t1); if(is_compound(t1) && CompoundArity(t1)==2 && CompoundName(t1)==OPR_COMMA) { Term a1,a2; a1=ConsumeCompoundArg(t1,1); a2=ConsumeCompoundArg(t1,2); FreeAtomic(t1); ProcLet(MakeCompound1(OPR_LET,a1),0); ProcLet(MakeCompound1(OPR_LET,a2),0); return 0; } if(!is_compound(t1) || CompoundArity(t1)!=2 || (CompoundName(t1)!=OPR_EQSIGN && CompoundName(t1)!=OPR_RARROW)) { ErrorInfo(325); printf("bad argument in let statement\n"); return 0; } if(CompoundName(t1)==OPR_EQSIGN && is_atom(CompoundArg1(t1)) && is_atom(CompoundArg2(t1)) && (CompoundArg2(t1)==A_GAMMA5 || GetAtomProperty(CompoundArg2(t1), A_GAMMA5))) { SetAtomProperty(CompoundArg1(t1),A_GAMMA5,NewInteger(1)); } if(CompoundName(t1)==OPR_RARROW) transf_fl=1; if(CompoundName(t1)==OPR_EQSIGN && is_atom(CompoundArg1(t1)) && is_compound(CompoundArg2(t1)) && CompoundName(CompoundArg2(t1))==A_ANTI && is_atom(CompoundArg1(CompoundArg2(t1)))) { anti1=CompoundArg1(t1); anti2=CompoundArg1(CompoundArg2(t1)); } nm=ConsumeCompoundArg(t1,1); sub=ConsumeCompoundArg(t1,2); FreeAtomic(t1); if(transf_fl) allow_transf_lets=0; if(is_compound(nm) && (CompoundName(nm)==OPR_USCORE || CompoundName(nm)==OPR_CARET)) nm=SplitIndices(nm,&il); if(!is_atom(nm)) { ErrorInfo(325); printf("bad left argument in let call\n"); FreeAtomic(sub); FreeAtomic(t1); return 0; } if(transf_fl) { if(!is_parameter(nm) && !is_particle(nm,NULL)) { ErrorInfo(728); printf("Unknown object '%s'.\n",AtomValue(nm)); return 0; } } if(GetAtomProperty(nm,A_KEEP_LETS)) { Term prp; kl=ExprTo1kl(CopyTerm(sub)); if(kl==0) return 0; prp=GetAtomProperty(nm,A_KEEP_LETS); SetCompoundArg(prp,1,kl); } sub=ExprTo1(sub); alg1_set_cos0(sub); if(sub==0) return 0; if(transf_fl) allow_transf_lets=1; t1=CopyTerm(CompoundArg2(sub)); if(is_empty_list(il)) { l1=t1; while(!is_empty_list(l1)) { Term t; t=CompoundArg2(ListFirst(l1)); if(!is_label(t)) { ErrorInfo(326); printf("unbalanced index '"); WriteTerm(t); printf("' in let statement\n"); FreeAtomic(sub); FreeAtomic(t1); FreeAtomic(ol); return 0; } ol=AppendLast(ol,t); l1=ListTail(l1); } /* mk_let(nm,sub,ol,t1); */ } else { List t2; t2=0; if(ListLength(il)!=ListLength(t1)) { ErrorInfo(327); printf("distinct indices number "); printf("in let statement.\n"); FreeAtomic(sub); FreeAtomic(t1); return 0; } l1=t1; while(!is_empty_list(l1)) { Term t; t=CompoundArg2(ListFirst(l1)); if(!is_atom(t) || !ListMember(il,t)) { ErrorInfo(326); printf("unbalanced index '"); WriteTerm(t); printf("' in let statement\n"); FreeAtomic(sub); FreeAtomic(t1); FreeAtomic(ol); return 0; } ol=AppendLast(ol,t); l1=ListTail(l1); } l1=il; while(!is_empty_list(l1)) { List l2; if(!ListMember(ol,ListFirst(l1))) { ErrorInfo(326); printf("unbalanced index '"); WriteTerm(t); printf("' in let statement\n"); FreeAtomic(sub); FreeAtomic(t1); FreeAtomic(ol); return 0; } for(l2=t1;l2;l2=ListTail(l2)) if(ListFirst(l1)==CompoundArg2(ListFirst(l2))) { t2=AppendLast(t2,ListFirst(l2)); break; } l1=ListTail(l1); } RemoveList(t1); t1=t2; FreeAtomic(ol); ol=il; } /* mk_let(nm,sub,ol,t1); */ l1=t1; while(!is_empty_list(l1)) { SetCompoundArg(ListFirst(l1),2,0); l1=ListTail(l1); } /*WriteTerm(sub); puts(""); getchar();*/ t=MakeCompound(OPR_LET,5); SetCompoundArg(t,1,sub); SetCompoundArg(t,2,ol); SetCompoundArg(t,3,alg1_inv_alg(sub)); if(transf_fl==0) { Term tt; tt=alg1_guess_mpl(sub); if(tt) { SetCompoundArg(t,4,NewInteger(1)); SetCompoundArg(t,5,tt); } else { int tp; tt=alg1_guess_mtr(sub, &tp); if(tt) { SetCompoundArg(t,4,NewInteger(tp)); SetCompoundArg(t,5,tt); } } ReportRedefined(nm,"let-substitution"); SetAtomProperty(nm,PROP_INDEX,t1); SetAtomProperty(nm,PROP_TYPE,t); alg1_let_cw(nm); if(anti1 && anti2) { SetAtomProperty(anti1,A_ANTI,anti2); SetAtomProperty(anti2,A_ANTI,anti1); } else if(only_prm(CompoundArg1(t))) SetAtomProperty(nm,A_ANTI,nm); return 0; } l1=GetAtomProperty(nm,PROP_INDEX); if(!EqualTerms(l1,t1)) { ErrorInfo(729); puts("transformed object has other indices types"); return 0; } if(GetAtomProperty(nm,OPR_LET)) { WarningInfo(0); printf("Warning: transformation rule for '%s' is redefined.\n", AtomValue(nm)); } SetAtomProperty(nm,OPR_LET,t); return 0; }
Term AtomicTo1(Term t, Term ind) { List rl; Term ret; Term t1; Atom ttype; if(is_compound(t) && CompoundName(t)==A_ALG1) { List l; ttype=A_ALG1; rl=CopyTerm(CompoundArg2(t)); for(l=rl;l;l=ListTail(l)) SetCompoundArg(ListFirst(l),2,0); goto cnt; } if(is_compound(t) && CompoundName(t)==A_FBRACET) { t=alg1_mk_wild(t,&rl,&ind); ttype=OPR_WILD; goto cnt; } /* if(is_compound(t) && CompoundName(t)==A_CC) { t=cc_particle(t,&rl); ttype=OPR_FIELD; goto cnt; } */ if(is_let(t,&rl)) { ttype=OPR_LET; goto cnt; } if(is_parameter(t) || (is_compound(t) && (CompoundName(t)==A_COS || CompoundName(t)==A_SIN)) ) { rl=NewList(); ttype=OPR_PARAMETER; goto cnt; } if(is_particle(t,&rl)) { ttype=OPR_FIELD; goto cnt; } if(is_special(t,&rl)) { ttype=OPR_SPECIAL; goto cnt; } ErrorInfo(301); printf(" \'%s\' undefined object.\n",AtomValue(t)); FreeAtomic(ind); longjmp(alg1_jmp_buf,1); cnt: ret=MakeCompound(A_MTERM,4); SetCompoundArg(ret,1,NewInteger(1)); SetCompoundArg(ret,2,NewInteger(1)); t1=0; if(!is_empty_list(rl)) { Term ttt; int skipped; rl=CopyTerm(rl); if(is_empty_list(ind)) { SetCompoundArg(ret,3,AppendFirst(NewList(),MakeCompound2(ttype,rl,t))); return AppendFirst(NewList(),ret); } skipped=must_skip(ListLength(ind),rl); if(skipped==-1) { ErrorInfo(302); printf(" can not set indices "); WriteTerm(ind); printf(" to \'%s\'.\n",AtomValue(t)); FreeAtomic(ind); FreeAtomic(rl); longjmp(alg1_jmp_buf,1); } t1=rl; ttt=ind; while(!is_empty_list(rl)) { if(skipped!=0 && should_skip(skipped,CompoundArg1(ListFirst(rl)))) { rl=ListTail(rl); continue; } SetCompoundArg(ListFirst(rl),2,ListFirst(ttt)); rl=ListTail(rl); ttt=ListTail(ttt); } FreeAtomic(ind); } if(ttype==OPR_PARAMETER && is_compound(t)) { Term mmm=MakeCompound(ttype,CompoundArity(t)+2); SetCompoundArg(mmm,1,t1); SetCompoundArg(mmm,2,CompoundName(t)); SetCompoundArg(mmm,3,CompoundArg1(t)); if(CompoundArity(t)==2) { Term m=ExprTo1(ConsumeCompoundArg(t,2)); m=CompoundArg1(m); if(ListLength(m)!=1) { ErrorInfo(0); puts("bad expression in sin/cos."); longjmp(alg1_jmp_buf,1); } m=ListFirst(m); SetCompoundArg(mmm,4,m); } SetCompoundArg(ret,3,AppendFirst(NewList(),mmm)); } else SetCompoundArg(ret,3,AppendFirst(NewList(),MakeCompound2(ttype,t1,t))); return AppendFirst(NewList(),ret); }
// Test with particles, checking that the Iterator doesn't loop over particles void TestNodeBasedCellPopulationWithParticlesSetup() throw(Exception) { EXIT_IF_PARALLEL; // This test doesn't work in parallel. unsigned num_cells_depth = 11; unsigned num_cells_width = 6; HoneycombMeshGenerator generator(num_cells_width, num_cells_depth, 2); TetrahedralMesh<2,2>* p_generating_mesh = generator.GetMesh(); // Convert this to a NodesOnlyMesh NodesOnlyMesh<2> mesh; mesh.ConstructNodesWithoutMesh(*p_generating_mesh, 1.5); std::vector<unsigned> location_indices = generator.GetCellLocationIndices(); // Set up cells std::vector<CellPtr> cells; CellsGenerator<FixedDurationGenerationBasedCellCycleModel,2> cells_generator; cells_generator.GenerateGivenLocationIndices(cells, location_indices); // Create a cell population NodeBasedCellPopulationWithParticles<2> cell_population(mesh, cells, location_indices); // Create a set of node indices corresponding to particles std::set<unsigned> node_indices; std::set<unsigned> location_indices_set; std::set<unsigned> particle_indices; for (unsigned i=0; i<mesh.GetNumNodes(); i++) { node_indices.insert(mesh.GetNode(i)->GetIndex()); } for (unsigned i=0; i<location_indices.size(); i++) { location_indices_set.insert(location_indices[i]); } std::set_difference(node_indices.begin(), node_indices.end(), location_indices_set.begin(), location_indices_set.end(), std::inserter(particle_indices, particle_indices.begin())); std::vector<bool> is_particle(mesh.GetNumNodes(), false); for (std::set<unsigned>::iterator it=particle_indices.begin(); it!=particle_indices.end(); it++) { TS_ASSERT_EQUALS(cell_population.GetNode(*it)->IsParticle(), true) } // Test the GetParticleIndices method std::set<unsigned> particle_indices2 = cell_population.GetParticleIndices(); TS_ASSERT_EQUALS(particle_indices, particle_indices2); // Check the iterator doesn't loop over particles unsigned counter = 0; for (AbstractCellPopulation<2>::Iterator cell_iter = cell_population.Begin(); cell_iter != cell_population.End(); ++cell_iter) { unsigned node_index = cell_population.GetLocationIndexUsingCell(*cell_iter); TS_ASSERT(!is_particle[node_index]); counter++; } TS_ASSERT_EQUALS(counter, cell_population.GetNumRealCells()); // Check counter = num_nodes - num_particles_nodes TS_ASSERT_EQUALS(counter + particle_indices.size(), mesh.GetNumNodes()); }
void check_hint(int col, int spin, int ch, List hint, Atom *n, Atom *an) { List l, l1; if(col==0) return; l=hint; while(!is_empty_list(l)) { Atom a1,a2; Term cp, tp; a1=CompoundArg1(ListFirst(l)); tp=GetAtomProperty(a1,PROP_TYPE); if(tp==0 || !is_compound(tp) || CompoundName(tp)!=OPR_PARTICLE) goto cnt; cp=GetAtomProperty(a1,A_COLOR); if(cp==0 || !is_compound(cp)) goto cnt; cp=CompoundArg1(cp); if((col==3 && IntegerValue(cp)!=3) || (col!=3 && IntegerValue(cp)==3)) goto cnt; if(ch && CompoundArg1(tp)==CompoundArg2(tp)) goto cnt; if(!ch && CompoundArg1(tp)!=CompoundArg2(tp)) goto cnt; if(ch) { if(a1==CompoundArg1(tp)) a2=CompoundArg2(tp); else a2=CompoundArg1(tp); } else a2=a1; if(ch) { l1=ListTail(l); while(!is_empty_list(l1)) { if(a2==CompoundArg1(ListFirst(l1))) break; l1=ListTail(l1); } if(is_empty_list(l1)) goto cnt; } l1=used_fields; while(!is_empty_list(l1)) { Atom aa; aa=CompoundArg2(CompoundArg2(ListFirst(l1))); if(aa==a1 || aa==a2) goto cnt; l1=ListTail(l1); } a1=CompoundArg1(tp); a2=CompoundArg2(tp); if(spin==2) { *n=a1; *an=a2; return; } if(AtomValue(a1)[0]=='~' || AtomValue(a2)[0]=='~') goto cnt; sprintf(nnbuf,"~%s",AtomValue(a1)); a1=NewAtom(nnbuf,0); sprintf(nnbuf,"~%s",AtomValue(a2)); a2=NewAtom(nnbuf,0); if(is_particle(a1,NULL) || is_particle(a2,NULL)) goto cnt; *n=a1; *an=a2; return; cnt: l=ListTail(l); } }