scprog()
{ short i,j,k,l,m,n,stconj,np,pm1,ncr,crct,ndc,dcct,
lo,intexsk,stpt,lpt,stint,olen,pt,ad,*p1,*ip1,*p2,*ip2,
*pint,*ptr,*g,*ig,ino,olo,**vsvptr;
int quot;
char ingp,igth;
if ((ip=fopen(inf1,"r"))==0)
{ fprintf(stderr,"Cannot open %s.\n",inf1); return(-1); }
fscanf(ip,"%hd%hd%hd%hd",&npt,&exp,&nb,&l);
if (npt>mpt)
{ fprintf(stderr,"npt too big. Increase MPT.\n"); return(-1); }
if (nb>=mb)
{ fprintf(stderr,"nb too big. Increase MB.\n"); return(-1); }
if (nb*npt*2>svsp)
{ fprintf(stderr,"svsp too small. Increase SVSP.\n"); return(-1); }
if (exp>=mexp)
{ fprintf(stderr,"exp too big. Increase MEXP.\n"); return(-1); }
if (l!=2) {fprintf(stderr,"Wrong input format.\n"); return(-1);}
readbaselo(nb,base,lorb); npt1=npt+1;
quot=psp/npt1; if (quot>mp) quot=mp; mxp=quot; mxp=2*(mxp/2);
if (2*exp>mxp)
{ fprintf(stderr,"Out of perm space. Increase PSP (or MP).\n"); return(-1); }
for (i=0;i<mxp;i++) pptr[i]=perm+i*npt1-1;
for (i=1;i<=nb;i++) svptr[i]=sv+(i-1)*npt-1;
readpsv(0,nb,exp,svptr);
for (i=exp;i>=1;i--) fscanf(ip,"%hd",pwt+i);
fscanf(ip,"%hd%hd",&prime,&ngads);
if (2*exp+ngads>mxp)
{ fprintf(stderr,"Out of perm space. Increase PSP (or MP).\n"); return(-1); }
for (i=1;i<=exp;i++) fscanf(ip,"%hd",power+i);
for (i=1;i<=exp;i++) { j=2*(i-1); ngno[i]=j; igno[j+1]=i; }
k=2*exp-1;
for (i=1;i<=ngads;i++)
{ l=i+k; readvec(pptr[l],1); m=pptr[l][npt1]; ngno[m]=l; }
fclose(ip);
stconj=2*exp+ngads-1; itp=tp+npt1;
if (4*exp+ngads>mxp)
{ fprintf(stderr,"Out of perm space. Increase PSP (or MP).\n"); return(-1); }
if (subgp)
{ stig=stconj+2*exp;
for (i=1;i<=nb;i++) sv2ptr[i]=sv+(nb+i-1)*npt-1;
if (subgp>1)
{strcpy(inf3,inf0); strcat(inf3,"sg"); sgstr[0]=sgc; strcat(inf3,sgstr);}
if (rsgp()== -1) return(-1);
igth=1;
}
else vsvptr=svptr;
if ((ip=fopen(inf2,"r"))==0)
{ printf("Cannot open %s.\n",inf2); return(-1); }
fscanf(ip,"%hd%hd",&i,&ndc); while (getc(ip)!='\n');
if (i!=npt) {printf("dcr has npt false.\n"); return(-1); }
/* If subgp is true, then we will have to update the dcr file, so we print
it out on to a temporary file as we go along.
*/
if (subgp)
{ opy=fopen(outft,"w"); fprintf(opy,"%4d%4d%4d%4d\n",npt,ndc,0,0);}
op=fopen(outf,"w"); pm1=prime-1; setpinv();
for (dcct=1;dcct<=ndc;dcct++)
{ if (subgp>1 && igth==0)
{ strcpy(inf3,inf0); strcat(inf3,"sg"); sgstr[0]=sgc;
strcat(inf3,sgstr); ipkp=ip;
if (rsgp()== -1) return(-1);
ip=ipkp; vsvptr=sv2ptr; igth=1;
}
else if (subgp) vsvptr=sv2ptr;
readvec(dcrep,0); invert(dcrep,dcrepinv);
fscanf(ip,"%hd",&lo); intexp=0; olo=lo;
while (lo%prime==0) {intexp++; lo/=prime; }
if (lo!=1) printf("Warning. lo was not a power of p.\n");
intexp=exp-intexp; printf("dcct,intexp=%d,%d.\n",dcct,intexp);
/* intexp is the exponent of Q = P ^ gPg(-1), for the current dcrep g */
if (intexp==0 || (intexp==1 && mult))
{ if (subgp)
{ if (npt>=1000) for (n=1;n<=npt;n++) fprintf(opy,"%5d",dcrep[n]);
else for (n=1;n<=npt;n++) fprintf(opy,"%4d",dcrep[n]);
fprintf(opy," %4d\n",olo);
}
if (mult==0) fprintf(op,"%4d\n",0);
continue;
}
/* Now we compute the gens g(-1)h(i)g, where h(i) are the PCP gens of P */
for (i=1;i<=exp;i++)
{ p1=pptr[ngno[i]]; p2=pptr[stconj+i];
for (n=1;n<=npt;n++) p2[n]=dcrep[p1[dcrepinv[n]]];
}
stint=stconj+exp; pint=pptr[stint]; intexsk=0;
for (i=1;i<=exp;i++) intno[i]=0;
lpt=1; stpt=1; pm1=prime-1;
/* Now we search through the elements of g(-1)Pg, testing for membership of
P, until we have found the intexp gens of g(-1)Qg.
*/
for (i=1;i<=exp;i++)
{ olen=1; cp[1]=stconj+i;
for (j=1;j<=exp;j++) co[j]=0;
while(1)
{ *cp=olen; ingp=1;
for (k=1;k<=nb;k++)
{ pt=image(base[k]); ptr=vsvptr[k];
if (ptr[pt]==0) {ingp=0; ad=stpt; break;}
if (k<nb) addsv(pt,ptr);
}
if (ingp) break;
while (co[ad]==pm1) {olen-=pm1; co[ad]=0; ad=fpt[ad]; }
if (ad==i) { lpt=i; fpt[i]=i+1; break; }
olen++; co[ad]++; cp[olen]=stconj+ad;
}
if (ingp)
{ intexsk++; pint+=npt1; *cp=olen;
for (n=1;n<=npt;n++) pint[n]=image(n);
pint[npt1]=intexsk; intno[i]=stconj+2*intexsk-1;
if (intexsk==intexp) break;
if (stpt==i) {lpt=i+1; stpt=lpt; } else fpt[lpt]=i+1;
}
}
/* Search is complete */
if (intexsk<intexp) {fprintf(stderr,"Intersection error.\n"); return(-1); }
printf("Found intersection.\n");
/* If subgp, then we will now modify g, until H ^ gHg- contains Q */
if (subgp) for (m=subgp;m>=1;m--)
{ if (m==subgp) for (i=1;i<=npt;i++) {tp[i]=i; itp[i]=i;}
if (subgp>1)
{ strcpy(inf4,inf0); strcat(inf4,"cr"); strcat(inf4,sgstr);
if (m>1)
{ sgstr[0]--; strcpy(inf3,inf0); strcat(inf3,"sg"); strcat(inf3,sgstr);
ipkp=ip;
if (rsgp()== -1) return(-1);
ip=ipkp; igth=0; vsvptr=sv2ptr;
}
else vsvptr=svptr;
}
else vsvptr=svptr;
if ((ipcr=fopen(inf4,"r"))==0)
{ fprintf(stderr,"Cannot open %s.\n",inf4); return(-1); }
ingp=0;
fscanf(ipcr,"%hd%hd",&n,&ncr); while (getc(ipcr)!='\n');
if (n!=npt) { fprintf(stderr,"inf4 has npt wrong.\n"); return(-1); }
for (crct=0;crct<=ncr;crct++)
{ if (crct==0) for (n=1;n<=npt;n++) crep[n]=n;
else for (n=1;n<=npt;n++) fscanf(ipcr,"%hd",crep+n);
invert(crep,crepinv);
for (i=1;i<=intexp;i++)
{ p1=pptr[stint+i]; *cp=0;
for (j=1;j<=nb;j++)
{ pt=image(crep[tp[p1[itp[crepinv[base[j]]]]]]); ptr=vsvptr[j];
if (ptr[pt]==0) goto nextcr;
if (j<nb) addsv(pt,ptr);
}
}
ingp=1; printf("Got intersection in subgp %d. crct=%d.\n",m-1,crct);
for (n=1;n<=npt;n++) tp[n]=crep[tp[n]]; invert(tp,itp);
fclose(ipcr); break;
nextcr:;
}
if (ingp==0)
{ fprintf(stderr,"Cannot get intersection in subgp %d.\n",m-1);
return(-1);
}
}
/* Now we reconjugate the gens of g(-1)Qg by g(-1) to get gens of Q */
for (i=1;i<=intexp;i++)
{ p1=pptr[stconj+2*i-1]; p2=pptr[stint+i];
for (n=1;n<=npt;n++) p1[n]=dcrepinv[p2[dcrep[n]]]; p1[npt1]=p2[npt1];
invert(p1,p1+npt1);
}
/* If subgp, then update dcr */
if (subgp)
{ if (npt>=1000) for (n=1;n<=npt;n++)
{ dcrep[n]=tp[dcrep[n]]; fprintf(opy,"%5d",dcrep[n]); }
else for (n=1;n<=npt;n++)
{ dcrep[n]=tp[dcrep[n]]; fprintf(opy,"%4d",dcrep[n]); }
fprintf(opy," %4d\n",olo); invert(dcrep,dcrepinv);
}
norm= intexp==exp;
/* If norm, then we do not need to compute the PCP for Q */
if (norm)
{ fprintf(op,"%4d\n",intexp);
if (mult==0)
{ for (i=exp;i>=1;i--) { wt[i]=pwt[i]; fprintf(op,"%4d",wt[i]); }
fprintf(op,"\n");
}
goto outconj;
}
/* Now we compute the PCP for Q. This is similar to the algorithm in pcrun */
for (i=1;i<=intexp;i++) { wt[i]=1; d1[i]=0; d2[i]=0; }
restart:
if (mult) nwt=2;
for (i=intexp;i>=2;i--)
{ p1=pptr[stconj+2*i-1]; ip1=p1+npt1;
for (j=intexp;j>i;j--)
{ if (mult==0) nwt=wt[i]+wt[j];
p2=pptr[stconj+2*j-1]; ip2=p2+npt1;
for (n=1;n<=npt;n++) {pt=p2[p1[ip2[ip1[n]]]]; tp[n]=pt; itp[pt]=n; }
if ((n=expint(intexp+1-i,intexp+1-j,nwt))>0) goto restart;
if (n== -1) return(-1);
}
}
if (mult==0) for (i=intexp;i>=2;i--)
{ nwt=wt[i]+1; p1=pptr[stconj+2*i-1]; ip1=p1+npt1;
for (n=1;n<=npt;n++)
{ pt=n; for (m=1;m<=prime;m++) pt=p1[pt]; tp[n]=pt; itp[pt]=n; }
if ((n=expint(intexp+1-i,intexp+1-i,nwt))>0) goto restart;
if (n== -1) return(-1);
}
fprintf(op,"%4d\n",intexp);
if (mult==0)
{ for (i=intexp;i>=1;i--) fprintf(op,"%3d",wt[i]); fprintf(op,"\n"); }
/* We output the PCP gens of Q followed by those of g(-1)Qg */
for (i=intexp;i>=1;i--)
{ p1=pptr[stconj+2*i-1]; p2=tp; ptr=p1+2*npt1;
while (p1<ptr) *(++p2)= *(++p1);
express(tp,rel,0); l= *rel;
for (n=0;n<=l;n++) fprintf(op,"%4d",rel[n]); fprintf(op,"\n");
}
outconj:
for (i=intexp;i>=1;i--)
{ p1= pptr[stconj+2*i-1];
for (n=1;n<=npt;n++) {pt=dcrep[p1[dcrepinv[n]]]; tp[n]=pt; itp[pt]=n; }
express(tp,rel,0); l= *rel;
for (n=0;n<=l;n++) fprintf(op,"%4d",rel[n]); fprintf(op,"\n");
}
if (norm) continue;
if (mult==0)
{ for (i=intexp;i>=1;i--) fprintf(op,"%3d",d1[i]); fprintf(op,"\n");
for (i=intexp;i>=1;i--) fprintf(op,"%3d",d2[i]); fprintf(op,"\n");
}
for (i=intexp;i>=2;i--)
{ p1=pptr[stconj+2*i-1]; ip1=p1+npt1;
for (j=intexp;j>i;j--)
{ p2=pptr[stconj+2*j-1]; ip2=p2+npt1;
for (n=1;n<=npt;n++) {pt=p2[p1[ip2[ip1[n]]]]; tp[n]=pt; itp[pt]=n; }
expint(intexp+1-i,intexp+1-j,0);
}
}
if (mult==0) for (i=intexp;i>=2;i--)
{ p1=pptr[stconj+2*i-1]; ip1=p1+npt1;
for (n=1;n<=npt;n++)
{ pt=n; for (m=1;m<=prime;m++) pt=p1[pt]; tp[n]=pt; itp[pt]=n; }
expint(intexp+1-i,intexp+1-i,0);
}
}
fprintf(op,"%d\n",-1);
if (subgp)
{ fclose(opy); fclose(op); fclose(ip);
ip=fopen(outft,"r"); op=fopen(inf2,"w");
while ((i=getc(ip))!= -1) putc(i,op); fclose(ip); unlink(outft);
}
return(0);
}
int
sylprog (int x)
/* x!=0 means that a subgroup of the sylp-group has already been computed, and
is stored in inf2. The search should now start at bno=abs(x). sylnorm always
returns the current bno, if it exits in order to compute the normalizer. It
returns 0 if it completes the computation of the sylp-group
If x>0, its normalizer has also been computed, and lies in outf1,
and so the next element of the sylp-group will be sought from this
normalizer. Any p-element will do in this case.
*/
{ char nontriv,seek,b,incadno,comm,pow,id;
short i,j,k,l,m,n,lnt,fnt,mxp,mnb,mxexp,nperms,ct,stp,
*z,*ap,*sva,ct1,ct2,ct3,ord,kord,pt,stbno,skct,
*tpk,*itpk,*commp,*icommp,*spptr;
int quot;
adpt=obase; lorbdef=nbase; ntfpt=ntorno; ntbpt=lorbn; invbase=reg;
facord=ipno; orno=tsv1; lporb=tsv2; deft=tsv3; orbp=orep, gorb=intorb;
if (chpar)
/* par1,par2 and par3 are used when seeking random elts. See line 152 (approx).
When searching for an element normalizing a subgroup, we give up after
par4 attempts, and use normalizer program to compute the complete
normalizer first.
*/
{ printf("Choose values of par1,par2,par3,par4. (Defaults are %d %d %d %d.)\n",
par1,par2,par3,par4);
scanf("%hd%hd%hd%hd",&par1,&par2,&par3,&par4);
}
if ((ip=fopen(inf1,"r"))==0)
{ fprintf(stderr,"Cannot open %s.\n",inf1); return(-1);}
if (x==0) { printf("Input prime! "); scanf("%hd",&prime);}
fscanf(ip,"%hd%hd%hd%hd",&npt,&nperms,&nb,&l);
if (npt>mnpt) {fprintf(stderr,"npt too big. Increase NPT.\n"); return(-1);}
if (nb>mb) {fprintf(stderr,"nb too big. Increase MB.\n"); return(-1);}
if (nb*npt*2>svsp)
{ fprintf(stderr,"Out of sv space. Increase SVSP.\n");return(-1);}
if (l<=2) { fprintf(stderr,"Wrong input format.\n"); return(-1); }
readbaselo(nb,gbase,lorbg);
for (i=1;i<=npt;i++) invbase[i]=0;
for (i=1;i<=nb;i++) invbase[gbase[i]]=i;
lnt=0; fnt=0;
/* Determine order of sylp subgroup . Links ntfpt and ntbpt are used to bypass
trivial indices in the stab chain.
*/
for (i=nb;i>=1;i--)
{ j=lorbg[i]; lorbh[i]=1;
if (j>1)
{ if (lnt==0) { lnt=i; k=i; ntfpt[lnt]=nb+1; }
else { ntbpt[k]=i; ntfpt[i]=k; k=i; }
while (j%prime==0) {lorbh[i]*=prime; j/=prime; }
if (lorbh[i]>1) fnt=i;
}
else invbase[gbase[i]]=0;
}
ntbpt[fnt]=0; ntfpt[0]=fnt;
if (fnt==0) {fprintf(stderr,"Sylp-group is trivial!\n"); return(-1); }
printf("Orbit lengths of Sylp-group:\n");
for (i=1;i<=nb;i++) printf("%4d",lorbh[i]); printf(".\n");
quot=psp/(npt+1); if (quot>mp) quot=mp; mxp=quot;
quot=sp/npt; if (quot>mexp) quot=mexp; mxexp=quot;
np2=2*nperms-1;
if (np2>=mxp)
{fprintf(stderr,"Out of space. Increase PSP (or MP).\n"); return(-1); }
for (i=0;i<mxp;i++) pptr[i]=perm+(npt+1)*i-1;
for (i=1;i<=nb;i++) svgptr[i]=sv+npt*(i-1)-1;
for (i=1;i<=nb;i++) svhptr[i]=sv+npt*(i+nb-1)-1;
readpsv(0,nb,nperms,svgptr);
fclose(ip);
tpk=space-1; itpk=tpk+npt; commp=itpk+npt; icommp=commp+npt;
spptr=icommp+npt+1; sp-=4*npt;
for (i=fnt;i<=nb;i=ntfpt[i])
{ gorb[i]=spptr; sva=svgptr[i];
for (j=1;j<=npt;j++) if (sva[j]!=0) *(spptr++)=j;
sp-=lorbg[i];
}
/* We now determine how much space we have to store cosetrep perms, and
calculate these with the function exprep
*/
lexp=0; ct=0;
for (i=nb;i>fnt;i--)
{ ct+=(lorbg[i]-1); if (ct+i>=mxexp) {lexp=i; break; } }
if (lexp==0) lexp=fnt;
z=spptr-1; i=0;
while (i!=lexp)
{ i= (i==0) ? fnt : ntfpt[i]; expptr[i]=z;
z+=npt; start[i]=i-1;
}
printf("lexp=%d.\n",lexp);
start[lexp+1]=lexp; k=lexp;
for (i=lexp+1;i<=lnt;i++)
{ l=lorbg[i]; start[i+1]=start[i]+l-1;
if (l>1) for (j=1;j<=npt;j++) if (svgptr[i][j]>0)
{ k++; expptr[k]=z; z+=npt; exprep(j,k,svgptr[i]); }
}
/* nontriv nonzero means in this case that any p-element in G will do; i.e. we
are not looking for an element in the normalizer of the group found so far.
This is the case either when x=0, right at the beginning, or when x>0, and
we have already computed this normalizer.
*/
nontriv = (x>=0) ? 0 : 1;
*pno=0; deft[0]=0; stp=np2+1;
if (x!=0)
{ ip=fopen(inf2,"r");
fscanf(ip,"%hd%hd%hd%hd",&i,&nperms,&i,&i);
readbaselo(nb,gbase,lorbdef);
readpsv(stp,nb,nperms,svhptr);
for (i=1;i<=nperms;i++)
{ (*pno)++; pno[*pno]= ++np2; fscanf(ip,"%hd",facord+np2); np2++;}
fclose(ip);
k=abs(x); l=0;
for (i=1;i<=npt;i++) if (svhptr[k][i]!=0) orb[++l]=i;
}
else for (i=1;i<=nb;i++)
{ for (j=1;j<=npt;j++) {svhptr[i][j]=0; svhptr[i][gbase[i]]= -1; }
lorbdef[i]=1;
}
/* Starting search. lorbdef records the length of the orbit ofthe Sylp group
found so far. tp is a perm that we are currently considering as a
possible new element of Sylp. nontriv is set true as soon as the first
element of Sylp has been found. adno is then number in the stabilizer chain
for which the coset reps are currently being advanced in the search.
*/
stbno= (x==0) ? lnt : abs(x);
for (bno=stbno;bno>=fnt;bno=ntbpt[bno])
{ printf("bno=%d.\n",bno);
if (bno!=abs(x)) orb[1]=gbase[bno];
adno=bno;
while (lorbdef[bno]<lorbh[bno])
{ if (np2+2>=mxp)
{fprintf(stderr,"Out of space. Increase PSP.\n"); return(-1); }
*expcp=0; tp=pptr[np2+1]; itp=pptr[np2+2]; tp[npt+1]=bno;
/* When any p-element suffices, we seek random elements until one of them has
order a multiple of p. If after par1 elements, we have not found one, we try
commutators of the last element with new elements. If after par2 such
attempts we still have not found one, we try commutators with powers of the
last element. Then if after par3 tries we are still unsuccessful, we try a new
random element, and use commutators with that and so on...
*/
if (nontriv==0)
{ ct1=0; seek=1; comm=0;
while (seek)
{ (*expcp)=0; ranelt(); ord=findord(tp,itp);
if (ord%prime!=0)
{ ct1++;
if (comm)
{ id=1;
for (i=1;i<=npt;i++)
{ j=itpk[itp[tpk[tp[i]]]];
if (id && j!=i) id=0;
commp[i]=j; icommp[i]=0;
}
if (id)
{ ct2++;
if (ct2>par2) comm=0;
continue;
}
ct2=0;
ord=findord(commp,icommp);
if (ord%prime!=0)
{ ct3++;
if (ct3>par3)
{ if (pow) { comm=0; continue;}
printf("Trying powers.\n");
pow=1; ct3=0; ct2=0;
for (i=2;i<=kord;i++) if (kord%i==0)
{ if (kord==i) { comm=0; continue;}
k=kord/i;
for (i=1;i<=npt;i++)
{ pt=i; for (j=1;j<=k;j++) pt=tpk[pt]; itpk[pt]=i;}
invert(itpk,tpk);
}
}
}
else
{ for (i=1;i<=npt;i++) {tp[i]=commp[i]; itp[i]=icommp[i];}
seek=0;
}
} /* if (comm) */
else if (ct1>par1 && ord>1)
{ printf("Trying commutators.\n");
ct2=0; ct3=0; kord=ord; comm=1; pow=0;
for (i=1;i<=npt;i++) { tpk[i]=tp[i]; itpk[i]=itp[i];}
}
} /* if (ord%prime... */
else seek=0;
if (seek==0)
{ while (ord%prime==0) ord/=prime;
if (ord>1)
{ for (i=1;i<=npt;i++)
{ pt=i; for (j=1;j<=ord;j++) pt=tp[pt]; itp[pt]=i; }
invert(itp,tp);
}
if (svhptr[bno][tp[gbase[bno]]]!=0) { seek=1; comm=0; }
else { nontriv=1; fndelt();}
}
} /* while (seek) */
continue;
} /* if (nontriv==0) */
for (i=1;i<=npt;i++) tp[i]=i;
/* Now we compute all orbits of Sylp. The new element must
permute these orbits.
*/
allorbs(lporb,orno); bnoorno=orno[gbase[bno]]; bt=0;
opno=bnoorno; opct=1; skct=0;
for (i=1;i<= *lporb;i++) {orbp[i]=0; deft[i]=0; }
seek=1;
while (seek)
{ skct++; if (skct>par4)
{ printf("Exiting to try normrun.\n");
for (i=1;i<=npt;i++) if (svhptr[bno][i]== -2) svhptr[bno][i]=0;
goto exit;
}
for (i=1;i<=npt;i++) itp[i]=0;
b=1; ok=1;
while(1)
{ k=expcp[*expcp];
/* Advance to next element in search. ok is set false if this element is
eliminated from membership of Sylp, and we advance again.
*/
if (b && (*expcp==0 || k<=start[adno]))
{ (*expcp)++;
if (adno<=lexp) {adpt[adno]=0; expcp[*expcp]=adno;}
else expcp[*expcp]=start[adno];
b=0;
}
else
{ if (adno<=lexp)
{ sva=svgptr[adno]; ap=adpt+adno; (*ap)++;
while (sva[*ap]<=0 && *ap<=npt) (*ap)++;
if (*ap<=npt) { exprep(*ap,adno,sva); break; }
}
else if (k<start[adno+1]) {expcp[*expcp]++; break;}
if (*expcp==1)
{ fprintf(stderr,"Premature end of search.\n"); return(-1); }
(*expcp)--; bt=1; adno=ntbpt[adno]; b=1;
if (adno==bno)
{ im=expimage(gbase[adno]); l=orno[im];
if (lporb[l]>1) for (i=1;i<=npt;i++)
if (orno[i]==l) svhptr[adno][i]= -2;
/* Setting sv= -2 when bno=adno avoids testing more elements than necessary
which map the main orbit of gbase[bno] to another.
*/
}
}
}
incadno=1;
while (incadno)
{ cb=gbase[adno]; im=expimage(cb);
if (adno==bno && svhptr[adno][im]!=0) {ok=0;break;}
if (bt)
{ for (i=1;i<=*lporb;i++)
{ j=orbp[i]; if (deft[j]>=adno) {orbp[i]=0;deft[j]=0;}}
opno=bnoorno; opct=1; l=orbp[opno];
while (l!=0 && l!=bnoorno) { opct++; opno=l; l=orbp[l];}
}
bt=0; deforbp();
if (ok==0) break;
/* This means either that the element does not permute the orbits,
or that it permutes the base orbit with a cycle of p' length.
*/
else tp[cb]=im;
if (adno==lnt)
{ incadno=0;
for (cb=1;cb<=npt;cb++) if (invbase[cb]==0)
{ im=expimage(cb); deforbp();
if (ok==0) { bt=1; break; }
else tp[cb]=im;
}
}
else adno=ntfpt[adno];
}
if (ok)
{ ord=findord(tp,itp);
while (ord%prime==0) ord/=prime;
if (ord>1)
{ for (i=1;i<=npt;i++)
{ n=i; for (j=1;j<=ord;j++) n=tp[n]; itp[n]=i;}
invert(itp,tp);
}
}
/* if ok then tp is a p-element permuting the orbits. The final test is to
check that it normalizes Sylp.
*/
if (ok) for (i=stp;i<np2 && ok;i+=2)
{ *cp=0;
for (j=fnt;j<=lnt;j=ntfpt[j])
{ k=image(tp[pptr[i][itp[gbase[j]]]]);
if (svhptr[j][k]!=0) addsv(k,svhptr[j]);
else {ok=0; bt=1; break; }
}
if (ok==0 && ord>1)
for (j=bno;j<lnt;j=ntfpt[j]) tp[gbase[j]]=expimage(gbase[j]);
}
/* if ok then tp is the new element of Sylp */
if (ok) { seek=0; fndelt();}
}
}
for (i=1;i<=npt;i++) if (svhptr[bno][i]== -2) svhptr[bno][i]=0;
}
exit:
op=fopen(inf2,"w");
fprintf(op,"%4d%4d%4d%4d\n",npt,*pno,nb,4);
printbaselo(nb,gbase,lorbdef); printpsv(nb,pno,svhptr);
if (bno==0) fprintf(op,"%3d",prime);
for (i=stp;i<np2;i+=2) fprintf(op,"%4d",facord[i]); fprintf(op,"\n");
fclose(op);
if (x<=0 && bno>0)
{ op=fopen(outf1,"w");
*pno=0;
for (i=0;i<stp;i+=2) if (pptr[i][npt+1]>=bno)
{ (*pno)++; pno[*pno]=i;}
for (i=1;i<bno;i++) if (lorbg[i]>1)
{ lorbg[i]=1;
for (j=1;j<=npt;j++) svgptr[i][j]=0;
svgptr[i][gbase[i]]= -1;
}
fprintf(op,"%4d%4d%4d%4d\n",npt,*pno,nb,3);
printbaselo(nb,gbase,lorbg); printpsv(nb,pno,svgptr);
fclose(op);
}
return(bno);
}