`type/mytype` := proc (v) if type(v, indexed) and op(0, v) = E or op(0, v) = F or op(0, v) = Theta 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:

 Arrange := proc (v) local L, m; if v = 0 then return [0, 0, 0] else L := indets(v, mytype); 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:

 grade11 := proc (V) local L; L := Arrange(V); if L[1] = 1 and L[2] <> E[10000000000, 10000000000] and L[2] <> F[10000000000, 10000000000] then return 2*ldegree(coeff(L[3], L[2]), indets(L[3], mutype))+op(2, L[2]) end if end proc:

 GRADE2 := proc (V) local J, w; return max(map(grade11, {op(V+E[10000000000, 10000000000]+F[10000000000, 10000000000])})) end proc:

 ELKTRASFORMATION := proc (V1, l, k, a0) local c; c := 0; if l <> k then c := E[l+1, k]*coeff(V1, E[l, k])/((2*l+2)*a0) end if; return c end proc:
 
 FLKTRASFORMATION := proc (V1, l, k, a0) local d; d := 0; if l <> k then d := (1/2)*F[l+1, k]*coeff(V1, F[l, k])/(a0*(l+2)) end if; return d end proc:
 
 ThetaLKTRASFORMATION := proc (V1, l, k, a0) local e; e := 0; if l <> k then e := (1/2)*Theta[l+1, k]*coeff(V1, Theta[l, k])/(a0*(l+1)) end if; return e end proc:

TRANSFORMATION := proc (n, VF) local transformation, trans, i, W, INDETS, NEWVF, a0, a1; transformation := 0; trans := 0; NEWVF := expand(VF+E[20000, 20000]+F[2000, 2000]); a0 := coeff(VF, F[-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 E[20000, 20000] = op(i, NEWVF) or F[2000, 2000] = op(i, NEWVF) then trans := 0; transformation := transformation+trans else W := op(i, NEWVF); INDETS := indets(W, mytype); if n = GRADE2(W) then if op(0, INDETS[1]) = E then trans := ELKTRASFORMATION(op(i, NEWVF), op(1, INDETS[1]), op(2, INDETS[1]), a1); transformation := transformation+trans elif op(0, INDETS[1]) = F then trans := FLKTRASFORMATION(op(i, NEWVF), op(1, INDETS[1]), op(2, INDETS[1]), a1); transformation := transformation+trans elif op(0, INDETS[1]) = Theta then trans := ThetaLKTRASFORMATION(op(i, NEWVF), op(1, INDETS[1]), op(2, INDETS[1]), a1); transformation := transformation+trans end if else trans := 0; transformation := transformation+trans end if end if end do; return transformation end proc:

 LIEBRACKETEE := proc (l, k, m, n) return (n-k)*E[l+m, k+n] end proc:

 LIEBRACKETFF := proc (l, k, m, n) return ((m+1)*(k+2)-(l+1)*(n+2))*F[l+m, k+n] end proc:
 
LIEBRACKETThetaTheta := proc (l, k, m, n) return 0 end proc:

LIEBRACKETFE := proc (l, k, m, n) return (n+2)*(m*(k+2)-n*(l+1))*E[l+m, k+n]/(k+n+2)-k*(k+2)*F[l+m, k+n]/(k+n+2) end proc: 
 
 LIEBRACKETEF := proc (m, n, l, k) return (n+2)*(-m*(k+2)+n*(l+1))*E[m+l, n+k]/(n+k+2)+k*(k+2)*F[m+l, n+k]/(n+k+2) end proc:

LIEBRACKETFTheta := proc (l, k, m, n) return (m*(k+2)-n*(l+1))*Theta[l+m, k+n] end proc:

LIEBRACKETThetaF := proc (m, n, l, k) return (-m*(k+2)+n*(l+1))*Theta[m+l, n+k] end proc:

LIEBRACKETETheta := proc (l, k, m, n) return n*Theta[l+m, k+n] end proc:

LIEBRACKETThetaE := proc (m, n, l, k) return -n*Theta[m+l, n+k] end proc:

 LIEPRODUCT := proc (V1, V2) local INDETS1, INDETS2; INDETS1 := indets(V1, mytype); INDETS2 := indets(V2, mytype);
 if V1 = 0 or V2 = 0 then return 0 elif op(0, INDETS1[1]) = E and op(0, INDETS2[1]) = E then
 return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETEE(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]))
 elif op(0, INDETS1[1]) = F and op(0, INDETS2[1]) = F then 
