1##################################################
2InstallGlobalFunction(LieTensorSquare,
3function(L)
4local
5      BasisL, lenBL, SCTL, lisabelian, K, SCTC, u1, u2, u3, u4, l1, l2,
6      index1, index2, C, t1, t2, t3, t4, t5, t6, i, j, k, m, p,
7      vectorsI, vectorsII,w1,w2,
8      zr1, mr1, zr2, mr2, derayeh1,
9      lenv1, lenv2, lenv3, lenv4, lenv5, lenv6,
10      e, q, w, v1, v2, lzr1, lzr2, lmr1, lmr2,
11      q1, q2, tt1, tt2, ww, h, LTL, LVL, t, v7, I, II,
12      bL, bLTL, g, MLTL, v, vv1, BI, I1, I2, I3,
13      LenBI, BLTL, BBLTL, liltl, llzr1,g1,Pair;
14
15lisabelian:=0;
16if IsLieAbelian(L) then lisabelian:=1; fi;
17K:=L!.LeftActingDomain;
18BasisL:=Basis(L);
19lenBL:=Length(BasisL);
20SCTL:=StructureConstantsTable(BasisL);
21SCTC:=EmptySCTable(lenBL^2,0*One(K),"antisymmetric");
22
23for u1 in [1..lenBL] do
24 for u2 in [1..lenBL] do
25  for u3 in [1..lenBL] do
26   for u4 in [1..lenBL] do
27     l1:=Length(SCTL[u1][u2][1]);
28     l2:=Length(SCTL[u3][u4][1]);
29     if l1<>0 then if l2<>0 then
30                         index1:=(u1-1)*lenBL+u2;
31                         index2:=(u3-1)*lenBL+u4;
32                         derayeh1:=[];
33
34                         for t1 in [1..l1] do
35                          for t2 in [1..l2] do
36                            i:=SCTL[u1][u2][1][t1];
37                            j:=SCTL[u3][u4][1][t2];
38                            m:=(i-1)*lenBL+j;
39                            p:=SCTL[u1][u2][2][t1]*SCTL[u3][u4][2][t2];
40                            Add(derayeh1,p*One(K));
41                            Add(derayeh1,m);
42                          od;
43                         od;
44
45                         SetEntrySCTable(SCTC,index1,index2,derayeh1);
46     fi; fi;
47   od;
48  od;
49 od;
50od;
51
52C:=AlgebraByStructureConstants(K,SCTC);
53
54vectorsI:=[];
55
56for u1 in [1..lenBL] do
57 for u2 in [1..lenBL] do
58  for u3 in [1..lenBL] do
59    zr1:=[];
60    mr1:=[];
61    zr2:=[];
62    mr2:=[];
63    lenv1:=Length(SCTL[u1][u2][1]);
64    if lenv1<>0 then
65      for t1 in [1..lenv1] do
66        i:=SCTL[u1][u2][1][t1];
67        j:=u3;
68        m:=(i-1)*lenBL+j;
69        p:=SCTL[u1][u2][2][t1]*1;
70        Add(zr1,p*One(K));
71        Add(mr1,m);
72      od;
73    fi;
74    lenv2:=Length(SCTL[u2][u3][1]);
75    if lenv2<>0 then
76      for t2 in [1..lenv2] do
77        i:=u1;
78        j:=SCTL[u2][u3][1][t2];
79        m:=(i-1)*lenBL+j;
80        p:=1*SCTL[u2][u3][2][t2];
81        e:=0;
82        if Length(zr1)<>0 then
83          for q in [1..Length(zr1)] do
84            if mr1[q]=m then zr1[q]:=zr1[q]-p*One(K); e:=1; fi;
85          od;
86          if e=0 then Add(zr1,-1*p*One(K)); Add(mr1,m); fi;
87        fi;
88        if Length(zr1)=0 then  Add(zr1,-1*p*One(K)); Add(mr1,m); fi;
89      od;
90    fi;
91    lenv3:=Length(SCTL[u1][u3][1]);
92    if lenv3<>0 then
93      for t3 in [1..lenv3] do
94        i:=u2;
95        j:=SCTL[u1][u3][1][t3];
96        m:=(i-1)*lenBL+j;
97        p:=1*SCTL[u1][u3][2][t3];
98        e:=0;
99        if Length(zr1)<>0 then
100          for q in [1..Length(zr1)] do
101            if mr1[q]=m then zr1[q]:=zr1[q]+p*One(K); e:=1; fi;
102          od;
103          if e=0 then Add(zr1,p*One(K)); Add(mr1,m); fi;
104        fi;
105        if Length(zr1)=0 then Add(zr1,p*One(K)); Add(mr1,m); fi;
106      od;
107    fi;
108    lenv4:=Length(SCTL[u2][u3][1]);
109    if lenv4<>0 then
110      for t4 in [1..lenv2] do
111        i:=u1;
112        j:=SCTL[u2][u3][1][t4];
113        m:=(i-1)*lenBL+j;
114        p:=1*SCTL[u2][u3][2][t4];
115        Add(zr2,p*One(K));
116        Add(mr2,m);
117      od;
118    fi;
119    lenv5:=Length(SCTL[u3][u1][1]);
120    if lenv5<>0 then
121      for t5 in [1..lenv5] do
122        i:=SCTL[u3][u1][1][t5];
123        j:=u2;
124        m:=(i-1)*lenBL+j;
125        p:=SCTL[u3][u1][2][t5]*1;
126        e:=0;
127        if Length(zr2)<>0 then
128          for q in [1..Length(zr2)] do
129            if mr2[q]=m then zr2[q]:=zr2[q]-p*One(K); e:=1; fi;
130          od;
131          if e=0 then Add(zr2,-1*p*One(K)); Add(mr2,m); fi;
132        fi;
133        if Length(zr2)=0 then  Add(zr2,-1*p*One(K)); Add(mr2,m); fi;
134      od;
135    fi;
136    lenv6:=Length(SCTL[u2][u1][1]);
137    if lenv6<>0 then
138      for t6 in [1..lenv6] do
139        i:=SCTL[u2][u1][1][t6];
140        j:=u3;
141        m:=(i-1)*lenBL+j;
142        p:=SCTL[u2][u1][2][t6]*1;
143        e:=0;
144        if Length(zr2)<>0 then
145          for q in [1..Length(zr2)] do
146            if mr2[q]=m then zr2[q]:=zr2[q]+p*One(K); e:=1; fi;
147          od;
148          if e=0 then Add(zr2,p*One(K)); Add(mr2,m); fi;
149        fi;
150        if Length(zr2)=0 then Add(zr2,p*One(K)); Add(mr2,m); fi;
151      od;
152    fi;
153
154    lzr1:=Length(zr1);
155    lmr1:=Length(mr1);
156    v1:=0;
157    if lzr1<>0 then
158      v1:=zr1[1]*(Elements(Basis(C))[lenBL^2-mr1[1]+1]);
159      for q1 in [2..lzr1] do
160        if zr1[q1]<>0 then
161          v1:=v1+zr1[q1]*(Elements(Basis(C))[lenBL^2-mr1[q1]+1]);
162        fi;
163      od;
164    fi;
165    tt1:=0;
166    for ww in [1..Length(Basis(C))] do
167      if v1=0*Elements(Basis(C))[ww] then tt1:=1; fi;
168    od;
169    w:=0;
170    for h in [1..Length(vectorsI)] do
171      if v1=vectorsI[h] then w:=1; fi;
172      if -1*v1=vectorsI[h] then w:=1; fi;
173    od;
174    if v1<>0 then if w=0 then if tt1=0 then Add(vectorsI,v1); fi; fi; fi;
175    lzr2:=Length(zr2);
176    lmr2:=Length(mr2);
177    v2:=0;
178    if lzr2<>0 then
179      v2:=zr2[1]*(Elements(Basis(C))[lenBL^2-mr2[1]+1]);
180      for q2 in [2..lzr2] do
181        if zr2[q2]<>0 then
182          v2:=v2+zr2[q2]*(Elements(Basis(C))[lenBL^2-mr2[q2]+1]);
183        fi;
184      od;
185    fi;
186    tt2:=0;
187    for ww in [1..Length(Basis(C))] do
188      if v2=0*Elements(Basis(C))[ww] then tt2:=1; fi;
189    od;
190    w:=0;
191    for h in [1..Length(vectorsI)] do
192      if v2=vectorsI[h] then w:=1; fi;
193      if -1*v2=vectorsI[h] then w:=1; fi;
194    od;
195    if v2<>0 then if w=0 then if tt2=0 then Add(vectorsI,v2); fi; fi; fi;
196
197  od;
198 od;
199od;
200
201I:=Ideal(C,vectorsI);
202#LTL:=C/I;
203g1:=NaturalHomomorphismByIdeal(C,I);
204LTL:=Image(g1);
205vectorsII:=[];
206
207for t in [1..Length(vectorsI)] do
208  Add(vectorsII,vectorsI[t]);
209od;
210
211for i in [1..lenBL] do
212  w:=(i-1)*lenBL+i;
213  v7:=Elements(Basis(C))[lenBL^2-w+1];
214  Add(vectorsII,v7);
215od;
216
217for i in [1..lenBL] do
218 for j in [1..lenBL] do
219   w1:=(i-1)*lenBL+j;
220   w2:=(j-1)*lenBL+i;
221   v7:=Elements(Basis(C))[lenBL^2-w1+1]+Elements(Basis(C))[lenBL^2-w2+1];
222   Add(vectorsII,v7);
223 od;
224od;
225
226II:=Ideal(C,vectorsII);
227LVL:=C/II;
228MLTL:=[];
229
230for i in [1..Length(Basis(C))] do
231  v:=Elements(Basis(C))[lenBL^2-i+1];
232  if not (v in I) then Add(MLTL,v); fi;
233od;
234
235BI:=Basis(I);
236LenBI:=Length(BI);
237BLTL:=[];
238BBLTL:=[];
239
240for j in [1..LenBI] do
241  Add(BBLTL,Elements(BI)[j]);
242od;
243
244for i in [1..Length(MLTL)] do
245  Add(BLTL,MLTL[i]);
246  Add(BBLTL,MLTL[i]);
247  I1:=VectorSpace(K,BBLTL);
248  if Dimension(I1)=LenBI+1 then LenBI:=LenBI+1;
249    else
250      Remove(BLTL);
251      Remove(BBLTL);
252  fi;
253  if Length(BLTL)=Dimension(C) then break; fi;
254od;
255
256I2:=VectorSpace(K,BLTL);
257I3:=VectorSpace(K,Basis(LTL));
258liltl:=[];
259
260for i in [1..Length(BLTL)] do
261 for j in [1..Length(Basis(C))] do
262   if BLTL[i]=Elements(Basis(C))[lenBL^2-j+1] then
263     Add(liltl,j);
264     break;
265   fi;
266 od;
267od;
268
269bL:=[];
270
271for k in [1..Length(liltl)] do
272  u1:=Int(liltl[k]/lenBL)+1;
273  u2:= liltl[k] mod lenBL;
274  if u2=0 then u2:=lenBL; u1:=u1-1;  fi;
275  u3:=SCTL[u1][u2];
276  llzr1:=Length(SCTL[u1][u2][1]);
277  vv1:=0*Elements(BasisL)[1];
278  if llzr1<>0 then
279    vv1:=SCTL[u1][u2][2][1]*Elements(BasisL)[lenBL-SCTL[u1][u2][1][1]+1];
280    for i in [2..llzr1] do
281      vv1:=vv1+SCTL[u1][u2][2][i]*Elements(BasisL)[lenBL-SCTL[u1][u2][1][i]+1];
282    od;
283  fi;
284  Add(bL,vv1);
285od;
286
287bLTL:=Basis(LTL);
288g:= AlgebraHomomorphismByImages( LTL, L, bLTL , bL );;
289#g1:= NaturalHomomorphismByIdeal( C, I );
290
291################################
292Pair:=function(x,y)
293  local
294    z1,z2,z3,z4,l,v1,v,k,i,j;
295
296z1:=Coefficients( Basis(L), x );
297z2:=Coefficients( Basis(L), y );
298l:=Length(z1);
299v:=0*Random(Images(g1,Basis(C)[1]));
300for i in [1..l] do
301 for j in [1..l] do
302   z3:=z1[i]*z2[j];
303   if z3<>0 then
304     k:=(i-1)*lenBL+j;
305     v1:=Random(Images(g1,Basis(C)[k]));
306     v:=v+z3*v1;
307   fi;
308 od;
309od;
310return v;
311end;
312
313################################
314return rec(homomorphism:=g, pairing:=Pair );
315end);
316###############################################################################
317