CONVERT0 := proc (F, G, H) local F1, F2, G1, G2, H1;
F1 := expand(subs(x = (1/2)*z+(1/2)*conjugate(z), y = -((1/2)*I)*(z-conjugate(z)), F)); 
G1 := expand(subs(x = (1/2)*z+(1/2)*conjugate(z), y = -((1/2)*I)*(z-conjugate(z)), G)); 
H1 := expand(subs(x = (1/2)*z+(1/2)*conjugate(z), y = -((1/2)*I)*(z-conjugate(z)), H)); 
F2 := expand(I*G1+F1);
G2 := expand(-I*G1+F1); 
return [H1, F2, G2] end proc:

CONVERT1 := proc (V, N) local i, c, a, b, NEWVF, NEWVF1, R, n1, n2, n3, K, J;
 a := 0; b := 0; 
 NEWVF1 := subs(conjugate(z) = l, V); 
 NEWVF := expand(NEWVF1+z^5000+ z^50000); 
 for i to nops(NEWVF) do 
 R := op(i, NEWVF); 
 n1 := degree(R, s); 
 n2 := degree(R, z);
n3 := degree(R, l);
K := coeffs(R, {l, s, z}); 
J := coeffs(R, indets(R));
 if R = z^5000 or R = z^50000 then c := 0 
 elif type(J, realcons) then 
 if n2 = n3 and n3 = 0 then 
 a := a+R*x[n1, 0, 0]/(s^n1*l^n3*z^n2) elif
  n2 = n3 and n3 <> 0 then 
  a := a+R*x[n1, n2, n3]/(s^n1*l^n3*z^n2) 
  elif n3 < n2 then 
  a := a+2*R*x[n1, n2, n3]/(s^n1*l^n3*z^n2) end if
   else if n2 = n3 and n3 = 0 then
    b := b-I*R*t[n1, 0, 0]/(s^n1*l^n3*z^n2) 
    elif n2 = n3 and n3 <> 0 then
     b := b-I*R*t[n1, n2, n3]/(s^n1*l^n3*z^n2) 
     elif n3 < n2 then b := b-(2*I)*R*t[n1, n2, n3]/(s^n1*l^n3*z^n2) 
     end if end if end do; return a+b+c end proc:

CONVERT2 := proc (V, N) local i, c, a, b, l, NEWVF, NEWVF1, n1, n2, n3, R, K, J; 
a := 0; b := 0; 
NEWVF1 := subs(conjugate(z) = l, V); 
NEWVF := expand(NEWVF1+z^5000+z^50000); 
for i to nops(NEWVF) do 
R := op(i, NEWVF); 
n1 := degree(R, s); 
n2 := degree(R, z); 
n3 := degree(R, l);
 K := coeffs(R, {s, z, l}); 
 J := coeffs(R, indets(R));
  if op(i, NEWVF) = z^5000 or op(i, NEWVF) = z^50000 then c := 0 
  elif type(J, realcons) then a := a+R*y[n1, n2, n3]/(s^n1*l^n3*z^n2) else b := b-I*R*z[n1, n2, n3]/(s^n1*l^n3*z^n2) end if end do; return a+b+c end proc:
 
`type/mytype0` := proc (v) if type(v, indexed) and op(0, v) = x or op(0, v) = y or op(0, v) = z or op(0, v) = t then return true else return false end if end proc:
  
`type/mutype` := proc (v) if type(v, indexed) and op(0, v) = mu then return true else return false end if end proc:

NopsCheck := proc (V) local L; if V = 0 then return [0, 0] elif V <> 0 then L := indets(V, mytype0); return [nops(L), L[1]] end if end proc:
 
Arrange0 := proc (v) local L, m; if v = 0 then return [0, 0, 0] else L := indets(v, mytype0); m := nops(L) end if; if 1 < m then return [m, L[1], add(i, i = normal([op(collect(v, L, distributed))]))] elif m = 1 then return 1, L[1], coeff(v, L[1])*L[1] end if end proc:
 
grade := proc (V) local L; L := Arrange0(V); if L[1] = 1 and L[2] <> x[10000000000, 10000000000, 10000000000] and L[2] <> y[10000000000, 10000000000, 10000000000] then return 2*ldegree(coeff(L[3], L[2]), indets(L[3], mutype))+op(1, L[2])+op(2, L[2])+op(3, L[2])-1 end if end proc:
 

GRADE00 := proc (V) local J, w; return max(map(grade, {op(V+x[10000000000, 10000000000, 10000000000]+y[10000000000, 10000000000, 10000000000])})) end proc:
 