return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETFF(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]))
 elif op(0, INDETS1[1]) = Theta and op(0, INDETS2[1]) = Theta then
 return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETThetaTheta(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) 
elif op(0, INDETS1[1]) = E and op(0, INDETS2[1]) = F then return
 coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETEF(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]))
 elif op(0, INDETS1[1]) = F and op(0, INDETS2[1]) = E then
 return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETFE(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) 
elif op(0, INDETS1[1]) = E and op(0, INDETS2[1]) = Theta then
 return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETETheta(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) 
elif op(0, INDETS1[1]) = Theta and op(0, INDETS2[1]) = E then 
return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETThetaE(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) 
elif op(0, INDETS1[1]) = F and op(0, INDETS2[1]) = Theta then
 return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETFTheta(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1]))
 elif op(0, INDETS1[1]) = Theta and op(0, INDETS2[1]) = F then 
return coeff(V1, INDETS1[1], 1)*coeff(V2, INDETS2[1], 1)*LIEBRACKETThetaF(op(1, INDETS1[1]), op(2, INDETS1[1]), op(1, INDETS2[1]), op(2, INDETS2[1])) end if end proc:
 
LIEPRODUCTS := 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+E[20000, 20000]+F[2000, 2000]; NEWG := g+E[20000, 20000]+F[2000, 2000]; for i to nops(NEWF) do for j to nops(NEWG) do if E[20000, 20000] = op(i, NEWF) or E[20000, 20000] = op(j, NEWG) or F[2000, 2000] = op(i, NEWF) or F[2000, 2000] = op(j, NEWG) then lie := 0 else lie := LIEPRODUCT(op(i, NEWF), op(j, NEWG)) end if; lieproducts := lieproducts+lie end do end do; return lieproducts end if end proc:

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

TRUNCATE := proc (VF, n) local i, NEWVF, W, trun, truncate; trun := 0; truncate := 0; NEWVF := expand(VF+E[20000, 20000]+F[2000, 2000]); for i to nops(NEWVF) do W := op(i, NEWVF); if W <> E[20000, 20000] and W <> F[2000, 2000] and GRADE2(W) <= n then trun := op(i, NEWVF) else trun := 0 end if; truncate := truncate+trun end do; return truncate end proc:

SECONDNORMALFORM := proc (N, VF) local newvf1, newvf2, i, secondnormalform;
 secondnormalform := expand(simplify(TRUNCATE(VF, N))); for i to N do newvf1 := TRANSFORMATION(i, expand(secondnormalform)); newvf2 := TRUNCATE(ADJOINT(N, newvf1, expand(secondnormalform)), N); secondnormalform := expand(newvf2) end do; return secondnormalform end proc:

ZFPRODUCT := proc (m, n, k, l) return (l+2)*F[k+m, l+n]/(l+n+2)+(l*m+2*m-n-k*n)*E[k+m, l+n]/(l+n+2) end proc:

ZEPRODUCT := proc (m, n, k, l) return E[k+m, l+n] end proc:

ZThetaPRODUCT:= proc (m, n, k, l) return Theta[k+m, l+n] end proc:

