% WDVV equation in 6 components: bi-Hamiltonian formalism
% 2017-02-09

% Checking that
% 1 - the third-order operator aa2 fulfills [aa2,aa2]=0.
% 2 - the first-order operator aa1 fulfills [aa1,aa1]=0.
% 3 - the two operators are compatible, [aa1,aa2]=0.

% Loading the interface to cdiff packages
load_package cde$

indep_var:={x}$
dep_var:={a,b,c,d,ee,f}$
odd_var:={p,q,r,s,tt,u}$
total_order:=10$

% Calling cde's main routine
cde({indep_var,dep_var,odd_var,total_order},{})$
% Saving cde state in a file
% save_cde_state(statename)$

% Number of components of the operators
ncomp:=length(dep_var)$

% Some functions
cap_p:=(c*d+f)/a$
cap_q:=ee**2 - f*d + (c**2*d + c*f - 2*b*ee*c + b**2*f)/a$
cap_r:=(2*ee + b*d)/a$
cap_s:=(2*ee*c - b*f)/a$

% Ist order operator
gu1:=mat(
(0,0,a,-2,b,2*c),
(0,-2,b,0,d,2*ee),
(a,b,2*c,d,2*ee,3*f),
(-2,0,d,0,cap_r,2*cap_p),
(b,d,2*ee,cap_r,2*cap_p,3*cap_s),
(2*c,2*ee,3*f,2*cap_p,3*cap_s,4*cap_q)
)$

gl1:=gu1**(-1)$

% Transform metrics into operators in order to use riemann.red
operator glo1,guo1$
for i:=1:ncomp do
 for j:=1:ncomp do
  <<
   glo1(i,j):=gl1(i,j);
   guo1(i,j):=gu1(i,j)
  >>$

in "riemann3.red"$
generate_all_chr1(glo1,chr1_wdvv,dep_var)$
check_nabla(glo1,chr1_wdvv,dep_var)$
generate_all_chr2(glo1,guo1,chr1_wdvv,chr2_wdvv,dep_var)$

% Raise another second index of the Christoffel symbols of second type
% Gamma^i_jk of gl1
templist:={}$
operator gamma_hi$
for i:=1:ncomp do
 for j:=1:ncomp do
  for k:=1:ncomp do
   gamma_hi(i,j,k):=
    <<
     templist:=
      for s:=1:ncomp collect
        - gu1(i,s)*mk_chr2(chr2_wdvv,j,s,k)$
     templist:=part(templist,0):=plus
    >>$

% Introduce the contracted operator
operator gamma_hi_con$
for i:=1:ncomp do
 for j:=1:ncomp do
  gamma_hi_con(i,j):=
   <<
    templist:=for k:=1:ncomp collect gamma_hi(i,j,k)*mkid(part(dep_var,k),!_x)$
    templist:=part(templist,0):=plus
   >>$

% The operator aa1 is the ansatz for the first homogeneous Hamiltonian operator
mk_cdiffop(aa1,1,{6},6)$
for all i,j,psi let aa1(i,j,psi)=
 gu1(i,j)*td(psi,x)+gamma_hi_con(i,j)*psi$

% IIIrd order operator

% The leading term
gl3:=mat(
  (d**2, - 2*ee,2*d, - (a*d + c),b,1),
  ( - 2*ee, - 2*c,b,0,a,0),
  (2*d,b,2, - a,0,0),
  ( - (a*d + c),0, - a,a**2,0,0),
  (b,a,0,0,0,0),
  (1,0,0,0,0,0)
    )$

% Reconstruction of the third order operator.
gu3:=gl3**(-1)$

% Define c_ijk = (1/3)*(g_ki,j - g_ji,k)
operator c_lo$
for i:=1:ncomp do
 for j:=1:ncomp do
  for k:=1:ncomp do
  <<
   c_lo(i,j,k):=
    (1/3)*(df(gl3(k,i),part(dep_var,j)) - df(gl3(j,i),part(dep_var,k)))$
  >>$

% Define c^ij_k=c_hi(i,j,k) using the formula
% g^ni*g^mj*c_mnk = c^ij_k
templist:={}$
operator c_hi$
for i:=1:ncomp do
 for j:=1:ncomp do
  for k:=1:ncomp do
   c_hi(i,j,k):=
    <<
     templist:=
      for m:=1:ncomp join
       for n:=1:ncomp collect
        gu3(n,i)*gu3(m,j)*c_lo(m,n,k)$
     templist:=part(templist,0):=plus
    >>$

% Introduce the contracted operator
operator c_hi_con$
for i:=1:ncomp do
 for j:=1:ncomp do
  c_hi_con(i,j):=
   <<
    templist:=for k:=1:ncomp collect c_hi(i,j,k)*mkid(part(dep_var,k),!_x)$
    templist:=part(templist,0):=plus
   >>$

% The operator aa2 is the ansatz for the second hamiltonian operator aa
mk_cdiffop(aa2,1,{6},6)$
for all i,j,psi let aa2(i,j,psi) =
td(
gu3(i,j)*td(psi,x,2)+c_hi_con(i,j)*td(psi,x)
,x)$

% Converting the operators into vector-valued superfunctions
conv_cdiff2superfun(aa1,aa1_sf)$
conv_cdiff2superfun(aa2,aa2_sf)$

% We can test the operators for skew-adjointness:
adjoint_cdiffop(aa1,aa1_star);
for i:=1:length(dep_var) do
  if aa1_sf(i) + aa1_star_sf(i) neq 0 then
    write "Warning: non-skew-adjoint operator!";

adjoint_cdiffop(aa2,aa2_star);
for i:=1:length(dep_var) do
  if aa2_sf(i) + aa2_star_sf(i) neq 0 then
    write "Warning: non-skew-adjoint operator!";

conv_genfun2biv(aa1_sf,biv1)$
conv_genfun2biv(aa2_sf,biv2)$

iszero_schouten_bracket(biv1,biv1,thr11b);
iszero_schouten_bracket(biv1,biv2,thr12b);
iszero_schouten_bracket(biv2,biv2,thr22b);

;end;

Local Variables:
mode:reduce
End:
