#COMPL:=[];
TIMING:=rec();
SetInfoLevel(InfoAli,0);
DOTRICK27:=true;

# normalizer in constructing wreat product
Krnormalizer:=NewAttribute("Krnormalizer",IsPermGroup);
HasKrnormalizer:=Tester(Krnormalizer);
SetKrnormalizer:=Setter(Krnormalizer);

# normalizer in large wreat product
GrKrnormalizer:=NewAttribute("GrKrnormalizer",IsPermGroup);
HasGrKrnormalizer:=Tester(GrKrnormalizer);
SetGrKrnormalizer:=Setter(GrKrnormalizer);

UnorderedSignaturesAttr:=NewAttribute("UnorderedSignaturesAttr",IsPermGroup,
  "mutable");
HasUnorderedSignaturesAttr:=Tester(UnorderedSignaturesAttr);

ClassShapes:=NewAttribute("ClassShapes",IsPermGroup);
HasClassShapes:=Tester(ClassShapes);
SetClassShapes:=Setter(ClassShapes);

LengthSortFun := function(a,b)
  if Length(a)=Length(b) then
    return a<b;
  else
    return Length(a)<Length(b);
  fi;
end;


# This list contains all wreath products of symmetric groups. They are
# stored in the form [deg,nr,a,b] where TransitiveGroup(deg,nr)=S_a\wr S_b.

WR_POOL:=[[4,3,2,2],[6,11,2,3],[6,13,3,2],[8,44,2,4],
[8,47,4,2],[9,31,3,3],[10,39,2,5],[10,43,5,2],
[12,289,3,4],[12,293,2,6],[12,294,4,3],[12,299,6,2],
[14,57,2,7],[14,61,7,2],[15,93,3,5],[15,102,5,3],
[ 16, 1948, 2, 8 ], [ 16, 1947, 4, 4 ],
[ 16, 1952, 8, 2 ], [ 18, 968, 2, 9 ], [ 18, 962, 3, 6 ], [ 18, 977, 6, 3 ],
[ 18, 981, 9, 2 ], [ 20, 1110, 2, 10 ], [ 20, 1101, 4, 5 ], 
[ 20, 1111, 5, 4 ], [ 20, 1115, 10, 2 ], [ 21, 152, 3, 7 ], 
[ 21, 162, 7, 3 ], [ 22, 53, 2, 11 ], [ 22, 57, 11, 2 ], 
[ 24, 24979, 2, 12 ], [ 24, 24932, 3, 8 ], [ 24, 24944, 4, 6 ], 
[ 24, 24984, 6, 4 ], [ 24, 24994, 8, 3 ], [ 24, 24998, 12, 2 ], 
[ 25, 209, 5, 5 ], [ 26, 90, 2, 13 ], [ 26, 94, 13, 2 ], [ 27, 2380, 3, 9 ],
[ 27, 2390, 9, 3 ], [ 28, 1834, 2, 14 ], [ 28, 1798, 4, 7 ], 
[ 28, 1848, 7, 4 ], [ 28, 1852, 14, 2 ], [ 30, 5696, 2, 15 ], 
[ 30, 5666, 3, 10 ], [ 30, 5685, 5, 6 ], [ 30, 5695, 6, 5 ], 
[ 30, 5706, 10, 3 ], [ 30, 5710, 15, 2 ] ];


DifferenceMultiset:=function(a,b)
local i,p;
  a:=ShallowCopy(a);
  for i in b do
    p:=Position(a,i);
    if p<>false then
      Unbind(a[p]);
    fi;
  od;
  return Filtered(a,i->IsBound(i));
end;

GroupOrbitsMinimumEach := function(G,l)
local m,o,i,s,no,te;

  if IsRecord(l) then
    # special treatment: we may throw away the original list
    m:=l;
    l:=l.liste;
    Unbind(m.liste);
  fi;

  m:=[];
  while Length(l)>0 do
    s:=Size(l[1]);
    if Number(l{[2..Length(l)]},i->Size(i)=s)>0 then
      no:=Normalizer(G,l[1]);
      if Index(G,no)>500 then
	o:=GroupOnSubgroupsOrbit(G,l[1]); 
      else
        o:=List(RightTransversal(G,no),i->ConjugateGroup(l[1],i));
	#o:=[];
	#for te in RightTransversal(G,no) do
	#  Add(o,ConjugateSubgroup(l[1],te));
        #od;
      fi;
    else
      o:=[l[1]];
    fi;

    Add(m,Minimum(o));

    l:=Filtered(l{[2..Length(l)]},i->Size(i)<>s or not i in o);
  od;
  return m;
end;


############################################################################
##
#F  PermGroupOps.MinimizedGenerators(<G>) . . . same subgroup with less gens.
##  (the generating set is not reducible, if Random Schreier Sims did not
##  fail)
##
PermMinGens := function(G)
local i,bU,U,gens;
  return Group(SmallGeneratingSet(G),());

  bU:=G;
  gens:=GeneratorsOfGroup(G);
  i:=1;
  while i<Length(gens) do
    U:=Subgroup(Parent(G),gens{Difference([1..Length(gens)],[i])});
    StabChain(U,rec(random:=10,limit:=Size(G)));
    if Size(U)<Size(G) then
      i:=i+1;
    else
      bU:=U;
      gens:=GeneratorsOfGroup(U);
    fi;
  od;
#  if IsParent(G) then
#    bU:=Group(bU);
#    StabChain(bU,rec(size:=Size(G)));
#  fi;
  Info(InfoAli,4,"MinGens: ",Length(GeneratorsOfGroup(G))," to ",
        Length(GeneratorsOfGroup(bU)));
  return bU;
end;


AsMorphism:=function(a,b)
  return Image(b,a);
end;


# compare: Group with Group/mingens
# returns: -1: G larger, 0 equal, 1 gl larger

ComparePermGroups := function ( G , gl)
local fun;

  fun:=function(S)
    local   gens,       # smallest generating system of <S>, result
            gen,        # one generator in <gens>
            orb,        # basic orbit of <S>
	    orbs,norb,i,j,img,	# orbit algo
            pnt,        # one point in <orb>
            T;          # stabilizer in <S>

    # handle the anchor case
    if Length(S.generators) = 0  then
      return [];
    fi;

    # now get the smallest generating system of the stabilizer
    #gens := PermGroupOps.SmallestGeneratorsStab( S.stabilizer );
    gens := fun( S.stabilizer );

    # Work around the missing GOTO

    if IsInt(gens) then
      return gens;
    fi;
  
    pnt:=[1..Minimum(Length(gens),Length(gl))];
    if gl{pnt}<>gens then
      # then we have a difference
      gl:=gl{pnt};
      if gl<gens then
        return -1;
      else
        return 1;
      fi;
    fi;

    # get the sorted orbit (the basepoint will be the first point)
    orb := Set( S.orbit );
    SubtractSet( orb, [S.orbit[1]] );

    # handle the other points in the orbit
    while Length(orb) <> 0  do

      # take the smallest point (coset) and one representative
      pnt := orb[1];
      gen := S.identity;
      while S.orbit[1] ^ gen <> pnt  do
	 gen := LeftQuotient( S.transversal[ pnt / gen ], gen );
      od;

      # the next generator is the smallest element in this coset
      T := S.stabilizer;
      while Length(T.generators) <> 0  do
	pnt := Minimum( OnTuples( T.orbit, gen ) );
	while T.orbit[1] ^ gen <> pnt  do
	  gen := LeftQuotient( T.transversal[ pnt / gen ], gen );
	od;
	T := T.stabilizer;
      od;

      # add this generator to the generators list and reduce orbit
      Add( gens, gen );

      #SubtractSet( orb, Orbit( Group( gens, () ), S.orbit[1] ) );
      norb:=[S.orbit[1]];
      orbs:=Set(norb);
      for i in norb do
        for j in gens do
	  img:=i^j;
	  if not img in orbs then
	    Add(norb,img);
	    AddSet(orbs,img);
	    RemoveSet(orb,img);
	  fi;
	od;
      od;


    od;

    # return the smallest generating system
    return gens;
  end;

  if IsList(gl) then
    gl:=ShallowCopy(gl);
  else
    gl:=GeneratorsSmallest(gl);
  fi;

  G:=fun(MinimalStabChain(G));

  if IsInt(G) then
    return G;
  fi;

  if gl<G then
    return -1;
  elif gl>G then
    return 1;
  else
    return 0;
  fi;

end;

# this function is just to avoid an overflow of symmetric groups

SYMGRPS:=[];
MySymmetricGroup:=function(n)
  if not IsBound(SYMGRPS[n]) then
    SYMGRPS[n]:=SymmetricGroup(n);
  fi;
  return SYMGRPS[n];
end;

AdaptCanonizingSystem:=function(sys,u)
  if IsList(u) then
    u:=Group(u,());
  fi;
  if (not ForAll(GeneratorsOfGroup(u),i->i in sys.s)) or
     Length(Orbit(u,1))>sys.a then
    Error("not applicable to system");
  else
    sys.sg:=u;
    sys.kr:=AsSubgroup(sys.parent,WreathProduct(u,sys.t));
    sys.first:=u;
    sys.directs:=List(sys.emb,i->Image(i,u));
    sys.adapted:=true;
  fi;
end;

CanonizingSystem:=function(arg)
local a,b,s,t,wp,p,d,wrg,map,emb,parts,projs,i,blocks,epis,tmp;
  a:=arg[1];
  b:=arg[2];
  s:=MySymmetricGroup(a);
  t:=MySymmetricGroup(b);
  wp:=WreathProduct(s,t);
  p:=MySymmetricGroup(a*b);
  d:=DirectProduct(List([1..b],i->s));
#  emb:=List(d.perms,i->GroupHomomorphismByImagesNC(s,p,GeneratorsOfGroup(s),
#	      List(GeneratorsOfGroup(s),j->j^i)));
  emb:=List([1..b],i->Embedding(d,i));

  blocks:=Orbits(d,MovedPoints(d));
  d:=AsSubgroup(p,d);
  wrg:=Subgroup(p,Filtered(GeneratorsOfGroup(wp),i->not i in d));
  map:=GroupHomomorphismByImagesNC(t,wrg,GeneratorsOfGroup(t),
                                         GeneratorsOfGroup(wrg));

  # projections on [1..i]-th block
  parts:=[];
  projs:=[];
  for i in [1..b] do
    projs[i]:=ActionHomomorphism(d,Concatenation(blocks{[1..i]}));
    parts[i]:=Concatenation(blocks{[i+1..b]});
  od;

  epis:=List(blocks,i->GroupHomomorphismByImagesNC(d,p,GeneratorsOfGroup(d),
          List(GeneratorsOfGroup(d),j->RestrictedPerm(j,i))));
  wp:=AsSubgroup(p,wp);

  s:= rec(
	   isCanonizingSystem:=true,
	   parent:=p,
	   a:=a,
	   b:=b,
	   s:=s,
	   t:=t,
	   sg:=s,
	   opdomain:=[1..a*b],
	   first:=s,
	   second:=t,
	   kr:=wp, # the full wreath product
	   # the symmetric permutation component
	   wrg:=wrg,
	   wrmap:=map,
	   emb:=emb,
	   directs:=List(emb,i->Image(i,s)),
	   parts:=parts,
	   anfaenge:=List(parts,i->Difference([1..a*b],i)),
	   blocks:=blocks,
	   blockhom:=ActionHomomorphism(wp,blocks,OnSets),
	   projs:=projs,
	   epis:=epis
         );
  if Length(arg)>2 and not IsBool(arg[3]) then
    AdaptCanonizingSystem(s,arg[3]);
  fi;
  if Length(arg)>2 and IsBool(arg[Length(arg)]) then
    s.transflag:=arg[Length(arg)];
  fi;
  return s;
end;

InstallMethod(UnorderedSignaturesAttr,"initialize",true,[IsPermGroup],0,G->[]);

UnorderedSignatures:=function(sys,grp)
local a,n,m,mm,i;
  a:=UnorderedSignaturesAttr(grp);
  for i in a do
    if i[1]=sys.a and i[2]=sys.b then
      return i[3];
    fi;
  od;
  #n:=Number(Orbits(grp,[1..sys.a*sys.b]),i->Length(i)>1);
  n:=Number(sys.blocks,
	    i->ForAny(i,j->ForAny(GeneratorsOfGroup(grp),k->j^k<>j)));
  m:=List([1..n],i->Stabilizer(grp,sys.blocks[i],OnTuples));
  mm:=List([1..n],i->List([1..n],
	    j->Size(Image(sys.epis[j],m[i]))));
  Add(a,[sys.a,sys.b,mm]);
  return mm;
end;

Signatures:=function(sys,grp)
local l,m,mm,i;
  m:=ShallowCopy(UnorderedSignatures(sys,grp));
  l:=[1..Length(m)];
  for i in l do 
    mm:=m[i];
    mm:=mm{Difference(l,[i])};
    Sort(mm);
    m[i]:=mm;
  od;
  return m;
end;

TransKgVLength:=function(sys,g)
local s,d,i;
  s:=Signatures(sys,g);
  d:=1;
  for i in Set(Flat(s)) do
    d:=d+Maximum(List(s,j->Number(j,k->k=i)));
  od;
  return d;
end;

# find parttition of blocks from signature (used to get smaller normalizer
# supergroup)
PartitionsSignatures:=function(m)
local l,z,b,i,j,s,part,c,dom,oth,ac;
  l:=Length(m);
  z:=Set(Flat(m)); #the possible entries
  b:=[];
  for i in z do
    s:=[1..l];
    part:=[];
    dom:=[1..l];
    while Length(s)>0 do
      # grow blocks
       c:=s{[1]};
       repeat
	 ac:=c; # old block (to check growth)
	 oth:=Difference(dom,c); # points to consider
	 for j in [1..l] do
	   # in any row another point?
	   c:=Union(c,Filtered(oth,k->ForAny(c,n->m[j][k]=i and m[j][n]=i)));
	 od;
       until c=ac;
       dom:=Difference(dom,c);
       AddSet(part,c);
       s:=Difference(s,c);
    od;
    if Length(part)>1 and Length(part)<l then
      AddSet(b,part);
    fi;
  od;
  return b;
end;

#Extend:=function(mm,sign)
Extend:=function(arg)
local mm,sign,z,p,m,l,d,i,s,r,j,k,freedom,f,b,Setze,Close;

  Setze:=function(i,j,pos)
    m[i][j]:=z[pos];
    m[j][i]:=z[pos];
    r[i]:=r[i]/p[pos];
    r[j]:=r[j]/p[pos];
  end;

  Close:=function()
  local i,j,f,flag;
    repeat
      flag:=true;
      for i in [1..d] do
	if IsInt(r[i]) then
	  f:=FactorsInt(r[i]);
	  if r[i]>1 and Length(Set(f))=1 then
	    f:=Position(p,f[1]);
	    flag:=false;
	    # we know how to fill
	    for j in [1..d] do 
	      if m[j][i]=0  then
		Setze(i,j,f);
	      fi;
	    od;
	  fi;
	fi;
      od;
    until flag;
  end;

  mm:=arg[1];
  sign:=arg[2];
#Print(mm,"\n",sign,"\n");

  # translate into numbers that we can use mult. and div.
  z:=Set(List(sign,i->i[1]));
  p:=Primes{[1..Length(z)]};
  Add(z,0);
  Add(p,1);

  d:=Sum(sign,i->i[2]);
  sign:=Product(sign,i->p[Position(z,i[1])]^i[2]);

  m:=ShallowCopy(mm);
  l:=Length(m);
  for i in [1..l] do
    m[i]:=Concatenation(m[i],ListWithIdenticalEntries(d-l,0));
  od;
  for i in [l+1..d] do
    Add(m,ListWithIdenticalEntries(d,0));
    m[i][i]:=1;
  od;

  # the remainders
  r:=List(m,i->sign/Product(i,j->p[Position(z,j)]));

  # if we force further entries
  if Length(arg)>2 then
    for i in arg[3] do
      Setze(i[1],i[2],Position(z,i[3])); 
    od;
  fi;

#Print(m,"\n");
  # initial closure step
  Close();
  if not ForAll(r,IsInt) then
    return false;
  fi;

  # fix numbers as long as this serves to select the additional rows/columns
  freedom:=l+1;
  
  while freedom<d do #freedom=d case is always a consequence
    repeat
    # search for the column which has the most diversity of entries while
    # selecting the 'freedom'est index
      b:=0;
      k:=d;
      for i in [1..l] do
	# try to find a column which gives a rarely occuring value (thus giving
	# lots of consequences)
	f:=Minimum(List(Collected(List(Factors(r[i]))),i->i[2]));
	# we want an entry, which sets this freedom level. However all enries
	# above must have been set already, because otherwise we could not set
	# it
	if m[i][freedom]=0 and ForAll([1..freedom-1],j->m[i][j]<>0)
	   and f<k then
	  k:=f;
	  b:=i;
	fi;
      od;
      if b=0 then
	# at 'freedom' we could not find anything, increase
	freedom:=freedom+1;
      fi;
    until b<>0 or freedom>d;

    if freedom<d then
      #Print("fixing ",b,",",freedom,"\n");
      # now set in column b the rarest entry, thus fixing a row number
      Setze(b,freedom,Position(p,Collected(Factors(r[b]))[1][1]));
      freedom:=freedom+1;
      # and take consequences
      Close();
      if ForAny(r,i->not IsInt(i)) then
#Print(m,"\n");
        return false;
      fi;
    fi;

  od;

  # here we might run through a backtrack, but that's hard

  if ForAll(r,i->i=1) then
    # the matrix is complete. Now test for the block property
    ;
  fi;

#Print(m,"\n");
  return m;
end;

#PossibleExtensionSignatures:=function(sys,g,pool,lev)
PossibleExtensionSignatures:=function(arg)
local m,z,k,i,j,l,s,e,ergs,sys,g,pool,lev,dran;
  sys:=arg[1];
  g:=arg[2];
  pool:=arg[3];
  lev:=arg[4];

  if Length(arg)>4 then
    dran:=arg[5];
  else
    dran:=false;
  fi;

  ergs:=[];
  m:=UnorderedSignatures(sys,g);
  # compute the kgV
  z:=Set(Flat(m));
  z:=Union(z,pool);

  k:=ListWithIdenticalEntries(Length(z),0);
  for i in m do
    for j in [1..Length(k)] do
      k[j]:=Maximum(k[j],Number(i,l->l=z[j]));
    od;
  od;

  # test for parity (still do block test ?)
  if lev<0 and Sum(k)=Length(m) then
    return -Length(m);
  fi;
 
  if 0<lev and lev<=Length(m[1]) then
    Error("no extension needed");
  fi;

  #lev:=lev-Length(m[1]); # the added levels
  lev:=lev-Sum(k); # note minimal number of levels to add
  if dran=false then
    i:=0; # the minimum degree extension
  else
    i:=lev;
  fi;
  # search for the first occurence of a transitivable descendant
  repeat
    l:=List(Concatenation(List([1..Length(z)+i-1],
         i->OrderedPartitions(i,Length(z)-1))),i->ShallowCopy(i-1));
    #Print("trying ",i," ",l,"\n");
    for j in l do
      Add(j,i-Sum(j));
      s:=k+j;
      s:=List([1..Length(z)],i->[z[i],s[i]]);
      if dran=false then
	e:=Extend(m,s);
      else
        e:=Extend(m,s,dran);
      fi;
      if e<>false then
	if lev<0 then
	  s:=Sum(s,i->i[2]);
	  g!.ntkgvlev:=s;
	  return s;
        else
	  Add(ergs,Concatenation(List(s,i->
	      List([1..i[2]],j->i[1]))));
	fi;
      fi;
    od;

    i:=i+1;
    if lev>=0 and i>lev then
      return ergs;
    fi;
  until false;
end;

NewTransKgVLength:=function(sys,g,pool,reachlev)
local n,i,l;
  if IsBound(sys.globalsys) then
    l:=NewTransKgVLength(sys.globalsys,
      Subgroup(sys.parent,GeneratorsOfGroup(g)),# don't use stored sigs
      pool,
      reachlev*2);
    l:=QuoInt(l+1,sys.localsys.b);
  else
    l:=0;
  fi;
  n:=PossibleExtensionSignatures(sys,g,pool,-1);
  if n=-reachlev then
    n:=reachlev;
  fi;
  if n<=0 then
    for i in [-n+1..reachlev] do
      n:=PossibleExtensionSignatures(sys,g,pool,i);
      n:=Filtered(n,j->Length(j)=i);
      if Length(n)>0 then
        g!.ntkgvlev:=Maximum(l,i);
	return g!.ntkgvlev;
      fi;
    od;
    g!.ntkgvlev:=reachlev+1;
    return reachlev+1;
  else
    g!.ntkgvlev:=Maximum(l,n);
    return g!.ntkgvlev;
  fi;
end;

HasConjugateKernels:=function(sys,grp)
local n,m,cl,p;

  if sys.a*sys.b>23 then return true;fi;

  #n:=Number(Orbits(grp,[1..sys.a*sys.b]),i->Length(i)>1);
  n:=Number(sys.blocks,i->ForAny(i,j->ForAny(GeneratorsOfGroup(grp),k->j^k<>j)));
  p:=Stabilizer(sys.kr,sys.parts[n],OnTuples);
  m:=List([1..n],i->Stabilizer(grp,sys.blocks[i],OnTuples));
  if Length(Set(List(m,Size)))=1 then
    if IsAbelian(m[1]) then
      cl:=List(m,i->Collected(List(AsList(i),CycleStructurePerm)));
    else
      if ForAll([2..n],i->RepresentativeAction(p,m[1],m[i])<>false) then
        cl:=[1];
      else
        cl:=[1,2];
      fi;

#      cl:=List(m,i->Collected(List(ConjugacyClasses(i),
#                       j->[Size(j),CycleStructurePerm(j.representative)])));

   fi;
   if Length(Set(cl))=1 then
      return true;
    fi;
  fi;
  return false;
end;

DiagonalGroup:=function(sys,g,nr)
local i,j,a,gens;
  gens:=[];
  for i in GeneratorsOfGroup(g) do
    a:=();
    for j in [1..nr] do
      a:=a*Image(sys.emb[j],i);
    od;
    Add(gens,a);
  od;
  return Subgroup(sys.parent,gens);
end;

IsMinGrp:=function(gens,grp)
local i,gns;
  gns:=GeneratorsSmallest(grp);
  for i in gens do
    #if ComparePermGroups(Group(i,()),grp) and not
    if ComparePermGroups(Group(i,()),gns)=1 and not
      (ForAll(i,j->j in grp) and Size(Group(i,()))=Size(grp) ) then
      return false;
    fi;
  od;
  return true;
end;

MinGrpInd:=function(gp,conj)
local min,ming,i,lg,comp;
  min:=1;
  ming:=gp;
  for i in [2..Length(conj)] do
    lg:=gp^conj[i];
    comp:=ComparePermGroups(lg,GeneratorsSmallest(ming));
    if comp>0 then
      min:=i;
      ming:=lg;
    fi;
  od;
  return [min,ming];
end;
    
Canonize:=function(repres,sys,wrg,lev,sdps,typ)
local cand,ncand,   # candidates in orbit
      repsz,	    # size of representative
      g,            # projection on first block
      step,
      prevnor,
      ker,U,k,    # kernels and kernel normalizers
      X,Y,anfst,M,no,
      Mno,kno,cno,rt,
      mel,	    # elts of M.
      conj,         # normalizer transversals
      lp,fg,fhom,fmin,
      i,p,
      short,        # can we drop normalizing in first component?
      s,s2,         # component stabilizers
      t,            # transversal
      cnd,gim,      # loop variables
      conjg,        # conjugation group in component
      o,min;     # minimization of component

  # in each step suppose, the initial part is already standardized
  # we will not actually compute with these groups. So
  # generators are sufficient
  repsz:=Size(repres);
  Info(InfoAli,2,"testing level ",lev,", size ",repsz);

  #if lev=sys.b and HasKrnormalizer(repres) and
   #Length(Orbits(repres.krnormalizer,sys.opdomain))>1 then
    #Error("this can't happen");
  #fi;

  # special case: diagonal
  g:=Image(sys.projs[1],repres);
  if IsBound(sys.noouts) and sys.noouts and Size(g)=Size(repres) then
    g:=DiagonalGroup(sys,g,lev); 
    if typ=1 then
      return g=repres;
    else
      return g;
    fi;
  fi;

  if not HasKrnormalizer(repres) then
#if not IsSubgroup(Normalizer(sys.kr,repres),repres) then
#  Error("a");
#fi;
    SetKrnormalizer(repres,Normalizer(sys.kr,repres));
  fi;

  # test for normalizer in first component
  if IsTransitive(Krnormalizer(repres),[1..sys.a*lev])
     and Size(sys.sg)=Size(Group(List(
       GeneratorsOfGroup(Stabilizer(
                            Krnormalizer(repres),sys.anfaenge[1],OnSets)),
       i->RestrictedPerm(i,sys.anfaenge[1])),()))
   then
    short:=true;
  else
    short:=false;
  fi;

  repres!.poolpos:=0;
  cand:=[repres];

  s:=wrg; # the wreath operation that permutes up to <lev>.
  # s is the subgroup, that fixes the first [step-1] components
  # pointwise
  for step in [1..lev] do
    # now canonize up to step-th component
    conjg:=sys.directs[step];
    # stabilizer of the first step components pointwise
    s2:=Stabilizer(s,[1..step*sys.a-1],OnTuples);
    # take all possible step-th comp.
    t:=List(RightTransversalOp(s,s2),i->i^-1);

    # remove all stabchains &c.
    ncand:=[];
    for cnd in cand do
      Assert(1,Size(cnd)=repsz);
      p:=cnd!.poolpos;
      U:=Subgroup(sys.parent,GeneratorsOfGroup(cnd));
      SetSize(U,repsz);
      U!.poolpos:=p;
      Add(ncand,U);
    od;
    cand:=ncand;
    ncand:=[];

    for cnd in cand do
      
      if step=1 then
	prevnor:=TrivialSubgroup(cnd);
      else
        prevnor:=Krnormalizer(sdps[step-1][cnd!.poolpos]);
      fi;

      o:=List(t,i->OnTuples(GeneratorsOfGroup(cnd),i));
      for gim in o do

	# test for suitability: K2 for step-projection
	# assign step-projection to anfst

	if step<lev then
	  anfst:=SubgroupNC(sys.parent,List(gim,i->Image(sys.projs[step],i)));
	else
	  anfst:=SubgroupNC(sys.parent,gim);
	fi;

	# X is kernel in step-1 proj
	if step>1 then
	  X:=Stabilizer(anfst,sys.parts[step-1],OnTuples);
	  k:=MinimumGroupOnSubgroupsOrbit(prevnor,X);
	else
	  # fake in case 1 (then it holds always)
	  X:=1;
	  k:=X;
	fi;

	if k=X then

	  # force K3 for step-projection
	  # Y is the kernel in the step-part
	  if step=1 then
	    Y:=anfst;
	  else
	    Y:=Stabilizer(anfst,sys.anfaenge[step-1],OnTuples);
	  fi;

	  U:=Normalizer(conjg,Y);
	  conj:=RightTransversalOp(conjg,U);

	  min:=MinGrpInd(Y,conj);
	  # conjugate s.t. the kernel is minimal
	  conj:=conj[min[1]];
	  U:=ConjugateGroup(U,conj);
	  anfst:=ConjugateGroup(anfst,conj);
	  M:=OnTuples(gim,conj);
	  
	  # force K1
	  no:=Normalizer(U,anfst);
	  conj:=RightTransversalOp(U,no);

	  # special treatment for diagonal case
	  if step>1 and IsBound(sys.noouts) and sys.noouts
	      and Size(g)=Size(anfst) then
	    p:=DiagonalGroup(sys,g,step); 
	    min:=First([1..Length(conj)],i->ConjugateGroup(anfst,conj[i])=p);
	    min:=[min,p];
	  else
	    min:=MinGrpInd(anfst,conj);
          fi;

	  if step<lev then
	    p:=Position(sdps[step],min[2]);
	  else
	    # Condition K1 becomes trivial here
	    p:=0;
	  fi;

	  if p<>fail then

	    conj:=conj[min[1]];
	    anfst:=min[2]; # the projection

	    U:=ConjugateGroup(no,conj); #L'

	    M:=OnTuples(M,conj);
	    # now K1-K3 are fulfilled, the groups all deduce from op.

	    # check, whether we already got this group:
	    # if one conjugate is in the orbit, all are. Thus test already now
	    M:=Subgroup(sys.parent,M);
	    SetSize(M,repsz);
	    mel:=M;
	    # if the group is not too big, but there are many candidates,
	    # its worth to get the element list to remove duplicates.
	    if repsz<2000 and Length(ncand)>500 then
	      mel:=AsSortedList(M);
	    fi;
	    if not ForAny(ncand,i->ForAll(GeneratorsOfGroup(i),j->j in mel)) then

	      if step=1 and short then
		# all further conjugacy will be normalizer induced.
		conj:=[()];
		Info(InfoAli,3,"shortening normalizer induced");

	      elif IsNormal(U,M) then
		# normal, i.e. no conjugates exist
		conj:=[()];

	      else
		conj:=[];
		# avoid the elements, that only induce inner automorphisms
		# of the resp. factor group
		# Determine Q

		ker:=Image(sys.projs[step],
		           Stabilizer(M,sys.anfaenge[step],OnTuples));

                kno:=Normalizer(U,ker);
                Mno:=Normalizer(U,M);
                for rt in RightTransversalOp(U,kno) do
                  # we conjugate with rt
                  k:=ConjugateGroup(ker,rt);
                  cno:=ConjugateGroup(kno,rt);

		  # look at the factor group anfst/kern
		  lp:=ClosureGroup(anfst,cno);
		  if Size(k)>1 then
		    fhom:=NaturalHomomorphismByNormalSubgroup(lp,k);
		    fg:=Image(fhom);
		  else
		    fg:=lp;
		    fhom:=IdentityMapping(lp);
                  fi;

		  # those elements, that induce inner homs
		  fmin:=PreImage(fhom,Centralizer(fg,Image(fhom,anfst)));
		  fmin:=ClosureGroup(fmin,anfst);
		  fmin:=Intersection(cno,fmin);

                  fmin:=ClosureGroup(fmin,ConjugateGroup(Mno,rt));

#Print("|fg|=",Size(fg)," ind:",Index(cno,fmin),"\n");
	
		  conj:=Concatenation(conj,List(
		    RightTransversalOp(cno,fmin),i->rt*i));

                od;
	      fi;
	      for i in conj do
		k:=Size(M);
		U:=Subgroup(sys.parent,List(GeneratorsOfGroup(M),j->j^i));
		SetSize(U,k);
		U!.poolpos:=p;
		Add(ncand,U);
	      od;
	    fi;
	    Unbind(mel);
	  fi;
	fi;

      od;
    od;

    Info(InfoAli,3,Length(cand),"->",Length(ncand));

    Assert(1,not (typ=1 and not repres in ncand)); 

    cand:=ncand; #"andere auf Set?
    #disabled duplicate removal -- too expensive
    #cand:=[];
    #for i in ncand do
    #  if not ForAny(cand,j->ForAll(GeneratorsOfGroup(j),k->k in i)) then
    #    Add(cand,i);
    #  fi;
    #od;

    if step=lev and typ=1 then
      # now take only those ncand, whose sdps[lev-1] projection is standard
      # (in the last two steps, these are already all)
      # we need those only for the quick discarder in typ=1
      if step<lev-1 then
	cand:=Filtered(cand,i->Group(List(GeneratorsOfGroup(i),
	  j->Image(sys.projs[lev-1],j)),()) in sdps[lev-1]);
      fi;

#      ncand:=Filtered(ncand,i->ComparePermGroups(i,repres)=1);
#      if Length(ncand)>0 then
#	# now we have to check for these groups, whether they fulfill the
#	# *remaining* local normalizer conditions
#	conj:=false;
#        if step<lev then
#	  for k in ncand do
#	    p:=Position(sdps[lev-1],Image(sys.projs[lev-1],k));
#	    ker:=Stabilizer(k,sys.parts[lev-1],OnTuples);
#            if MinimumGroupOnSubgroupsOrbit(sys.projs[lev-1].krnormalizer,ker)=ker
#	      and MinimumGroupOnSubgroupsOrbit() then
#	      conj:=true;
#            fi;
#	  od;
#	else
#	  conj:=true;
#	fi;
#
#	if conj then
#	  if step<lev then
#	    Info(InfoAli,2,"shortened");
#	  fi;

      if ForAny(ncand,i->ComparePermGroups(i,repres)=1) then
	return false;
#        fi;
      fi;
    fi;

    s:=s2;
  od;
  # in the last step, we have already checked minimality
  if typ=1 then
    return true;
  else
    #return MinGrpInd(sys.parent,cand,false)[2][1];   
    return Minimum(cand);
  fi;
end;

# compute classes of G, using Image under hom
ClassesByImage:=function(G,hom)
local a,c,cl,i;
  if not IsBound(G.conjugacyClasses) then
    a:=Image(hom,G);
    cl:=[];
    for i in ConjugacyClasses(a) do
      c:=ConjugacyClass(G,PreImage(hom,Representative(i)));
      c.size:=Size(i);
      if IsBound(i.centralizer) then
	c.centralizer:=PreImage(hom,i.centralizer);
      fi;
      Add(cl,c);
    od;
    G.conjugacyClasses:=cl;
  fi;
  return G.conjugacyClasses;
end;

InstallMethod(ClassShapes,"perm grp",true,[IsPermGroup],0,
function(G)
  return Collected(List(AttributeValueNotSet(ConjugacyClasses,G),
		    i->[Size(i),CycleStructurePerm(Representative(i))]));
end);

IDGRPSIZES:=Difference([1..1000],[256,512,768]);
MightBeConjugatePermGrps:=function(G,H)
  if Size(G)<>Size(H) then
    return false;
  fi;
  if Size(G) in IDGRPSIZES and IdGroup(G)<>IdGroup(H) then
      return false;
  fi;
  if Size(G)<5000 and Size(DerivedSubgroup(G)) in IDGRPSIZES and
    (Size(DerivedSubgroup(H))<>Size(DerivedSubgroup(G)) or
	    IdGroup(DerivedSubgroup(G))<>
	    IdGroup(DerivedSubgroup(H))) then
    return false;
  fi;
  if IsAbelian(G) then # and Size(G)<100 then
   if not IsAbelian(H) then
     return false;
   else
     return AbelianInvariants(G)=AbelianInvariants(H);
   fi;
  elif Size(G)<=100000 then
    return ClassShapes(G)=ClassShapes(H);
  else
    return true;
  fi;
end;

# Bahnen von g auf aus dom aufgebauten Partitionen von L"ange lev
RepresentativesOrbitsPartitions:=function(g,dom,lev)
local o,oo,i,l;
  if Length(dom)=1 then
    return [dom];
  fi;
  o:=List(Orbits(g,dom,OnSets),Set);
  l:=[];
  for i in [1..Length(o)] do
    oo:=o[i][1];
    l:=Concatenation(l,Filtered(
      List(RepresentativesOrbitsPartitions(Stabilizer(g,oo,OnSets),
    Filtered(Concatenation(o[i]{[2..Length(o[i])]},
				Concatenation(o{[i+1..Length(o)]})),
		  j->not ForAny(j,k->k in oo)),lev-1),
	j->Concatenation([oo],j)),j->Length(j)=lev and
	j=Set(Orbit(g,j,OnSetsSets))[1]));
  od;
  return l;
end;

ValidNestings:=function(sys,n,u)
local lsys,z,op,o,dom,dtyp,i,j,typ,r,rt,bs;

  for bs in sys.blszes do
    lsys:=sys.blocksys[bs];
    z:=lsys.localsys.b;
    op:=Action(n,sys.blocks,OnSets);
    o:=Orbits(op,Combinations([1..sys.b],z),OnSets);
    dom:=[];
    dtyp:=[];
    for i in o do
      typ:=lsys.idfunc(Action(u,Concatenation(sys.blocks{i[1]})));
      dom:=Concatenation(dom,i);
      for j in [1..Length(i)] do
	Add(dtyp,typ);
      od;
    od;

    # partitions orbits
    r:=RepresentativesOrbitsPartitions(op,dom,sys.b/z);

    # get nestings
    r:=Filtered(r,i->Length(Set(List(i,j->dtyp[Position(dom,j)])))=1);
    if Length(r)>0 then
      rt:=List(r,i->dtyp[Position(dom,i[1])]);
      z:=Minimum(rt);
      return [z,r{Filtered([1..Length(r)],i->rt[i]=z)}];
    fi;
  od;

  return false;
end;

PreCanonizingPerm:=function(grp,blocks,sys,globalsys)
local z,x,y,op,bs,s,cop,i;

  if globalsys<>false then
    # bring the block system itself in the 'nice' form
    # we use gsys.kr as we want to keep the structure
    z:=RepresentativeAction(globalsys.kr,Concatenation(blocks),
			       Concatenation(sys.blocks),OnTuples);
  else
    z:=MappingPermListList(Concatenation(blocks),Concatenation(sys.blocks));
  fi;

  grp:=ConjugateGroup(grp,z);
  op:=Action(grp,sys.blocks[1]);
  bs:=Length(sys.blocks[1]);
  s:=MySymmetricGroup(bs);

  if not IsBound(sys.localsys) then
    cop:=TransitiveGroup(bs,TransitiveIdentification(op));
  else
    cop:=sys.localprod[sys.localsys.b][sys.idfunc(op)];
  fi;

  # canonize in the orbits
  for i in sys.blocks do
    op:=Action(grp,i);
    y:=RepresentativeAction(s,op,cop);
    x:=MappingPermListList(sys.blocks[1],i);
    z:=z*y^x;
  od;
  return z;
end;

MinimalBlockAction:=function(sys,ker,allsdps,typ)
local asys,bsys,n,nest,i,l,z,u;

  if IsBound(sys.blocksys) then
    asys:=sys;
    bsys:=false;
  else
    asys:=sys.globalsys;
    bsys:=sys;
  fi;
  if HasGrKrnormalizer(ker) then
    # the normalizer is (even if sys is corresponding to blocks of M)
    # subgroup of globalsys.kr
    n:=GrKrnormalizer(ker);
  else
    n:=Normalizer(asys.kr,ker);
#if not IsSubgroup(n,ker) then
#  Error("C");
#fi;
    SetGrKrnormalizer(ker,n);
  fi;

  nest:=ValidNestings(asys,n,ker); # erf"ullen S1-S3

  if nest=false then
    Error("keine Verschachtelung!");
  fi;

  Info(InfoAli,3,"Nestings: ",nest);

  if bsys=false then
    bsys:=asys.blocksys[Length(nest[2][1][1])];
  fi;

  if typ=1 and Length(nest[2][1])<bsys.b then
    # kleinere Verschachtelung 
    return false;
  fi;
  
  # now get the different canonical forms
  l:=[];
  for i in nest[2] do
    if not IsRange(Concatenation(i)) then
      z:=PreCanonizingPerm(ker,List(i,j->Concatenation(asys.blocks{j})),
			   bsys,asys); 
      u:=ker^z;
      u:=Canonize(u,bsys,bsys.wrg,bsys.b,allsdps[nest[1]],2);
      Add(l,u);
    else
      # the created one is canonical
      Add(l,ker);
    fi;

  od;

  l:=Minimum(l);

  if typ=1 then
    return ker=l;
  else
    return l;
  fi;

end;

ConstructSubdirectProducts:=function(sys,gruppe)
local anz,g,d,no,s,o,
      au,aut,out,fsg,w,stale,dag,counter,
      n,nt,nrnt,f,fa,fid,faid,fh,fhom,grp,grp1,ghom,
      wrg,conjg,i,j,k,l,sel,nind,ntsiz,hom,gens,prds,sdps,lev,
      prae,tst,part,npart,normpart,action,maxes,eastep,eai,nopa,
      primdst,transflag,istrans,possntind,nspgflag,isopc;

  istrans:=IsTransitive(gruppe,MovedPoints(gruppe));
  nspgflag:=IsPrimitive(gruppe,MovedPoints(gruppe)) and
              not IsSolvableGroup(gruppe);
  anz:=sys.b;

  Unbind(sys.noouts); # we do not yet know about non perm automorphisms

  # test for transitivity indicator
  if IsBound(sys.transflag) then
    transflag:=sys.transflag;
  else
    transflag:=false;
  fi;

  # get permutation automorphisms
  s:=sys.s;
  g:=AsSubgroup(s,gruppe);
  no:=Normalizer(s,g);
  AdaptCanonizingSystem(sys,no);
  d:=AsSubgroup(sys.parent,DirectProduct(List([1..anz],i->g)));

  # all sdps of length 1
  sdps:=AsSubgroup(sys.parent,gruppe);
#if not IsSubgroup(AsSubgroup(sys.parent,no),sdps) then
#  Error("b");
#fi;
  SetKrnormalizer(sdps,AsSubgroup(sys.parent,no));
  sdps:=[[sdps]];
  stale:=2;

  # genimages by normalizer automs.

  if IsSolvableGroup(g) then
    Info(InfoAli,2,"transfering to PC group");
    isopc:=IsomorphismPcGroup(d);
    dag:=Image(isopc);

    # force g to be an AgGroup
    ghom:=GroupHomomorphismByImagesNC(g,dag,GeneratorsOfGroup(g),
			  List(GeneratorsOfGroup(g),i->Image(isopc,i)));
    grp:=Image(ghom,g);
    g:=grp;

    # how often to compute the derived subgroup to get an eA step.
    eastep:=0;
    tst:=g;
    while not IsElementaryAbelian(tst) do
      eastep:=eastep+1;
      tst:=DerivedSubgroup(tst);
    od;
    # just safety in case we got abelian and the trivial without EA:
    if Size(tst)=1 then
      eastep:=false;
      Print("Warning: Bad luck\n");
    fi;

  else 
    eastep:=false;
    dag:=false;
    isopc:=false;
    ghom:=IdentityMapping(g);
  fi;

  Info(InfoAli,2,"Preparation");
  # all factor groups

  # get normal subgroups
  nt:=NormalSubgroups(g);
  nrnt:=Length(nt);

  # only the ones minimal unter normalizer, map (if nec.) back in PermGroup
  n:=[];
  while Length(nt)>0 do
    j:=PreImage(ghom,nt[1]);
    s:=Normalizer(no,j);
    k:=RightTransversal(no,s);
    f:=List(k,i->ConjugateGroup(j,i));
    j:=Minimum(f);
    fh:=k[Position(f,j)]; # Conj. elm
    k:=Image(ghom,j);
    j!.localnorm:=s^fh;
    k!.mypermGroup:=j;
    Add(n,k);
    f:=List(f,i->Image(ghom,i));
    nt:=Filtered(nt,i->not i in f);
  od;

  f:=[];
  fh:=[];
  fid:=[];
  fsg:=[];
  nind:=[];
  for i in n do
    AddSet(nind,Index(g,i));
    if Size(i)=1 then
      # the group itself: get the permutation group again
      fa:=PreImage(ghom,g);
      fhom:=IdentityMapping(fa);
    else
     fhom:=NaturalHomomorphismByNormalSubgroup(g,i);
     fa:=Image(fhom,g);

     # get mapping from perm group to factor
     fhom:=ghom*fhom;

# grp:=fhom.source;
# fhom:=GroupHomomorphismByImagesNC(grp,fa,GeneratorsOfGroup(grp),
# 	  List(GeneratorsOfGroup(grp),i->Image(fhom,i)));
# Print("remind:",fhom,"\n"); # to remind me to check, whether this has been fixed!

   fi;

   # the permutations in the normalizer of g, normalizing this normal
   # subgroup
   s:=i!.mypermGroup!.localnorm;

   Add(f,fa);
   Add(fh,fhom);

   if Size(i)=1 and istrans then
     # the perm. group itself, special treatment in the transitive case

     Info(InfoAli,2,"Permutation case,");
     if sys.a>6 and Size(fa)>=Factorial(sys.a)/2 then
       # symmetric/alternating case: all automs are perm. automs.
       Add(fsg,[IdentityMapping(fa)]);
       au:=false;
       sys.noouts:=true;
       Info(InfoAli,2," symmetric/alternating groups");
     else
#Print(">",fa,"\n");
       au:=AutomorphismGroup(fa);
#Print(">>",au,"\n");

       if ForAll(GeneratorsOfGroup(au),
		 j->ForAny(Orbits(
			   Image(j,Stabilizer(fa,1)),
			   [1..sys.a]),
		     k->Length(k)=1)) then
	 # all automorphisms map the point stabilizer to another point
	 # stabilizer. Thus they are induced by a permutation autom.
	 Info(InfoAli,2," all perm automs");
	 sys.noouts:=true;
	 Add(fsg,[One(au)]);
         au:=false;
       else
	 Info(InfoAli,2," new automs");
       fi;
     fi;
   else
     au:=AutomorphismGroup(fa);
     IsomorphismPermGroup(au);
   fi;

   if au<>false then
     out:=Filtered(GeneratorsOfGroup(au),i-> not i in
       InnerAutomorphismsAutomorphismGroup(au));
     # all automorphisms are inner
     if Length(out)=0 then
       Add(fsg,[One(au)]);
     else

       # some special treatment for large groups with cyclic outer
       # automorphism group if no true outer autos are induced.
       # for example M12 is of this kind and would take very long otherwise

       # At the moment we just recognize an outer group of size 2 if the
       # whole group is large

       if Size(i)=1 and istrans and Size(fa)>20000 and Size(s)=Size(fa) 
         and Length(out)=1 and
	 ForAll(GeneratorsOfGroup(s),
	   i->RepresentativeAction(fa,GeneratorsOfGroup(fa),
	     List(GeneratorsOfGroup(fa),j->j^i),OnTuples)<>false) then
         
	 out:=out[1];
	 # find the power of out that is inner
	 aut:=2;
	 while
	 RepresentativeAction(fa,GeneratorsOfGroup(fa),
	                       List(GeneratorsOfGroup(fa),
				    j->j^(out^aut)),OnTuples)=false do
	   aut:=aut+1;
	 od;
	 # now the powers of `out' up to `aut-1` for a transversal
	 Add(fsg,Concatenation([IdentityMapping(fa)],
	                       List([1..aut-1],i->out^i)));
       else
	 aut:=List(GeneratorsOfGroup(s),
		i->GroupHomomorphismByImagesNC(fa,fa,
		     GeneratorsOfGroup(fa),
		     List(GeneratorsOfGroup(fa),
		       j->Image(fhom,PreImagesRepresentative(fhom,j)^i))));

	 aut:=Subgroup(au,aut);
	 if Index(au,aut)=2 then
	   Add(fsg,[One(au),First(GeneratorsOfGroup(au),i->not i in aut)]);
	 else
	   nt:=RightTransversal(au,aut);
	   Add(fsg,List(nt,i->i^-1));
	 fi;
       fi;

     fi;
   fi;

  od;

  Info(InfoAli,1,Length(n)," factor groups");

  # test whether all factor groups are primitive
  ntsiz:=List(nind,i->Size(g)/i);
  primdst:=0;
  if ForAll(nind,i->i=1 or IsPrime(i)) then
    # all normals must be maximal
    primdst:=1;
  elif IsSolvableGroup(g) then
    maxes:=MaximalSubgroupClassReps(g);
    nt:=Set(List(maxes,i->Core(g,i)));
    AddSet(nt,g);
    if Length(nt)=nrnt then
      #all normals must be kernel of maximal
      Info(InfoAli,2,"All factor groups are primitive");
      primdst:=2;
    else
      for j in maxes do
        nt:=Union(nt,List(MaximalSubgroupClassReps(j),i->Core(g,i)));
      od;
      if Length(nt)=nrnt then
	#all normals must be kernel of maximal
	Info(InfoAli,2,"All normal subgroups are kernels of maxmaxes");
	primdst:=3;
      fi;
    fi;
  fi;

  # make the normal subgroups PermGroups again
  n:=List(n,i->i!.mypermGroup);

  for lev in [stale..anz] do

    # appropriate wreath operation on the first [lev] components:
    if Length(sys.parts[lev])>0 then
      wrg:=Stabilizer(sys.wrg,sys.parts[lev],OnTuples);
    else
      # the old GAP has problems with an empty set stabilizer
      wrg:=sys.wrg;
    fi;

    prds:=[];
    prae:=[];
    counter:=0;

#    if IsBound(sys.trick) then
#      prds:=sys.trick.prds;
#      prae:=sys.trick.prae;
#      counter:=sys.trick.counter-1;
#      # don't fall twice
#      Unbind(sys.trick);
#    fi;

    # the sub wreath product acting on the first components
    part:=Stabilizer(sys.kr,sys.parts[lev],OnTuples);

#Print("sdps=",sdps,"\n");

    for grp1 in sdps[lev-1]{[counter+1..Length(sdps[lev-1])]} do

      grp:=Subgroup(sys.parent,GeneratorsOfGroup(grp1));
#if not IsSubgroup(Krnormalizer(grp1),grp) then
#  Error("c");
#fi;
      SetKrnormalizer(grp,Krnormalizer(grp1));
#Print("grp=",grp,"\n");
      counter:=counter+1;
      Info(InfoAli,1,"Extending Subpower Number ",counter);

#      if IsBound(sys.forcebreak) then
#        Error("kurz vor dem Fehler");
#      fi;

      # construct all products, that start with grp by adding lev steps
      Info(InfoAli,1,"Level: ",lev,", Size: ",Size(grp));

      # the possible indices of normal subgroups
      possntind:=nind;
      if lev=anz and transflag<>false then
        #use signatures
	j:=Filtered(PossibleExtensionSignatures(sys,grp,ntsiz,lev),
	            i->Length(i)=lev);
	# remove one '1' (i/i) component
	j:=List(j,i->DifferenceMultiset(i,[1]));
	if Length(j)>0 then
	  j:=Maximum(List(j,Minimum));
	  j:=Size(g)/j;
	  possntind:=Filtered(nind,i->i>=j);
	else
	  possntind:=[];
	fi;
        Info(InfoAli,3,"possible indices:",possntind," impossible:",
	         Difference(nind,possntind));
      fi;
      possntind:=Set(possntind);

      if Length(possntind)>0 then
	if dag<>false then
	  j:=Image(isopc,grp);
	  if primdst>0 then
	    # then all nt's must be derivable from maxes
	    maxes:=MaximalSubgroupClassReps(j);
	    Info(InfoAli,2,Length(maxes)," maxes");
	    if primdst>1 then
	      nt:=Set(List(maxes,i->Core(j,i)));

	      # is F a factor of grp which is suitable for us, than there is
	      # a maximal subgroup of grp (the correspondig one to a max in grp)
	      # whose core has index at most the maximal size for F
	      k:=Filtered([1..Length(nt)],i->Index(j,nt[i])<=Size(gruppe));
	      if Length(k)<Length(nt) then
	        nt:=nt{k};
		maxes:=maxes{k};
		Info(InfoAli,2,"reduced to ",Length(maxes)," maxes");
	      fi;

	      if primdst>2 then
		for k in maxes do
		  nt:=Union(nt,List(MaximalSubgroupClassReps(k),i->Core(j,i)));
		od;
	      fi;
	      nt:=Filtered(nt,x->Index(j,x) in possntind);
	    else
	      nt:=Filtered(maxes,i->IsNormal(j,i));
	    fi;
	    Info(InfoAli,3,1+Length(nt)," normals");
	    Add(nt,j);
	  elif IsElementaryAbelian(j) then
	    #special treatment for EA groups: Use Base Enumeration
	    nt:=Factors(Size(j))[1]; # the prime
	    nt:=InvariantSubgroupsElementaryAbelianGroup(j,[],
		  # possible dimensions
		  List(possntind,i->LogInt(Size(j)/i,nt)));
	    Info(InfoAli,4,Length(nt)," normal subgroups");
	  else
	    nt:=NormalSubgroups(j);
	  fi;
	  nt:=List(nt,i->PreImage(isopc,i));
	elif g=grp then
	  # special treatment for the first case
	  # as g=grp g will be perm and the nt's are OK.
	  #nt:=List(n,i->AsSubgroup(Parent(grp),i));
	  nt:=n;
	elif Length(AbelianInvariants(CommutatorFactorGroup(grp)))<3 then
	  # use a G-quotient routine
	  Info(InfoAli,3,"computing G-quotients");
	  nt:=[];
	  for k in f do
	    nt:=Union(nt,List(GQuotients(grp,k),Kernel));
	  od;
	else
	  if nspgflag and not HasNormalSubgroups(grp) then
	    # normal subgroups of good index
	    Info(InfoAli,3,"getting stored normal subgroups");
	    nt:=NormalSubgroups(grp);
	  else
	    Info(InfoAli,3,"computing normal subgroups");
	    nt:=NormalSubgroups(Subgroup(grp,GeneratorsOfGroup(grp)));
	  fi;

	fi;

	nt:=Filtered(nt,j->Index(grp,j) in possntind);

	Assert(1,Set(List(nt,i->Index(grp,i)))=possntind);

	nt:=rec(liste:=nt);

	# call special function to throw away as much as possible
#	if not HasKrnormalizer(grp) then
#	  SetKrnormalizer(grp,Normalizer(sys.kr,grp));
#	fi;
	nt:=GroupOrbitsMinimumEach(Krnormalizer(grp),nt);

	fa:=[];
	for j in nt do
	  if Size(j)=1 then
	    k:=IdentityMapping(grp);
	    k!.kernnormalizer:=Krnormalizer(grp);
	  else
	    # NOCH: Besser wenn aufl"osbar
	    k:=NaturalHomomorphismByNormalSubgroup(grp,j);
	    k!.kernnormalizer:=Normalizer(Krnormalizer(grp),j);
	  fi;
	  Add(fa,k);
	od;

	# get the possible factors
	sel:=[];
	faid:=[];
	for j in fa do
	  fid:=Filtered([1..Length(f)],i->Size(f[i])=Size(Image(j)));
	  l:=[];
	  for k in fid do
	    fhom:=IsomorphismGroups(Image(j),f[k]);
	    if fhom<>fail then
	      Add(l,[k,fhom]); 
	    fi;
	  od;
	  if Length(l)>0 then
	    Add(sel,j);
	    Add(faid,l);
	  fi;
	od;

	fa:=sel;
	Info(InfoAli,2,Length(fa)," orbits");
	Info(InfoAli,2,"Indices ",List(fa,i->Size(Image(i))));

	Assert(1,Set(List(fa,i->Size(Image(i))))=possntind);

	for j in [1..Length(fa)] do
	  fhom:=fa[j];

	  # all possible correspondents
	  for k in faid[j] do
	    # we will need a further loop for automorphisms 
	    for l in fsg[k[1]] do
	      # the glueing homomorphism
	      hom:=k[2]*l;

	      # generators of first part, glued
	      gens:=List(GeneratorsOfGroup(grp),
	          i->i*Image(sys.emb[lev],PreImagesRepresentative(fh[k[1]],
			       Image(hom,Image(fhom,i))
			     )
			   ));

	      # generators of second kernel
	      gens:=Concatenation(gens,List(GeneratorsOfGroup(n[k[1]]),
					    i->Image(sys.emb[lev],i)) );

	      gens:=Subgroup(sys.parent,gens);
if Set(MovedPoints(gens))<>[1..sys.a*lev] then
  Error("unmoved!");
fi;

  TIMING.canon:=Runtime()-TIMING.canon;

	      Info(InfoAli,2,"Size=",Size(gens));

	      # check, whether necessary properties are fulfilled (if we want
	      # this)
	      if transflag=false
		  or (NewTransKgVLength(sys,gens,ntsiz,anz)<=anz 
		  and (lev<anz or HasConjugateKernels(sys,gens)))
	       then

		if IsBound(sys.noouts) and sys.noouts and
		  Size(gens)=Size(g) then
		  # special treatment for diagonal, we will have just one orbit.
		  gens:=DiagonalGroup(sys,PreImage(ghom,g),lev);
		else

		  # canonize under local normalizers
		  conjg:=Image(sys.emb[lev],n[k[1]]!.localnorm);
		  conjg:=SubgroupNC(sys.parent,Union(GeneratorsOfGroup(conjg),
				  GeneratorsOfGroup(fa[j]!.kernnormalizer)));
		  gens:=MinimumGroupOnSubgroupsOrbit(conjg,gens); 
		fi;

		if eastep<>false then

		  # utilize last EA Normal subgrp
		  tst:=gens;
		  for eai in [1..eastep] do
		    tst:=DerivedSubgroup(tst);
		  od;
		else
		  tst:=false;
		fi;

		if lev=anz and IsBound(sys.localsys) then
		  if tst=false then
		    nopa:=sys.globalsys.kr;
		  else
		    nopa:=NormalizerEAPermGroup(sys.globalsys.kr,tst);
		  fi;
#if not IsSubgroup(Normalizer(nopa,gens),gens) then
#  Error("D");
#fi;
		  SetGrKrnormalizer(gens,Normalizer(nopa,gens));
		fi;

		# avoind unnecc. second normalizer computation
		# if the next is wrong, the computed normalizers would be
		# disregarded anyhow
		if
		  lev<anz or transflag=false or (not
		  HasGrKrnormalizer(gens)) or
		  (IsTransitive(GrKrnormalizer(gens),sys.opdomain) 
		   and ( (IsBound(sys.localsys) and
		   ForAll(AllBlocks(GrKrnormalizer(gens)),
			  i->Length(i)>=sys.globalsys.a) and
		    ForAny(List(ValidNestings(sys.globalsys,
		    GrKrnormalizer(gens),gens)[2], Concatenation),IsRange)))) then

		  if tst<>false then
		    nopa:=NormalizerEAPermGroup(part,tst);
		  else
		    nopa:=part;
		  fi;

#if not IsSubgroup(Normalizer(nopa,gens),gens) then
#  Error("d");
#fi;
		  SetKrnormalizer(gens,Normalizer(nopa,gens));

		  if not HasGrKrnormalizer(gens) then
#if not IsSubgroup(Krnormalizer(gens),gens) then
#  Error("E");
#fi;
		    SetGrKrnormalizer(gens,Krnormalizer(gens));
		  fi;
		fi;


		if 
		  # we take it if: lower level 
		  lev<anz
		  or
		  # we don't care about transitivity
		  transflag=false 
		  or
		  (
		   # the normalizer acts transitively
		   IsTransitive(GrKrnormalizer(gens),sys.opdomain) 
		   and (
		   # if we use block projections
		   (IsBound(sys.localsys) and
		   # no block of the normalizer is smaller
		    ForAll(AllBlocks(GrKrnormalizer(gens)),
			  i->Length(i)>=sys.globalsys.a) and
		    # It is possibly "nice"
		    ForAny(List(ValidNestings(sys.globalsys,GrKrnormalizer(gens),gens)[2],
				Concatenation),IsRange)
		    ) 
		    or
		   # we don't use block projections
		   ((not IsBound(sys.localsys)) and
		   # no block is smaller
		   (transflag<>true or
		   ForAll(AllBlocks(GrKrnormalizer(gens)),i->Length(i)>=sys.a))
		   )
		 )) then

		  # first a cheaper test to avoid the classes computation in
		  # 'Might...'
		  if not ForAny(prds,i->Size(i)=Size(gens)
		     and Size(Krnormalizer(i))=Size(Krnormalizer(gens)))
		   then
		    # the candidate is probably unique
		    tst:=Filtered(prae,i->MightBeConjugatePermGrps(i,gens)
			   and
			   Size(Krnormalizer(i))=Size(Krnormalizer(gens)));
		    if Length(tst)=0 then
		      Info(InfoAli,2,"praeadded");

if gens<>false and Set(MovedPoints(gens))<>[1..sys.a*lev] then
  Error("unmoved4!");
fi;
		      Add(prae,gens);
		      gens:=false;
		    else
		      tst:=tst[1];
		      # now we must check tst, whether it is OK
		      prae:=Filtered(prae,i->i<>tst);
		      if not Canonize(tst,sys,wrg,lev,sdps,1) then
			Info(InfoAli,2,"praedropped/praeadded");
			# now this group is our 'prae'
			Add(prae,gens);
if Set(MovedPoints(gens))<>[1..sys.a*lev] then
  Error("unmoved6!");
fi;
			gens:=false;
		      else
			Info(InfoAli,2,"praemoved");
#			Unbind(tst.elements);
			Add(prds,tst);
if Set(MovedPoints(tst))<>[1..sys.a*lev] then
  Error("unmoved5!");
fi;
		      fi;
		    fi;
		  fi;
		else
		  Info(InfoAli,2,"not transitive or smaller blocksystem");
		  gens:=false;
		fi;
	      else
		Info(InfoAli,2,"cannot yield transitive ",gens!.ntkgvlev);
		gens:=false;
	      fi;

if gens<>false and Set(MovedPoints(gens))<>[1..sys.a*lev] then
  Error("unmoved2!");
fi;

  TIMING.canon:=Runtime()-TIMING.canon;

	      # drop if already there, otherwise test for canonicity
	      if gens<>false and not (gens in prae or gens in prds) then
		# now construct the standard associate to gens,
		# check, whether it is new (i.e. THE canonical one)
		if Canonize(gens,sys,wrg,lev,sdps,1) then
#		  Unbind(gens.elements);
		  Add(prds,gens);
		  Info(InfoAli,2,"added");
		else
		  Info(InfoAli,2,"dropped");
		fi;
	      fi;

if gens<>false and Set(MovedPoints(gens))<>[1..sys.a*lev] then
  Error("unmoved3!");
fi;

	    od;	
	  od;
	  Info(InfoAli,2,"|prae|=",Length(prae));
	od;

      else
        Info(InfoAli,2,"can be ignored");
      fi;

      Info(InfoAli,1,Length(prds)," products");

    od;
    prds:=Concatenation(prds,prae);
    Info(InfoAli,1,"Total: ",Length(prds)," products");

    # clean up
#    for k in prds do
#      Unbind(i.elements);
#      Unbind(i.derivedSubgroup);
#      Unbind(i.conjugacyClasses);
#      Unbind(i.rationalClasses);
#    od;


if ForAny(prds,i->not HasGrKrnormalizer(i)) then
  Error("bug!");
fi;

    # clean up
    prae:=[];
    for i in prds do
      grp:=Subgroup(sys.parent,GeneratorsOfGroup(i));
      SetSize(grp,Size(i));
#if not IsSubgroup(Krnormalizer(i),grp) then
#  Error("e");
#fi;
      SetKrnormalizer(grp,Krnormalizer(i));
#if not IsSubgroup(GrKrnormalizer(i),grp) then
#  Error("F");
#fi;
      SetGrKrnormalizer(grp,GrKrnormalizer(i));
      if HasClassShapes(i) then
        SetClassShapes(grp,ClassShapes(i));
      fi;
      Add(prae,grp);
    od;
    sdps[lev]:=prae;
    prds:=[];
  od;

  return sdps;

end;

TransitiveSubgroupsWreathProductSymm:=function(w,l,m)
local b,c,d,i,j,n,t,u,sy,dl;
  b:=Filtered(AllBlocks(w),i->Length(i)=l);
  if Length(b)>1 then
    Error("has several blocksyst's, Theory ?");
  fi;

  b:=Orbit(w,b[1],OnSets);
  b:=Concatenation(b);

  t:=AllTransitiveGroups(NrMovedPoints,l*m);
  sy:=MySymmetricGroup(l*m);
  t:=List(t,i->AsSubgroup(sy,i));

  Info(InfoAli,2,"looping through ",Length(t)," transitive groups");
  u:=[];
  for i in t do
    # get all block systems of suitable size
    d:=Filtered(AllBlocks(i),j->Length(j)=l);

    if Length(d)>0 then
      if Length(d)>1 then
	# and fuse them under the normalizer
	dl:=Length(d);
	n:=Normalizer(sy,i);
	c:=[];
	while Length(d)>0 do
	  Add(c,d[1]);
	  d:=Difference(d,Orbit(n,d[1],OnSets));
	od;
	Info(InfoAli,3,dl," reduced to ",Length(c));
      else
	c:=d;
      fi;

      # embed via all possible block systems
      for j in c do
	d:=Orbit(i,j,OnSets);
	d:=Concatenation(d);
	d:=MappingPermListList(d,b); # map the block system to the standard
				     # one
	Add(u,Group(List(GeneratorsOfGroup(i),k->k^d)));
      od;
    fi;
  od;
  Info(InfoAli,3,Length(u)," subgroups");
  return u;
end;

TransitiveSubgroupsNormalSubgroupWreathProduct:=function(w,g,l,m)
local u,v,i,n,rt;
  #w:=AsSubgroup(Parent(g),w);
  if not IsNormal(w,g) or Index(w,g)>2 then
    Error("not normal or bad index");
    return false;
  fi;
  u:=TransitiveSubgroupsWreathProductSymm(w,l,m);
  v:=[];
  rt:=Filtered(RightTransversal(w,g),i-> not i in g);
  for i in u do
    if IsSubgroup(g,i) then
      Add(v,i);
      n:=Normalizer(w,i);
      if IsSubgroup(g,n) then
	# class grows, conjugate with cosets.
        Append(v,List(rt,j->i^j));
      fi;
    fi;
  od;
  return v;
end;

WreathProductDecomposition:=function(g)
local b,i,bs,op,s;
  b:=AllBlocks(g);
  for i in b do
    bs:=Orbit(g,i,OnSets);
    op:=Action(g,bs,OnSets);
    s:=Stabilizer(g,i,OnSets);
    s:=Action(s,i);
    if (Size(s)^Length(bs))*Size(op)=Size(g) then
      return bs;
    fi;
  od;
  return false;
end;

KuK:=function(arg)
local g,b,i,bs,op,s,x,y,sx,sy,p,g2,xt,yt,t,bp,dom,r,u,v,pairs;
  g:=arg[1];
  dom:=Set(MovedPoints(g));
  if not IsTransitive(g,dom) then
    Error("G must be transitive");
  fi;
  bs:=ShallowCopy(arg[2]);
  Sort(bs);
  # force block system from block
  if not IsList(bs[1]) then
    bs:=Orbit(g,bs,OnSets);
    Sort(bs);
  fi;
  if not dom[1] in bs[1] then
    Error("blocks are not sets");
  fi;

  op:=Action(g,bs,OnSets);
  u:=Stabilizer(g,bs[1],OnSets);
  v:=Stabilizer(g,dom[1]);
  t:=Action(u,bs[1]);
  x:=Length(bs[1]);
  y:=Length(bs);

  if Length(arg)<3 then
    if x<15 then
      xt:=TransitiveGroup(x,TransitiveIdentification(t));
    else 
      xt:=t;
    fi;
    if y<15 then
      yt:=TransitiveGroup(y,TransitiveIdentification(op));
    else
      yt:=op;
    fi;
  elif arg[3]=true then
    xt:=t;
    yt:=op;
  else
    xt:=arg[3];
    yt:=arg[4];
  fi;

  Info(InfoAli,4,xt," wr ",yt);
  sx:=MySymmetricGroup(x);
  sy:=MySymmetricGroup(y);

  s:=ShallowCopy(RightTransversal(g,u));
  p:=List(s,i->OnSets(bs[1],i)); # arrange the same way as bs
  SortParallel(p,s);

  # canonize the action on the block system
  op:=Action(g,bs,OnSets);
  bp:=RepresentativeAction(sy,AsSubgroup(sy,op),AsSubgroup(sy,yt));
  if bp=fail then
    Error("wrong blocks operation");
  fi;
  s:=Permuted(s,bp);

  r:=ShallowCopy(RightTransversal(u,v));
  p:=List(r,i->dom[1]^i); # arrange the same way as bs[1]
  SortParallel(p,r);

  # canonize the action on the block
  bp:=RepresentativeAction(sx,AsSubgroup(sx,t),AsSubgroup(sx,xt));
  if bp=fail then
    Error("wrong block operation");
  fi;
  r:=Permuted(r,bp);

  # get correspondence to points
  pairs:=Cartesian(s,r);
  p:=List(pairs,i->(dom[1]^i[2])^i[1]);
  p:=MappingPermListList(p,dom);

#  g2:=WreathProduct(xt,yt,IdentityMapping(yt));
#  if ForAnyGeneratorsOfGroup((g),i->not i^p in g2) then
#    Error("does not embed!");
#  fi;

  return p;
end;

TransitiveSubgroupsWreathProduct:=function(g)
local b,x,y,sx,sy,w,l,hom1,hom2,p,p1,q,m,r,ce,cx,cy,id,ie,u,v,op,
      tx,ty,i,j,dom,t,gorig,apart,bpart,conj,pp,pq;

  gorig:=g;
  b:=WreathProductDecomposition(g);
  if b=false then
    return fail;
  fi;

  # create the appropriate symmetric wreath
  x:=Length(b[1]);
  y:=Length(b);
  sx:=MySymmetricGroup(x);
  sy:=MySymmetricGroup(y);
  w:=WreathProduct(sx,sy);
  hom1:=[];
  l:=Length(GeneratorsOfGroup(sx));
  for i in [1..y] do
    hom2:=GroupHomomorphismByImagesNC(sx,w,GeneratorsOfGroup(sx),
					GeneratorsOfGroup(w){[l*(i-1)+1..l*i]});   
    Add(hom1,hom2);
  od;
  hom2:=GroupHomomorphismByImagesNC(sy,w,GeneratorsOfGroup(sy),
		  GeneratorsOfGroup(w){[y*l+1..Length(GeneratorsOfGroup(w))]});

  # g as a 'clean' subgroup of w
  p1:=KuK(g,b);
  g:=Subgroup(w,List(GeneratorsOfGroup(g),i->i^p1));
  b:=List(b,i->OnSets(i,p1));
  Sort(b);

  # now construct the classes of subgroups in both components
  # together with the normalizer transversals
  bpart:=Action(g,b,OnSets);
  dom:=[1..Length(b)];
  bpart:=AsSubgroup(sy,bpart);
  u:=List(ConjugacyClassesSubgroups(bpart),Representative);
  u:=Filtered(u,i->IsTransitive(i,dom));
  id:=List(u,TransitiveIdentification);
  if Length(id)<Length(Set(id)) then
    # multiple occurances cannot be treated
    return fail;
  fi;
  SortParallel(id,u);
  cy:=[];
  for i in u do
    t:=RightTransversal(Normalizer(sy,i),Normalizer(bpart,i));
    t:=List(Filtered(t,i->Order(i)>1),Inverse);
    Add(cy,t);
  od;

  apart:=Action(Stabilizer(g,b[1],OnSets),b[1]);
  dom:=[1..Length(b[1])];
  apart:=AsSubgroup(sx,apart);
  v:=List(ConjugacyClassesSubgroups(apart),Representative);
  v:=Filtered(v,i->IsTransitive(i,dom));
  ie:=List(v,TransitiveIdentification);
  if Length(ie)<Length(Set(ie)) then
    return fail;
  fi;
  SortParallel(ie,v);
  cx:=[];
  for i in v do
    t:=RightTransversal(Normalizer(sx,i),Normalizer(apart,i));
    t:=List(Filtered(t,i->Order(i)>1),Inverse);
    Add(cx,t);
  od;

  # now get the classes of subgroups of w
  t:=TransitiveSubgroupsWreathProductSymm(w,x,y);
  
  l:=[];
  for i in t do

    # identify both actions
    op:=Action(i,b,OnSets);
    ty:=TransitiveIdentification(op);
    pp:=Filtered([1..Length(id)],x->id[x]=ty);
    if Length(pp)>0 then
      op:=Action(Stabilizer(i,b[1],OnSets),b[1]);
      tx:=TransitiveIdentification(op);
      pq:=Filtered([1..Length(ie)],x->ie[x]=tx);
      if Length(pq)>0 then
       for p in pp do
       for q in pq do 
        # it might embed, so take the 'clean' version
	r:=KuK(i,b,v[q],u[p]);
	r:=Subgroup(w,List(GeneratorsOfGroup(i),j->j^r));
#if not IsSubgroup(g,r) then
#  Error("not in");
#fi;

        # take - if nec. - conjugates
        m:=[r];

	if Length(cx[q])>0 then
	  ce:=List([1..y],i->List(cx[q],j->Image(hom1[i],j)));
	  ce:=List(Cartesian(ce),Product);
	else
	  ce:=[()];
	fi;
	
	if Length(cy[p])>0 then
	  ce:=List(Cartesian(ce,cy[p]),i->i[1]*Image(hom2,i[2]));
	fi;

#Print(TransitiveIdentification(r),":",Length(cx[q]),":",Length(cy[p]),":",Length(ce),"\n");
	if ce<>[()] then
	  for j in ce do
            conj:=r^j;
	    if IsSubset(g,conj) then
	      Add(m,conj);
# else Error("not in 2");
	    fi;
	  od;
	fi;
	
	m:=List(m,i->ConjugacyClassSubgroups(g,i));
	r:=[];
	for j in m do
	  if not ForAny(r,i->Representative(j) in i) then
	    Add(r,j);
	  fi;
	od;
	Info(InfoAli,3,Length(m)," reduced to ",Length(r)," groups");
	l:=Concatenation(l,List(r,Representative));
       od;od;
      fi;
    fi;
  od;

  # map back
  p1:=p1^(-1);
  l:=List(l,i->Subgroup(gorig,List(GeneratorsOfGroup(i),j->j^p1)));
  return l;
end;

GroupsAtop:=function(arg)
local pmp,b,s,u,w,n,g,op,oh,hom,omp,k,f,v,co,i,j,jj,new,cl,sug,nsug,fg,pi,
      dop,ino,hasfuse,largedeg,fh,coind,docompl;

  n:=arg[1];
  if Size(n)=1 then
    return [];
  fi;
  pmp:=MovedPoints(n);
  b:=List(Orbits(n,pmp),Set);

  #s:=MySymmetricGroup(Length(b));
  #u:=MySymmetricGroup(Length(b[1]));

  if Length(arg)=1 then
    Error("Parent!");
    w:=Parent(n);#WreathProduct(u,s,IdentityMapping(s));
  else
    w:=arg[2].kr;
  fi;

  #n:=AsSubgroup(w,n);

  if not HasGrKrnormalizer(n) then
    if IsElementaryAbelian(n) then
      g:=NormalizerEAPermGroup(w,n);
    else
      # try to use elem ab subgroup
      omp:=w;
      op:=n;
      repeat
	op:=DerivedSubgroup(op);
      until IsElementaryAbelian(op) or IsPerfect(op);
      if Size(op)>1 and IsElementaryAbelian(op) then
	omp:=NormalizerEAPermGroup(omp,op);
      fi;
      g:=Normalizer(omp,n);
    fi;
    SetGrKrnormalizer(n,g);
  else
    g:=GrKrnormalizer(n);
  fi;

  op:=SmallGeneratingSet(g);
  if Length(op)<Length(GeneratorsOfGroup(g)) then
    Info(InfoAli,3,"reducing normalizer generators");
  fi;
  g:=Group(op); #always make a new group to permit throwing away all permrep.
  # information 

  oh:=ActionHomomorphism(g,b,OnSets,"surjective");
  op:=Image(oh);
  IsNaturalSymmetricGroup(op);
  IsNaturalAlternatingGroup(op);
  dop:=Length(b);
  omp:=[1..dop];
  if not IsTransitive(op,omp) then
    Info(InfoAli,3,"keine (for Frank: none)");
    return [];
  else
    Info(InfoAli,2,"Transitive operation of size ",Size(op));

    Info(InfoAli,3,"transitive type ",
	  TransitiveIdentification(op));
    AddSet(TIMING.pool,[dop,TransitiveIdentification(op)]);

  fi;
  k:=Kernel(oh);
  if Size(k)*Size(op)<>Size(g) then
    Error("wrong kernel");
  fi;
   docompl:=Size(k)>Size(n);

  # Now we get all transitive subgroups of the operation image:

  # catch some special cases, for which we already know the transitive
  # subgroups
  if dop=2 then
    # Avoid trouble with the 'alternating group' of deg 2.
    u:=[op];
  elif Size(op)=TRANSProperties(dop,TRANSLENGTHS[dop])[1] then
    # S_n
    # just use our list
    u:=[];
    for i in [1..TRANSLENGTHS[dop]-2] do
      Add(u,AsSubgroup(op,TransitiveGroup(dop,i)));
    od;
    # A_n (with better gens)
    if IsInt(dop/2) then
      Add(u,Subgroup(op,[(1,2,3),PermList(Concatenation([1,dop],
		     [2..dop-1]))]));
    else
      Add(u,Subgroup(op,[(1,2,3),PermList(Concatenation([dop],[1..dop-1]))]));
    fi;
    # S_n itself (with better gens)
    Add(u,Subgroup(op,[(1,2),PermList(Concatenation([dop],[1..dop-1]))]));
  elif Size(op)>60 and
       Size(op)=TRANSProperties(dop,TRANSLENGTHS[dop]-1)[1] then
    # A_n
    Error("A_n");
  # special case: full wreath products
  elif ForAny(WR_POOL,i->i[1]=dop and 
			 i[2]=TransitiveIdentification(op)) then
    u:=First(WR_POOL,i->i[1]=dop and 
			 i[2]=TransitiveIdentification(op));
    Info(InfoAli,2,"transitive subgroups of S(",u[3],") wr S(",u[4],")");
    u:=TransitiveSubgroupsWreathProductSymm(op,u[3],u[4]);

  elif Size(op)<30000 then
    TIMING.seatraop:=Runtime()-TIMING.seatraop;
    Info(InfoAli,2,"Searching for transitive operations");
    if Size(op)>100 and IsSolvableGroup(op) then
      v:=IsomorphismPcGroup(op);
      u:=List(SubgroupsSolvableGroup(Image(v,op),
                      rec(consider:=SizeConsiderFunction(dop))),
	      i->PreImage(v,i));
    else
      u:=List(ConjugacyClassesSubgroups(op),Representative);
    fi;
    u:=Filtered(u,i->IsTransitive(i,omp));
    TIMING.seatraop:=Runtime()-TIMING.seatraop;
  else
    #pi:=AsSubgroup(MySymmetricGroup(dop),op);
    pi:=op;
    v:=Normalizer(MySymmetricGroup(dop),pi);
    if Index(v,pi)=2 and ForAny(WR_POOL,i->i[1]=dop and 
			 i[2]=TransitiveIdentification(v)) then
      u:=First(WR_POOL,i->i[1]=dop and i[2]=TransitiveIdentification(v));
      Info(InfoAli,2,"transitive subgroups of NT of S(",u[3],") wr S(",
               u[4],")");
      u:=TransitiveSubgroupsNormalSubgroupWreathProduct(v,pi,u[3],u[4]);
      #u:=List(u,i->AsSubgroup(Parent(op),i));
    else
      u:=TransitiveSubgroupsWreathProduct(op);
      if u=fail then
	Info(InfoWarning,1,
	  "this group is probably too big to compute the subgroup lattice");
	u:=List(ConjugacyClassesSubgroups(op),Representative);
	u:=Filtered(u,i->IsTransitive(i,omp));
      fi;
    fi;
  fi;

  Info(InfoAli,3,Length(u)," subgroups");


  if not HasSolvableFactorGroup(k,n) then
    Error("not solvable factor -- cannot form complements!");
  elif docompl and HasSolvableFactorGroup(g,k) then
    hom:=NaturalHomomorphismByNormalSubgroup(g,n);

    f:=Image(hom);
    fh:=List(GeneratorsOfGroup(g),i->Image(hom,i));
    oh:=GroupHomomorphismByImagesNC(f,op,fh,List(GeneratorsOfGroup(g),
	   i->Image(oh,i)));

    # kernel in factor group
    k:=List(GeneratorsOfGroup(k),i->Image(hom,i));
    k:=Subgroup(f,k);

    largedeg:=false;
  else
    largedeg:=true;
  fi;

  Info(InfoAli,3,"Kernel size:",Size(k));

  v:=[];
  for i in u do

    TIMING.compl:=Runtime()-TIMING.compl;

    if docompl then

      IsNaturalSymmetricGroup(i);
      IsNaturalAlternatingGroup(i);
      IsomorphismFpGroup(i); # enforce the fp isomorphism, this will then be
      # used by the complement routine. (good for S_n/A_n!)
      pi:=PreImage(oh,i);
      # store the mapping we know
      ino:=GroupHomomorphismByImagesNC(pi,i,GeneratorsOfGroup(pi),
	              List(GeneratorsOfGroup(pi),i->Image(oh,i)));
      SetImagesSource(ino,i);
      SetKernelOfMultiplicativeGeneralMapping(ino,k);
      AddNaturalHomomorphismsPool(pi,k,ino);

      if IsSolvableGroup(i) then
        co:=DerivedSeries(i);
	j:=Length(co)-1;
	ino:=op;
	while j>=1 do
	  ino:=Normalizer(ino,co[j]);
	  j:=j-1;
	od;
	
      else
	ino:=Normalizer(op,i);
      fi;
      ino:=PreImage(oh,ino);
      if largedeg then
        co:=ComplementClassesRepresentativesSolvableWBG(pi,k,n);
	hasfuse:=false;
	Info(InfoAli,2,"Size ",Size(i),", ",Length(co)," complements, ");

	new:=[];

	if Length(co)>100 and Index(ino,Normalizer(ino,co[1]))<1000 then
	  Info(InfoAli,2,"fuse by computing full lists");
	  coind:=[1..Length(co)];
	  j:=1;
	  while Length(coind)>0 do
	    while not IsBound(coind[j]) do
	      j:=j+1;
	    od;
	    Add(new,co[j]);
	    cl:=AsSSortedList(ConjugacyClassSubgroups(ino,co[j]));
	    Unbind(coind[j]);
	    j:=j+1;
	    for jj in [j..Length(coind)] do
	      if IsBound(coind[jj]) and co[jj] in cl then
		Unbind(coind[jj]);
	      fi;
	    od;
	    Info(InfoAli,5,Length(new)," classes, ",
	      Number([j..Length(coind)],x->IsBound(coind[x]))," remaining");
	  od;

	else
	  for j in co do
	    cl:=ConjugacyClassSubgroups(ino,j);
	    if not ForAny(new,i->i in cl) then
	      # remove large attributes
	      sug:=Size(j);
	      j:=Group(GeneratorsOfGroup(j));
	      SetSize(j,sug);
	      Add(new,j);
	    fi;
	    Unbind(cl);
	  od;
	fi;
	Info(InfoAli,2,"fused into ",Length(new)," classes in preimage");

      else
	co:=ComplementClassesRepresentatives(pi,k);
	Info(InfoAli,2,"Size ",Size(i),", ",Length(co)," complements (factor), ");
	# if we do not work in the full normalizer factor
	# fuse under operation of this full factor
	new:=[];
	for j in co do
	  cl:=CanonicalSubgroupRepresentativePcGroup(ino,j);
	  if not cl[1] in new then
	    Add(new,cl[1]);
	  fi;
	od;

	Info(InfoAli,2,"fused into ",Length(new)," classes");
	# back into g -- fused
	new:=List(new,i->PreImage(hom,i));
      fi;

    else
      # if we are not doing complements we will not have a factor group
      # either.
      new:=[PreImage(oh,i)];
      Info(InfoAli,2,"Size ",Size(i),", ",Length(new)," complements, ");
    fi;

    TIMING.compl:=Runtime()-TIMING.compl;

    # remove large attributes.
    for j in [1..Length(new)] do
      sug:=Size(new[j]);
      new[j]:=Group(GeneratorsOfGroup(new[j]));
      SetSize(new[j],sug);
    od;
    Info(InfoAli,2,Length(new)," classes");





#    # fusion only takes place in the normalizer (as k\lhd f)
# 
#    if IsPcGroup(ino) then
#
#    elif largedeg=true then
#
#    else

#        
#      else
#	for j in co do
#	  cl:=ConjugacyClassSubgroups(ino,j);
#	  if not ForAny(new,i->i in cl) then
#	    Add(new,j);
#	  fi;
#	  Unbind(cl);
##	od;
#      fi;
#      hasfuse:=true;
#
#    fi;



    v:=Concatenation(v,new);
  od;

  return v;
end;

OrbitsDoFuse:=function(grp,lst)
local o;
  while Length(lst)>1 do
    o:=Orbit(grp,lst[1][1]);
    if ForAny(lst{[2..Length(lst)]},j->ForAny(j,k->k in o)) then
      return true;
    fi;
    lst:=lst{[2..Length(lst)]};
  od;
  return false;
end;

# sys, normalizer, subgroup
SmallSubgroupCanonizer:=function(sys,no,v)
local el,oldnorm,cen,to,erg,Recurse;

  if HasKrnormalizer(v) then
    oldnorm:=Krnormalizer(v);
  else
    oldnorm:=false;
  fi;
  cen:=sys.kr;
  to:=TrivialSubgroup(sys.parent);

  el:=Filtered(AsList(Subgroup(Parent(v),GeneratorsOfGroup(v))),i->i<>());
  erg:=[];

  Recurse:=function(no,cen,to,el,oldnorm)
  local orb,o,cen2,thecen,rt,rte,i,j,min,minel,ce,no2,to2,oldnorm2,
        el2,bf,bfl,orcl,found,bahn;

#if not IsNormal(no,to) then
#  Error("not closed 0?");
#fi;

    # take only those elements, that might give something new, i.e. ignore
    # contained elements, that cannot be conjugated any more.
    el:=Filtered(el,i-> not i in to);

    orb:=ShallowCopy(Orbits(no,el)); # spanische Weihnachten
    Sort(orb,function(a,b)
	       if Length(a)=Length(b) then
		 return CycleStructurePerm(a[1])<CycleStructurePerm(b[1]);
	       else
		 return Length(a)<Length(b);
	       fi;
	     end);

    Info(InfoAli,3,"trying for ",Length(orb)," orbitsets");

    bfl:=infinity;
    bf:=false; # invalid value that must be overwritten
    j:=1;
    found:=false;
    repeat
      o:=orb[j];
      if Length(orb)>1 and
	 ForAny(orb{[2..Length(orb)]},i->Length(o)=Length(i)
	  and CycleStructurePerm(o[1])=CycleStructurePerm(i[1])) then
	o:=Filtered(orb,i->Length(i)=Length(o) and
			CycleStructurePerm(i[1])=CycleStructurePerm(o[1]));
      else
	o:=[o];
      fi;

      # increment j
      while j<=Length(orb) and orb[j] in o do
        j:=j+1;
      od;

      # now collect fusion classes
      orcl:=[];
      while Length(o)>0 do
	if true or Size(cen)/Size(o[1][1])<30000 
	 or Index(cen,Centralizer(cen,o[1][1]))<30000 then
	  bahn:=Orbit(cen,o[1][1]);
	  cen2:=Filtered([2..Length(o)],i->ForAny(o[i],j->j in bahn));
	else
	  cen2:=Filtered([2..Length(o)],i->RepresentativeAction(cen,o[1][1],o[i][1])<>fail);
	fi;
	AddSet(cen2,1);
	Add(orcl,o{cen2});
	# take the rest.
	o:=o{Difference([2..Length(o)],cen2)};
      od;

      cen2:=Filtered([1..Length(orcl)],i->Length(orcl[i])=1);
      Info(InfoAli,3,j,", ",Sum(orcl,Length)," orbits, unfused:",Length(cen2));

      if Length(cen2)=0 then
	# minimize the tree width
	min:=Collected(List(orcl,Length));
	Sort(min,function(a,b) return (a[1]*a[2]<b[1]*b[2]);end);
	Info(InfoAli,4,"lengths:",min);
	if true then # min[1][2]=1 then # length 1-> unique choice
	  min:=min[1][1]; # the length with the least number of orbits
	  if min<bfl then
	    bfl:=min;
	    Info(InfoAli,4,"BFL reset to ",bfl);
	    bf:=Concatenation(Filtered(orcl,i->Length(i)=bfl));
	    bf:=List(bf,i->[i]);
	  fi;
        fi;
      else
	found:=true;
	bf:=[List(orcl{cen2},i->i[1])];
      fi;

    until found or j>Length(orb);

    if not found then
      Info(InfoAli,3,"Branch ",Length(bf));
    fi;

    for o in bf do
      min:=o[1][1];
      rte:=();
      thecen:=Centralizer(cen,o[1][1]);
      minel:=min;

      for j in o do

	cen2:=Centralizer(cen,j[1]);
	rt:=RightTransversal(cen,cen2);
	Info(InfoAli,10,"finding minimal element among ",Length(rt));

	for i in rt do
	  ce:=j[1]^i;
	  if ce<min then
	    rte:=i;
	    thecen:=cen2;
	    minel:=j[1];
	    min:=ce;
#	  elif ce=min then
#	    Error("collision");
	  fi;
	od;
      od;

      cen2:=ConjugateGroup(thecen,rte);
      no2:=ConjugateGroup(no,rte);
      if oldnorm<>false then
	oldnorm2:=ConjugateGroup(oldnorm,rte);
      else oldnorm2:=false;
      fi;
      no2:=Centralizer(no2,min);

      el2:=Filtered(el,i->i<>fail);#minel);
      el2:=List(el2,i->i^rte);

      to2:=ClosureGroup(to,min);
      Info(InfoAli,5,"Image has ",Length(GeneratorsOfGroup(to2))," gens");

      if Size(to2)=Size(v) then
	if oldnorm<>false then
	  Assert(1,IsNormal(oldnorm2,to2));
	fi;
#if not IsSubgroup(oldnorm2,to2) then
#  Error("f");
#fi;
	SetKrnormalizer(to2,oldnorm2);
	Add(erg,to2);
      else
	# next generator, respectively recursion branch!
	Recurse(no2,cen2,to2,el2,oldnorm2);
      fi;

    od;

    if not found then
      Info(InfoAli,4,"End branch ",Length(bf));
    fi;

  end;

  Recurse(no,cen,to,el,oldnorm);

  if Length(erg)>1 then 
    erg:=[Minimum(erg)];
  fi;
  return erg[1];;
end;

# compute a standard conjugate if a transitive normalizer action is
# permitted. Otherwise return false
# (sys,u,[normalizing group,[ normalizer parent]])
StandardConjugateAllowTSubgroup:=function(arg)
local no,grp,sys,v,nopa;
  sys:=arg[1];
  v:=arg[2];
  Info(InfoAli,3,"Standardize size ",Size(v));

  grp:=sys.kr;
  # do we know a smaller supergroup?
  if Length(arg)<4 then
    nopa:=grp;
  else
    nopa:=arg[4];
  fi;

  if Length(arg)>2 then
    no:=arg[3];
  else
    no:=v;
  fi;
  if IsNormal(grp,v) then
    # special trivial case
    no:=grp;
  elif IsElementaryAbelian(v) then
    no:=NormalizerEAPermGroup(nopa,v,no);
  else
    #no:=Normalizer(nopa,v,no); #TODO: Fix
    no:=Normalizer(nopa,v);
  fi;

  if not IsTransitive(no,sys.blocks,OnSets) then
    Info(InfoAli,3,"allows no transitive action");
    return false;
  fi;

#if not IsSubgroup(no,v) then
#  Error("v");
#fi;
  SetKrnormalizer(v,no);
  Info(InfoAli,3,"Length=",Index(grp,no));
  if no=grp then
    return v;
  fi;
  if Index(grp,no)<=Size(v) then
    # it's cheaper to take the transversal
    return MinimumGroupOnSubgroupsOrbit(grp,v,no);
  else
    nopa:=SmallSubgroupCanonizer(sys,no,v); 
    if nopa=fail then
      if ForAny(AllBlocks(no),i->Length(i)<sys.a) then
	# we don't need it
	Print("NASTY discarded\n");
        return TrivialSubgroup(v);
      else
	Print("#W  NASTY CASE,",Size(v),AllBlocks(no)," need orbit \n");
	Error();
	return MinimumGroupOnSubgroupsOrbit(grp,v,no);
      fi;
    else
      return nopa;
    fi;
  fi;
end;

FusedComplements:=function(act,g,n)
local co,no,nco,nno,i,j,a,b,cs,new,hom,ag,nh,gr,orb;
  if not (IsSubset(act,g) and IsSubset(g,n)) then
    Error("wrong arguments");
  fi;
  gr:=Normalizer(act,g);
  if IsSolvableGroup(gr) then
    hom:=IsomorphismSpecialPcGroup(gr);
  else
    hom:=fail;
  fi;
  co:=[g];
  no:=[gr];
  cs:=Filtered(ChiefSeriesThrough(gr,[n]),x->Size(x)<=Size(n));
  cs:=[n,SylowSubgroup(n,3),TrivialSubgroup(n)];
  for i in [2..Length(cs)] do
    #Print(Size(cs[i-1]),"->",Size(cs[i]),"\n");
    nh:=fail;
    if hom<>fail then
      nh:=NaturalHomomorphismByNormalSubgroup(gr,cs[i]);
    fi;
    nco:=[];
    nno:=[];
#Print(List(co,Size),"\n");
    for j in [1..Length(co)] do
      if nh<>fail then
        new:=ComplementClassesRepresentatives(Image(nh,co[j]),Image(nh,cs[i-1]));
	Info(InfoAli,4,Length(new)," local complement classes in factor");
	if Length(new)>10 then
	  Error("QQQ");
	fi;
	# fuse under group
	ag:=Image(nh,no[j]);

	b:=[];
	for a in new do
	  Add(nco,PreImage(nh,a));
	  Add(nno,PreImage(nh,Normalizer(ag,a)));
	  orb:=Orbit(ag,a);
	  #Print("orbitlen ",Length(orb),"\n");
	  for j in [1..Length(new)] do
	    if IsBound(new[j]) and new[j] in orb then 
	      Unbind(new[j]);
	    fi;
	  od;
	od;

      else
	new:=ComplementClassesRepresentativesSolvableWBG(co[j],cs[i-1],cs[i]);
	Info(InfoAli,4,Length(new)," local complement classes");
	b:=[];
	for a in new do
	  if ForAll(b,x->RepresentativeAction(no[j],a,x)=fail) then
	    Add(b,a);
	  fi;
	od;
	Append(nco,b);
	if i<Length(cs) then
	  Append(nno,List(b,x->Normalizer(no[j],x)));
	fi;
      fi;
    od;
    co:=nco;
    no:=nno;
    Info(InfoAli,3,"FusedComplements step ",i,": ",Size(cs[i])," has ",
         Length(co)," complements");
  od;
  co:=List(co,x->PreImage(hom,x));
  return co;
end;


# original version
WreathBasisComplementRepresentatives:=function(sys,c,t)
local b,w,a;
  t:=Image(sys.wrmap,t);
  if sys.a=2 or Gcd(Size(c),Size(t))=1 then
    #Schur/Zassenhaus or Z2
    Info(InfoAli,3,"coprime case or GF2, 1 complement");
    return [t];
  fi;
  b:=List(sys.emb,i->Image(i,c));
  b:=Subgroup(sys.parent,Concatenation(List(b,i->GeneratorsOfGroup(i))));
  w:=Subgroup(sys.parent,Concatenation(GeneratorsOfGroup(b),
                                       GeneratorsOfGroup(t)));

#Add(COMPL,[w,b]);
  t:=ComplementClassesRepresentatives(w,b);

  # further fusion 
  b:=[];
  for a in t do
    if ForAll(b,i->RepresentativeAction(sys.kr,i,a)=fail) then
      Add(b,a);
    fi;
  od;
  Info(InfoAli,3,Length(t)," complements fused to ",Length(b));
  return b;
end;

WreathBasisComplementRepresentatives:=function(sys,c,t)
local b,w,a,fno,cnt,normalsyl,tf,nt,tno,ntno,i,j,k,com,hom,cs,ker,nf;
  t:=Image(sys.wrmap,t);
  if sys.a=2 or Gcd(Size(c),Size(t))=1 then
    #Schur/Zassenhaus or Z2
    Info(InfoAli,3,"coprime case or GF2, 1 complement");
    return [t];
  fi;
  b:=List(sys.emb,i->Image(i,c));
  b:=Subgroup(sys.parent,Concatenation(List(b,i->GeneratorsOfGroup(i))));
  w:=Subgroup(sys.parent,Concatenation(GeneratorsOfGroup(b),
                                       GeneratorsOfGroup(t)));
  fno:=Normalizer(Image(sys.blockhom,sys.kr),Image(sys.blockhom,w));
  fno:=PreImage(sys.blockhom,fno); # factor normalizer

  # are we effectively working modulo a prime?
  normalsyl:=Filtered(PrimeDivisors(Size(fno)),p->
    (not IsInt(Index(w,b)/p)) and
    IsNormal(fno,SylowSubgroup(b,p)) );

  cs:=[b];
  if Length(normalsyl)>0 then
    Add(cs,SylowSubgroup(b,normalsyl[1]));
  fi;
  Add(cs,TrivialSubgroup(sys.kr));

  t:=[w];
  tno:=[fno];
  # fusion of complements along cs
  for i in [2..Length(cs)] do
    if i=Length(cs) then
      hom:=fail;
      ker:=cs[i-1];
    else
      hom:=NaturalHomomorphismByNormalSubgroup(fno,cs[i]);
      ker:=Image(hom,cs[i-1]);
    fi;
    Info(InfoAli,3,"Liftstep ",i,"/",Length(cs),":", Size(ker),"\n");
    nt:=[];
    ntno:=[];
    for j in [1..Length(t)] do
      tf:=t[j];
      nf:=tno[j];
      if hom<>fail then
	tf:=Image(hom,t[j]);
	nf:=Image(hom,nf);
      fi;
      k:=ComplementClassesRepresentatives(tf,ker);
      if Length(k)>1 then
        Info(InfoAli,3,"Class ",j," split into ",Length(k)," classes");
      fi;
      com:=SubgroupsOrbitsAndNormalizers(nf,k,false);
      if false and Length(k)>1 then
	Print(Size(cs[i])," : ",Length(k),"complements, ",
	      Length(com)," orbits\n");
      fi;
      for k in com do
        if hom=fail then
	  Add(nt,k.representative);
	  Add(ntno,k.normalizer);
	else
	  Add(nt,PreImage(hom,k.representative));
	  Add(ntno,PreImage(hom,k.normalizer));
	fi;
      od;
    od;
    t:=nt;
    tno:=ntno;
    #Print(Size(cs[i]),":",Length(t),"complements\n");
  od;
  return t;
end;

# (sys,[cycl,]l)
TGInvariantSubgroups:=function(sys,a2,l)
local d,u,i,ii,homs,v,o,j,sz,a,sym,dd,prms,p,weg,itra,abi,jind,abig,ag;
  sym:=Image(sys.wrmap);

  d:=Subgroup(sys.parent,Concatenation(List(sys.emb,
			   i->List(a2,j->Image(i,j)))));
  u:=Subgroup(sys.parent,a2);
  sz:=Size(u);

  if ForAny(l,i->Length(MovedPoints(i))>sys.b) then
    Info(InfoAli,1,"assume subgroups given");
    itra:=true; # test for trans. norm. action
  else
    itra:=ForAny(l,i->not IsTransitive(i,[1..sys.b]));
    l:=Concatenation(List(l,i->WreathBasisComplementRepresentatives(sys,
				 sys.sg,i)));
  fi;

  # the wreath basis
  #dd:=Subgroup(sys.parent,Concatenation(List(sys.emb,
  #                                        i->GeneratorsOfGroup(Image(i)))));
  dd:=sys.kr;
  for ii in sys.blocks do
    dd:=Stabilizer(dd,ii,OnSets);
  od;

  u:=[];
  #sz:=RootInt(Size(d),sys.b); # weird, but we don't compute the single size
  abig:=IsomorphismPcGroup(d);
  ag:=Image(abig);
  weg:=[];

  for ii in [1..Length(l)] do
    i:=l[ii];

    # try to express the automorphisms as conjugators
    abi:=false;
    if IsSolvableGroup(i) then
      a:=ClosureGroup(d,i);
      if IsSolvableGroup(a) then
        abi:=IsomorphismPcGroup(a);
	a:=Image(abi,d);
	homs:=List(GeneratorsOfGroup(i),
	           j->ConjugatorAutomorphism(a,Image(abi,j)));

      fi;
    fi;

    if abi=false then
      abi:=abig;
      a:=ag;

      homs:=List(GeneratorsOfGroup(i),
	      j->GroupHomomorphismByImagesNC(a,a,GeneratorsOfGroup(a),
		    List(GeneratorsOfGroup(a),
		      k->Image(abi,PreImagesRepresentative(abi,k)^j))));
    fi;



    if IsElementaryAbelian(a) then
      v:=InvariantSubgroupsElementaryAbelianGroup(a,homs);
      v:=Filtered(v,i->Size(i)>1); # drop the 1
    else
      v:=SubgroupsSolvableGroup(a,rec(actions:=homs,
                                consider:=SizeConsiderFunction(sz)));
    fi;
    v:=List(v,i->PreImage(abi,i));

    # take only those, that project correctly
    Info(InfoAli,1,Length(v)," invariant subgroups reduced to");
    v:=Filtered(v,i->Size(Image(sys.projs[1],i))=sz);
    Info(InfoAli,1,Length(v)," with right projection");

    v:=Filtered(v,j-> not (j in u or j in weg));
    Info(InfoAli,1,Length(v)," new ones");

    # clean the `weg' list once it is not needed any longer
    if ii=Length(l) then
      weg:=[];
    fi;


    if itra then
      # throw away those, which cannot allow trans. action
      v:=Filtered(v,i->TransKgVLength(sys,i)>=sys.b);
      Info(InfoAli,1,"reduced to ",Length(v)," transcands");
    fi;

    for jind in [1..Length(v)] do
      Info(InfoAli,2,"standardizing ",jind," of ",Length(v));
      j:=v[jind];
      v[jind]:=false; #free the memory

      if ForAny(l{[ii+1..Length(l)]},k->IsNormal(k,j)) then
	# we will get this group later again, so remember it
	Info(InfoAli,2,"memorized for later complements");
	o:=Subgroup(sys.parent,GeneratorsOfGroup(j)); # we'll change the group later
	Add(weg,o);
      fi;

      # try to find a smaller group containing the normalizer:
      # check for block systems
      p:=PartitionsSignatures(UnorderedSignatures(sys,j));

      if not itra and Length(p)>0 then
	# take the 'middlemost' partition, if in doubt the smaller one. This
	# gives the optimal (smallest) wreath product
	Sort(p,LengthSortFun);
	o:=1;
	while Length(p)>o and Length(p[o+1][1])<Length(p[o+1]) do
	  o:=o+1;
	od;
	p:=p[o];

	# now construct the wreath product corresponding to this partition
	o:=MySymmetricGroup(Length(p));
	o:=WreathProduct(MySymmetricGroup(Length(p[1])),o);
	o:=GeneratorsOfGroup(o);
	# map the generators to be according to the partition
	prms:=PermList(Concatenation(p));
	o:=List(o,i->i^prms);

	# permutations to map it right to the points in sys...
	prms:=List([1..sys.a],i->MappingPermListList([1..sys.b],
		   List(sys.blocks,j->j[i])));

	# and take the right wreather
	o:=List(o,i->Product(prms,j->i^j));
	p:=Subgroup(sys.parent,o);

	# note the base
	p:=ClosureGroup(dd,p);

	Info(InfoAli,2,"normalizer supergroup reduced by ",
		  Index(sys.kr,p));
      else
	p:=sys.kr;
      fi;

      if not IsElementaryAbelian(j) then
        # try to use elem ab subgroup
	o:=j;
	repeat
	  o:=DerivedSubgroup(o);
	until IsElementaryAbelian(o) or IsPerfect(o);
	if Size(o)>1 and IsElementaryAbelian(o) then
	  p:=NormalizerEAPermGroup(p,o);
	  Info(InfoAli,2,"normalizer supergroup reduced by ",
		  Index(sys.kr,p));
	fi;
      fi;

      # we already know something about the normalizer
      o:=Normalizer(Normalizer(sym,i),j);
#Print("approxsize:",Size(o));

      if Size(p)<Size(sys.kr) then
	o:=StandardConjugateAllowTSubgroup(sys,j,o,p);
      else
	o:=StandardConjugateAllowTSubgroup(sys,j,o);
      fi;
      if o<>false and not o in u then
	Add(u,o);
      fi;

    od;
    
#Exec("cp sdpstmp1 sdpstmp1.bak");
#PrintTo("sdpstmp1",u,"\n",weg,"\n");

  od;

  u:=Set(u);

  for i in u do
    if HasKrnormalizer(i) then
#if not IsSubgroup(Krnormalizer(i),i) then
#  Error("B");
#fi;
      SetGrKrnormalizer(i,Krnormalizer(i));
    fi;
  od;
  return u;
end;

ValueComparison:=function(a,b)
  if a<b then
    return -1;
  elif a>b then
    return 1;
  else
    return 0;
  fi;
end;

IsValidlyConstructed:=function(sys,grp,lst,prods)
local n,o,bl,i,b,flag,nt,op,fil,z,id,bo;
  n:=false;
  o:=false;
  id:=false;
  bl:=Difference(AllBlocks(grp),[sys.blocks[1]]);
  flag:=0;
  i:=1;
  while i<=Length(bl) and flag>=0 do
    b:=bl[i];
    flag:=ValueComparison(Length(b),sys.a);
    if flag=0 then
      if n=false then
	n:=Core(grp,Stabilizer(grp,sys.blocks[1],OnSets));
      fi;
      nt:=Core(grp,Stabilizer(grp,b,OnSets));
      flag:=ValueComparison(Size(nt),Size(n));
      if flag=0 then
	if o=false then
	  o:=Action(grp,sys.blocks,OnSets);
	fi;
        op:=Action(grp,Orbit(grp,b,OnSets),OnSets);
	flag:=ValueComparison(TransitiveIdentification(op),
	                      TransitiveIdentification(o));
	if flag=0 then
	  # test for block operation
	  if id=false then
	    id:=TransitiveIdentification(Action(Stabilizer(grp,
	                       sys.blocks[1],OnSets),sys.blocks[1]));
	  fi;

	  bo:=TransitiveIdentification(Action(Stabilizer(grp,b,OnSets),b));
	  flag:=ValueComparison(bo,id);

	  if flag=0 then

	    nt:=PermMinGens(nt);

	    # bring the block system in the 'nice' form
	    z:=PreCanonizingPerm(nt,Orbit(grp,b,OnSets),sys,false);

	    #z:=MappingPermListList(Concatenation(Orbit(grp,b,OnSets)),
	#		     Concatenation(sys.blocks));
	    #nt:=Subgroup(sys.parent,List(GeneratorsOfGroup(nt),i->i^z));

	    nt:=ConjugateGroup(nt,z);
            
	    # and canonize
	    Info(InfoAli,2,"Block canonizing");
  TIMING.canon:=Runtime()-TIMING.canon;
	    if IsBound(sys.useInvariants) then
	      nt:=StandardConjugateAllowTSubgroup(sys,nt,
	                   ConjugateGroup(grp,z));
	    elif IsBound(sys.blocksys) then
	      nt:=MinimalBlockAction(sys,nt,prods[1].ap,2);
	    else
	      nt:=Canonize(nt,sys,sys.wrg,sys.b,prods,2);
	    fi;

  TIMING.canon:=Runtime()-TIMING.canon;

	    if nt=n then

	      # probably twice created to the same n
	      # thus check, if already created
	      fil:=Filtered(lst,i->MightBeConjugatePermGrps(i,grp));

	      if Length(fil)>0 then
		# now the hard test is inevitable.
		nt:=Subgroup(sys.parent,List(GeneratorsOfGroup(grp),i->i^z));
		TIMING.ctest:=Runtime()-TIMING.ctest;
		Info(InfoAli,2,"Conj. test, ");
		
		# special case: regular groups (for which the conj. test
		#  is extremely expensive)
		if IsRegular(nt,[1..sys.a*sys.b]) then
		  Info(InfoAli,2,"regular");
		  op:=IdGroup(nt);
		  if ForAny(fil,i->IdGroup(i)=op) then
		    flag:=-1;
		  fi;
		else
		  Info(InfoAli,2,"ordinary");
		  for op in fil do
		    # note conjugacy classes
		    if not IsBound(op!.klasse) then
		      op!.klasse:=ConjugacyClassSubgroups(sys.kr,op);
		    fi;
		  od;

		  if ForAny(fil,i->nt in i!.klasse) then
		    # forget it
		    flag:=-1;
		  fi;
		fi;

		TIMING.ctest:=Runtime()-TIMING.ctest;
	      else
		Info(InfoAli,3,"no isomorphic preliminary candidate");
	      fi;

	      if flag<>-1 then
		# note it as troublemaker
		grp!.troublesome:=true;
	      fi;

	    else
	      #if ComparePermGroups(nt,j) then
	      if nt<n then
		# we will get the same group already earlier
		flag:=-1;
	      # else we can ignore this block system
	      fi;
	    fi;
	  fi;
	fi;
      fi;
    fi;
    i:=i+1;
  od;
  return flag>=0;
end;

TestAtops := function(sys,at,p)
local tf,trouble,t,k,oldsz,i,atp;

  # sort the groups according to ascending size
  Sort(at,function(a,b) return Size(a)<Size(b);end);

  t:=[];
  trouble:=[];
  oldsz:=0;

  for atp in [1..Length(at)] do
    k:=at[atp];
    Unbind(at[atp]);

    if Size(k)>oldsz then
      # we now deal with larger groups, throw away the noted troublemakers
      oldsz:=Size(k);
      trouble:=[];
    fi;

    # now check, whether this group really belongs to this class:
    tf:=IsValidlyConstructed(sys,k,trouble,p);
    if tf then
      if IsBound(k!.troublesome) and k!.troublesome=true then
	Add(trouble,k);
	Info(InfoAli,1,"troublesome new group");
      else
#	Unbind(k.conjugacyClasses);
#	Unbind(k.derivedSubgroup);
	Info(InfoAli,1,"new group");
      fi;

      # remove superfluous Attributes
      oldsz:=Size(k);
      if Length(GeneratorsOfGroup(k))<4 then
	k:=Group(GeneratorsOfGroup(k));
      else
	k:=Group(SmallGeneratingSet(k));
      fi;
      SetSize(k,oldsz);

      Add(t,k);
    else
#      Unbind(k.conjugacyClasses);
#      Unbind(k.derivedSubgroup);
      Info(InfoAli,1,"old group");
    fi;

  od;

  return t;
end;

SupoIdFunction:=function(sys,sdps)
local q;
  q:=List(sdps,i->List(i,j->[Size(j),ClassShapes(j)]));
  if ForAny(q,i->Length(Set(i))<Length(i)) then
    Info(InfoAli,2,"identification will need canonization");
  fi;
  return function(grp)
  local l,id;
    # Nr. moved blocks
    l:=Number(sys.blocks,i->ForAny(i,j->ForAny(GeneratorsOfGroup(grp),k->j^k<>j)));
    id:=[Size(grp),ClassShapes(grp)];
    id:=Filtered([1..Length(sdps[l])],i->id=q[l][i]);
    if Length(id)=1 then
      return id[1];
    else
      # we'll have to canonize
      # we can suppose, that orbits and orbit actions are already OK!
      grp:=Canonize(grp,sys,sys.wrg,l,sdps,2);
      return Position(sdps[l],grp);
    fi;
  end;
end;

# for u normal in g get (representatives of) the primitive
# supergroups of u in g
MinimalPrimitiveSupergroups:=function(g,u)
local i,j,l,p,sup,dom,use,lcl;
  dom:=MovedPoints(g);
  l:=LatticeSubgroups(g);
  lcl:=ConjugacyClassesSubgroups(l);
  sup:=MinimalSupergroupsLattice(l);
  sup:=List(sup,i->Set(List(i,j->j[1])));
  # we know that u is normal in g
  use:=[First([1..Length(lcl)],i->Size(lcl[i])=1
              and Representative(lcl[i])=u)];

  p:=[];
  # store primitive leaves of ascending trees
  for i in use do
    if IsPrimitive(Representative(lcl[i]),dom) then
      AddSet(p,i);
    else
      for j in sup[i] do
	if not j in use then
	  Add(use,j);
        fi;
      od;
    fi;
  od;

  # throw away non minimal ones
  use:=ShallowCopy(p);
  for i in use do
    for j in sup[i] do
      if j in p then
        RemoveSet(p,j);
      else
        Add(use,j);
      fi;
    od;
  od;

  p:=List(p,i->TransitiveIdentification(Representative(lcl[i])));
  return p; 
end;

# get the minimal transitive groups whose point stabilizer is divides by siz
# gets a superset
MinTransGrpsWithGivenStabSizeNrs:=function(deg,siz)
local i,j,sel,nsel,m,g,flag;
  if siz=1 then
    return MINTRANSIND[deg];
  fi;
  # pick the indices for which the stabilizer size is OK
  sel:=Filtered([1..TRANSLENGTHS[deg]],
                i->ForAny(siz,j->IsInt(TRANSProperties(deg,i)[1]/deg/j)));
  # HAVE TO BE SORTED BY SIZE !

  nsel:=[];
  for i in sel do
    if ForAll(nsel,j->not IsInt(TRANSProperties(deg,i)[1]
                               /TRANSProperties(deg,j)[1])) then
      # Bisher keine passenden
      Add(nsel,i);
    else

      g:=TransitiveGroup(deg,i);
      if IsSolvableGroup(g) then
        m:=MaximalSubgroupClassReps(g);
	m:=Filtered(m,i->IsTransitive(i,[1..deg]));
	m:=List(m,TransitiveIdentification);
	if not ForAny(m,j->j in nsel) then
	  Add(nsel,i);
	fi;

      # silly test for s_n and a_n
      elif not ForAny(nsel,j->ForAll(GeneratorsOfGroup(TransitiveGroup(deg,j)),
                                     k-> k in g)) then
        flag:=true;
	j:=1;
	# try some random subgroups for elimination
	while flag and j<=10 do
	  repeat
	    m:=Subgroup(g,[Random(g),Random(g)]);
	  until Size(m)<Size(g);
	  if IsTransitive(m,[1..deg]) and TransitiveIdentification(m) in
	    nsel then
	    flag:=false;
	  fi;
	  j:=j+1;
        od;
	if flag then
	  Error("would need maximal subgroups, not yet written");
	fi;
      fi;
    fi;
  od;
  return nsel;
end;

NewImprimitiveGroups:=function(arg)
local bls, # block size
      bla, # block Anzahl
      sys,
      dom,
      minops,trueminops,actgroups,
      i,j,k,l,at,bl,flag,p,n,nids,nt,id,t,op,z,trouble,fil,m,
      b,c,lsys,gsys,lp,neu,ap,idfunc,localbls,lplbs,
      indices,ind;

  sys:=arg[1];
  bls:=sys.a;
  bla:=sys.b;
  dom:=[1..bla*bls];
  Info(InfoAli,1,"NewImprimitiveGroups(",bls,",",bla,")");

  # for bases, we have to take all transitive normal subgroups of primitive
  # groups, whose index divides the order of the point stabilizer of a
  # minimal transitive group.
  TransGrpLoad(bla,0);
  TransGrpLoad(bls,0);
  indices:=Set(List([1..TRANSLENGTHS[bla]],i->TRANSProperties(bla,i)[1]/bla));

  # get all normal subgroups of primitive groups if none are prescribed
  if Length(arg)=1 then
    p:=AllPrimitiveGroups(NrMovedPoints,bls);
    n:=[];
    nids:=[];
    for i in p do
      Add(n,TransitiveGroup(bls,TransitiveIdentification(i)));
      if Size(i)<Factorial(bls) # the symmetric group yields nothing new
	and not IsSimple(i) then 
	nt:=Filtered(NormalSubgroups(i),
		 j->IsTransitive(j,[1..bls]) and not IsPrimitive(j,[1..bls]));
	for j in nt do
	  id:=TransitiveIdentification(j);
	  if not id in nids and 
	     # index divides one stab size
	     ForAny(indices,x->x mod Index(i,j)=0) then
	    Add(nids,id);
	    Add(n,TransitiveGroup(bls,id));
	  fi;
	od;
      fi;
    od;
  else
    n:=arg[2];
  fi;
  # now n contains all transitive normal subgroups of primitive groups we
  # want

  Sort(n,function(a,b) return Size(a)<Size(b);end);

  Info(InfoAli,1,Length(n)," base components");
  Info(InfoAli,1,"Sizes:",List(n,Size));

  trueminops:=List(MINTRANSIND[bla],i->TransitiveGroup(bla,i));

  t:=[];
  for i in n do
    id:=TransitiveIdentification(i);
    Unbind(sys.useInvariants); # we don't yet know whether invariants will do

    # note the normalizer as the group to conjugate with
    # we might later want to use different subgroups of the normalizer (index
    # cond.) ??
    p:=Normalizer(sys.s,AsSubgroup(sys.s,i));
    AdaptCanonizingSystem(sys,p);

    if not IsPrimitive(i,[1..bls]) then
      # restrict minops to the minimal groups with suitable stabilizer
      # get the minimal primitive supergroups
      minops:=MinimalPrimitiveSupergroups(p,i);

      minops:=MinTransGrpsWithGivenStabSizeNrs(bla,
	       List(minops,j->TRANSProperties(sys.a,j)[1]/Size(i)));

      Info(InfoAli,1,"not primitive, actions changed from ",MINTRANSIND[bla],
               " to ",minops);
      minops:=List(minops,i->TransitiveGroup(bla,i));
      
    else
      # test, whether it is sufficient to use for invariants:
      minops:=trueminops;
    fi;

    lp:=Size(p);

    if bls=2 or
      (IsAbelian(i) and
      ForAll(trueminops,j->Gcd(Size(Stabilizer(j,1)),lp/Size(i))=1)) then
      Info(InfoAli,1,"using invariant modules");
      sys.useInvariants:=1;
      actgroups:=trueminops;

    # complement case
    elif ForAll(trueminops,j->Gcd(Size(i),Size(j))=1) then
      if IsSolvableGroup(i) then
	Info(InfoAli,1,"using invariant subgroups");
	sys.useInvariants:=2;
      fi;
      actgroups:=trueminops;

    # complements under subgroup case
    else
      # see, whether it's worth to use subgroups of minops
      p:=List(minops,i->Factors(Size(i)));
      c:=PrimeDivisors(Size(i));
      c:=List(p,i->Filtered(i,j->not j in c));
      p:=Minimum(List(c,Product));
      if p>1 and bla>5 and bls*bla>23 then
        # probably still change heuristics

	# now use nontrans such that splits
	Info(InfoAli,1,"using invariants under intransitive subgroups");
	sys.useInvariants:=3;
	p:=minops;

	# we will use invariants under actgroups, so change these appropriately
	actgroups:=[];
	for b in [1..Length(p)] do
	  # try to find large subgroup of coprime order
	  if IsSolvableGroup(p[b]) then
	    lp:=HallSubgroup(p[b],Set(c[b]));
          else
	    # nonsolvable, use largest sylow (ought to use better!)
	    # probably use sylownormalizer and iterate
	    # anyhow this probably will never be used
	    ap:=List(c[b],i->Product(Filtered(c[b],j->j=i)));
	    ap:=Maximum(ap);
	    ap:=Factors(ap)[1];
	    lp:=SylowSubgroup(p[b],ap);
	  fi;
	  Info(InfoAli,3,"subgroup size ",Size(lp)," of group size ",
	           Size(p[b]));
	  AddSet(actgroups,lp);
	od;
      elif sys.b>8 and DOTRICK27 then
	# can we complement a factor? (degree 27 trick)
	# (Don't try this for small sys.b.)

	# get all characteristic subgroups which are transitive and index
	# coprime to sizes of minimal transitive factor groups
	nt:=NormalSubgroups(i);
	nt:=Filtered(nt,j->IsAbelian(j) and Index(i,j)>1 
	                  and IsTransitive(j,MovedPoints(i))
			  and ForAll(minops,k->Gcd(Index(i,j),Size(k))=1));
	nt:=Filtered(nt,j->IsCharacteristicSubgroup(i,j));

	# those nt's which would be type-1 complements
	p:=List(nt,j->Normalizer(sys.s,j));
	lp:=List(p,Size);
	nt:=nt{Filtered([1..Length(nt)],k->ForAll(trueminops,
	                       j->Gcd(Size(Stabilizer(j,1)),
			              lp[k]/Size(nt[k]))=1))};

	if Length(nt)>0 then
	  Info(InfoAli,1,"Get actgroups bottom");
	  nt:=nt[1]; # will give the smallest number of sdps
	  # construct the sdp's for nt
	  actgroups:=TGInvariantSubgroups(sys,GeneratorsOfGroup(nt),trueminops); 
	  Info(InfoAli,1,"Get actgroups top");
	  # get the groups which act on them, select those whose block
	  # action is small
	  actgroups:=Concatenation(List(actgroups,i->Filtered(GroupsAtop(i,sys),
	             j->TransitiveIdentification(Action(j,sys.blocks,OnSets))
			  in MINTRANSIND[sys.b])));
	  sys.useInvariants:=4;
	fi;
      fi;
    fi;

sys.keineschachtel:=true;

TIMING.sdp:=Runtime()-TIMING.sdp;
    if IsBound(sys.useInvariants) then

      Info(InfoAli,1,"Invariant case ",sys.useInvariants);
      Info(InfoAli,1,Length(actgroups),"acting groups");
      # check, whether there might be several complements to consider
      p:=[];

      # invariants always under true minops (we don't need minimality here)
      p[bla]:=TGInvariantSubgroups(sys,GeneratorsOfGroup(i),actgroups);
    else
      # we need to construct the products.
      # can we use blocks?
      b:=List(minops,i->Set(List(AllBlocks(i),Length)));

      if (not IsBound(sys.keineschachtel)) and
         bla>6 and ForAll(b,i->Length(i)>0) and IsSolvableGroup(i) then
        c:=Combinations(Union(b));
	Sort(c,LengthSortFun);
	c:=c{[2..Length(c)]};
	b:=First(c,i->ForAll(b,j->Length(Intersection(i,j))>0));
	Info(InfoAli,1,"using blocks of size ",b);

	localbls:=Maximum(b);
	lsys:=CanonizingSystem(sys.a,localbls);

	if Length(b)=1 then
	  #Print("TRANSFLAG!\n");
	  lsys.transflag:="wahr"; # all transitive except block sizes
	fi;

	lp:=ConstructSubdirectProducts(lsys,i);

        idfunc:=SupoIdFunction(lsys,lp);

	p:=[];
	p[bla]:=[];
	ap:=[];
	sys.blocksys:=[];
	sys.blszes:=b;

        for localbls in b do
	  Info(InfoAli,1,"blocksize ",localbls);
	  # first construct all possible products of b componenents
	  lsys:=CanonizingSystem(sys.a,localbls);

	  if Length(b)=1 then
	    lplbs:=lp[localbls];
	  else
	    lplbs:=Filtered(lp[localbls],
	                    i->IsTransitive(GrKrnormalizer(i),[1..localbls]));
	  fi;
	  Info(InfoAli,2,Length(lplbs)," components");
	  gsys:=CanonizingSystem(sys.a*localbls,sys.b/localbls);
	  gsys.la:=localbls;
	  gsys.localsys:=lsys;
	  gsys.localprod:=lp;
	  gsys.idfunc:=idfunc;
	  gsys.globalsys:=sys;
	  sys.blocksys[localbls]:=gsys;

	  for j in [1..Length(lplbs)] do
	    Info(InfoAli,2,"blockpart ",j," Size ",Size(lplbs[j]));
	    #NOCH: Diagonale speziell behandeln (Prod.diag.=Diag.Prod.)

	    #Auskommentiert, da: tests already for no smaller local operation !!!!
	    #Print("TRANSFLAG!\n");
	    #gsys.transflag:=true;
	    neu:=ConstructSubdirectProducts(gsys,lplbs[j]); 

	    Info(InfoAli,3,"supos=",neu);
	    # remember all for future tests
            Add(ap,neu);

	    # test which ones we will need for the construction
	    neu:=Filtered(neu[sys.b/localbls],
	                  i->MinimalBlockAction(sys,i,ap,1)=true);

	    Info(InfoAli,2,"yields ",Length(neu)," possible kernels");
	    p[bla]:=Concatenation(p[bla],neu);

	    Unbind(gsys.transflag);
	  od;

        od;

	# something to recognize immediately the different structure of p
        p[1]:=rec(ap:=ap);
      else

	# we want only those with transitive normalizer
	#Print("TRANSFLAG!\n");
	sys.transflag:=true;

	p:=ConstructSubdirectProducts(sys,i);
	Unbind(sys.transflag);
      fi;

    fi;
    Info(InfoAli,1,"sdps=",p);
TIMING.sdp:=Runtime()-TIMING.sdp;

    Info(InfoAli,2,"Base component ",id,", ",Length(p[bla])," base groups");

    for j in p[bla] do

TIMING.atop:=Runtime()-TIMING.atop;
      at:=GroupsAtop(j,sys);
TIMING.atop:=Runtime()-TIMING.atop;

      t:=Concatenation(t,TestAtops(sys,at,p));

#Print("###\nt=",t,"\n###\n");

    od;
  od;
  return t;
end;

CheatingImprimitiveGroups:=function(sys)
local a,blopid,norm,au,j,b,u,r,s,k,ob,bl,op,l,flag,nr,z,img,t,sel,bhom;

TIMING.cheat:=Runtime()-TIMING.cheat;

  t:=[];
  TransGrpLoad(sys.b,0);
  AdaptCanonizingSystem(sys,MySymmetricGroup(sys.a));

  for j in [1..TRANSLENGTHS[sys.b]] do
    a:=TransitiveGroup(sys.b,j);
    u:=Stabilizer(a,1);
    if sys.a in [2,3,4] then
      # for i<5 the symmetric group S_i is solvable of derived length at
      # most i. Thus we will find subgroups of index i above the i-th step
      # of the derived series.
      b:=u;
      for k in [2..sys.a] do
	b:=DerivedSubgroup(b);
      od;
      l:=NaturalHomomorphismByNormalSubgroup(u,b);
      k:=Image(l,u);
    else
      l:=false;
      k:=u;
    fi;
    r:=MaximalSubgroupClassReps(k);

    r:=Filtered(r,j->Index(k,j)=sys.a);

    if l<>false then
      # map the subgroups back from the factor group
      r:=List(r,i->PreImage(l,i));
    fi;

    if Length(r)>0 then
      norm:=Normalizer(sys.t,a);
      Info(InfoAli,3,"classlength ",Length(r));
    fi;

    # take representatives of the normalizer classes
    s:=[];
    for k in r do
      if not ForAny(s,i->k in i.klasse) then
	k:=rec(group:=k,klasse:=ConjugacyClassSubgroups(norm,k));
	Add(s,k);
      else
	Info(InfoAli,2,"cheating duplicate");
      fi;
    od;

    # we create the groups and check for need for automs.

    r:=[];
    flag:=0;
    for k in s do
      l:=RightTransversal(a,k.group);
      if not l[1] in u then
	Error("wrong order! #1 must be in pt stab <u>");
      fi;
      bhom:=ActionHomomorphism(a,l,OnRight);
      b:=Image(bhom,a);
      k.b:=b;

      # the block
      ob:=Orbit(Image(bhom,u),1);
      ob:=Set(ob);
      k.ob:=ob;
      bl:=Difference(AllBlocks(b),[ob]);
      k.bl:=bl;
      if ForAll(bl,i->Length(i)>=sys.a) then
	bl:=Filtered(bl,i->Length(i)=sys.a);
	l:=List(bl,i->Image(ActionHomomorphism(b,Orbit(b,i,OnSets),OnSets)));
        sel:=Filtered([1..Length(l)],i->Size(l[i])=Size(a));
	bl:=bl{sel};
	l:=l{sel};
	blopid:=List(l,TransitiveIdentification);
	if ForAll(blopid,i->i>=j) then
	  Add(r,k);
	  # test, whether we might need automorphism fuse
	  if ForAny(blopid,i->i=j) then
	    flag:=1;
	  fi; 
	else
	  Info(InfoAli,2,"inappropriate operation");
	fi;
      else
	Info(InfoAli,2,"inappropriate blocksize");
      fi;
    od;

    if flag=1 and Length(r)>1 then
      # use AgGroup if possible
      IsSolvableGroup(a);
      # we need to fuse under automorphisms as well
      au:=AutomorphismGroup(a);
      IsomorphismPermGroup(au);
      l:=SubgroupNC(au,List(GeneratorsOfGroup(norm),
           x->ConjugatorAutomorphism(a,x)));

      Info(InfoAli,1,a,", Automorphism group of size ",Size(au),
                     ", normalizer index ",Index(au,l));

      # AH: 24-2-99:
      # we want to test g^a=u but know already normalizer classes of u. So
      # we have to test g^(an)=u, i.e. a has to be determined only up to
      # right multiplication by the normalizer -- that is left coset
      # representatives of the normalizer
      l:=RightTransversal(au,l); 
      l:=List(l,Inverse);

      s:=[];
      for k in r do
	if not ForAny(s,i->ForAny(l,j->Image(j,k.group) in i.klasse)) then
	  # take it
	  Info(InfoAli,1,"new 'cheating' group");
	  Add(s,k);
	  Add(t,k.b);
	else
	  Info(InfoAli,1,"old 'cheating' group");
	fi;
      od;
    else 
      if Length(r)=0 then
	Info(InfoAli,1,"no blow-ups");
      elif Length(r)=1 then
	Info(InfoAli,1,"1 new 'cheating' group");
      else
	Info(InfoAli,1,Length(r)," new 'cheating' groups");
      fi;
      t:=Concatenation(t,List(r,i->i.b));
    fi;

    Unbind(au);
    Unbind(u);
    Unbind(b);
    Unbind(bhom);
    Unbind(r);
    Unbind(l);
    Unbind(k);
    Unbind(a);
    Unbind(norm);
  od;

  TIMING.cheat:=Runtime()-TIMING.cheat;
  return t;
end;

ResetTiming:=function()
  TIMING.pool:=[];
  TIMING.total:=0;
  TIMING.canon:=0;
  TIMING.sdp:=0;
  TIMING.nimp:=0;
  TIMING.atop:=0;
  TIMING.cheat:=0;
  TIMING.compl:=0;
  TIMING.ctest:=0;
  TIMING.tcompl:=0;
  TIMING.seatraop:=0;
end;

PrintTiming:=function()
  Print("Total = ",TIMING.total,
        "\ncanonizing  : ",Int(TIMING.canon/TIMING.total*100),
       "%\nsubdirect   : ",Int(TIMING.sdp/TIMING.total*100),
       "%\nnew imprims : ",Int(TIMING.nimp/TIMING.total*100),
       "%\nExtending   : ",Int(TIMING.atop/TIMING.total*100),
       "%\nCheating    : ",Int(TIMING.cheat/TIMING.total*100),
       "%\nTransOperats: ",Int(TIMING.seatraop/TIMING.total*100),
       "%\nComplements : ",Int(TIMING.compl/TIMING.total*100),
       "%\nconj. tests : ",Int(TIMING.ctest/TIMING.total*100),
       "%\nlatt.compl. : ",Int(TIMING.tcompl/TIMING.total*100),
       "\n");
end;

MakeTransitiveGroups:=function(deg)
local trans,z,i,a,sys;

  ResetTiming();
TIMING.total:=Runtime()-TIMING.total;

  trans:=[];
  z:=Filtered(DivisorsInt(deg),i->i>1 and i<deg);
  for i in z do

    # now the groups with blocks of size i
    sys:=CanonizingSystem(i,deg/i);
TIMING.nimp:=Runtime()-TIMING.nimp;
    a:=NewImprimitiveGroups(sys);
TIMING.nimp:=Runtime()-TIMING.nimp;

    trans:=Concatenation(trans,a);

    # and now the cheating ones...
    a:=CheatingImprimitiveGroups(sys);
    trans:=Concatenation(trans,a);

  od;
  trans:=Concatenation(trans,AllPrimitiveGroups(NrMovedPoints,deg));

TIMING.total:=Runtime()-TIMING.total;
Info(InfoAli,1,TIMING);

  return trans;

end;

ResetTiming();