ZPRODUCT := proc (m, n, VF) local zproduct, zp, i, W, INDETS, NEWVF, a0; zproduct := 0; zp := 0; NEWVF := Arrange(expand(VF+E[20000, 20000]+F[2000, 2000]))[3]; for i to nops(NEWVF) do if E[20000, 20000] = op(i, NEWVF) or F[2000, 2000] = op(i, NEWVF) then zp := 0; zproduct := zproduct+zp else W := op(i, NEWVF); INDETS := indets(W, mytype); if op(0, INDETS[1]) = E then zp := coeff(NEWVF, INDETS[1], 1)*ZEPRODUCT(m, n, op(1, INDETS[1]), op(2, INDETS[1])); zproduct := zproduct+zp elif op(0, INDETS[1]) = F then zp := coeff(NEWVF, INDETS[1], 1)*ZFPRODUCT(m, n, op(1, INDETS[1]), op(2, INDETS[1])); zproduct := zproduct+zp elif op(0, INDETS[1]) = Theta then zp := coeff(NEWVF, INDETS[1], 1)*ZThetaPRODUCT(m, n, op(1, INDETS[1]), op(2, INDETS[1])); zproduct := zproduct+zp end if end if end do; return zproduct end proc:

CoeffE := proc (V) local W, i, INDETS, A, VF; 
A := 10^100; VF := subs(seq(mu[i] = 0, i = 1 .. 100), expand(V)+E[1000, 1000]); for i to nops(VF) do W := op(i, VF); INDETS := indets(W, mytype); if op(0, INDETS[1]) = E and op(2, INDETS[1]) <> 0 and W <> E[1000, 1000] then if op(1, INDETS[1]) <= A then A := op(1, INDETS[1]) end if end if end do; return A end proc:

CoeffF := proc (V) local W, i, INDETS, A, VF; 
A :=10^100 ; VF := subs(seq(mu[i] = 0, i = 1 .. 100), expand(V)+E[1000, 1000]); for i to nops(VF) do W := op(i, VF); INDETS := indets(W, mytype); if op(0, INDETS[1]) = F and op(2, INDETS[1]) <> 0 and W <> E[1000, 1000] then if op(1, INDETS[1]) <= A then A := op(1, INDETS[1]) end if end if end do; return A end proc:

Coefftheta:= proc (VF) local W, i, INDETS, A; A := 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000; for i to nops(VF) do W := op(i, VF); INDETS := indets(W, mytype); if op(0, INDETS[1]) = Theta then if op(1, INDETS[1]) <= A then A := op(1, INDETS[1]) end if end if end do; return A end proc:

gradee := proc (V, r, s) local L, grade, grad, W, INDETS; grade := 0; grad := 0; L := Arrange(V); if L[1] = 1 and L[2] <> E[10000000000, 10000000000] and L[2] <> F[10000000000, 10000000000] then W := L[2]; INDETS := indets(W, mytype); if op(0, INDETS[1]) = E or op(0, INDETS[1]) = F then grad := r*(op(2, INDETS[1])-op(1, INDETS[1]))+op(2, INDETS[1])+(s+1)*ldegree(coeff(L[3], L[2]), indets(L[3], mutype)); grade := max(grade, grad) else grad := r*(op(2, INDETS[1])-op(1, INDETS[1]))+op(2, INDETS[1])+s+(s+1)*ldegree(coeff(L[3], L[2]), indets(L[3], mutype)); grade := max(grade, grad) end if end if; return grade end proc:

GRADE3 := proc (V, r, s) local J, w; return max(map(gradee, {op(V+E[10000000000, 10000000000]+F[10000000000, 10000000000])}, r, s)) end proc:

ADJOINT2 := proc (N, Y, VF, r, s) local i, n, N10, NEWVF, adjoint; if Y = 0 then adjoint := VF else N10 := GRADE3(Y, r, s); n := floor(N/N10); NEWVF := expand(simplify(VF)); adjoint := VF; for i to n do NEWVF := LIEPRODUCTS(Y, NEWVF); adjoint := adjoint+NEWVF/factorial(i) end do end if; adjoint := expand(simplify(adjoint)); return adjoint end proc:

TRUNCATE3 := proc (VF, n, r, s) local i, NEWVF, W, trun, truncate; #option trace;
 trun := 0; truncate := 0; NEWVF := expand(VF+E[20000, 20000]+F[2000, 2000]); for i to nops(NEWVF) do W := op(i, NEWVF); if W <> E[20000, 20000] and W <> F[2000, 2000] and GRADE3(W, r, s) <= n then trun := op(i, NEWVF) else trun := 0 end if; truncate := truncate+trun end do; return truncate end proc:
 
 Ytransformation := proc (VF, m, n) local A, B, C, b1, l, s; A := 0; B := 0; C := 0; s := CoeffE(VF); b1 := subs(seq(mu[i] = 0, i = 1 .. 100), coeff(expand(VF), E[s, s])); for l from 0 to n-m do A := A+(-b1)^l*(product(n+i*s, i = 0 .. l-1))*F[m+l*s+l, n+l*s]/(2^l*(n+l*s+2)*(product(m+1+i*(s+1), i = 0 .. l))) end do; for l from 0 to n-m do B := B+(b1^l*(product(s-n+i(-s), i = 0 .. l-1))/((n+2)*2^l*(product(m+s+1+i*(s+1), i = 0 .. l-1)))-b1^l*(s+2)*((n+l*s+2)*(product(m+1+i*(s+1), i = 0 .. l-1))-(n+2)*(product(m+s+1+i*(s+1), i = 0 .. l-1)))*(product(-n-i*s, i = 0 .. l-1))/((n+2)*2^l*(n+l*s+2)*(product(m+s+1+i(s+1), i = 0 .. l-1))*(product(m+1+i(s+1), i = 0 .. l-1))))*E[m+l*s+l, n+l*s] end do; for l from 0 to n-m-1 do C := C+b1^(l+1)*(product(-n-i*s, i = 0 .. l-1))*E[s+m+l*s+l+1, s+n+l*s]/(2^(l+1)*(s+m+1)*(product(m+2*s+2+i*(s+1), i = 0 .. l-1))) end do; return A+B+C end proc:


Ytransformation01 := proc (VF, m, n) local A, B, C, b1, l, s; A := 0; B := 0; C := 0; s := CoeffE(VF); b1 := subs(seq(mu[i] = 0, i = 1 .. 100), coeff(expand(VF), E[s, s])); for l from 0 to n-m do A := A+(-b1)^l*(product(n+i*s, i = 0 .. l-1))*F[m+l*s+l, n+l*s]/(2^l*(n+l*s+2)*(product(m+1+i*(s+1), i = 0 .. l))) end do; for l from 0 to n-m do B := B-b1^l*(s+2)*((n+l*s+2)*(product(m+1+i*(s+1), i = 0 .. l-1))-(n+2)*(product(m+s+1+i*(s+1), i = 0 .. l-1)))*(product(-n-i*s, i = 0 .. l-1))*E[m+l*s+l, n+l*s]/((n+2)*2^l*(n+l*s+2)*(product(m+s+1+i(s+1), i = 0 .. l-1))*(product(m+1+i(s+1), i = 0 .. l-1))) end do; for l from 0 to n-m-1 do C := C+b1^(l+1)*(product(-n-i*s, i = 0 .. l-1))*E[s+m+l*s+l+1, s+n+l*s]/(2^(l+1)*(s+m+1)*(product(m+2*s+2+i*(s+1), i = 0 .. l-1))) end do; return A+B+C end proc:

Ytransformationtheta := proc (VF, m, n) local a1, k, c1, s, b1; k := Coefftheta(VF); s := CoeffE(VF); b1 := subs(seq(mu[i] = 0, i = 1 .. 100), coeff(expand(VF), E[s, s])); c1 := coeff(VF, Theta[k, k]); return sum(-b1^l*(product(n+l*s, i = 0 .. l-1))*Theta[m+l*s+l+1, n+l*s]/(2^(l+1)*(product(m+1+i*(s+1), i = 0 .. l))), l = 0 .. n-m-1) end proc:

transformationvarepsilon:= proc (VF, k) local A, s, b1, m; A := 0; s := CoeffE(VF); b1 := subs(seq(mu[i] = 0, i = 1 .. 100), coeff(expand(VF), E[s, s])); for m from 0 to k do A := A+(-b1)^m*(product(k-s+i*s, i = 0 .. m-1))*E[m*(s+1), m*s+k]/((2*s+2)^m*factorial(m)) end do; return A end proc:


HM := proc (VF, m, k) local s, h, t; h[0] := 0; s := CoeffE(VF); for t to m do h[t] := (-1)^t*s*(s+2)*(k+2)*(k-t+3)*(product(k+i*s, i = 0 .. t-2))/(2^t*(s+1)^(t-1)*factorial(t-1)*(t*(s+1)-1)*(product((t-1)*s+k+2+i*s, i = 0 .. 1)))-(s*(t-2)+k)*h[t-1]/(2*t*(s+1)-2) end do; return h[m] end proc:

transformationf := proc (VF, k) local m, A, s, b1; A := 0; s := CoeffE(VF); b1 := subs(seq(mu[i] = 0, i = 1 .. 100), coeff(expand(VF), E[s, s])); for m from 0 to k+1 do A := A+(-b1)^m*(k+2)*(product(k+i*s, i = 0 .. m-1))*F[m*(s+1)-1, m*s+k]/((2*s+2)^m*factorial(m)*(m*s+k+2))-b1^m*HM(VF, m, k)*E[m*(s+1)-1, m*s+k] end do; return A end proc:


CHANGE := proc (VF, A, n) local i, l, b, f, e, d, W, k, c, INDETS, VF1; l := 0; b := 0; f := 0; 
VF1 := Arrange(VF); 
VF1 := VF1[3]; 
for i to nops(VF1) do
 W := op(i, VF1); 
 INDETS := indets(W, mytype);
  k := op(1, INDETS[1]); 
  if op(0, INDETS[1]) = F then
      c := coeff(VF1, INDETS[1], 1);
       l := expand(l+c*add(binomial(k+1, j)*F[k-j, k-j]*A^j, j = 0 .. k)) 
       elif op(0, INDETS[1]) = E then 
       d := coeff(VF1, INDETS[1], 1);
        b := expand(b+d*add((binomial(k+1, j)-(binomial(k+1, j)-binomial(k, j))/(k+2-j))*E[k-j, k-j]*A^j, j = 0 .. k)+d*add((binomial(k+1, j)-binomial(k, j))*F[k-j, k-j]*A^j/(k+2-j), j = 1 .. k)+d*F[-1, -1]*A^(k+1)) 
        else 
        e := coeff(VF1, INDETS[1], 1); 
        f := expand(f+e*add(Theta[k-j, k-j]*A^j, j = 0 .. k)) 
        end if end do; return TRUNCATE(l+b+f+coeff(VF, F[-1, -1])*F[-1, -1], n) end proc:

SECOND := proc (VF, n) local r, i, j, t, W, INDETS, k, a, b, c, d, f, e, A, l, VF1, NASRIN, s, b1;
r := CoeffF(VF);
s := CoeffE(VF); 
b1 := subs(seq(mu[i] = 0, i = 1 .. 100), coeff(expand(VF), E[s, s])); 
VF1 := Arrange(VF); 
VF1 := VF1[3]; 
for t to n do NASRIN := VF1; 
for i to nops(VF1) do 
W := op(i, VF1); 
INDETS := indets(W, mytype);
 if op(0, INDETS[1]) = F and op(1, INDETS[1]) = s-1 and GRADE3(W,r,s) = t then 
 A := expand(-(s+1)*coeff(W, F[s-1, s-1])/b1);#print(A,transformarion-secondary);
NASRIN := Arrange(CHANGE(VF1, A, n)); 
NASRIN := NASRIN[3] end if end do; 
VF1 := NASRIN end do; 
return VF1+coeff(VF, F[-1, 0])*F[-1, 0] 
end proc:


 ORBITALNF1 := proc (N, VF) local VF2, Y, TimeStateTrans, r, a1, m, gamma1, NVF, k, W, VF1, j, gamma2, s, gamma3, c1, b1, B, gamma, CO, A, alpha, beta, VF3, VF4, Y2, l, q1, Y1;#option trace;
r := CoeffF(VF); print(R=r); 
s := CoeffE(VF); print(S=s); 
a1 := subs(seq(mu[i] = 0, i = 1 .. 100), coeff(expand(VF), F[r, r])); 
b1 := subs(seq(mu[i] = 0, i = 1 .. 100), coeff(expand(VF), E[s, s])); 
c1 := subs(seq(mu[i] = 0, i = 1 .. 100), coeff(expand(VF), Theta[0, 0])); 
NVF := VF; if r <= s then print(''We*have*r <= s*Thus*we*only*provide*classical*normal*form'') else 
for j to N do NVF := NVF-c1*Theta[0, 0]; 
for l from 0 to floor(j/(s+1)) do 
q1 := j-l*(s+1); 
if mods(j-l*(s+1), s+1) = s and j-l*(s+1) <> s^2+2*s and l = ldegree(coeff(NVF, E[q1, q1]), {seq(mu[i], i = 1 .. 100)}) then 
 m := q1-s; 
 if 0 < m then
 gamma2 :=factor(mtaylor(coeff(NVF, F[q1, q1]), [seq(mu[i], i = 1 .. 100)], l+1)*(m+1)*(m+s+2)/(b1*m)); 
 VF1 := Arrange(factor(expand(NVF+gamma2*ZPRODUCT(m, m, NVF))))[3]; 
 Y := expand(factor(gamma2*Ytransformation(VF, m, m))); 
 TimeStateTrans :=Arrange(factor(expand( ADJOINT2(N, Y, VF1, r,s))))[3]; 
 NVF :=Arrange(factor(expand(SECONDNORMALFORM(N, TimeStateTrans))))[3]; end if;
  k := (q1-s)/(s+1); 
 if 0 < k and type(k, integer) then 
 B := (-b1)^(k+1)*(product(k-s+i*s, i = 0 .. k))/((2*s+2)^k*factorial(k));
  if B <> 0 then 
 gamma :=factor( expand(-mtaylor(coeff(NVF, E[q1, q1])), [seq(mu[i], i = 1 .. 100)], l+1)/B);
  if gamma <> 0 then 
 Y := expand(gammatransformationvarepsilon(VF, k)); 
 TimeStateTrans :=Arrange(factor(expand( ADJOINT2(N, Y, NVF,r, s))))[3]; 
 NVF :=Arrange(factor(expand( SECONDNORMALFORM(N, TimeStateTrans))))[3]; end if end if end if else
 s := CoeffE(expand(NVF));
 b1 := subs(seq(mu[i] = 0, i = 1 .. 100), coeff(expand(NVF), E[s, s]));
 q1 := j-l*(s+1); if l = ldegree(coeff(NVF, F[q1, q1]), {seq(mu[i], i = 1 .. 100)}) then 
 m := q1-s;
  if 0 < m then
 gamma2 := factor(expand(mtaylor(coeff(NVF, F[q1, q1]), [seq(mu[i], i = 1 .. 100)], l+1)*(m+1)*(m+s+2)/(b1*m))); #print(m,Time);
  VF1 :=Arrange(factor(expand(NVF+gamma2*ZPRODUCT(m, m, NVF))))[3]; #print(VF1,v+gz);
  Y := Arrange(factor(expand(gamma2*Ytransformation(VF, m, m))))[3]; #print(Y,ytransformation,gamma2,Ytransformation(VF, m, m));
 TimeStateTrans :=Arrange(factor(expand( ADJOINT2(N, Y, VF1,r, s))))[3]; 
#print(TimeStateTrans,ad);
  NVF :=Arrange(factor(expand( SECONDNORMALFORM(N, TimeStateTrans))))[3]; #print(NVF,seconddlevel);
end if end if end if;
  q1 := j-l*(s+1); if mods(j-l*(s+1), s+1) = s-1 and l = ldegree(coeff(NVF, E[q1, q1]), {seq(mu[i], i = 1 .. 100)}) then k := (q1-2*s)/(s+1); if 0 <= k and type(k, integer) then
 B := -2*b1^(k+2)*((s+1)*(k+1)+s)*HM(NVF, k+2, k); if B <> 0 then 
 gamma :=factor(expand(-mtaylor(coeff(NVF, E[q1, q1]), [seq(mu[i], i = 1 .. 100)], l+1)/B)); 
 if gamma <> 0 then
  Y := expand(gamma*transformationf(NVF, k));
TimeStateTrans := ADJOINT2(N, Y, NVF,r, s); 
 NVF :=Arrange(expand( SECONDNORMALFORM(N, TimeStateTrans)))[3]; end if end if end if end if end do;
 CO := coeff(NVF, E[s, s])-b1;
  l := ldegree(CO, {seq(mu[i], i = 1 .. 100)}); 
 CO := mtaylor(CO, [seq(mu[i], i = 1 .. 100)], l+1); 
  if l <> 0 then if s+l*(s+1) = j then q1 := j-l*(s+1); m := q1-s; if 0 < m
  then gamma2 :=factor( expand(mtaylor(coeff(NVF, F[q1, q1]), [seq(mu[i], i = 1 .. 100)], l+1)*(m+1)*(m+s+2)/(b1*m))); 
 VF1 :=Arrange(expand(NVF+gamma2*ZPRODUCT(m, m, NVF)))[3];
  Y := Arrange(expand(gamma2*Ytransformation(VF, m, m)))[3];
  TimeStateTrans :=Arrange( expand(ADJOINT2(N, Y, VF1, r,s)))[3]; 
 NVF := Arrange(expand(SECONDNORMALFORM(N, TimeStateTrans)))[3]; end if;
 gamma2 := factor(-CO/(s*b1)); 
 Y :=factor(expand(gamma2*E[0, 0])); 
 TimeStateTrans := Arrange(expand(ADJOINT2(N, Y, NVF, r,s)))[3];
  NVF :=Arrange(expand(SECONDNORMALFORM(N, TimeStateTrans)))[3]; end if end if;
 CO := coeff(NVF, F[s-1, s-1]);
 l := ldegree(CO, {seq(mu[i], i = 1 .. 100)});
 CO := mtaylor(CO, [seq(mu[i], i = 1 .. 100)], l+1);
 if l <> 0 then if s-1+l*(s+1) = j then 
# print(CO,why);
 NVF := SECOND(NVF, N); #print(NVF,secondry);
 end if end if; 
NVF := NVF+c1*Theta[0, 0]; 
m := j-s-1;
if m >= 0 then 
gamma3 := factor(coeff(NVF, Theta[j, j])/((1/2)*c1*b1)); 
VF1 :=Arrange(NVF+gamma3*ZPRODUCT(m, m+1, NVF))[3]; 
Y :=Arrange(gamma3*Ytransformationtheta(VF, m, m+1))[3]; 
TimeStateTrans :=Arrange(ADJOINT2(N, Y, VF1,r, s))[3]; 
NVF := Arrange(SECONDNORMALFORM(N, TimeStateTrans))[3]; 
end if 
end do;
  VF2 := TRUNCATE3(NVF, N, r,s); return Arrange(VF2)[3] end if end proc:

CONVERTR := proc (VF1) local i, W, L, K, XX, rhorho, ThetaTheta, INDETS, V11, VF; 
XX := 0; rhorho := 0; ThetaTheta:= 0;
VF := expand(VF1); 
for i to nops(VF) do
 W := op(i, VF);
 INDETS := indets(W, mytype); 
L := op(1, INDETS[1]); 
K := op(2, INDETS[1]); 
if op(0, INDETS[1]) = F then XX := XX+expand(coeff(W, INDETS[1], 1)*(K-L+1)*x^(L+1)*rho^(2*K-2*L));
rhorho := rhorho-expand(coeff(W, INDETS[1], 1)*((1/2)*L+1/2)*x^L*rho^(2*K-2*L+1));
ThetaTheta:=ThetaTheta;
 elif op(0, INDETS[1]) = E then XX := XX+expand(coeff(W, INDETS[1], 1)*x^(L+1)*rho^(2*K-2*L));
 rhorho:= rhorho+expand((1/2)*coeff(W, INDETS[1], 1)*x^L*rho^(2*K-2*L+1));
ThetaTheta:= ThetaTheta;
 else XX := XX; 
rhorho:=rhorho; 
ThetaTheta:=ThetaTheta+expand(coeff(W, INDETS[1], 1)*x^L*rho^(2*K-2*L)) 
end if end do; 
return [XX, rhorho , ThetaTheta] end proc: