#############################################################################
##
#W  construc.gi           GAP 4 package `ctbllib'               Thomas Breuer
##
#H  @(#)$Id: construc.gi,v 1.12 2004/03/26 08:10:11 gap Exp $
##
#Y  Copyright (C)  2002,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
##
##  1. Character Tables of Groups of Structure $M.G.A$
##  2. Character Tables of Groups of Structure $G.S_3$
##  3. Character Tables of Groups of Structure $G.2^2$
##  4. Character Tables of Groups of Structure $2^2.G$
##  5. Brauer Tables of Extensions by $p$-regular Automorphisms
##  6. Construction Functions used in the Character Table Library
##  7. Character Tables of Coprime Central Extensions
##  8. Miscellaneous
##
Revision.( "ctbllib/gap4/construc_gi" ) :=
    "@(#)$Id: construc.gi,v 1.12 2004/03/26 08:10:11 gap Exp $";


#############################################################################
##
##  2. Character Tables of Groups of Structure $G.S_3$
##


#############################################################################
##
#F  IrreducibleCharactersOfTypeGS3( <tbl>, <tblC>, <tblK>, <aut>,
#F     <tblfustblC>, <tblfustblK>, <tblCfustblKC>, <tblKfustblKC>, <outerC> )
##
BindGlobal( "IrreducibleCharactersOfTypeGS3",
    function( tbl, tblC, tblK, aut, tblfustblC, tblfustblK, tblCfustblKC,
              tblKfustblKC, outerC )
    local irreducibles,  # list of irreducible characters, result
          zero,          # zero vector on the classes of `tblC' \ `tbl'
          irrtbl,        # irreducible of `tbl'
          irrtblC,       # irreducible of `tblC'
          irrtblK,       # irreducible of `tblK'
          done,          # Boolean list, `true' for all processed characters
          outerKC,       # position of classes outside `tblK'
          k,             # order of the factor `tblK / tbl'
          c,             # order of the factor `tblC / tbl'
          p,             # characteristic of `tbl'
          r,             # ramification index
          i,             # loop over the irreducibles of `tblK'
          chi,           # currently processed character of `tblK'
          img,           # image of `chi' under `aut'
          rest,          # restriction of `chi' to `tbl' (via `tblfustblK')
          e,             # current ramification
          const,         # irreducible constituents of `rest'
          ext,           # extensions of an extendible constituent to `tblC'
          chitilde,      # one extension
          irr,           # one irreducible character
          j,             # loop over the classes of `tblK'
          sum;           # an induced character

    # Initializations.
    irreducibles:= [];
    zero:= 0 * outerC;
    irrtbl:= Irr( tbl );
    irrtblC:= Irr( tblC );
    irrtblK:= Irr( tblK );
    done:= BlistList( [ 1 .. Length( irrtblK ) ], [] );
    outerKC:= tblCfustblKC{ outerC };
    k:= Size( tblK ) / Size( tbl );
    c:= Size( tblC ) / Size( tbl );
    p:= UnderlyingCharacteristic( tbl );

    r:= RootInt( k );
    if r^2 <> k then
      r:= 1;
    fi;

    # Loop over the irreducibles of `tblK'.
    for i in [ 1 .. Length( irrtblK ) ] do
      if not done[i] then

        done[i]:= true;
        chi:= irrtblK[i];
        img:= Permuted( chi, aut );

        if img = chi then

          # `chi' extends.
          rest:= chi{ tblfustblK };
          e:= 1;
          if rest in irrtbl then
            # `rest' is invariant in `tblKC', so we take the values
            # of its extensions to `tblC' on the outer classes.
            const:= [ rest ];
          elif r <> 1 and rest / r in irrtbl then
            # `rest' is a multiple of an irreducible character of `tbl'.
            const:= [ rest / r ];
            e:= r;
          else
            # `rest' is a sum of `k' irreducibles of `tbl';
            # exactly one of them is fixed under the action of `tblC',
            # so we take the values of the extensions of this constituent
            # on the outer classes.
            const:= Filtered( irrtbl,
                        x -> x[1] = rest[1] / k and
                          Induced( tbl, tblK, [ x ], tblfustblK )[1] = chi );
            Assert( 1, Length( const ) = k,
                    "Strange number of constituents.\n" );
          fi;
          Assert( 1, ( p = c and Length( const ) = 1 ) or
                     ( p <> c and Length( const ) = c ),
                  "Extendible constituent is not unique.\n" );
          ext:= Filtered( irrtblC, x ->     x[1] = const[1][1]
                                        and x{ tblfustblC } in const );
          # We can handle only a few cases where $e \not= 1$:
          if   e <> 1 and e = c - 1 then
            # If $e = |C|-1$ then sum up all except one extension.
            ext:= List( ext, x -> Sum( ext ) - x );
          elif e <> 1 and e = c + 1 then
            # If $e = |C|+1$ then sum up all plus one extension.
            ext:= List( ext, x -> Sum( ext ) + x );
          elif e <> 1 then
            Error( "cannot handle a case where <e> > 1" );
          fi;
          for chitilde in ext do
            irr:= [];
            for j in [ 1 .. Length( tblKfustblKC ) ] do
              irr[ tblKfustblKC[j] ]:= chi[j];
            od;
            irr{ outerKC }:= chitilde{ outerC };
            Add( irreducibles, irr );
          od;

        else

          # `chi' induces irreducibly.
          irr:= [];
          done[ Position( irrtblK, img ) ]:= true;
          sum:= chi + img;
          for j in [ 3 .. c ] do
            img:= Permuted( img, aut );
            done[ Position( irrtblK, img ) ]:= true;
            sum:= sum + img;
          od;
          for j in [ 1 .. Length( tblKfustblKC ) ] do
            irr[ tblKfustblKC[j] ]:= sum[j];
          od;
          irr{ outerKC }:= zero;
          Add( irreducibles, irr );

        fi;

      fi;
    od;

    # Return the result.
    Assert( 1, Length( irreducibles ) = Length( irreducibles[1] ),
            Concatenation( "Not all irreducibles found (have ",
                String( Length( irreducibles ) ), " of ",
                String( Length( irreducibles[1] ) ), ")\n" ) );
    return irreducibles;
end );


#############################################################################
##
#F  CharacterTableOfTypeGS3( <tbl>, <tblC>, <tblK>, <aut>, <identifier> )
#F  CharacterTableOfTypeGS3( <modtbl>, <modtblC>, <modtblK>, <ordtblKC>,
#F                           <identifier> )
##
InstallGlobalFunction( CharacterTableOfTypeGS3,
    function( tbl, tblC, tblK, aut, identifier )
    local p,             # prime integer
          tblfustblC,    # class fusion from `tbl' into `tblC'
          tblfustblK,    # class fusion from `tbl' into `tblK'
          tblKfustblKC,  # class fusion from `tblK' into the desired table
          tblCfustblKC,  # class fusion from `tblC' into the desired table
          outer,         # positions of the classes of `tblC' \ `tbl'
          i,
          tblKC,
          classes,
          subclasses,
          k,
          orders,
          suborders,
          powermap,
          pow;

    # Fetch the underlying characteristic, and check the arguments.
    p:= UnderlyingCharacteristic( tbl );
    if    UnderlyingCharacteristic( tblC ) <> p
       or UnderlyingCharacteristic( tblK ) <> p then
      Error( "UnderlyingCharacteristic values differ for <tbl>, <tblC>, ",
             "<tblK>" );
    elif 0 < p and not IsOrdinaryTable( aut ) then
      Error( "enter the ordinary table of G.KC as the fourth argument" );
    elif 0 = p and not IsPerm( aut ) then
      Error( "enter a permutation as the fourth argument" );
    fi;

    # Fetch the stored fusions from `tbl'.
    tblfustblC:= GetFusionMap( tbl, tblC );
    tblfustblK:= GetFusionMap( tbl, tblK );
    if tblfustblC = fail or tblfustblK = fail then
      Error( "fusions <tbl> -> <tblC>, <tbl> -> <tblK> must be stored" );
    fi;
    outer:= Difference( [ 1 .. NrConjugacyClasses( tblC ) ], tblfustblC );

    if 0 < p then

      # We assume that the ordinary table of `tblKC' (given as the argument
      # `aut') has the same ordering of classes as is guaranteed for the
      # table to be constructed.
      tblKC:= CharacterTableRegular( aut, p );

      # Compute the restriction of the action to the `p'-regular classes.
      tblKfustblKC:= GetFusionMap( tblK, tblKC );
      if tblKfustblKC = fail then
        Error( "fusion <tblK> -> <tblKC> must be stored" );
      fi;
      aut:= Product( List( Filtered( InverseMap( tblKfustblKC ), IsList ),
                           x -> MappingPermListList( x,
                                    Concatenation( x{ [ 2 .. Length(x) ] },
                                                   [ x[1] ] ) ) ),
                     () );

      # Fetch fusions for the result.
      tblKfustblKC:= GetFusionMap( tblK, tblKC );
      tblCfustblKC:= GetFusionMap( tblC, tblKC );

    else

      # Compute the needed fusions into `tblKC'.
      tblKfustblKC:= InverseMap( Set( Orbits( Group( aut ),
                         [ 1 .. NrConjugacyClasses( tblK ) ] ) ) );
      tblCfustblKC:= CompositionMaps( tblKfustblKC,
          CompositionMaps( tblfustblK, InverseMap( tblfustblC ) ) );
      tblCfustblKC{ outer }:= [ 1 .. Length( outer ) ]
                              + Maximum( tblKfustblKC );

      # Initialize the record for the character table `tblKC'.
      tblKC:= rec( UnderlyingCharacteristic := 0,
                   Identifier := identifier,
                   Size := Size( tblK ) * Size( tblC ) / Size( tbl ) );

      # Compute class lengths and centralizer orders.
      classes:= ListWithIdenticalEntries( Maximum( tblCfustblKC ), 0 );
      subclasses:= SizesConjugacyClasses( tblK );
      for i in [ 1 .. Length( subclasses) ] do
        classes[ tblKfustblKC[i] ]:= classes[ tblKfustblKC[i] ]
                                     + subclasses[i];
      od;
      subclasses:= SizesConjugacyClasses( tblC );
      k:= Size( tblK ) / Size( tbl );
      for i in outer do
        classes[ tblCfustblKC[i] ]:= classes[ tblCfustblKC[i] ]
                                     + k * subclasses[i];
      od;
      tblKC.SizesConjugacyClasses:= classes;
      tblKC.SizesCentralizers:= List( classes, x -> tblKC.Size / x );

      # Compute element orders.
      orders:= [];
      suborders:= OrdersClassRepresentatives( tblK );
      for i in [ 1 .. Length( tblKfustblKC ) ] do
        orders[ tblKfustblKC[i] ]:= suborders[i];
      od;
      suborders:= OrdersClassRepresentatives( tblC );
      for i in outer do
        orders[ tblCfustblKC[i] ]:= suborders[i];
      od;
      tblKC.OrdersClassRepresentatives:= orders;

      # Convert the record to a table object.
      ConvertToCharacterTableNC( tblKC );

      # Put the power maps together.
      powermap:= ComputedPowerMaps( tblKC );
      for p in Set( Factors( Size( tblKC ) ) ) do
        pow:= InitPowerMap( tblKC, p );
        TransferDiagram( PowerMap( tblC, p ), tblCfustblKC, pow );
        TransferDiagram( PowerMap( tblK, p ), tblKfustblKC, pow );
        powermap[p]:= pow;
        Assert( 1, ForAll( pow, IsInt ),
                Concatenation( Ordinal( p ),
                               " power map not uniquely determined" ) );
      od;

    fi;

    # Compute the irreducibles.
    SetIrr( tblKC,
            List( IrreducibleCharactersOfTypeGS3( tbl, tblC, tblK, aut,
                      tblfustblC, tblfustblK, tblCfustblKC, tblKfustblKC,
                      outer ),
                  chi -> Character( tblKC, chi ) ) );

    # Return the result.
    return rec( table        := tblKC,
                tblCfustblKC := tblCfustblKC,
                tblKfustblKC := tblKfustblKC );
end );


#############################################################################
##
#F  PossibleActionsForTypeGS3( <tbl>, <tblC>, <tbl3> )
##
InstallGlobalFunction( PossibleActionsForTypeGS3, function( tbl, tblC, tblK )
    local tfustC,
          tfustK,
          c,
          elms,
          inner,
          linK,
          i,
          vals,
          c1,
          c2,
          newelms,
          inv,
          orbs,
          orb;

    # Check that the function is applicable.
    tfustC:= GetFusionMap( tbl, tblC );
    if tfustC = fail then
      Error( "class fusion <tbl> -> <tblC> must be stored on <tbl>" );
    fi;
    tfustK:= GetFusionMap( tbl, tblK );
    if tfustK = fail then
      Error( "class fusion <tbl> -> <tblK> must be stored on <tbl>" );
    fi;

    # The automorphism must have order `c'.
    c:= Size( tblC ) / Size( tbl );
    elms:= Filtered( AsList( AutomorphismsOfTable( tblK ) ),
                     x -> Order( x ) = c );
    Info( InfoCharacterTable, 1,
          Length( elms ), " automorphism(s) of order ", c );
    if Length( elms ) <= 1 then
      return elms;
    fi;

    # The automorphism must permute the outer cosets of `tblK'.
    inner:= Set( tfustK );
    linK:= Filtered( Irr( tblK ),
               chi -> IsSubset( ClassPositionsOfKernel( chi ), inner ) );
    linK:= Difference( linK, [ TrivialCharacter( tblK ) ] );
    elms:= Filtered( elms, x -> Permuted( linK[1], x ) = linK[2] );
    Info( InfoCharacterTable, 1,
          Length( elms ), " automorphism(s) permuting the cosets" );
    if Length( elms ) <= 1 then
      return elms;
    fi;

    # The automorphism respects the fusion of classes of `tbl' into `tblC'.
    for i in InverseMap( tfustC ) do
      if IsList( i ) then
        vals:= SortedList( tfustK{ i } );
        c1:= vals[1];
        c2:= vals[2];
        if c1 <> c2 then
          RemoveSet( vals, c1 );
          newelms:= Filtered( elms, x -> c1^x in vals );
          if newelms <> elms then
            elms:= newelms;
            Info( InfoCharacterTable, 1,
                  Length( elms ), " automorphism(s) fusing ", c1, " and ",
                  c2 );
            if Length( elms ) <= 1 then
              return elms;
            fi;
          fi;
        fi;
      fi;
    od;

    # Two inner classes that are fused neither in `tblC' nor in `tblK'
    # cannot be conjugate in `tKC'.
    inv:= InverseMap( tfustK );
    orbs:= Union( List( elms, i -> Filtered( Orbits( Group( i ), inner ),
                                              orb -> Length( orb ) = c ) ) );
    orbs:= Filtered( orbs, x ->     IsInt( inv[ x[1] ] )
                                  and IsInt( inv[ x[2] ] )
                                  and tfustC[ inv[ x[1] ] ]
                                   <> tfustC[ inv[ x[2] ] ] );
    for orb in orbs do
      c1:= orb[1];
      c2:= orb[2];
      newelms:= Filtered( elms, x -> c1^x <> c2 );
      if newelms <> elms then
        elms:= newelms;
        Info( InfoCharacterTable, 1,
              Length( elms ),
              " automorphism(s) not fusing ", c1, " and ", c2 );
        if Length( elms ) <= 1 then
          return elms;
        fi;
      fi;
    od;

    # Return the result.
    return elms;
end );


#############################################################################
##
##  1. Character Tables of Groups of Structure $M.G.A$
##


#############################################################################
##
#F  PossibleCharacterTablesOfTypeMGA( <tblMG>, <tblG>, <tblGA>, <aut>,
#F      <identifier> )
##
InstallGlobalFunction( PossibleCharacterTablesOfTypeMGA,
    function( tblMG, tblG, tblGA, perm, identifier )
    local MGfusG,        # factor fusion map from `tblMG' onto `tblG'
          GfusGA,        # subgroup fusion map from `tblG' into `tblGA'
          tblMGA,        # record for the desired table
          orbits,        # orbits of `perm' on the class positions of `tblMG'
          MGfusMGA,      # subgroup fusion map from `tblMG' into `tblMGA'
          factouter,     # positions of classes of `tblGA' outside `tblG'
          MGAfusGA,      # factor fusion map from `tblMGA' onto `tblGA'
          inner,         # inner classes of `tblMGA'
          outer,         # outer classes of `tblMGA'
          nccl,          # class number of `tblMG'
          classes,       # class lengths of `tblMG'
          i,             # loop variable
          kernel,        # kernel of `tblMGfustblG'
          zero,          # zero vector (for ind. characters on outer classes)
          chi,           # loop variable
          sum,           # sum of images of `chi' under the automorphism
          chip,          # one image of `chi'
          ind,           # simulate an induced character
          primes,        # prime divisors of the order of `tblMGA'
          invMGAfusGA,   # inverse of `MGAfusGA'
          p,             # loop variable
          GAmapp,        # `p'-th power map of `tblGA'
          orders,        # element orders of `tblMGA'
          suborders,     # element orders of `tblMG'
          outerorders,   # outer part of the orders
          gcd,           # g.c.d. of the orders of `M' and `A'
          matautos,      # matrix automorphisms of the irred. of `tblMGA'
          tblrecord,     # record of `tblMGA' (power maps perhaps ambiguous)
          info,          # list of possible tables
          newinfo,       # list of possible tables for the next step
          pair,          # loop variable
          pow,           # one possible power map
          newmatautos,   # automorphisms respecting one more power map
          newtblMGA;     # intermediate table with one more unique power map

    # Fetch the stored fusions.
    MGfusG:= GetFusionMap( tblMG, tblG );
    GfusGA:= GetFusionMap( tblG, tblGA );
    if MGfusG = fail or GfusGA = fail then
      Error( "fusions <tblMG> -> <tblG>, <tblG> -> <tblGA> must be stored" );
    fi;

    # Initialize the table record `tblMGA' of $m.G.a$.
    tblMGA:= rec( UnderlyingCharacteristic := 0,
                  Identifier := identifier,
                  Size := Size( tblMG ) * Size( tblGA ) / Size( tblG ),
                  ComputedPowerMaps := [] );

    # The class fusion of `tblMG' into `tblMGA' is given by `perm'.
    orbits:= Set( Orbits( Group( perm ),
                          [ 1 .. NrConjugacyClasses( tblMG ) ] ) );
    MGfusMGA:= InverseMap( orbits );

    # Determine the outer classes of `tblGA'.
    factouter:= Difference( [ 1 .. NrConjugacyClasses( tblGA ) ], GfusGA );

    # Compute the fusion of `tblMGA' onto `tblGA'.
    MGAfusGA:= CompositionMaps( GfusGA, CompositionMaps( MGfusG, orbits ) );
    Append( MGAfusGA, factouter );

    # Distinguish inner and outer classes of `tblMGA'.
    inner:= [ 1 .. Maximum( MGfusMGA ) ];
    outer:= [ Maximum( MGfusMGA ) + 1 .. Length( MGAfusGA ) ];
    nccl:= Length( inner ) + Length( outer );

    # Compute the class lengths of `tblMGA'.
    tblMGA.SizesConjugacyClasses:= Concatenation( Zero( inner ),
        ( Size( tblMG ) / Size( tblG ) )
        * SizesConjugacyClasses( tblGA ){ factouter } );
    classes:= SizesConjugacyClasses( tblMG );
    for i in inner do
      tblMGA.SizesConjugacyClasses[i]:= Sum( classes{ orbits[i] } );
    od;

    # Compute the centralizer orders of `tblMGA'.
    tblMGA.SizesCentralizers:= List( tblMGA.SizesConjugacyClasses,
                                     x -> tblMGA.Size / x );

    # Compute the irreducible characters of `tblMGA'.
    kernel:= ClassPositionsOfKernel( MGfusG );
    zero:= Zero( outer );
    tblMGA.Irr:= List( Irr( tblGA ),
                       chi -> CompositionMaps( chi, MGAfusGA ) );
    for chi in Irr( tblMG ) do
      if not IsSubset( ClassPositionsOfKernel( chi ), kernel ) then
        sum:= chi;
        chip:= chi;
        for i in [ 2 .. Order( perm ) ] do
          chip:= Permuted( chip, perm );
          sum:= sum + chip;
        od;
        ind:= CompositionMaps( sum, orbits );
        Append( ind, zero );
        if not ind in tblMGA.Irr then
          Add( tblMGA.Irr, ind );
        fi;
      fi;
    od;

    # Compute approximations for power maps of `tblMGA'.
    # (All $p$-th power maps for $p$ coprime to $|A|$ are uniquely
    # determined this way, since inner and outer part are kept separately.)
    primes:= Set( Factors( tblMGA.Size ) );
    invMGAfusGA:= InverseMap( MGAfusGA );

    for p in primes do

      # inner part: Transfer the map from `tblMG' to `tblMGA'.
      tblMGA.ComputedPowerMaps[p]:= CompositionMaps( MGfusMGA,
           CompositionMaps( PowerMap( tblMG, p ), orbits ) );

      # outer part: Use the map of `tblGA' for an approximation.
      GAmapp:= PowerMap( tblGA, p );
      for i in outer do
        tblMGA.ComputedPowerMaps[p][i]:=
            invMGAfusGA[ GAmapp[ MGAfusGA[i] ] ];
      od;

    od;

    # Enter the element orders.
    # (If $|A|$ and $|M|$ are coprime then the orders of outer elements
    # are uniquely determined; otherwise there may be ambiguities.)
    orders:= [];
    suborders:= OrdersClassRepresentatives( tblMG );
    for i in [ 1 .. Length( MGfusMGA ) ] do
      orders[ MGfusMGA[i] ]:= suborders[i];
    od;
    outerorders:= OrdersClassRepresentatives( tblGA ){ factouter };
    gcd:= Gcd( Size( tblMG ), Size( tblGA ) ) / Size( tblG );
    if gcd <> 1 then
      gcd:= DivisorsInt( gcd );
      outerorders:= List( outerorders, x -> gcd * x );
    fi;
    tblMGA.OrdersClassRepresentatives:= Concatenation( orders, outerorders );

    # Compute the automorphisms of the matrix of characters.
    if gcd = 1 then
      matautos:= [ tblMGA.SizesCentralizers,
                   tblMGA.OrdersClassRepresentatives ];
    else
      matautos:= [ tblMGA.SizesCentralizers ];
    fi;
    matautos:= MatrixAutomorphisms( tblMGA.Irr, matautos,
                   GroupByGenerators( [], () ) );

    # Convert the record to a character table object.
    # (Keep a record for the case that we need copies later.)
    tblrecord:= ShallowCopy( tblMGA );
    Unbind( tblrecord.ComputedPowerMaps );
    ConvertToCharacterTableNC( tblMGA );

    # Improve the ambiguous power maps
    # (and update the automorphisms if necessary) using characters.
    # Whenever several $p$-th power maps are possible then we branch,
    # so we end up with a list of possible character tables.
    info:= [ [ tblMGA, matautos ] ];
    for p in primes do

      newinfo:= [];
      for pair in info do
        tblMGA:= pair[1];
        matautos:= pair[2];
        pow:= ComputedPowerMaps( tblMGA )[p];
        if ForAll( pow, IsInt ) then
          Add( newinfo, pair );
        else
          pow:= PossiblePowerMaps( tblMGA, p, rec( powermap:= pow ) );
          if not IsEmpty( pow ) then

            # Consider representatives up to matrix automorphisms.
            for pow in RepresentativesPowerMaps( pow, matautos ) do

              newmatautos:= SubgroupProperty( matautos,
                         perm -> ForAll( [ 1 .. nccl ],
                                     i -> pow[ i^perm ] = pow[i]^perm ),
                         TrivialSubgroup( matautos ),
                         TrivialSubgroup( matautos ) );
              newtblMGA:= ConvertToCharacterTableNC( ShallowCopy( tblrecord ) );
              SetComputedPowerMaps( newtblMGA,
                  StructuralCopy( ComputedPowerMaps( tblMGA ) ) );
              ComputedPowerMaps( newtblMGA )[p]:= pow;
              Add( newinfo, [ newtblMGA, newmatautos ] );

            od;

          fi;
        fi;
      od;

      # Hand over the list for the next step.
      info:= newinfo;

    od;

    # Here we have the final list of tables.
    for pair in info do

      tblMGA:= pair[1];
      SetAutomorphismsOfTable( tblMGA, pair[2] );

      # Store the unique element orders if necessary.
      if gcd <> 1 then
        ResetFilterObj( tblMGA, HasOrdersClassRepresentatives );
        SetOrdersClassRepresentatives( tblMGA,
            ElementOrdersPowerMap( ComputedPowerMaps( tblMGA ) ) );
      fi;

      # Store the fusion onto the factor group.
      StoreFusion( tblMGA, MGAfusGA, tblGA );

    od;

    # Return the result list.
    return List( info, pair -> rec( table    := pair[1],
                                    MGfusMGA := MGfusMGA ) );
end );


#############################################################################
##
#F  PossibleActionsForTypeMGA( <tblMG>, <tblG>, <tblGA> )
##
InstallGlobalFunction( PossibleActionsForTypeMGA,
    function( tblMG, tblG, tblGA )
    local tfustA,
          Mtfust,
          ker,
          index,
          inner,
          i,
          elms,
          cenMG,
          cenG,
          inv,
          factorbits,
          img,
          newelms;

    # Check that the function is applicable.
    tfustA:= GetFusionMap( tblG, tblGA );
    if tfustA = fail then
      Error( "class fusion <tblG> -> <tblGA> must be stored on <tblG>" );
    fi;

    Mtfust:= GetFusionMap( tblMG, tblG );
    if Mtfust = fail then
      Error( "class fusion <tblMG> -> <tblG> must be stored on <tblMG>" );
    fi;

    ker:= ClassPositionsOfKernel( Mtfust );
    if Length( ker ) <> Sum( SizesConjugacyClasses( tblMG ){ ker }, 0 ) then
      Error( "<tblMG> must be a central extension of <tblG>" );
    fi;

    index:= Size( tblGA ) / Size( tblG );
    if not IsPrimeInt( index ) then
      inner:= Set( tfustA );
      for i in Set( Factors( index ) ) do
        if ForAll( PowerMap( tblGA, index / i ), j -> j in inner ) then
          Error( "factor of <tblGA> by <tblG> must be cyclic" );
        fi;
      od;
    fi;

    # The automorphism must have order equal to the order of $A$.
    # We need to consider only one generator for each cyclic group of
    # the right order.
    elms:= Filtered( AsList( AutomorphismsOfTable( tblMG ) ),
                     x -> Order( x ) = index );
    elms:= Set( List( elms, SmallestGeneratorPerm ) );
    Info( InfoCharacterTable, 1,
          Length( elms ), " automorphism(s) of order ", index );

    # The automorphism must act semiregularly on those characters of the
    # centre of $M.G$ that are not characters of the centre of $G$.
    # (Think of the case that the centres of $G$ and $M.G$ have orders
    # $2$ and $6$, respectively, and $A$ is of order $2$.)
    cenMG:= ClassPositionsOfCentre( tblMG );
    cenG:= ClassPositionsOfCentre( tblG );
    elms:= Filtered( elms,
               x -> index * ( Length( Orbits( Group( x ), cenMG ) )
                              - Length( Set( tfustA{ cenG } ) ) )
                    = Length( cenMG ) - Length( cenG ) );
    Info( InfoCharacterTable, 1,
          Length( elms ), " automorphism(s) acting on the centre" );

    # The automorphism respects the fusion of classes of $G$ into $G.A$.
    inv:= InverseMap( Mtfust );
    for i in [ 1 .. Length( inv ) ] do
      if IsInt( inv[i] ) then
        inv[i]:= [ inv[i] ];
      fi;
    od;
    factorbits:= Filtered( InverseMap( GetFusionMap( tblG, tblGA ) ),
                           IsList );
    for i in [ 1 .. Length( inv ) ] do

      img:= First( factorbits, orb -> i in orb );
      if img = fail then
        img:= inv[i];
        newelms:= Filtered( elms, x -> OnSets( img, x ) = img );
      else
        img:= Union( inv{ Difference( img, [ i ] ) } );
        newelms:= Filtered( elms, x -> IsSubset( img, OnSets( inv[i], x ) ) );
      fi;
      if newelms <> elms then
        elms:= newelms;
        Info( InfoCharacterTable, 1,
              Length( elms ), " automorphism(s) mapping ",i," compatibly" );
      fi;

    od;

    # Return the result.
    return elms;
end );


#############################################################################
##
#F  ConstructMGA( <tbl>, <subname>, <factname>, <plan>, <perm> )
##
InstallGlobalFunction( ConstructMGA,
    function( tbl, subname, factname, plan, perm )
    local factfus,  # factor fusion from `tbl' to `fact'
          subfus,   # subgroup fusion from `sub' to `tbl'
          proj,     # projection map of `subfus'
          irreds,   # list of irreducibles
          zero;     # list of zeros to be appended to the characters

    factfus  := First( tbl.ComputedClassFusions,
                       fus -> fus.name = factname ).map;
    factname := CharacterTableFromLibrary( factname );
    subname  := CharacterTableFromLibrary( subname );
    subfus   := First( ComputedClassFusions( subname ),
                       fus -> fus.name = tbl.Identifier ).map;
    proj    := ProjectionMap( subfus );
    irreds  := List( Irr( factname ),
                     x -> ValuesOfClassFunction( x ){ factfus } );
    zero    := Zero( [ Maximum( subfus ) + 1
                       .. Length( tbl.SizesCentralizers ) ] );
    Append( irreds, List( plan, entry ->
         Concatenation( Sum( Irr( subname ){ entry } ){ proj }, zero ) ) );
    tbl.Irr:= Permuted( irreds, perm );
end );


#############################################################################
##
##  3. Character Tables of Groups of Structure $G.2^2$
##


#############################################################################
##
#F  PossibleActionsForTypeGV4( <tblG>, <tblsG2> )
##
InstallGlobalFunction( PossibleActionsForTypeGV4,
    function( tblG, tblsG2 )
    local tfust2, elms, domains, triples, elm, comp, nccl, filt2, filt3;

    # Check that the function is applicable.
    tfust2:= List( tblsG2, t2 -> GetFusionMap( tblG, t2 ) );
    if fail in tfust2 then
      Error( "class fusions <tblG> -> <tblsG2> must be stored on <tblG>" );
    fi;

    # The automorphisms must have order at most 2.
    elms:= List( tblsG2, t -> Filtered( AsList( AutomorphismsOfTable( t ) ),
                     x -> Order( x ) <= 2 ) );
    Info( InfoCharacterTable, 1,
          Product( List( elms, Length ) ),
          " triple(s) of automorphisms of order <= 2" );

    # The automorphisms must act compatibly on `tblG', and
    # they must result in the same number of classes for $G.2^2$.
    # (Note that the class number corresponds to the number of cycles.)
    domains:= List( tblsG2, t -> [ 1 .. NrConjugacyClasses( t ) ] );
    triples:= [];
    for elm in elms[1] do
      comp:= CompositionMaps( InverseMap(
                 OrbitsPerms( [ elm ], domains[1] ) ), tfust2[1] );
      nccl:= 2 * NrConjugacyClasses( tblsG2[1] )
             - 3 * NrMovedPointsPerm( elm ) / 2;
      filt2:= Filtered( elms[2], x -> comp = CompositionMaps(
                  InverseMap( OrbitsPerms( [ x ], domains[2] ) ), tfust2[2] )
                  and nccl = 2 * NrConjugacyClasses( tblsG2[2] )
                             - 3 * NrMovedPointsPerm( x ) / 2 );
      filt3:= Filtered( elms[3], x -> comp = CompositionMaps(
                  InverseMap( OrbitsPerms( [ x ], domains[3] ) ), tfust2[3] )
                  and nccl = 2 * NrConjugacyClasses( tblsG2[3] )
                             - 3 * NrMovedPointsPerm( x ) / 2 );
      Append( triples, Cartesian( [ elm ], filt2, filt3 ) );
    od;
    Info( InfoCharacterTable, 1,
          Length( triples ),
          " triple(s) of automorphisms acting compatibly" );

    # Return the result.
    return triples;
end );


#############################################################################
##
#F  PossibleCharacterTablesOfTypeGV4( <tblG>, <tblsG2>, <acts>, <identifier> )
##
InstallGlobalFunction( PossibleCharacterTablesOfTypeGV4,
    function( tblG, tblsG2, acts, identifier )
    local tblGfustblsG2, GfusG2, G2fusGV4inner, ncclinner, G2fusGV4outer,
          tblGV4, classes, subclasses, orders, suborders, i, k, map,
          G2fusGV4, powermap, p, pow, ind, norms, minus, irr, triv, coset,
          done, bad, ext, num2, poss1, poss2, chi;

    # Get the three subgroup fusions.
    tblGfustblsG2:= List( tblsG2, t -> GetFusionMap( tblG, t ) );
    if fail in tblGfustblsG2 then
      Error( "the factor fusions from <tblG> must be stored" );
    fi;

    # Construct the three fusions into $G.2^2$, via the three embeddings.
    # The classes of $G$ come first in each map; note that we must choose
    # the classes of $G$ compatibly in all three maps.
    GfusG2:= List( tblsG2, t -> GetFusionMap( tblG, t ) );

    G2fusGV4inner:= [];
    G2fusGV4inner[1]:= InverseMap( Set( Orbits( Group( acts[1] ),
        Set( GfusG2[1] ) ) ) );
    G2fusGV4inner[2]:= CompositionMaps( G2fusGV4inner[1],
        CompositionMaps( GfusG2[1], InverseMap( GfusG2[2] ) ) );
    G2fusGV4inner[3]:= CompositionMaps( G2fusGV4inner[1],
        CompositionMaps( GfusG2[1], InverseMap( GfusG2[3] ) ) );
    ncclinner:= Maximum( G2fusGV4inner[1] );

    G2fusGV4outer:= [];
    G2fusGV4outer[1]:= InverseMap( Set( Orbits( Group( acts[1] ),
        Difference( [ 1 .. NrConjugacyClasses( tblsG2[1] ) ],
            Set( GfusG2[1] ) ) ) ) ) + ncclinner;
    G2fusGV4outer[2]:= InverseMap( Set( Orbits( Group( acts[2] ),
        Difference( [ 1 .. NrConjugacyClasses( tblsG2[2] ) ],
            Set( GfusG2[2] ) ) ) ) ) + Maximum( G2fusGV4outer[1] );
    G2fusGV4outer[3]:= InverseMap( Set( Orbits( Group( acts[3] ),
        Difference( [ 1 .. NrConjugacyClasses( tblsG2[3] ) ],
            Set( GfusG2[3] ) ) ) ) ) + Maximum( G2fusGV4outer[2] );

    # Initialize the record for the character table `tblGV4'.
    tblGV4:= rec( UnderlyingCharacteristic := 0,
                  Identifier               := identifier,
                  Size                     := 4 * Size( tblG ) );

    # Compute class lengths, centralizer orders, and element orders.
    G2fusGV4:= G2fusGV4inner + G2fusGV4outer;
    classes:= ListWithIdenticalEntries( Maximum( G2fusGV4[3] ), 0 );
    subclasses:= SizesConjugacyClasses( tblsG2[1] );
    orders:= [];
    suborders:= OrdersClassRepresentatives( tblsG2[1] );
    for i in [ 1 .. Length( G2fusGV4inner[1] ) ] do
      if IsBound( G2fusGV4inner[1][i] ) then
        classes[ G2fusGV4inner[1][i] ]:= classes[ G2fusGV4inner[1][i] ]
                                         + subclasses[i];
        orders[ G2fusGV4inner[1][i] ]:= suborders[i];
      fi;
    od;
    for k in [ 1 .. 3 ] do
      subclasses:= SizesConjugacyClasses( tblsG2[k] );
      suborders:= OrdersClassRepresentatives( tblsG2[k] );
      map:= G2fusGV4outer[k];
      for i in [ 1 .. Length( map ) ] do
        if IsBound( map[i] ) then
          classes[ map[i] ]:= classes[ map[i] ] + subclasses[i];
          orders[ map[i] ]:= suborders[i];
        fi;
      od;
    od;
    tblGV4.SizesConjugacyClasses:= classes;
    tblGV4.SizesCentralizers:= List( classes, x -> tblGV4.Size / x );
    tblGV4.OrdersClassRepresentatives:= orders;

    # Convert the record to a table object.
    ConvertToCharacterTableNC( tblGV4 );

    # Put the power maps together.
    powermap:= ComputedPowerMaps( tblGV4 );
    for p in Set( Factors( Size( tblGV4 ) ) ) do
      pow:= InitPowerMap( tblGV4, p );
      for k in [ 1 .. 3 ] do
        TransferDiagram( PowerMap( tblsG2[k], p ), G2fusGV4[k], pow );
      od;
      powermap[p]:= pow;
      Assert( 1, ForAll( pow, IsInt ),
              Concatenation( Ordinal( p ),
                             " power map not uniquely determined" ) );
    od;

    # Compute the irreducibles, starting from the irreducibles of $G$.
    # First we compute the known extensions of the trivial character,
    # then add the characters which are induced from some table in `tblsG2',
    # then try to determine the extensions of the remaining characters.
    irr:= List( Irr( tblG ), ValuesOfClassFunction );
    ind:= List( tblsG2, t -> Induced( tblG, t, irr ) );
    norms:= List( [ 1 .. NrConjugacyClasses( tblG ) ],
               k -> List( [ 1 .. 3 ],
                   i -> ScalarProduct( tblsG2[i], ind[i][k], ind[i][k] ) ) );

    irr:= [];
    triv:= Position( Irr( tblG ), TrivialCharacter( tblG ) );

    irr[ triv ]:= List( [ 1 .. 4 ], i -> 0 * classes + 1 );
    coset:= Set( G2fusGV4outer[1] );
    irr[ triv ][3]{ coset }:= 0 * coset - 1;
    irr[ triv ][4]{ coset }:= 0 * coset - 1;
    coset:= Set( G2fusGV4outer[2] );
    irr[ triv ][2]{ coset }:= 0 * coset - 1;
    irr[ triv ][4]{ coset }:= 0 * coset - 1;
    coset:= Set( G2fusGV4outer[3] );
    irr[ triv ][2]{ coset }:= 0 * coset - 1;
    irr[ triv ][3]{ coset }:= 0 * coset - 1;

    done:= [ triv ];
    bad:= [];
    for i in [ 1 .. NrConjugacyClasses( tblG ) ] do
      if not i in done then
        num2:= Number( norms[i], x -> x = 2 );
        Assert( 1, num2 <> 2, "..." );
#T ...
        if   num2 = 0 then
          # The character has inertia subgroup $G$.
          irr[i]:= Induced( tblsG2[1], tblGV4, [ ind[1][i] ], G2fusGV4[1] );
          AddSet( done, i );
          AddSet( done, Position( ind[1], ind[1][i], i ) );
          AddSet( done, Position( ind[2], ind[2][i], i ) );
          AddSet( done, Position( ind[3], ind[3][i], i ) );
        elif num2 = 1 then
          # The character has inertia subgroup one of the $G.2_k$.
          k:= Position( norms[i], 2 );
          ext:= Filtered( Irr( tblsG2[k] ),
                    x -> ScalarProduct( tblsG2[k], x, ind[k][i] ) <> 0 );
          irr[i]:= Induced( tblsG2[k], tblGV4, ext, G2fusGV4[k] );
          k:= ( ( k+1 ) mod 3 ) + 1;
          AddSet( done, i );
          AddSet( done, Position( ind[k], ind[k][i], i ) );
        else
          # The character has inertia subgroup $G.2^2$
          ext:= Filtered( Irr( tblsG2[1] ),
                    x -> ScalarProduct( tblsG2[1], x, ind[1][i] ) <> 0 );
          if Permuted( ext[1], acts[1] ) <> ext[1] then
            # The character induces from any of the $G.2_i$.
            irr[i]:= Induced( tblsG2[1], tblGV4, ext{[1]}, G2fusGV4[1] );
            AddSet( done, i );
          fi;
        fi;
      fi;
    od;

    # Deal with the extension case.
    pow:= ComputedPowerMaps( tblGV4 )[2];
    minus:= Set( List( Union( irr ), chi -> MinusCharacter( chi, pow, 2 ) ) );

    for i in Difference( [ 1 .. NrConjugacyClasses( tblG ) ], done ) do
      # The character extends $4$-fold.
      # We have two possibilities for combining the different extensions
      # to the tables in `tblsG2'.
      # Try to exclude one by computing scalar products.
      ext:= Filtered( Irr( tblsG2[1] ),
                x -> ScalarProduct( tblsG2[1], x, ind[1][i] ) <> 0 );
      ext:= List( ext,
                  chi -> CompositionMaps( chi, InverseMap( G2fusGV4[1] ) ) );
      poss1:= [ ShallowCopy( ext[1] ),
                ShallowCopy( ext[1] ),
                ShallowCopy( ext[2] ),
                ShallowCopy( ext[2] ) ];
      ext:= Filtered( Irr( tblsG2[2] ),
                x -> ScalarProduct( tblsG2[2], x, ind[2][i] ) <> 0 );
      for k in [ 1 .. Length( G2fusGV4outer[2] ) ] do
        if IsBound( G2fusGV4outer[2][k] ) then
          poss1{ [ 1 .. 4 ] }[ G2fusGV4outer[2][k] ]:=
              ext[1][k] * [ 1, -1, 1, -1 ];
        fi;
      od;
      ext:= Filtered( Irr( tblsG2[3] ),
                x -> ScalarProduct( tblsG2[3], x, ind[3][i] ) <> 0 );
      for k in [ 1 .. Length( G2fusGV4outer[3] ) ] do
        if IsBound( G2fusGV4outer[3][k] ) then
          poss1{ [ 1 .. 4 ] }[ G2fusGV4outer[3][k] ]:=
              ext[1][k] * [ 1, -1, -1, 1 ];
        fi;
      od;
      poss2:= List( poss1, ShallowCopy );
      for chi in poss2 do
        chi{ coset }:= - chi{ coset };
      od;
      if   not NonnegIntScalarProducts( tblGV4, minus, poss1[1] ) then
        irr[i]:= poss2;
      elif not NonnegIntScalarProducts( tblGV4, minus, poss2[1] ) then
        irr[i]:= poss1;
      else
Error( "irreducibles not uniquely determined!!" );
      fi;
    od;
    SetIrr( tblGV4, List( Concatenation( Compacted( irr ) ),
                          chi -> Character( tblGV4, chi ) ) );

    SetInfoText( tblGV4,
                 "constructed using `PossibleCharacterTablesOfTypeGV4" );
    AutomorphismsOfTable( tblGV4 );

    return [ rec( table:= tblGV4, G2fusGV4:= G2fusGV4 ) ];
#T really list the different possibilities!
#T example where not unique!
    end );


#############################################################################
##
#F  PossibleActionsForTypeGA( <tblG>, <tblGA> )
##
InstallGlobalFunction( PossibleActionsForTypeGA,
    function( tblG, tblGA )
    local tfustA, A, elms, i, newelms;

    # Check that the function is applicable.
    tfustA:= GetFusionMap( tblG, tblGA );
    if tfustA = fail then
      Error( "class fusion <tblG> -> <tblGA> must be stored on <tblG>" );
    fi;

    # The automorphism must have order dividing `A'.
    A:= Size( tblGA ) / Size( tblG );
    elms:= Filtered( AsList( AutomorphismsOfTable( tblG ) ),
                     x -> A mod Order( x ) = 0 );
    Info( InfoCharacterTable, 1,
          Length( elms ), " automorphism(s) of order dividing ", A );
    if Length( elms ) <= 1 then
      return elms;
    fi;

    # The automorphism respects the fusion of classes of `tblG' into `tblGA'.
    for i in InverseMap( tfustA ) do
      if IsList( i ) then
        newelms:= Filtered( elms, x -> OnSets( i, x ) = i and
                                       OnPoints( i[1], x ) <> i[1] );
      else
        newelms:= Filtered( elms, x -> OnPoints( i, x ) = i );
      fi;
      if newelms <> elms then
        elms:= newelms;
        Info( InfoCharacterTable, 1,
              Length( elms ), " automorphism(s) acting on ", i );
        if Length( elms ) <= 1 then
          return elms;
        fi;
      fi;
    od;

    # Return the result.
    return elms;
end );


#############################################################################
##
#F  ConstructMGAInfo( <tblmGa>, <tblmG>, <tblGa> )
##
InstallGlobalFunction( ConstructMGAInfo, function( tblmGa, tblmG, tblGa )
    local factfus,
          subfus,
          kernel,
          nccl,
          irr,
          plan,
          chi,
          rest,
          nonfaith,
          zero,
          proj,
          faithful,
          perm;

    factfus:= GetFusionMap( tblmGa, tblGa );
    subfus:= GetFusionMap( tblmG, tblmGa );
    if factfus = fail or subfus = fail then
      Error( "fusions <tblmG> -> <tblmGa> -> <tblGa> must be stored" );
    fi;

    kernel:= ClassPositionsOfKernel( factfus );

    nccl:= NrConjugacyClasses( tblmG );
    irr:= Irr( tblmG );
    plan:= [];
    for chi in Irr( tblmGa ) do
      if not IsSubset( ClassPositionsOfKernel( chi ), kernel ) then
        rest:= chi{ subfus };
        Add( plan, Filtered( [ 1 .. nccl ],
                       i -> ScalarProduct( tblmG, rest, irr[i] ) <> 0 ) );
      fi;
    od;

    nonfaith:= List( Irr( tblGa ), chi -> chi{ factfus } );
    zero:= Zero( [ Maximum( subfus ) + 1 .. NrConjugacyClasses( tblmGa ) ] );
    proj:= ProjectionMap( subfus );
    faithful:= List( plan,
        entry -> Concatenation( Sum( irr{ entry } ){ proj }, zero ) );
    perm:= Sortex( Concatenation( nonfaith, faithful ) ) /
           Sortex( ShallowCopy( Irr( tblmGa ) ) );

    return [ "ConstructMGA",
             Identifier( tblmG ), Identifier( tblGa ), plan, perm ];
end );


#############################################################################
##
#F  ConstructProj( <tbl>, <irrinfo> )
#F  ConstructProjInfo( <tbl>, <kernel> )
##
InstallGlobalFunction( ConstructProj, function( tbl, irrinfo )
    local i, j, factor, fus, mult, irreds, linear, omegasquare, I,
          d, name, factfus, proj, adjust, Adjust,
          ext, lin, chi, faith, nccl, partner, divs, prox, foll,
          vals;

    nccl:= Length( tbl.SizesCentralizers );
    factor:= CharacterTableFromLibrary( irrinfo[1][1] );
    fus:= First( tbl.ComputedClassFusions,
                 fus -> fus.name = irrinfo[1][1] ).map;
    mult:= tbl.SizesCentralizers[1] / Size( factor );
    irreds:= List( Irr( factor ), x -> ValuesOfClassFunction( x ){ fus } );
    linear:= Filtered( irreds, x -> x[1] = 1 );
    linear:= linear{ [ 2 .. Length( linear ) ] };

    # some roots of unity
    omegasquare:= E(3)^2;
    I:= E(4);

    # Loop over the divisors of `mult' (a divisor of 12).
    # Note the succession for `mult = 12'!
    if mult <> 12 then
      divs:= Difference( DivisorsInt( mult ), [ 1 ] );
    else
      divs:= [ 2, 4, 3, 6, 12 ];
    fi;

    for d in divs do

      # Construct the faithful irreducibles for an extension by `d'.
      # For that, we split and adjust the portion of characters (stored
      # on the small table `factor') as if we would create this extension,
      # and then we blow up these characters to the whole table.

      name:= irrinfo[d][1];
      partner:= irrinfo[d][2];
      proj:= First( ProjectivesInfo( factor ), x -> x.name = name );
      faith:= List( proj.chars, y -> y{ fus } );
      proj:= ShallowCopy( proj.map );

      if name = tbl.Identifier then
        factfus:= [ 1 .. Length( tbl.SizesCentralizers ) ];
      else
        factfus:= First( tbl.ComputedClassFusions, x -> x.name = name ).map;
      fi;

      Add( proj, Length( factfus ) + 1 );    # for termination of loop
      adjust:= [];
      for i in [ 1 .. Length( proj ) - 1 ] do
        for j in [ proj[i] .. proj[i+1]-1 ] do
          adjust[ j ]:= proj[i];
        od;
      od;

      # Now we have to multiply the values on certain classes `j' with
      # roots of unity, dependent on the value of `d':
#T Note that we do not have the factor fusion from d.G to G available,
#T since the only tables we have are those of mult.G and G,
#T together with the projective characters for the various intermediate
#T tables!

      Adjust:= [];
      for i in [ 1 .. d-1 ] do
        Adjust[i]:= Filtered( [ 1 .. Length( factfus ) ],
                              x -> adjust[ factfus[x] ] = factfus[x] - i );
      od;
#T this means to adjust also in many zero columns;
#T if d = 6 and a class has only 2 or 3 preimages, the second preimage class
#T need not be adjusted for the faithful characters ...

      # d =  2: classes in `Adjust[1]' multiply with `-1'
      # d =  3: classes in `Adjust[x]' multiply
      #                     with `E(3)^x' for the proxy cohort,
      #                     with `E(3)^(2*x)' for the follower cohort
      # d =  4: classes in `Adjust[x]' multiply
      #                     with `E(4)^x' for the proxy cohort,
      #                     with `(-E(4))^x' for the follower cohort,
      # d =  6: classes in `Adjust[x]' multiply with `(-E(3))^x'
      # d = 12: classes in `Adjust[x]' multiply with `(E(12)^7)^x'
      #
      # (*Note* that follower cohorts of classes never occur in projective
      #  ATLAS tables ... )

      # Determine proxy classes and follower classes:
      if Length( linear ) in [ 2, 5 ] then  # out in [ 3, 6 ]
        prox:= [];
        foll:= [];
        chi:= irreds[ Length( linear ) ];
        for i in [ 1 .. nccl ] do
          if chi[i] = omegasquare then
            Add( foll, i );
          else
            Add( prox, i );
          fi;
        od;
      elif Length( linear ) = 3 then        # out = 4
        prox:= [];
        foll:= [];
        chi:= irreds[2];
        for i in [ 1 .. nccl ] do
          if chi[i] = -I then Add( foll, i ); else Add( prox, i ); fi;
        od;
      else
        prox:= [ 1 .. nccl ];
        foll:= [];
      fi;

      if d = 2 then
        # special case without Galois partners
        for chi in faith do
          for i in Adjust[1] do chi[i]:= - chi[i]; od;
          Add( irreds, chi );
          for lin in linear do
            ext:= List( [ 1 .. nccl ], x -> lin[x] * chi[x] );
            if not ext in irreds then Add( irreds, ext ); fi;
          od;
        od;
      elif d = 12 then
        # special case with three Galois partners and `lin = []'
        vals:= [ E(12)^7, - omegasquare, - I, E(3), E(12)^11, -1,
                 -E(12)^7, omegasquare, I, -E(3), -E(12)^11 ];
        for j in [ 1 .. Length( faith ) ] do
          chi:= faith[j];
          for i in [ 1 .. 11 ] do
            chi{ Adjust[i] }:= vals[i] * chi{ Adjust[i] };
          od;
          Add( irreds, chi );
          for i in partner[j] do
            Add( irreds, List( chi, x -> GaloisCyc( x, i ) ) );
          od;
        od;
      else

        if d = 3 then
          Adjust{ [ 1, 2 ] }:= [ Union( Intersection( Adjust[1], prox ),
                                        Intersection( Adjust[2], foll ) ),
                                 Union( Intersection( Adjust[2], prox ),
                                        Intersection( Adjust[1], foll ) ) ];
          vals:= [ E(3), E(3)^2 ];
        elif d = 4 then
          Adjust{ [ 1, 3 ] }:= [ Union( Intersection( Adjust[1], prox ),
                                        Intersection( Adjust[3], foll ) ),
                                 Union( Intersection( Adjust[3], prox ),
                                        Intersection( Adjust[1], foll ) ) ];
          vals:= [ I, -1, -I ];
        elif d = 6 then
          vals:= [ -E(3), omegasquare, -1, E(3), - omegasquare ];
        fi;

        for j in [ 1 .. Length( faith ) ] do
          chi:= faith[j];
          for i in [ 1 .. d-1 ] do
            chi{ Adjust[i] }:= vals[i] * chi{ Adjust[i] };
          od;
          Add( irreds, chi );
          for lin in linear do
            ext:= List( [ 1 .. nccl ], x -> lin[x] * chi[x] );
            if not ext in irreds then Add( irreds, ext ); fi;
          od;
          chi:= List( chi, x -> GaloisCyc( x, partner[j] ) );
          Add( irreds, chi );
          for lin in linear do
            ext:= List( [ 1 .. nccl ], x -> lin[x] * chi[x] );
            if not ext in irreds then Add( irreds, ext ); fi;
          od;
        od;

      fi;
    od;
    tbl.Irr:= irreds;
end );


#############################################################################
##
#F  CharacterTableSortedWRTCentralExtension( <tbl>, <fusion> )
##
##  It is assumed that the parts corresponding to proper factor groups
##  modulo subsets of the kernel of <fusion> are already sorted in the
##  right way.
##
BindGlobal( "CharacterTableSortedWRTCentralExtension",
    function( tbl, fusion )
    local kernel, facttbl, sort, pi, map, 
          classes,     # class lengths of `tbl'
          orders,      # representative orders of `tbl'
          mult, faithpos, powers, pi2, inv, mapping, i, preimorders,
          min, cand, count, j, first;

    kernel:= ClassPositionsOfKernel( fusion );

    # Permute the classes such that the preimages under the factor fusion
    # are consecutive, and adjust the fusion map.
    facttbl:= tbl / kernel;
    sort:= SortedCharacterTable( tbl, facttbl, kernel );
    pi:= ();
    if HasClassPermutation( sort ) then
      pi:= ClassPermutation( sort );
    fi;
    if HasClassPermutation( tbl ) then
      pi:= ClassPermutation( tbl )^-1 * pi;
    fi;
    fusion:= Permuted( fusion, pi );
    kernel:= Set( OnTuples( kernel, pi ) );
    tbl:= sort;

    # Check that the kernel is a central cyclic subgroup.
    classes:= SizesConjugacyClasses( tbl );
    orders:= OrdersClassRepresentatives( tbl );
    mult:= Sum( classes{ kernel } );
    faithpos:= First( kernel, i -> orders[i] = mult );
    if    12 mod mult <> 0
       or faithpos = fail
       or Length( kernel ) <> mult then
      Error( "only cyclic central ext. by a group of order dividing 12" );
    fi;

    # Permute the classes of the kernel such that the $i$-th class
    # is the $(i-1)$-th power of a generator class.
    powers:= List( [ 1 .. mult-1 ], i -> PowerMap( tbl, i, faithpos ) );
    if powers <> [ 2 .. mult ] then
      sort:= CharacterTableWithSortedClasses( tbl,
                 PermList( Concatenation( [ 1 ], powers ) ) );
      pi2:= ();
      if HasClassPermutation( sort ) then
        pi2:= ClassPermutation( sort );
      fi;
      if HasClassPermutation( tbl ) then
        pi2:= pi2 / ClassPermutation( tbl );
      fi;
      fusion:= Permuted( fusion, pi2 );
      tbl:= sort;
      pi:= pi * pi2;
    fi;

    # Permute the classes such that the preimages of each class in the factor
    # group are ordered in such a way that
    # - the first preimage has minimal element order and among those classes
    #   with the minimal order has the fewest number of irrationalities,
    #   and for the classes where these two are minimal has more positive
    #   character values, and
    # - the $i$-th preimage is obtained by
    #   multiplying the first preimage with the root of unity on the $i$-th
    #   class of the kernel.
    # We assume that for the classes of the factor groups, the table is
    # already sorted compatibly.
    # So we have to consider only those cases where a full splitting occurs.
    classes:= SizesConjugacyClasses( tbl );
    orders:= OrdersClassRepresentatives( tbl );
    inv:= InverseMap( fusion );
    mapping:= [];
    for i in [ 1 .. Length( inv ) ] do
      if IsInt( inv[i] ) then
        Add( mapping, inv[i] );
      elif Length( inv[i] ) < mult then
        Append( mapping, inv[i] );
      else
        preimorders:= orders{ inv[i] };
        min:= Minimum( preimorders );
        cand:= Filtered( inv[i], j -> orders[j] = min );
        if 1 < Length( cand ) then
          count:= List( cand,
                        j -> Number( Irr( tbl ), x -> not IsInt( x[j] ) ) );
          min:= Minimum( count );
          cand:= cand{ Filtered( [ 1 .. Length( cand ) ],
                                 j -> count[j] = min ) };
          if 1 < Length( cand ) then
            count:= List( cand,
                          j -> Number( Irr( tbl ), x -> IsNegInt( x[j] ) ) );
            min:= Minimum( count );
            cand:= cand{ Filtered( [ 1 .. Length( cand ) ],
                                   j -> count[j] = min ) };
          fi;
        fi;
        first:= cand[1];
        for j in [ 1 .. mult ] do
          Add( mapping, First( inv[i], k -> ForAll( Irr( tbl ),
                            x -> x[k] * x[1] = x[j] * x[ first ] ) ) );
        od;
      fi;
    od;

    pi2:= PermList( mapping );
    if not IsOne( pi2 ) then
      tbl:= CharacterTableWithSortedClasses( tbl, pi2 );
      pi:= pi * pi2;
    fi;

    return rec( tbl:= tbl, pi:= pi );
end );

InstallGlobalFunction( ConstructProjInfo, function( tbl, kernel )
    local fusions,     # computed fusions of `tbl'
          fus,         # one fusion
          sort,
          mult,        # order of the central subgroup `kernel'
          faithpos,    # position of a cyclic generator of the kernel
          nsg,         # class positions of subgroups of `kernel'
          faith,       # corresponding group orders
          names,       # names of factors by these subgroups
          fusrec,      # loop over fusions
          faithchars,  # faithful characters for each subgroup
          chi,         # loop over irreducibles of `tbl'
          ker,         # kernel of `chi'
          proj,
          nccl,
          linear,
          partners,
          i,
          new,
          gal,
          rest,
          projectives,
          info;

    # Get the factor fusions.
    fusions:= ComputedClassFusions( tbl );
    fus:= First( fusions, x -> ClassPositionsOfKernel( x.map ) = kernel );
    if fus = fail then
      Error( "factor fusion from <tbl> with kernel <kernel> not stored" );
    fi;
    fus:= fus.map;

    # Permute the classes.
#T apparently this makes problems for a kernel of order 6
    sort:= CharacterTableSortedWRTCentralExtension( tbl, fus );
    kernel:= [ 1 .. Length( kernel ) ];
    fus:= Permuted( fus, sort.pi );
    tbl:= sort.tbl;
    faithpos:= 2;
    fusions:= List( fusions,
                    x -> rec( name := x.name,
                              map  := Permuted( x.map, sort.pi ) ) );

    nsg:= Filtered( ClassPositionsOfNormalSubgroups( tbl ),
                    x -> IsSubset( kernel, x ) );
    faith:= List( nsg, l -> Length( kernel ) / Length( l ) );
    SortParallel( faith, nsg );
    if Length( kernel ) = 12 then
      nsg:= Permuted( nsg, (3,4) );
      faith:= Permuted( faith, (3,4) );
    fi;

    names:= [];
    for i in [ 1 .. Length( nsg )-1 ] do
      fusrec:= First( fusions,
                      r -> ClassPositionsOfKernel( r.map ) = nsg[i] );
      if fusrec = fail then
        Error( "factor fusion with kernel ", nsg[i], " not stored" );
      fi;
      names[i]:= fusrec.name;
    od;
    names[ Length( nsg ) ]:= Identifier( tbl );

    # Distribute the irreducibles according to their kernels.
    # Take only those irreducibles
    # of  $3.G$ with value `E(3)' times the degree on the first nonid. class,
    # of  $4.G$ with value `E(4)' times the degree on the first nonid. class,
    # of  $6.G$ with value `E(6)^5' times the deg. on the first nonid. class,
    # of $12.G$ with value `E(12)^7' times the deg. on the first nonid. class,
    faithchars:= List( nsg, l -> [] );
    for chi in Irr( tbl ) do
      ker:= ClassPositionsOfKernel( chi );
      for i in [ 1 .. Length( nsg ) ] do
        if IsSubset( ker, nsg[i] ) then

          if      faith[i] <= 2
             or ( faith[i] =  3 and chi[ faithpos ] = E(3) * chi[1] )
             or ( faith[i] =  4 and chi[ faithpos ] = E(4) * chi[1] )
             or ( faith[i] =  6 and chi[ faithpos ] = E(6)^5 * chi[1] )
             or ( faith[i] = 12 and chi[ faithpos ] = E(12)^7 * chi[1] ) then
            Add( faithchars[i], chi );
            break;
          fi;

        fi;
      od;
    od;

    # Remove characters obtained by multiplication with linear characters
    # of the factor group,
    # and create the result info.
    proj:= ProjectionMap( fus );
    nccl:= Length( proj );
    linear:= List( Filtered( faithchars[1], chi -> chi[1] = 1 ),
                   lambda -> lambda{ proj } );
    projectives:= [];
    info:= [ [ names[1], [] ] ];

    for i in [ 2 .. Length( nsg ) ] do

      new:= [];
      gal:= [];
      for chi in faithchars[i] do
        rest:= chi{ proj };
        if ForAll( linear, lambda -> not List( [ 1 .. nccl ],
               j -> lambda[j] * rest[j] ) in new ) then
          Add( new, rest );
          if 2 < faith[i] then
            partners:= GaloisPartnersOfIrreducibles( tbl, [ chi ], faith[i] );
            if faith[i] <> 12 then
              partners:= partners[1];
            fi;
            Append( gal, partners );
#T works for 12 ??
          fi;
        fi;
      od;
      info[ faith[i] ]:= [ names[i], gal ];
      Add( projectives, rec( name:= names[i], chars:= new ) );

    od;

    # Return the result.
    return rec( tbl         := tbl,
                projectives := projectives,
                info        := info         );
end );


#############################################################################
##
#F  ConstructDirectProduct( <tbl>, <factors> )
#F  ConstructDirectProduct( <tbl>, <factors>, <permclasses>, <permchars> )
##
InstallGlobalFunction( ConstructDirectProduct, function( arg )
    local tbl, factors, t, i;

    tbl:= arg[1];
    factors:= arg[2];
    t:= CallFuncList( CharacterTableFromLibrary, factors[1] );
    for i in [ 2 .. Length( factors ) ] do
      t:= CharacterTableDirectProduct( t,
              CallFuncList( CharacterTableFromLibrary, factors[i] ) );
    od;
    if 2 < Length( arg ) then
      t:= CharacterTableWithSortedClasses( t, arg[3] );
      t:= CharacterTableWithSortedCharacters( t, arg[4] );
      if not IsBound( tbl.ClassPermutation ) then
        # Do *not* inherit the permutation from the construction!
        tbl.ClassPermutation:= ();
      fi;
    fi;
    TransferComponentsToLibraryTableRecord( t, tbl );
    if 1 < Length( factors ) then
      Append( tbl.ComputedClassFusions, ComputedClassFusions( t ) );
    fi;
end );


#############################################################################
##
#F  ConstructSubdirect( <tbl>, <factors>, <choice> )
##
InstallGlobalFunction( ConstructSubdirect, function( tbl, factors, choice  )
    local t, i;

    t:= CallFuncList( CharacterTableFromLibrary, factors[1] );
    for i in [ 2 .. Length( factors ) ] do
      t:= CharacterTableDirectProduct( t,
              CallFuncList( CharacterTableFromLibrary, factors[i] ) );
    od;
    t:= CharacterTableOfNormalSubgroup( t, choice );
    TransferComponentsToLibraryTableRecord( t, tbl );
end );


#############################################################################
##
#F  ConstructIsoclinic( <tbl>, <factors> )
#F  ConstructIsoclinic( <tbl>, <factors>, <nsg> )
##
InstallGlobalFunction( ConstructIsoclinic, function( arg )
    local tbl, factors, t, i, fld;

    tbl:= arg[1];
    factors:= arg[2];
    t:= CallFuncList( CharacterTableFromLibrary, factors[1] );
    for i in [ 2 .. Length( factors ) ] do
      t:= CharacterTableDirectProduct( t,
              CallFuncList( CharacterTableFromLibrary, factors[i] ) );
    od;
    if Length( arg ) = 2 then
      t:= CharacterTableIsoclinic( t );
    else
      t:= CharacterTableIsoclinic( t, arg[3] );
    fi;
    TransferComponentsToLibraryTableRecord( t, tbl );
end );


#############################################################################
##
#F  PossibleCharacterTablesOfTypeV4G( <tblG>, <tbls2G>, <identifier> )
#F  PossibleCharacterTablesOfTypeV4G( <tblG>, <tbl2G>, <aut>, <identifier> )
##
InstallGlobalFunction( PossibleCharacterTablesOfTypeV4G, function( arg )
    local tblG, tbls2G, aut, identifier,
          i, j, k,
          2Gorders, Gorders, lst, int, Gord,
          error, p, pow,
          fus,
          irrpos1, irrpos2, irrpos3,
          chi, localirr,
          factirr, poss, choice, ker, powermaps,
          irr, irr2, faith, inv, classes, tblV4G,
          orders, invfus,
          tbls2GfustblG, tbl2G, tbl2GfustblG, 2Gord,
          split, result;

    # Get and check the arguments.
    if   Length( arg ) = 3 and IsOrdinaryTable( arg[1] ) and IsList( arg[2] )
                           and IsString( arg[3] ) then
      tblG       := arg[1];
      tbls2G     := arg[2];
      aut        := fail;
      identifier := arg[3];

      # Get the three factor fusions.
      tbls2GfustblG:= List( tbls2G, t -> GetFusionMap( t, tblG ) );
      if fail in tbls2GfustblG then
        Error( "the factor fusions to <tblG> must be stored" );
      fi;

    elif Length( arg ) = 4 and IsOrdinaryTable( arg[1] )
                           and IsOrdinaryTable( arg[2] )
                           and IsPerm( arg[3] )
                           and IsString( arg[4] ) then
      tblG       := arg[1];
      tbl2G      := arg[2];
      aut        := arg[3];
      identifier := arg[4];

      # Get the three factor fusions.
      tbl2GfustblG:= GetFusionMap( tbl2G, tblG );
      if tbl2GfustblG = fail then
        Error( "the factor fusion to <tblG> must be stored" );
      fi;
      tbls2GfustblG:= List( [ 0 .. 2 ], i -> OnTuples( tbl2GfustblG, aut^i ) );
      tbls2G:= ListWithIdenticalEntries( 3, tbl2G );

    else
      Error( "usage: PossibleCharacterTablesOfTypeV4G(<tbl>,<tbls>,<id>),\n",
             "PossibleCharacterTablesOfTypeV4G(<tbl1>,<tbl2>,<aut>,<id>" );
    fi;

    # Construct the classes of $2^2.G$, via the three splittings.
    invfus:= List( tbls2GfustblG, InverseMap );
    fus:= [ [], [], [] ];
    orders:= [];
    2Gorders:= List( tbls2G, OrdersClassRepresentatives );
    Gorders:= OrdersClassRepresentatives( tblG );
    for i in [ 1 .. NrConjugacyClasses( tblG ) ] do

      # Deal with the preimages of class `i' in `tblG'.
      lst:= Filtered( [ 1 .. 3 ], j -> IsList( invfus[j][i] ) );
      int:= Difference( [ 1 .. 3 ], lst );

      Gord:= Gorders[i];

      if   Length( lst ) = 0 then
        # also no splitting here
        for j in [ 1 .. 3 ] do
          fus[j][i]:= [ [ invfus[j][i] ] ];
        od;

        # element order
        2Gord:= List( [ 1 .. 3 ], j -> 2Gorders[j][ invfus[j][i] ] );
        if 2 * Gord in 2Gord then
          Add( orders, 2 * Gord );
        else
          Add( orders, [ Gord, 2 * Gord ] );
        fi;
      elif Length( lst ) = 1 then
        # there is exactly one splitting in step 1, so there are two in step 2.
        fus[ lst[1] ][i]:= [ invfus[ lst[1] ][i] ];
        fus[ int[1] ][i]:= [ invfus[ int[1] ]{ [ i, i ] } ];
        fus[ int[2] ][i]:= [ invfus[ int[2] ]{ [ i, i ] } ];

        # element order
        2Gord:= Concatenation( 2Gorders[ lst[1] ]{ invfus[ lst[1] ][i] },
                               [ 2Gorders[ int[1] ][ invfus[ int[1] ][i] ] ],
                               [ 2Gorders[ int[2] ][ invfus[ int[2] ][i] ] ] );
        if 2 * Gord in 2Gord then
          Append( orders, [ 2 * Gord, 2 * Gord ] );
        else
          Append( orders, List( [ 1, 2 ], k -> [ Gord, 2 * Gord ] ) );
        fi;
      elif Length( lst ) = 3 then
        # splitting in all three cases, we have the problem of identifying!
        # (the first two fusions can be chosen, the third leads to two
        # possibilities in general)
        fus[1][i]:= [ invfus[1][i]{ [ 1, 1, 2, 2 ] } ];
        fus[2][i]:= [ invfus[2][i]{ [ 1, 2, 1, 2 ] } ];

        # If the order in G is odd then one preimage has odd order,
        # and we have no choice.
        if IsOddInt( Gord ) then
          # if necessary then make the class of odd element order the
          # first preimage.
          if IsEvenInt( 2Gorders[1][ invfus[1][i][1] ] ) then
            fus[1][i]:= [ fus[1][i][1]{ [ 3, 4, 1, 2 ] } ];
          fi;
          if IsEvenInt( 2Gorders[2][ invfus[2][i][1] ] ) then
            fus[2][i]:= [ fus[2][i][1]{ [ 1, 2, 4, 3 ] } ];
          fi;

          # the third fusion!
          if IsOddInt( 2Gorders[3][ invfus[3][i][1] ] ) then
            fus[3][i]:= [ invfus[3][i]{ [ 1, 2, 2, 1 ] } ];
          else
            fus[3][i]:= [ invfus[3][i]{ [ 2, 1, 1, 2 ] } ];
          fi;
          Append( orders, [ Gord, 2*Gord, 2*Gord, 2*Gord ] );

        else

          # unfortunate case ...
          fus[3]:= [ invfus[3][i]{ [ 1, 2, 2, 1 ] },
                     invfus[3][i]{ [ 2, 1, 1, 2 ] } ];
          Append( orders, List( [ 1, 4 ], k -> [ Gord, 2 * Gord ] ) );
#T chance to improve this?
        fi;

      else
        Error( "this should not happen!" );
      fi;
    od;

    fus[1]:= Concatenation( Concatenation( fus[1] ) );
    fus[2]:= Concatenation( Concatenation( fus[2] ) );
    poss:= List( Cartesian( fus[3] ), Concatenation );

    # Create the table head of $2^2.G$.
    inv:= InverseMap( fus[1] );
    classes:= [];
    for i in [ 1 .. NrConjugacyClasses( tbls2G[1] ) ] do
      if IsInt( inv[i] ) then
        Add( classes, 2 * SizesConjugacyClasses( tbls2G[1] )[i] );
      else
        Append( classes, SizesConjugacyClasses( tbls2G[1] ){ [ i, i ] } );
      fi;
    od;

    # Power maps: It suffices to check the consistency with the power maps
    # in the factors.
    powermaps:= [];
    for p in Set( Factors( Size( tbls2G[1] ) ) ) do
      powermaps[p]:= CompositionMaps( inv,
                         CompositionMaps( PowerMap( tbls2G[1], p ), fus[1] ) );
      PowerMap( tbls2G[2], p );
    od;
    if not TestConsistencyMaps( powermaps, fus[2],
               ComputedPowerMaps( tbls2G[2] ) ) then
Error("inconsistent!");
    fi;
Print( "indet: ", List( powermaps, Indeterminateness ), "\n" );

    tblV4G:= rec( Identifier:= identifier,
                  UnderlyingCharacteristic:= 0,
                  Size:= 2 * Size( tbls2G[1] ),
                  SizesConjugacyClasses:= classes,
                  ComputedPowerMaps:= powermaps
                 );

    irr:= List( Irr( tbls2G[1] ), chi -> chi{ fus[1] } );
    factirr:= irr{ [ 1 .. NrConjugacyClasses( tblG ) ] };
    irrpos1:= [ NrConjugacyClasses( tblG ) .. Length( irr ) ];
    ker:= ClassPositionsOfKernel( fus[2] );
    irr2:= List( Filtered( Irr( tbls2G[2] ),
                           chi -> chi[ ker[1] ] <> chi[ ker[2] ] ),
                 chi -> chi{ fus[2] } );
    irrpos2:= Length( irr ) + [ 1 .. Length( irr2 ) ];
    Append( irr, irr2 );
    ker:= ClassPositionsOfKernel( poss[1] );
    faith:= Filtered( Irr( tbls2G[3] ),
                      chi -> chi[ ker[1] ] <> chi[ ker[2] ] );
    irrpos3:= Length( irr ) + [ 1 .. Length( faith ) ];

    # Loop over the possible fusions onto the third factor table.
    result:= [];
    for choice in poss do
Print( "choice: ", choice, "\n" );

      # Check whether the power maps are compatible.
      if TestConsistencyMaps( powermaps, choice, ComputedPowerMaps( tbls2G[3] ) ) then
Print( "choice consistent\n" );

        split:= ConvertToLibraryCharacterTableNC( ShallowCopy( tblV4G ) );
        localirr:= List( Concatenation( irr, List( faith, chi -> chi{ choice } ) ),
                         chi -> Character( split, chi ) );
        SetIrr( split, localirr );

        # Compute some threefold tensor products,
        # in order to check the table.
        error:= false;
        for i in irrpos1 do
          for j in irrpos2 do
            for k in irrpos3 do
              if not error then
                chi:= Tensored( localirr{ [i] },
                          Tensored( localirr{ [j] }, localirr{ [k] } ) )[1];
                if not NonnegIntScalarProducts( split, factirr, chi ) then
                  error:= true;
Error( "?" );
                fi;
              fi;
            od;
          od;
        od;

        # Check that the power maps are possible.
#T can this exclude something??
        for p in Set( Factors( Size( tbls2G[1] ) ) ) do
          if not error then
            pow:= PossiblePowerMaps( split, p );
            if IsEmpty( pow ) then
              error:= true;
            fi;
          fi;
        od;

        if not error then
          SetInfoText( split, "constructed from the tables of ..." );
          AutomorphismsOfTable( split );
          StoreFusion( split, rec( name:= Identifier( tbls2G[1] ),
                                   map:= fus[1], specification:= "1" ),
                       tbls2G[1] );
          StoreFusion( split, rec( name:= Identifier( tbls2G[2] ),
                                   map:= fus[2], specification:= "2" ),
                       tbls2G[2] );
          StoreFusion( split, rec( name:= Identifier( tbls2G[3] ),
                                   map:= fus[3], specification:= "3" ),
                       tbls2G[3] );
          Add( result, split );
        fi;

      fi;

    od;

    return result;
    end );


#############################################################################
##
#F  ConstructV4G( <tbl>, <facttbl>, <aut>[, <ker>] )
##
InstallGlobalFunction( ConstructV4G, function( arg )
    local tbl, facttbl, aut, ker, fus, chars;

    tbl:= arg[1];
    facttbl:= arg[2];
    aut:= arg[3];
    ker:= 2;
    if Length( arg ) = 4 then
      ker:= arg[4];
    fi;
    fus:= First( tbl.ComputedClassFusions, fus -> fus.name = facttbl ).map;
    ker:= Position( fus, ker );
    facttbl:= CharacterTableFromLibrary( facttbl );
    tbl.Irr:= List( Irr( facttbl ), x -> ValuesOfClassFunction( x ){ fus } );
    chars:= List( Filtered( tbl.Irr, x -> x[1] <> x[ ker ] ),
                  x -> Permuted( x, aut ) );
    Append( tbl.Irr, chars );
    Append( tbl.Irr, List( chars, x -> Permuted( x, aut ) ) );
end );


#############################################################################
##
#F  ConstructGS3( <tbls3>, <tbl2>, <tbl3>, <ind2>, <ind3>, <ext>, <perm> )
##
InstallGlobalFunction( ConstructGS3,
    function( tbls3, tbl2, tbl3, ind2, ind3, ext, perm )
    local fus2,       # fusion map `tbl2' in `tbls3'
          fus3,       # fusion map `tbl3' in `tbls3'
          proj2,      # projection $G.S3$ to $G.2$
          pos,        # position in `proj2'
          proj2i,     # inner part of projection $G.S3$ to $G.2$
          proj2o,     # outer part of projection $G.S3$ to $G.2$
          proj3,      # projection $G.S3$ to $G.3$
          zeroon2,    # zeros for part of $G.2 \setminus G$ in $G.S_3$
          irr,        # irreducible characters of `tbls3'
          irr3,       # irreducible characters of `tbl3'
          irr2,       # irreducible characters of `tbl2'
          i,          # loop over `ind2'
          pair,       # loop over `ind3' and `ext'
          chi,        # character
          chii,       # inner part of character
          chio;       # outer part of character

    tbl2:= CharacterTableFromLibrary( tbl2 );
    tbl3:= CharacterTableFromLibrary( tbl3 );

    fus2:= First( ComputedClassFusions( tbl2 ),
                  fus -> fus.name = tbls3.Identifier ).map;
    fus3:= First( ComputedClassFusions( tbl3 ),
                  fus -> fus.name = tbls3.Identifier ).map;

    proj2:= ProjectionMap( fus2 );
    pos:= First( [ 1 .. Length( proj2 ) ], x -> not IsBound( proj2[x] ) );
    proj2i:= proj2{ [ 1 .. pos-1 ] };
    pos:= First( [ pos .. Length( proj2 ) ], x -> IsBound( proj2[x] ) );
    proj2o:= proj2{ [ pos .. Length( proj2 ) ] };
    proj3:= ProjectionMap( fus3 );

    zeroon2:= Zero( Difference( [ 1 .. Length( tbls3.SizesCentralizers ) ],
                    fus3 ) );

    # Induce the characters given by `ind2' from `tbl2'.
    irr:= InducedLibraryCharacters( tbl2, tbls3, Irr( tbl2 ){ ind2 }, fus2 );

    # Induce the characters given by `ind3' from `tbl3'.
    irr3:= List( Irr( tbl3 ), ValuesOfClassFunction );
    Append( irr, List( ind3,
        pair -> Concatenation( Sum( irr3{ pair } ){ proj3 }, zeroon2 ) ) );

    # Put the extensions from `tbl' together.
    irr2:= List( Irr( tbl2 ), ValuesOfClassFunction );
    for pair in ext do
      chii:= irr3[ pair[1] ]{ proj3 };
      chio:= irr2[ pair[2] ]{ proj2o };
      Add( irr, Concatenation( chii,  chio ) );
      Add( irr, Concatenation( chii, -chio ) );
    od;

    # Permute the characters with `perm'.
    irr:= Permuted( irr, perm );

    # Store the irreducibles.
    tbls3.Irr:= irr;
end );


#############################################################################
##
#F  ConstructGS3Info( <tbl2>, <tbl3>, <tbls3> )
##
InstallGlobalFunction( ConstructGS3Info, function( tbl2, tbl3, tbls3 )
    local irr2,        # irreducible characters of `tbl2'
          irr3,        # irreducible characters of `tbl3'
          irrs3,       # irreducible characters of `tbls3'
          ind,         # list of induced characters
          ind2,        # positions of irreducible characters of `tbl2'
                       # inducing irreducibly to `tbls3'
          oldind,      # auxiliary list
          i,           # loop over positions in `ind'
          pos,         # position in `ind' or `irr3'
          ind3,        # positions of pairs of irreducible characters of
                       # `tbl3' inducing irreducibly to `tbls3'
          ext,         # list of pairs corresponding to irreducibles of
                       # `tbls3' that are extensions from `tbl2' and `tbl3'
          chi,         # loop over `irrs3'
          pos2,        # position in `irr2'
          rest,        # one restricted character
          irr,
          fus3,
          proj3,
          zeroon2,
          proj2,
          proj2o,
          pair,
          chii,
          chio,
          perm;

    irr2  := Irr( tbl2 );
    irr3  := Irr( tbl3 );
    irrs3 := Irr( tbls3 );

    ind:= Induced( tbl2, tbls3, Irr( tbl2 ) );
    ind2:= Filtered( [ 1 .. Length( ind ) ],
                     i -> Position( ind, ind[i] ) = i and ind[i] in irrs3 );
    oldind:= ind;

    ind:= Induced( tbl3, tbls3, Irr( tbl3 ) );
    ind3:= [];
    for i in [ 1 .. Length( ind ) ] do
      if ind[i] in irrs3 and not ind[i] in oldind then
        pos:= Position( ind, ind[i] );
        if pos <> i then
          Add( ind3, [ pos, i ] );
        fi;
      fi;
    od;

    ext:= [];
    for chi in irrs3 do
      rest:= Restricted( tbls3, tbl3, [ chi ] )[1];
      pos:= Position( irr3, rest );
      if pos <> fail and ForAll( ext, x -> x[1] <> pos ) then
        rest:= Restricted( tbls3, tbl2, [ chi ] )[1];
        pos2:= Position( irr2, rest );
        if pos2 <> fail then
          Add( ext, [ pos, pos2 ] );
        fi;
      fi;
    od;

    # Put the characters together, for computing the necessary permutation.
    # (Use the same code as in `ConstructGS3'.
    irr:= Induced( tbl2, tbls3, Irr( tbl2 ){ind2} );
    fus3:= GetFusionMap( tbl3, tbls3 );
    proj3:= ProjectionMap( fus3 );
    zeroon2:= Zero( Difference( [ 1 .. NrConjugacyClasses( tbls3 ) ],
                                fus3 ) );
    proj2:= ProjectionMap( GetFusionMap( tbl2, tbls3 ) );
    pos:= First( [ 1 .. Length( proj2 ) ], x -> not IsBound( proj2[x] ) );
    pos:= First( [ pos .. Length( proj2 ) ], x -> IsBound( proj2[x] ) );
    proj2o:= proj2{ [ pos .. Length( proj2 ) ] };
    Append( irr, List( ind3,
        pair -> Concatenation( Sum( irr3{ pair } ){ proj3 }, zeroon2 ) ) );
    for pair in ext do
      chii := irr3[pair[1]]{proj3};
      chio := irr2[pair[2]]{proj2o};
      Add( irr, Concatenation( chii, chio ) );
      Add( irr, Concatenation( chii, - chio ) );
    od;
    perm := Sortex( irr ) / Sortex( ShallowCopy( Irr( tbls3 ) ) );

    # Return the result.
    return rec( ind2:= ind2, ind3:= ind3, ext:= ext, perm := perm,
                list:= [ "ConstructGS3",
                         Identifier( tbl2 ), Identifier( tbl3 ),
                         ind2, ind3, ext, perm ] );
    end );


#############################################################################
##
#F  ConstructPermuted( <tbl>, <libnam>[, <prmclasses>, <prmchars>] )
##
InstallGlobalFunction( ConstructPermuted,
    function( arg )
    local tbl, t;

    tbl:= arg[1];

    # There may be fusions into `tbl',
    # so we must guarantee a trivial class permutation.
    if not IsBound( tbl.ClassPermutation ) then
      tbl.ClassPermutation:= ();
    fi;

    # Get the permuted table.
    t:= CallFuncList( CharacterTableFromLibrary, arg[2] );
    if 2 < Length( arg ) and not IsOne( arg[3] ) then
      t:= CharacterTableWithSortedClasses( t, arg[3] );
    fi;
    if 3 < Length( arg ) and not IsOne( arg[4] ) then
      t:= CharacterTableWithSortedCharacters( t, arg[4] );
    fi;

    # Store the components in `tbl'.
    TransferComponentsToLibraryTableRecord( t, tbl );
    end );


#############################################################################
##
#F  ConstructFactor( <tbl>, <libnam>, <kernel> )
##
InstallGlobalFunction( ConstructFactor, function( tbl, libnam, kernel )
    local t;

    # Construct the required table of the factor group.
    t:= CharacterTableFactorGroup( CallFuncList( CharacterTableFromLibrary,
                                                 libnam ),
                                   kernel );

    # Store the components in `tbl'.
    TransferComponentsToLibraryTableRecord( t, tbl );
end );


#############################################################################
##
#F  ConstructClifford( <tbl>, <cliffordtable> )
##
InstallGlobalFunction( ConstructClifford, function( tbl, cliffordtable )
    local i, j, n,
          AnzTi,
          tables,
          ct,        # list of lists of relevant characters,
                     # one for each inertia factor group
          clmexp,
          clmat,
          matsize,
          grps,
          newct,     # the list of irreducibles of `tbl'
          rowct,     # actual row
          colct,     # actual column
          eintr,
          chars,
          linear,
          chi,       # loop over a character list
          lin,
          new;

    # Decode `cliffordTable'.
    cliffordtable:= rec( Ti:= rec( fusions := cliffordtable[1],
                                   tables  := cliffordtable[2] ),
                         cliffordrecords:= cliffordtable[3] );
    cliffordtable.Ti.ident:= StructuralCopy( cliffordtable.Ti.tables );
#T really ?

    # Get the character tables of the inertia groups,
    # and store the relevant list of characters.
    tables:= cliffordtable.Ti.tables;
    AnzTi:= Length( tables );
    ct:= [];
    for i in [ 1 .. AnzTi ] do
      if tables[i][1] = "projectives" then
        eintr:= CharacterTableFromLibrary( tables[i][2] );
      else
        eintr:= CallFuncList( CharacterTableFromLibrary, tables[i] );
      fi;
      if eintr = fail then
        Error( "table of inertia factor group `", tables[i],
               "' not in the library" );
      fi;
      if tables[i][1] = "projectives" then

        # We must multiply the stored projectives with all linear characters
        # of the factor group in order to get the full list.
        chars:= First( ProjectivesInfo( eintr ),
                       x -> x.name = tables[i][3] ).chars;
        ct[i]:= [];
        linear:= List( Filtered( Irr( eintr ), x -> x[1] = 1 ),
                       ValuesOfClassFunction );
        n:= Length( Irr( eintr ) );
#T ?
        for chi in chars do
          for lin in linear do
            new:= List( [ 1 .. n ], x -> chi[x] * lin[x] );
            if not new in ct[i] then
              Add( ct[i], new );
            fi;
          od;
        od;

      else
        ct[i]:= List( Irr( eintr ), ValuesOfClassFunction );
      fi;
      tables[i]:= eintr;
    od;

    # Construct the matrix of irreducibles characters.
    newct := List( tbl.SizesCentralizers, x -> [] );
    colct := 0;

    for i in cliffordtable.cliffordrecords do

      # Get the necessary components of the `i'-th Clifford matrix,
      # and multiply it with the character tables of inertia factor groups.

      clmexp  := UnpackedCll( i );
      clmat   := clmexp.mat;
      matsize := Length( clmat );
      grps    := clmexp.inertiagrps;

      # Loop over the columns of the matrix.
      for n in [ 1 .. matsize ] do

        rowct := 0;
        colct := colct + 1;

        # Loop over the inertia factor groups.
        for j in [ 1 .. AnzTi ] do
          for chi in ct[j] do
            rowct:= rowct + 1;
            newct[rowct][colct]:= Sum( Filtered( [ 1 .. matsize ],
                                                 r -> grps[r] = j ),
               x -> clmat[x][n] * chi[ clmexp.fusionclasses[x] ]);
#T Eventually it should be possible to handle tables where not all
#T classes belonging to a Clifford matrix are expected to be
#T subsequent ...
#T (add an indirection by the fusion)
          od;
        od;

      od;

    od;

    tbl.Irr := newct;
end );


#############################################################################
##
#F  BrauerTableOfExtensionBySingularAutomorphism( <modtbl>, <ordexttbl> )
##
InstallGlobalFunction( BrauerTableOfExtensionBySingularAutomorphism,
    function( modtbl, ordexttbl )
    local ordtbl, p, modexttbl, fus, inv, extirr, nccl, chi, comp, sum, i;

    ordtbl:= OrdinaryCharacterTable( modtbl );
    p:= UnderlyingCharacteristic( modtbl );
    modexttbl:= CharacterTableRegular( ordexttbl, p );
    fus:= GetFusionMap( modtbl, modexttbl );

    # Check the consistency of the arguments.
    if   Size( ordexttbl ) <> p * Size( ordtbl ) then
      Error( "<ordexttbl> is not an order <p> extension of <ordtbl>" );
    elif fus = fail then
      Error( "fusion from <modtbl> to <modexttbl> is not stored" );
    elif not Set( GetFusionMap( ordtbl, ordexttbl ) ) in
         ClassPositionsOfNormalSubgroups( ordexttbl ) then
      Error( "<ordtbl> is not normal in <ordexttbl>" );
    fi;

    # Compute the orbits of the automorphism on the classes of `modtbl'.
    inv:= InverseMap( fus );
    extirr:= [];
    nccl:= NrConjugacyClasses( modexttbl );
    for chi in Irr( modtbl ) do
      comp:= CompositionMaps( chi, inv );
      if ForAny( comp, IsList ) then
        # The character is not invariant, so it does not extend.
        sum:= [];
        for i in [ 1 .. nccl ] do
          if IsList( comp[i] ) then
            sum[i]:= Sum( comp[i] );
          else
            sum[i]:= p * comp[i];
          fi;
        od;
        if not sum in extirr then
          Add( extirr, sum );
        fi;
      else
        # The character is invariant, so it extends uniquely.
        Add( extirr, comp );
      fi;
    od;

    SetIrr( modexttbl, List( extirr, chi -> Character( modexttbl, chi ) ) );

    # Return the result;
    return modexttbl;
end );


#############################################################################
##
##  7. Character Tables of Coprime Central Extensions
##


#############################################################################
##
#F  CharacterTableOfCommonCentralExtension( <tblG>, <tblmG>, <tblnG>, <id> )
##
InstallGlobalFunction( CharacterTableOfCommonCentralExtension,
    function( tblG, tblmG, tblnG, id )
    local mGfusG, nGfusG, m, n, M, invm, invn, i, ordersG, ordersmG,
          ordersnG, try, facttbl, factfusion, newinvm, newinvn, mnGfusmG,
          mnGfusnG, lenm, lenn, j, imod, jmod, cents, invmnGfusmG, pow, p,
          comp, tblmnG, ker, faithm, faithn, irr, centre, ordersmnG, zpos,
          needed, faithmn, partners, chi;

    # Check the arguments.
    mGfusG:= GetFusionMap( tblmG, tblG );
    nGfusG:= GetFusionMap( tblnG, tblG );
    if mGfusG = fail or nGfusG = fail then
      Error( "the fusions <tblmG>, <tblnG> ->> <tblG> must be stored" );
    fi;
    m:= Size( tblmG ) / Size( tblG );
    n:= Size( tblnG ) / Size( tblG );
    if   not IsPrimeInt( m ) then
      Error( "<tblmG> ->> <tblG> must be a prime order extension" );
    elif not IsPrimeInt( n ) then
      Error( "<tblnG> ->> <tblG> must be a prime order extension" );
    elif m = n then
      Error( "<tblmG>, <tblnG> ->> <tblG> must have coprime kernel" );
    elif not IsSubset( ClassPositionsOfCentre( tblmG ),
                       ClassPositionsOfKernel( mGfusG ) ) then
      Error( "<tblmG> must be a central extension of <tblG>" );
    elif not IsSubset( ClassPositionsOfCentre( tblnG ),
                       ClassPositionsOfKernel( nGfusG ) ) then
      Error( "<tblnG> must be a central extension of <tblG>" );
    fi;
    M:= m * n;

    # Compute compatible fusions from $mn.G$ to $m.G$ and $n.G$.
    invm:= InverseMap( mGfusG );
    invn:= InverseMap( nGfusG );
    for i in [ 1 .. Length( invm ) ] do
      if IsInt( invm[i] ) then
        invm[i]:= [ invm[i] ];
      fi;
      if IsInt( invn[i] ) then
        invn[i]:= [ invn[i] ];
      fi;
    od;

    # Note that $mn.G$ may have a cyclic central subgroup of order $M$
    # larger than $m n$.
    # We consider a largest possible cyclic central extension
    # because then more cohorts of faithful characters exist;
    # note that we have to compute only the characters in one family of
    # Galois conjugate cohorts, and derive the others in the end.
    # The second implication is that we can achieve the class ordering
    # relative to the smaller factor group, as in the {\ATLAS} tables in
    # the {\GAP} Character Table Library.
    ordersG:= OrdersClassRepresentatives( tblG );
    ordersmG:= OrdersClassRepresentatives( tblmG );
    ordersnG:= OrdersClassRepresentatives( tblnG );
    try:= Filtered( ClassPositionsOfCentre( tblG ),
                    x ->     ordersG[x] * m in ordersmG{ invm[x] }
                         and ordersG[x] * n in ordersnG{ invn[x] }
                         and Length( invm[x]  ) = m
                         and Length( invn[x]  ) = n );
    if 1 < Length( try ) then
      # Compute the fusions onto the smaller factor group.
      i:= Maximum( ordersG{ try } );
      facttbl:= tblG / [ try[ Position( ordersG{ try }, i ) ] ];
      factfusion:= GetFusionMap( tblG, facttbl );
      M:= M * Size( tblG ) / Size( facttbl );

      # Choose the class ordering w.r.t. the smaller factor group.
      # For that, replace the inverse maps by compositions with the
      # additional factor fusion, but be careful about compatible congurnces.
      newinvm:= [];
      newinvn:= [];
      for i in InverseMap( factfusion ) do
        if IsInt( i ) then
          Add( newinvm, invm[i] );
          Add( newinvn, invn[i] );
        else
          Add( newinvm, Concatenation( TransposedMat( invm{ i } ) ) );
          Add( newinvn, Concatenation( TransposedMat( invn{ i } ) ) );
        fi;
      od;
      invm:= newinvm;
      invn:= newinvn;
    fi;

    mnGfusmG:= [];
    mnGfusnG:= [];
    for i in [ 1 .. Length( invm ) ] do
      lenm:= Length( invm[i] );
      lenn:= Length( invn[i] );
      for j in [ 1 .. LcmInt( lenm, lenn ) ] do
        # Take only those parameter pairs that are compatible
        # with the fusions onto `tblmG' and `tblnG'.
        imod:= j mod lenm;  if imod = 0 then imod:= lenm; fi;
        Add( mnGfusmG, invm[i][ imod ] );
        jmod:= j mod lenn;  if jmod = 0 then jmod:= lenn; fi;
        Add( mnGfusnG, invn[i][ jmod ] );
      od;
    od;

    # Create the table head.
    cents:= [];
    invmnGfusmG:= InverseMap( mnGfusmG );
    for i in [ 1 .. Length( invmnGfusmG ) ] do
      if IsInt( invmnGfusmG[i] ) then
        cents[ invmnGfusmG[i] ]:= SizesCentralizers( tblmG )[i];
      else
        cents{ invmnGfusmG[i] }:= Length( invmnGfusmG[i] )
            * SizesCentralizers( tblmG ){ List( invmnGfusmG[i], x -> i ) };
      fi;
    od;

    pow:= [];
    for p in Set( Factors( cents[1] ) ) do
      pow[p]:= CompositionMaps( InverseMap( mnGfusmG ),
                   CompositionMaps( PowerMap( tblmG, p ), mnGfusmG ) );
      comp:= CompositionMaps( InverseMap( mnGfusnG ),
                 CompositionMaps( PowerMap( tblnG, p ), mnGfusnG ) );
      MeetMaps( pow[p], comp );
      Assert( 1, ForAll( pow[p], IsInt ) );
    od;

    tblmnG:= ConvertToLibraryCharacterTableNC( rec(
        Identifier                 := id,
        Size                       := Size( tblmG ) * n,
        UnderlyingCharacteristic   := 0,
        SizesCentralizers          := cents,
        ComputedPowerMaps          := pow,
        OrdersClassRepresentatives := ElementOrdersPowerMap( pow ) ) );

    StoreFusion( tblmnG, mGfusG{ mnGfusmG }, tblG );
    StoreFusion( tblmnG, mnGfusmG, tblmG );
    StoreFusion( tblmnG, mnGfusnG, tblnG );

    # Transfer the known irreducibles.
    ker:= ClassPositionsOfKernel( mGfusG );
    faithm:= Filtered( Irr( tblmG ),
        chi -> not IsSubset( ClassPositionsOfKernel( chi ), ker ) );
    faithm:= List( faithm, chi -> Character( tblmnG, chi{ mnGfusmG } ) );
    ker:= ClassPositionsOfKernel( nGfusG );
    faithn:= Filtered( Irr( tblnG ),
        chi -> not IsSubset( ClassPositionsOfKernel( chi ), ker ) );
    faithn:= List( faithn, chi -> Character( tblmnG, chi{ mnGfusnG } ) );
    if m < n then
      irr:= List( Irr( tblmG ), chi -> Character( tblmnG, chi{ mnGfusmG } ) );
      Append( irr, faithn );
    else
      irr:= List( Irr( tblnG ), chi -> Character( tblmnG, chi{ mnGfusnG } ) );
      Append( irr, faithm );
    fi;

    # Fix a central class on which the values of missing characters
    # can be prescribed as the degree times a fixed root of unity.
    centre:= ClassPositionsOfCentre( tblmnG );
    ordersmnG:= OrdersClassRepresentatives( tblmnG );
    i:= Maximum( ordersmnG{ centre } );
    zpos:= First( centre, x ->     ordersmnG[x] = i
                               and ordersmG[ mnGfusmG[x] ] < ordersmnG[x]
                               and ordersnG[ mnGfusnG[x] ] < ordersmnG[x] );

    # We use a heuristic for finding the irreducibles in one cohort.
    needed:= ( NrConjugacyClasses( tblmnG ) - Length( irr ) ) / Phi( M );
    faithmn:= IrreduciblesForCharacterTableOfCommonCentralExtension( tblmnG,
                  irr, zpos, needed );

    # Create also the other cohorts.
    partners:= GaloisPartnersOfIrreducibles( tblmnG, faithmn, M );
    for i in [ 1 .. Length( faithmn ) ] do
      chi:= faithmn[i];
      Add( irr, chi );
      for j in partners[i] do
        Add( irr, Character( tblmnG, List( chi, x -> GaloisCyc( x, j ) ) ) );
      od;
    od;

    if Length( irr ) = NrConjugacyClasses( tblmnG ) then
      SetIrr( tblmnG, irr );
    fi;

    return rec( tblmnG       := tblmnG,
                IsComplete   := Length( irr ) = NrConjugacyClasses( tblmnG ),
                irreducibles := irr );
    end );


#############################################################################
##
#F  IrreduciblesForCharacterTableOfCommonCentralExtension(
#F      <tblmnG>, <factirreducibles>, <zpos>, <needed> ) 
##
InstallGlobalFunction( IrreduciblesForCharacterTableOfCommonCentralExtension,
    function( tblmnG, factirreducibles, zpos, needed ) 
    local id, z, root, cohorts, faithmn, reducibles, i, ten, red, galois,
          lll;

    id:= Identifier( tblmnG );
    Info( InfoCharacterTable, 1,
          id, ": need ", needed, " faithful irreducibles" );

    # Try to find the faithful irreducibles.
    # We restrict our interest to one faithful cohort for each factor,
    # and form tensor products.
    # The faithful cohort is determined by the values of the central class
    # `zpos' of maximal order whose image in both factor groups has smaller
    # element order.
    z:= OrdersClassRepresentatives( tblmnG )[ zpos ];
    root:= E( z );
    cohorts:= List( [ 1 .. z ],
                    i -> Filtered( factirreducibles,
                             x -> x[ zpos ] = x[1] * root^i ) );

    # Take those combinations of two cohorts such that the tensor products
    # lie in the target cohort.
    faithmn:= [];
    reducibles:= [];
    for i in [ 1 .. Int( z / 2 ) ] do
      if not IsEmpty( cohorts[i] ) and not IsEmpty( cohorts[ z+1-i ] ) then
        ten:= TensorAndReduce( tblmnG, cohorts[i], cohorts[ z+1-i ],
                  faithmn, needed );
        red:= ReducedX( tblmnG, ten, reducibles );
        reducibles:= red.remainders;
        if not IsEmpty( red.irreducibles ) then
          Info( InfoCharacterTable, 1,
                id, ": ", Length( red.irreducibles ),
                " found by tensoring" );
          Append( faithmn, red.irreducibles );
          if needed <= Length( faithmn ) then
            return faithmn;
          fi;
        fi;
      fi;
    od;

    # Use Galois conjugates of the found faithful irreducibles
    # to form tensor products that lie in the target cohort.
    for i in [ 1 .. Int( z / 2 ) ] do
      if GcdInt( i, z ) = 1 and not IsEmpty( faithmn )
                            and not IsEmpty( cohorts[ z+1-i ] ) then
        galois:= List( faithmn, x -> List( x, y -> GaloisCyc( y, i ) ) );
        ten:= TensorAndReduce( tblmnG, cohorts[ z+1-i ], galois,
                  faithmn, needed );
        red:= ReducedX( tblmnG, ten, reducibles );
        reducibles:= red.remainders;
        if not IsEmpty( red.irreducibles ) then
          Info( InfoCharacterTable, 1,
                id, ": ", Length( red.irreducibles ),
                " found by further tensoring" );
          Append( faithmn, red.irreducibles );
          if needed <= Length( faithmn ) then
            return faithmn;
          fi;
        fi;
      fi;
    od;

    # Use LLL.
    lll:= LLL( tblmnG, reducibles );
    if not IsEmpty( lll.irreducibles ) then
      Info( InfoCharacterTable, 1,
            id, ": ", Length( lll.irreducibles ), " found by LLL" );
      Append( faithmn, lll.irreducibles );
    fi;
    if needed <= Length( faithmn ) then
      return faithmn;
    fi;

    # Sort the irreducibles.
    faithmn:= SortedCharacters( tblmnG, faithmn, "degree" );

    # Return the irreducibles.
    return faithmn;
    end );


#############################################################################
##
##  8. Miscellaneous
##


#############################################################################
##
#F  ReducedX( <tbl>, <redresult>, <chars> )
##
##  In each step, we start with a record irr1/red1 and a list red.
##  After the step, we have a result record irr2/red2 and the list red1.
##
##  red1,irr1    red
##    |    |      |
##    |    --------
##    |        |
##  red1   irr2,red2
##    |      |    |
##    --------    |
##       |        |
##  red3,irr3   red2
##    |    |      |
##    |    --------
##    |        |
##  red3   irr4,red4
## 
##
InstallGlobalFunction( ReducedX, function( tbl, redresult, chars )
    local irreducibles, help;

    irreducibles:= ShallowCopy( redresult.irreducibles );
    while not IsEmpty( redresult.irreducibles ) do
      help:= Reduced( tbl, redresult.irreducibles, chars );
      chars:= redresult.remainders;
      redresult:= help;
      Append( irreducibles, redresult.irreducibles );
    od;

    # Return the result.
    return rec( irreducibles := irreducibles,
                remainders   := Concatenation( redresult.remainders, chars ) );
    end );


#############################################################################
##
#F  TensorAndReduce( <tbl>, <chars1>, <chars2>, <irreducibles>, <needed> )
##
InstallGlobalFunction( TensorAndReduce,
    function( tbl, chars1, chars2, irreducibles, needed )
    local newirreducibles,
          reducibles,
          chi,           # loop over `chars1'
          psi,           # loop over `chars2'
          ten,           # one tensor product
          red;

    irreducibles:= ShallowCopy( irreducibles );
    newirreducibles:= [];
    reducibles:= [];
    for chi in chars1 do
      for psi in chars2 do
        ten:= Tensored( [ chi ], [ psi ] );
        ten:= ReducedOrdinary( tbl, irreducibles, ten );
        red:= ReducedX( tbl, ten, reducibles );
        Append( irreducibles, red.irreducibles );
        Append( newirreducibles, red.irreducibles );
        reducibles:= red.remainders;
        if needed <= Length( newirreducibles ) then
          return rec( irreducibles := newirreducibles,
                      remainders   := reducibles );
        fi;
      od;
    od;

    # Return the result.
    return rec( irreducibles := newirreducibles,
                remainders   := reducibles );
    end );


#############################################################################
##
#E