XkijTRASFORMATION := proc (n, V1, k, i, j, a0) local c; c := 0; if GRADE00(V1) = n and i <> j then c := -t[k, i, j]*coeff(V1, x[k, i, j])/((i-j)*a0) end if; return c end proc:

YkijTRASFORMATION := proc (n, V1, k, i, j, a0) local d; d := 0; if GRADE00(V1) = n and i <> j+1 then d := -z[k, i, j]*coeff(V1, y[k, i, j])/((i-j-1)*a0) end if; return d end proc:

ZkijTRASFORMATION := proc (n, V1, k, i, j, a0) local e; e := 0; if GRADE00(V1) = n and i <> j+1 then e := -y[k, i, j]*coeff(V1, z[k, i, j])/((j-i+1)*a0) end if; return e end proc:


TkijTRASFORMATION := proc (n, V1, k, i, j, a0) local r; r := 0; if GRADE00(V1) = n and i <> j then r := -x[k, i, j]*coeff(V1, t[k, i, j])/((j-i)*a0) end if; return r end proc:

TRANSFORMATION0 := proc (n, VF) local transformation, trans, i, W, INDETS, NEWVF, a0, a1; #option trace;
 transformation := 0; trans := 0; NEWVF := VF+y[20000, 20000, 20000]+z[2000, 2000, 2000]; 
 a0 := coeff(NEWVF, z[0, 1, 0]); 
 a1 := subs(mu[1] = 0, mu[2] = 0, mu[3] = 0, mu[4] = 0, mu[5] = 0, mu[6] = 0, mu[7] = 0, mu[8] = 0, mu[9] = 0, mu[10] = 0, mu[11] = 0, a0); 
 for i to nops(NEWVF) do
  if y[20000, 20000, 20000] = op(i, NEWVF) or z[2000, 2000, 2000] = op(i, NEWVF) then 
  trans := 0; 
  transformation := transformation+trans 
  else 
  W := op(i, NEWVF); 
  INDETS := indets(W, mytype0);
   if n = GRADE00(W) then
    if op(0, INDETS[1]) = x then
     trans := XkijTRASFORMATION(n, op(i, NEWVF), op(1, INDETS[1]), op(2, INDETS[1]), op(3, INDETS[1]), a1); transformation := transformation+trans elif op(0, INDETS[1]) = y then trans := YkijTRASFORMATION(n, op(i, NEWVF), op(1, INDETS[1]), op(2, INDETS[1]), op(3, INDETS[1]), a1); transformation := transformation+trans elif op(0, INDETS[1]) = z then trans := ZkijTRASFORMATION(n, op(i, NEWVF), op(1, INDETS[1]), op(2, INDETS[1]), op(3, INDETS[1]), a1); transformation := transformation+trans elif op(0, INDETS[1]) = t then trans := TkijTRASFORMATION(n, op(i, NEWVF), op(1, INDETS[1]), op(2, INDETS[1]), op(3, INDETS[1]), a1); transformation := transformation+trans end if else trans := 0; transformation := transformation+trans end if end if end do; return transformation end proc:

 LIEBRACKETXX := proc (k, m, n, i, j, r) local A, B; A := 0; B := 0; if n+r <= m+j then A := ((1/2)*i-(1/2)*k)*x[k+i-1, m+j, n+r] else A := ((1/2)*i-(1/2)*k)*x[k+i-1, n+r, m+j] end if; if n+j <= m+r then B := ((1/2)*i-(1/2)*k)*x[k+i-1, m+r, n+j] else B := ((1/2)*i-(1/2)*k)*x[k+i-1, n+j, m+r] end if; return A+B end proc:
 
LIEBRACKETYY := proc (k, m, n, i, j, r) return (j-m)*y[k+i, m+j-1, n+r]+r*y[k+i, n+j, m+r-1]-n*y[k+i, m+r, j+n-1] end proc:
 
LIEBRACKETZZ := proc (k, m, n, i, j, r) return (m-j)*y[k+i, m+j-1, n+r]+r*y[k+i, n+j, m+r-1]-n*y[k+i, m+r, j+n-1] end proc:
 
LIEBRACKETTT := proc (k, m, n, i, j, r) local A, B; A := 0; B := 0; if n+r <= m+j then A := ((1/2)*k-(1/2)*i)*x[k+i-1, m+j, n+r] else A := ((1/2)*k-(1/2)*i)*x[k+i-1, n+r, m+j] end if; if n+j <= m+r then B := ((1/2)*i-(1/2)*k)*x[k+i-1, m+r, n+j] else B := ((1/2)*i-(1/2)*k)*x[k+i-1, n+j, m+r] end if; return A+B end proc:

LIEBRACKETYZ := proc (k, m, n, i, j, r) return (j-m)*z[k+i, m+j-1, n+r]+r*z[k+i, n+j, m+r-1]+n*z[k+i, m+r, j+n-1] end proc:
 
LIEBRACKETZY := proc (k, m, n, i, j, r) return (j-m)*z[k+i, m+j-1, n+r]-r*z[k+i, n+j, m+r-1]-n*z[k+i, m+r, j+n-1] end proc:
 
LIEBRACKETXY := proc (k, m, n, i, j, r) local A, B; A := 0; B := 0; if n+r <= m+j-1 then A := -m*x[k+i, m+j-1, n+r]+(1/2)*i*y[k+i-1, m+j, n+r]+(1/2)*i*y[k+i-1, n+j, m+r] else A := -m*x[k+i, n+r, m+j-1]+(1/2)*i*y[k+i-1, m+j, n+r]+(1/2)*i*y[k+i-1, n+j, m+r] end if; if m+r <= j+n-1 then B := -n*x[k+i, j+n-1, m+r] else B := -n*x[k+i, m+r, j+n-1] end if; return A+B end proc:

LIEBRACKETYX := proc (k, m, n, i, j, r) local A, B; A := 0; B := 0; if n+r <= m+j-1 then A := j*x[k+i, m+j-1, n+r]-(1/2)*k*y[k+i-1, m+j, n+r]-(1/2)*k*y[k+i-1, m+r, n+j] else A := j*x[k+i, n+r, m+j-1]-(1/2)*k*y[k+i-1, m+j, n+r]-(1/2)*k*y[k+i-1, m+r, n+j] end if; if n+j <= m+r-1 then B := r*x[k+i, m+r-1, n+j] else B := r*x[k+i, n+j, m+r-1] end if; return A+B end proc:

LIEBRACKETXZ := proc (k, m, n, i, j, r) local A, B; if m+j-1 = n+r then A := (1/2)*i*z[k+i-1, m+j, n+r]+(1/2)*i*z[k+i-1, n+j, m+r] elif n+r < m+j-1 then A := -m*t[k+i, m+j-1, n+r]+(1/2)*i*z[k+i-1, m+j, n+r]+(1/2)*i*z[k+i-1, n+j, m+r] else A := m*t[k+i, n+r, m+j-1]+(1/2)*i*z[k+i-1, m+j, n+r]+(1/2)*i*z[k+i-1, n+j, m+r] end if; if m+r = j+n-1 then B := 0 elif j+n-1 < m+r then B := n*t[k+i, m+r, j+n-1] else B := -n*t[k+i, j+n-1, m+r] end if; return A+B end proc:
 
LIEBRACKETZX := proc (k, m, n, i, j, r) local A, B; if m+j-1 = n+r then A := -(1/2)*k*z[k+i-1, m+j, n+r]-(1/2)*k*z[k+i-1, m+r, n+j] elif n+r < m+j-1 then A := j*t[k+i, m+j-1, n+r]-(1/2)*k*z[k+i-1, m+j, n+r]-(1/2)*k*z[k+i-1, m+r, n+j] else A := -j*t[k+i, n+r, m+j-1]-(1/2)*k*z[k+i-1, m+j, n+r]-(1/2)*k*z[k+i-1, m+r, n+j] end if; if n+j = m+r-1 then B := 0 elif m+r-1 < n+j then B := -r*t[k+i, n+j, m+r-1] else B := r*t[k+i, m+r-1, n+j] end if; return A+B end proc:
 
 LIEBRACKETXT := proc (k, m, n, i, j, r) local A, B; if m+j = n+r then A := 0 elif n+r < m+j then A := (i-k)*t[k+i-1, m+j, n+r] else A := (-i+k)*t[k+i-1, n+r, m+j] end if; if n+j = m+r then B := 0 elif m+r < n+j then B := (i-k)*t[k+i-1, n+j, m+r] else B := (-i+k)*t[k+i-1, m+r, n+j] end if; return A+B end proc:

LIEBRACKETTX := proc (k, m, n, i, j, r) local A, B; if m+j = n+r then A := 0 elif n+r < m+j then A := (i-k)*t[k+i-1, m+j, n+r] else A := (-i+k)*t[k+i-1, n+r, m+j] end if; if n+j = m+r then B := 0 elif n+j < m+r then B := (i-k)*t[k+i-1, m+r, n+j] else B := (-i+k)*t[k+i-1, n+j, m+r] end if; return A+B end proc:

LIEBRACKETTZ := proc (k, m, n, i, j, r) local A, B; if n+r <= m+j-1 then A := m*x[k+i, m+j-1, n+r]-(1/2)*i*y[k+i-1, m+j, n+r]+(1/2)*i*y[k+i-1, n+j, m+r] else A := m*x[k+i, n+r, m+j-1]-(1/2)*i*y[k+i-1, m+j, n+r]+(1/2)*i*y[k+i-1, n+j, m+r] end if; if j+n-1 <= m+r then B := -n*x[k+i, m+r, j+n-1] else B := -n*x[k+i, j+n-1, m+r] end if; return A+B end proc:

LIEBRACKETZT := proc (k, m, n, i, j, r) local A, B; if n+r <= m+j-1 then A := -j*x[k+i, m+j-1, n+r]+(1/2)*k*y[k+i-1, m+j, n+r]-(1/2)*k*y[k+i-1, m+r, n+j] else A := -j*x[k+i, n+r, m+j-1]+(1/2)*k*y[k+i-1, m+j, n+r]-(1/2)*k*y[k+i-1, m+r, n+j] end if; if m+r-1 <= n+j then B := r*x[k+i, n+j, m+r-1] else B := r*x[k+i, m+r-1, n+j] end if; return A+B end proc:

LIEBRACKETYT := proc (k, m, n, i, j, r) local A, B; if m+j-1 = n+r then A := -(1/2)*k*z[k+i-1, m+j, n+r]+(1/2)*k*z[k+i-1, m+r, n+j] elif n+r < m+j-1 then A := j*t[k+i, m+j-1, n+r]-(1/2)*k*z[k+i-1, m+j, n+r]+(1/2)*k*z[k+i-1, m+r, n+j] else A := -j*t[k+i, n+r, m+j-1]-(1/2)*k*z[k+i-1, m+j, n+r]+(1/2)*k*z[k+i-1, m+r, n+j] end if; if m+r-1 = n+j then B := 0 elif n+j < m+r-1 then B := -r*t[k+i, m+r-1, n+j] else B := r*t[k+i, n+j, m+r-1] end if; return A+B end proc:
 
LIEBRACKETTY := proc (k, m, n, i, j, r) local A, B; if m+j-1 = n+r then A := (1/2)*i*z[k+i-1, m+j, n+r]-(1/2)*i*z[k+i-1, n+j, m+r] elif m+j-1 < n+r then A := m*t[k+i, n+r, m+j-1]+(1/2)*i*z[k+i-1, m+j, n+r]-(1/2)*i*z[k+i-1, n+j, m+r] else A := -m*t[k+i, m+j-1, n+r]+(1/2)*i*z[k+i-1, m+j, n+r]-(1/2)*i*z[k+i-1, n+j, m+r] end if; if j+n-1 = m+r then B := 0 elif m+r < j+n-1 then B := n*t[k+i, j+n-1, m+r] else B := -n*t[k+i, m+r, j+n-1] end if; return A+B end proc:

LIEPRODUCT0 := proc (V1, V2) local INDETS1, INDETS2; INDETS1 := indets(V1, mytype0); INDETS2 := indets(V2, mytype0); if V1 = 0 or V2 = 0 then return 0 elif op(0, INDETS1[1]) = x and op(0, INDETS2[1]) = x then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETXX(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = y and op(0, INDETS2[1]) = y then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETYY(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = z and op(0, INDETS2[1]) = z then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETZZ(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = t and op(0, INDETS2[1]) = t then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETTT(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = x and op(0, INDETS2[1]) = y then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETXY(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = y and op(0, INDETS2[1]) = x then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETYX(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = x and op(0, INDETS2[1]) = z then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETXZ(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = z and op(0, INDETS2[1]) = x then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETZX(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = y and op(0, INDETS2[1]) = z then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETYZ(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = z and op(0, INDETS2[1]) = y then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETZY(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = x and op(0, INDETS2[1]) = t then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETXT(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = t and op(0, INDETS2[1]) = x then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETTX(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = y and op(0, INDETS2[1]) = t then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETYT(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = t and op(0, INDETS2[1]) = y then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETTY(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = z and op(0, INDETS2[1]) = t then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETZT(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) elif op(0, INDETS1[1]) = t and op(0, INDETS2[1]) = z then return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETTZ(op(1, INDETS1[1]), op(2, INDETS1[1]), op(3, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]), op(3, INDETS2[1])) end if end proc:

LIEPRODUCTS0 := proc (f, g) local NEWF, NEWG, i, j, lie, lieproducts; lie := 0; lieproducts := 0; if f = 0 or g = 0 then return 0 else NEWF := f+y[20000, 20000, 20000]+z[2000, 2000, 2000]; NEWG := g+y[20000, 20000, 20000]+z[2000, 2000, 2000]; for i to nops(NEWF) do for j to nops(NEWG) do if y[20000, 20000, 20000] = op(i, NEWF) or y[20000, 20000, 20000] = op(j, NEWG) or z[2000, 2000, 2000] = op(i, NEWF) or z[2000, 2000, 2000] = op(j, NEWG) then lie := 0 else lie := LIEPRODUCT0(op(i, NEWF), op(j, NEWG)) end if; lieproducts := lieproducts+lie end do end do; return lieproducts end if end proc:

ADJOINTT := proc (N, Y, VF) local i, n, N10, NEWVF, adjoint; if Y = 0 then adjoint := VF else N10 := GRADE00(Y); n := floor(N/N10); NEWVF := expand(simplify(VF)); adjoint := VF; for i to n do NEWVF := LIEPRODUCTS0(Y, NEWVF); adjoint := adjoint+NEWVF/factorial(i) end do end if; adjoint := simplify(adjoint); return adjoint end proc:

TRUNCATEE := proc (VF, n) local i, NEWVF, INDETS, W, trun, truncate; #option trace;
 trun := 0; truncate := 0; NEWVF := expand(VF+y[20000, 20000, 20000]+z[2000, 2000, 2000]); for i to nops(NEWVF) do 
W := op(i, NEWVF); 
INDETS := indets(W, mytype0);
 if op(i, NEWVF) <> y[20000, 20000, 20000] and op(i, NEWVF) <> z[2000, 2000, 2000] and GRADE00(W) <= n then
  trun := op(i, NEWVF)
   else trun := 0 end if;
    truncate := truncate+trun end do;
     return truncate end proc:


CONVERT3 := proc (V) local EFtheta, i, j, k, l, W, INDETS, VF;
 EFtheta := 0;
 VF := expand(V)+y[2000, 2000, 2000]+y[20000, 20000, 20000]; 
 EFtheta := 0;
  for i to nops(VF) do
   if y[2000, 2000, 2000] = op(i, VF) or y[20000, 20000, 20000] = op(i, VF)  then 
   EFtheta := EFtheta 
   else
W := op(i, VF); 
INDETS := indets(W, mytype0);
j := op(1, INDETS[1]);
k := op(2, INDETS[1]); 
l := op(3, INDETS[1]); 
  if op(0, INDETS[1]) = x then
      EFtheta := EFtheta+W*(F[j-1, j+k-1]+j*E[j-1, j+k-1])/(x[j, k, l]*(j+k+1))
  elif 
      op(0, INDETS[1]) = y then
      EFtheta := EFtheta-2*W*(F[j, j+l]-(l+1)*E[j, j+l])/(y[j, k, l]*(j+l+2)) 
  elif 
       op(0, INDETS[1]) = z then
       EFtheta := EFtheta+W*Theta[j, j+l]/z[j, k, l] 
   end if end if end do; 
          return expand(EFtheta) end proc:


#NORMALFORM := proc (N, VF) local newvf1, newvf2, i, normalform; 
#normalform := expand(simplify(TRUNCATEE(VF, N))); 
#for i from 1 to N do 
#newvf1 := expand(TRANSFORMATION0(i, expand(normalform))); # print(i,(newvf1),firstlevel);
#newvf2 := expand(TRUNCATEE(ADJOINTT(N, newvf1, normalform), N));
#normalform := expand(simplify(newvf2)) end do;
#return(normalform); end proc:

NORMALFORM := proc (N, VF) local newvf1, newvf2, i, normalform, K;
#K:= [seq(k[i], i = 1 .. N)]; 
 normalform :=Arrange0(expand(simplify(TRUNCATEE(VF, N))))[3];
 for i to N do 
newvf1:= Arrange0(expand(TRANSFORMATION0(i, expand(normalform))))[3]; 
#K[i] := [newvf1,first]; 
newvf2 := Arrange0(expand(TRUNCATEE(ADJOINTT(N, newvf1, normalform), N)))[3]; 
normalform := Arrange0(expand(simplify(newvf2)))[3];
end do; 
#return([normalform, K]);
return(normalform);
end proc: