#############################################################################
##
#A  genVchtab            CHEVIE library          Meinolf Geck & Frank L"ubeck
##
#Y  Copyright 1992--1993,  Lehrstuhl D f"ur Mathematik,    RWTH Aachen,   and
#Y                         IWR   der   Universit"at    Heidelberg,   Germany.
##
####################################################################
##
##  
## 
#H 1994/08/05  FL
#H Copy changed to work with very small tables
#H
#H modifications in Copy, CopyChar, CopyClass t avoid unnesssary
#H copying of Klassen.. and Char..Parameter (this solves also a problem
#H of PrintToTeX for copied tables).
#H
#H Added a function LinComb
#H
Copy:=proc(ta,tn)
   local sy, syl, nosy, lil, noli, adrows, 
         adcols, ch, cl, cha, cla, chn, cln,
         cc, ll1, ll2;
   tablenumber(ta);
   nosy := 0;
   noli := 0;
   cha := ta[-2,3];
   cla := ta[-2,5];
   chn := cha;
#   cln := cla;
   cln := max(cla,5);
   ll1 := [$ 1..ta[-2,2]];
   ll2 := [$ 1..ta[-2,4]];
   if ( ( nargs < 2 ) or ( nargs > 6 ) )
       then 
         ERROR(`No. of arguments must be at least 2 and at most 6`);
       else for cc from 3 to nargs do
                if  type(args[cc],`+`)
                    then nosy := nosy + 1;
                         syl[nosy] := cc;
                    else noli := noli + 1;
                         lil[noli] := cc;
                fi;
            od;
   fi;
   if nargs - nosy - 2 > 0
       then ll1 := makelist(args[lil[1]]);
   fi;
   if nargs - nosy - 2 = 2
       then ll2 := makelist(args[lil[2]]);
   fi;
   for cc from 1 to nosy do
       sy := syl[cc];
       adrows := args[sy] - 'ROWS';
       adcols := args[sy] - 'COLS';
       if type( adrows,integer )
           then chn := chn + adrows;
       elif type( adcols,integer )
           then cln := cln + adcols;
       fi;
   od;
   ll1 := [-1,0,op(ll1)];
   ll2 := [-1,0,op(ll2)];

   tn := array(-2..chn,-1..cln);
   if evaln(Klassen||ta||Parameter)<>op(Klassen||ta||Parameter) or
      evaln(Char||ta||Parameter)<>op(Char||ta||Parameter) then
     Klassen||tn||Parameter := array(-1..cln);
     Char||tn||Parameter := array(-2..chn);
     for ch to nops(ll1) do
           Char||tn||Parameter[ch - 2] := Char||ta||Parameter[ll1[ch]];
     od;
     for cl to nops(ll2) do
           Klassen||tn||Parameter[cl - 2] := 
                                     Klassen||ta||Parameter[ll2[cl]];
     od;
   fi;
   for ch to nops(ll1) do
     for cl to nops(ll2) do
           tn[ch - 2,cl - 2] := ta[ll1[ch],ll2[cl]];  
     od;
   od;
   tn[-2,-1]:= ta[-2,-1];
   tn[-2,0] := ta[-2,0];
   tn[-2,1] := ta[-2,1];
   tn[-2,4] := nops(ll2) - 2;
   tn[-2,2] := nops(ll1) - 2;
   tn[-2,3] := chn;
   tn[-2,5] := cln;
   NULL;
end:


####################################################################
##
##  
## 
CopyChar:=proc(t1,t2)
   local ll, ch, cl, nr1, nr2; 
   nr1:=tablenumber(t1);
   nr2:=tablenumber(t2);
   if nr1=nr2 then 
       if nargs = 2 then 
           ll := [$ 1..t1[-2,2]]
       else 
           ll := makelist(args[3])
       fi;
       if (t2[-2,3] - t2[-2,2] < nops(ll)) or (t2[-2,5] < t1[-2,4]) 
       then 
           ERROR(`Second table too small: Enlarge with "Copy"`);
       else 
         if evaln(Klassen||t1||Parameter)<>op(Klassen||t1||Parameter) or
            evaln(Char||t1||Parameter)<>op(Char||t1||Parameter) then
            for cl from -1 to t1[-2,4] do
               Klassen||t2||Parameter[cl]:=Klassen||t1||Parameter[cl];
                for ch to nops(ll) do
                    Char||t2||Parameter[ch + t2[-2,2]] :=
                                        Char||t1||Parameter[ll[ch]];
                od;
            od;
         fi;
         for cl from -1 to t1[-2,4] do
               t2[-1,cl] := t1[-1,cl];
               t2[ 0,cl] := t1[ 0,cl];
               for ch to nops(ll) do
                   t2[ch + t2[-2,2],cl] := t1[ll[ch],cl];
               od;
         od;
         t2[-2,2] := t2[-2,2] + nops(ll);
         t2[-2,4] := t1[-2,4];
       fi;
   else 
     ERROR(`Both tables must have the same "tablenumber"`);
   fi;
   NULL;
end:


####################################################################
##
##  
## 
CopyClass:=proc(t1,t2)
   local ll, ch, cl, nr1, nr2; 
   nr1:=tablenumber(t1);
   nr2:=tablenumber(t2);
   if nr1=nr2 then 
       if nargs = 2 then
           ll := [$ 1..t1[-2,4]]
       else
           ll := makelist(args[3])
       fi; 
       if (t2[-2,5] - t2[-2,4] < nops(ll)) or (t2[-2,3] < t1[-2,2])
       then
           ERROR(`Second table too small: Enlarge with "Copy"`);
       else
         if evaln(Klassen||t1||Parameter)<>op(Klassen||t1||Parameter) or
            evaln(Char||t1||Parameter)<>op(Char||t1||Parameter) then
           for ch from -1 to t1[-2,2] do
               Char||t2||Parameter[ch]:=Char||t1||Parameter[ch];
               for cl to nops(ll) do
                   Klassen||t2||Parameter[cl + t2[-2,4]] :=
                                    Klassen||t1||Parameter[ll[cl]];
               od; 
           od; 
         fi;
         for ch from -1 to t1[-2,2] do
               t2[ch,-1] := t1[ch,-1];
               t2[ch, 0] := t1[ch, 0];
               for cl to nops(ll) do
                   t2[ch,cl + t2[-2,4]] := t1[ch,ll[cl]];
               od; 
         od; 
         t2[-2,4] := t2[-2,4] + nops(ll);
         t2[-2,2] := t1[-2,2];
       fi; 
   else 
     ERROR(`Both tables must have the same "tablenumber"`);
   fi;
   NULL;
end:



####################################################################
##
##  
## 
SpecCharParam:=proc(t,i)
  local nr, s, cl, ct, a, Substituted;
  nr:=tablenumber(t);
  cl:=t[-2,4];
  s:={args[3..nargs]};
  for ct to cl do
    setCongruence||nr(); 
    a:=GEW2qscew(subs(s,t[i,ct]));
    unsetCongruence||nr(); 
    t[i,ct]:=qscew2GEW(a);
  od;
  if s<>{} then
    printf("Substituted\n");
    printf("    %a\n",s);
    printf("in character type %a.\n",i);
    # in Char||t||Parameter notieren:
    if nops(Char||t||Parameter[i])=2 then
      Char||t||Parameter[i]:=[op(Char||t||Parameter[i]),[s]];
    elif nops(Char||t||Parameter[i])=3 then
      Char||t||Parameter[i]:=[Char||t||Parameter[i][1],
                            Char||t||Parameter[i][2],
                            [op(Char||t||Parameter[i][3]),s]];
    fi;  
  fi;
  NULL;
end:

####################################################################
##
##  
## 
SpecClassParam:=proc(t,i)
  local nr, s, cl, ct, a, Substituted;
  nr := tablenumber(t);
  ct:=t[-2,2];
  s:={args[3..nargs]};
  for cl to ct do
    setCongruence||nr(); 
    a:=GEW2qscew(subs(s,t[cl,i]));
    unsetCongruence||nr(); 
    t[cl,i]:=qscew2GEW(a);
  od;
  if s<>{} then
    printf("Substituted\n");
    printf("    %a\n",s);
    printf("in class type %a.\n",i);
    # in Klassen||t||Parameter notieren:
    if nops(Klassen||t||Parameter[i])=2 then
      Klassen||t||Parameter[i]:=[op(Klassen||t||Parameter[i]),[s]];
    elif nops(Klassen||t||Parameter[i])=3 then
      Klassen||t||Parameter[i]:=[Klassen||t||Parameter[i][1],
                            Klassen||t||Parameter[i][2],
                            [op(Klassen||t||Parameter[i][3]),s]];
    fi;  
  fi;
  NULL;
end:


####################################################################
##
##  Tensor(tf1,ll1,tf2,ll2,tf3)
##  Tensor(tf1,tf3)
##  Tensor(tf1,ll1,tf3)
##  Tensor(tf1,tf2,tf3)
## 
Tensor:=proc(tf1)
   local cl,nr,ch,ct,w1,w2,tt,t1,t2,ll1,ll2,tf2,tf3,i,j,cp1,cp2;
   nr:=tablenumber(tf1);
   if nargs=5 then
     ll1:=makelist(args[2]);
     if nr=tablenumber(args[3]) then
       tf2:=args[3];
     else
       ERROR(`Tables must have the same "tablenumber"`);
     fi;
     ll2:=makelist(args[4]);
     if nr=tablenumber(args[5]) then
       tf3:=args[5];
     else
       ERROR(`Tables must have the same "tablenumber"`);
     fi;
   elif nargs=3 and (type(args[2],list) or type(args[2],integer)) then
     ll1:=makelist(args[2]);
     tf2:=tf1;
     ll2:=[$ 1..tf1[-2,2]];
     if nr=tablenumber(args[3]) then
       tf3:=args[3];
     else
       ERROR(`Tables must have the same "tablenumber"`);
     fi;
   elif nargs=3 then
     ll1:=[$ 1..tf1[-2,2]];
     if nr=tablenumber(args[2]) then
       tf2:=args[2];
     else
       ERROR(`Tables must have the same "tablenumber"`);
     fi;
     ll2:=[$ 1..tf2[-2,2]];
     if nr=tablenumber(args[3]) then
       tf2:=args[3];
     else
       ERROR(`Tables must have the same "tablenumber"`);
     fi;
   elif nargs=2 then
     tf2:=tf1;
     if nr=tablenumber(args[2]) then
       tf3:=args[2];
     else
       ERROR(`Tables must have the same "tablenumber"`);
     fi;
     if tf3[-2,3] - tf3[-2,2] < tf1[-2,2]*(tf1[-2,2]+1)/2 then
       ERROR(`Third table too small: Enlarge with "Copy"`);
     fi;
     for i to tf1[-2,2] do
       for j to i do 
         Tensor(tf1,i,tf2,j,tf3);
       od;
     od;
     RETURN(NULL);
   else
     ERROR(`Wrong arguments`);
   fi;
   if tf3[-2,3] - tf3[-2,2] < nops(ll1)*nops(ll2) then
      ERROR(`Third table too small: Enlarge with "Copy"`);
   fi;
   cl:=tf1[-2,4];
   ch:=tf3[-2,2];
   tf3[-1,-1] := tf1[-1,-1];
   tf3[ 0,-1] := tf1[ 0,-1];
   tf3[-2,4] := tf1[-2,4];
   if nops(ll1)*nops(ll2)<>0 then
     for i from 0 to tf1[-2,4] do
       Klassen||tf3||Parameter[i]:=Klassen||tf1||Parameter[i];
     od;
   fi;
   for i in ll1 do
     for j in ll2 do
       for ct from 0 to cl do 
         tf3[-1,ct] := tf1[-1,ct];
         tf3[ 0,ct] := tf1[ 0,ct];
         if NurPolynom||nr = true then
           tf3[ch+1,ct]:=expand(tf1[i,ct]*tf2[j,ct]);    
         else
           setCongruence||nr(); 
           w1:=GEW2qscew(parameter||nr(tf1[i,ct],`t1`,``));
           w2:=GEW2qscew(parameter||nr(tf2[j,ct],`t2`,``));
           tt:=qscew2GEW(malqscew(w1,w2));
           unsetCongruence||nr(); 
           tf3[ch+1,ct]:=normal(eval(tt));
         fi;
       od;
       ch:=ch+1;
       tf3[-2,2]:=ch;
       tf3[ch,-1]:=[`Tensor(`||tf1||`,`||i||`,`||tf2||`,`||j||`)`];
       cp1:=parameter||nr(Char||tf1||Parameter[i],`t1`,``);
       cp2:=parameter||nr(Char||tf2||Parameter[j],`t2`,``);
       Char||tf3||Parameter[ch]:=
                 [[op(cp1[1]),op(cp2[1])],[op(cp1[2]),op(cp2[2])]];
                    
     od;
   od;
   NULL;
end:

####################################################################
##
##  Omega(tf1,ll1,tf2); 
##  Omega(tf1,tf2); 
## 
Omega:=proc(tf1)
   local cl,ch,i,ct,tf2,ll1,nr;
   nr:=tablenumber(tf1);
   if nargs=3 and nr=tablenumber(args[3]) then
     tf2:=args[3];
     ll1:=makelist(args[2]);
   elif nargs=2 and nr=tablenumber(args[2]) then
     tf2:=args[2];
     ll1:=[$ 1..tf1[-2,2]];
   else
     ERROR(`Wrong arguments`);
   fi;
   if tf2[-2,3] - tf2[-2,2] < nops(ll1) then
      ERROR(`Second table too small: Enlarge with "Copy"`);
   fi;
   tf2[-2,4] := tf1[-2,4];
   cl:=tf1[-2,4];
   ch:=tf2[-2,2];
   if nops(ll1)<>0 then
     for i from 0 to tf1[-2,4] do
       Klassen||tf2||Parameter[i]:=Klassen||tf1||Parameter[i];
     od;
   fi;
   for i in ll1 do
     for ct from 0 to cl do
       tf2[ch+1,ct]:=normal(tf1[i,ct]*tf1[0,ct]/tf1[i,0]);
     od;
     ch:=ch+1;
     tf2[-2,2]:=ch;
     tf2[ch,-1]:=[`Omega(`||tf1||`,`||i||`)`];
     Char||tf2||Parameter[ch]:=Char||tf1||Parameter[i];
   od;
   NULL;
end:


####################################################################
##
##  LinComb(tf1,c1,l1,tf2,c2,l2,. . . ,tn)
## 
LinComb:=proc(tf1)
   local tn,cl,nr,ch,ct,anz,i,w,cp1,cp2;
   nr:=tablenumber(tf1);
   anz:=(nargs-1)/3;
   if not( type(anz,integer) ) then
     ERROR(`Wrong arguments`);
   fi;
   tn:=args[nargs];
   for i to anz do
     if tablenumber(args[3*i+1])<>nr then
       ERROR(`Tables must have the same "tablenumber"`);
     fi;
   od;
   if tn[-2,3] - tn[-2,2] < 1 then
      ERROR(`Table `||tn||` too small: Enlarge with "Copy"`);
   fi;
   cl:=tf1[-2,4];
   ch:=tn[-2,2];
   tn[-1,-1] := tf1[-1,-1];
   tn[ 0,-1] := tf1[ 0,-1];
   tn[-2,4] := tf1[-2,4];
   for i from 0 to tf1[-2,4] do
     Klassen||tn||Parameter[i]:=Klassen||tf1||Parameter[i];
   od;
   for ct from 0 to cl do 
     tn[-1,ct] := tf1[-1,ct];
     tn[ 0,ct] := tf1[ 0,ct];
     if NurPolynom||nr = true then
       tn[ch+1,ct]:=0;
       for i to anz do
         tn[ch+1,ct]:=expand(args[3*i-2][args[3*i],ct]*args[3*i-1]
                                                            +tn[ch+1,ct]);
       od;
     else
       tn[ch+1,ct]:=0;
       for i to anz do
         w:=parameter||nr(expand(args[3*i-2][args[3*i],ct]*args[3*i-1]),l||i,``);
         tn[ch+1,ct]:=w+tn[ch+1,ct];
       od;
     fi;
   od;
   ch:=ch+1;
   tn[-2,2]:=ch;
   tn[ch,-1]:=`LinComb(`;
   for i to anz do
     tn[ch,-1]:=``||(tn[ch,-1])||(args[3*i-2])||`,`||(args[3*i-1])||
		                                                         `,`||(args[3*i]);
     if i<anz then tn[ch,-1]:=``||(tn[ch,-1])||`,`; fi;
   od;
   tn[ch,-1]:=[``||(tn[ch,-1])||`)`];
   if NurPolynom||nr<>true then
     Char||tn||Parameter[ch]:=parameter||nr(
                                     Char||tf1||Parameter[args[3]],`l1`,``);
     for i to anz-1 do
       cp1:=Char||tn||Parameter[ch];
       cp2:=parameter||nr(
                      Char||(args[3*i+1])||Parameter[args[3*i+3]],l||(i+1),``);
         Char||tn||Parameter[ch]:=
                 [[op(cp1[1]),op(cp2[1])],[op(cp1[2]),op(cp2[2])]];
     od;           
   fi;
   NULL;
end:



