% Classification of compatible brackets
% One unknown first-order homogeneous operator,
% one known third-order operator in canonical form.
% R. Vitolo

% Loading the interface to cdiff packages
load_package cde;

% Initialization
indep_var:={x}$
dep_var:={b1,b2}$
odd_var:={p1,p2}$
total_order:=8$
resfile:="wnc_sb2c2_res.red"$

% Calling cde's main routine
cde({indep_var,dep_var,odd_var,total_order},
  {})$

% Number of components of the operators
ncomp:=length(dep_var)$
% Unknowns in the final system
unk:={}$
unk_gu1:={}$
unk_gamma_hi:={}$

% Define the contravariant metric -- leading term of the first-order operator.
operator gu1_op$
for i:=1:ncomp do for j:=i:ncomp do
 <<
  for each el in dep_var do gu1_op(i,j):=mkid(mkid(gu1_,i),j);
  unk_gu1:=gu1_op(i,j) . unk_gu1;
  if i neq j then gu1_op(j,i):=gu1_op(i,j);
  for each el in dep_var do depend(mkid(mkid(gu1_,i),j),el)
 >>$

% Define the upper indices Christoffel symbols.
% Here gamma_hi(i,j,k) = \Gamma^{ij}_k
operator gamma_hi$
for i:=1:ncomp do
 for j:=i:ncomp do
  for k:=1:ncomp do
   <<
    gamma_hi(i,j,k):=mkid(mkid(mkid(gamma_hi_,i),j),k);
    if i neq j then unk_gamma_hi:=gamma_hi(i,j,k) . unk_gamma_hi;
    for each el in dep_var do depend(gamma_hi(i,j,k),el)
   >>$

% The first-order operator is selfadjoint, i.e. the symmetrised
% Christoffel symbols are determined by the metric
for i:=1:ncomp do
 for j:=i:ncomp do
  for k:=1:ncomp do
   if i = j then gamma_hi(i,i,k):=(1/2)*df(gu1_op(i,i),part(dep_var,k))
   else gamma_hi(j,i,k):= - gamma_hi(i,j,k) + df(gu1_op(i,j),part(dep_var,k))$

% 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,{2},2)$
for all i,j,psi let aa1(i,j,psi)=
  gu1_op(i,j)*td(psi,x)+gamma_hi_con(i,j)*psi$

% IIIrd order operator

% Must load one metric (as a matrix), then rename it as 'gl3'.
matrix g2_3(2,2)$
g2_3(1,1):=b2**2 + 1$
g2_3(1,2):= - b1*b2$
g2_3(2,1):=g2_3(1,2)$
g2_3(2,2):=b1**2$
gl3:=g2_3$

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

% Define c_ijk = (1/3)*(g_ki,j - g_ji,k)
% Verified 15.09.01
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,{2},2)$
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)$

% Convert operators into bivectors
conv_cdiff2superfun(aa1,sym1)$
conv_cdiff2superfun(aa2,sym2)$
conv_genfun2biv(sym1,biv1)$
conv_genfun2biv(sym2,biv2)$

% Compute the Schouten bracket of the third-order operator for checking
schouten_bracket(biv2,biv2,sb22);
euler_df(sb22(1));

% Compute the equations of compatibility
schouten_bracket(biv1,biv2,sb12);
comp12:=euler_df(sb12(1))$

% Split the equations - they are polynomials in the odd variables
operator equ;
equ(1):=num first first comp12$
equ(2):=num second first comp12$
equ(3):=num first second comp12$
equ(4):=num second second comp12$
tel:=4$
tel_start:=4$
tel:=splitext_opequ(equ,1,4)$

% Set up the overdetermied PDE solver CRACK
unk:=append(unk_gu1,unk_gamma_hi)$
system_eq:=for i:=tel_start+1:tel collect equ(i)$
load_package crack;
lisp(max_gc_counter:=10000000000)$
crack_results:=crack(system_eq,{},unk,
   cde_difflist(all_parametric_der,dep_var));

pause;

% Load results from crack run
rule_crack:={
gamma_hi_121= - c_20,
gamma_hi_122=( - c_16)/2,
gu1_11=b1*c_16 + b2*c_9,
gu1_12=( - 2*b1**2*c_20 + b2**2*c_9 - 2*c_19)/(2*b1),
gu1_22=( - 2*b1*b2*c_20 + b1*c_18 - b2**2*c_16 + c_17)/b1
  }$
let rule_crack;

pause;

% NOTE: next code is useless, gamma_hi already fulfills the symmetry condition
% Add the symmetry condition and solve for the gamma's
%% eq_gamma_hi:={}$
%% tempeq:={}$
%% for i:=1:ncomp do for j:=1:ncomp do for k:=1:ncomp do
%%  <<
%%   tempeq:=(for s:=1:ncomp sum gu1_op(i,s)*gamma_hi(j,k,s))
%%    - (for s:=1:ncomp sum gu1_op(j,s)*gamma_hi(i,k,s));
%%   eq_gamma_hi:=tempeq . eq_gamma_hi
%%  >>$
%% sol_gamma_hi:=solve(eq_gamma_hi,unk_gamma_hi);

% Define contravariant and covariant matrices
matrix gu1(ncomp,ncomp)$
for i:=1:ncomp do for j:=1:ncomp do gu1(i,j):=gu1_op(i,j)$
gl1:=gu1**(-1)$

% Introduce operator for covariant metric
operator gl1_op$
for i:=1:ncomp do for j:=1:ncomp do
 gl1_op(i,j):=gl1(i,j)$

% Compute the curvature in upper indexes R^{ijk}_l
% Formula from BA Dubrovin, Flat pencils ...
operator riem_u$
for all i,j,k,l let riem_u(i,j,k,l) =
 (for s:=1:ncomp sum 
  gu1_op(i,s)*(df(gamma_hi(j,k,l),part(dep_var,s)) -
   df(gamma_hi(j,k,s),part(dep_var,l)))
 ) +
 (for s:=1:ncomp sum gamma_hi(i,j,s)*gamma_hi(s,k,l)) -
 (for s:=1:ncomp sum gamma_hi(i,k,s)*gamma_hi(s,j,l))$

zero_riem_u:={}$
for i:=1:ncomp do
 for j:=1:ncomp do
  for k:=1:ncomp do
   for l:=1:ncomp do
    zero_riem_u:=num(riem_u(i,j,k,l)) . zero_riem_u$

operator sym_gamma_hi;
for all i,j,k let sym_gamma_hi(i,j,k) =
  (
    (for s:=1:ncomp sum gu1_op(i,s)*gamma_hi(j,k,s)) -
    (for s:=1:ncomp sum gu1_op(j,s)*gamma_hi(i,k,s))
    );

zero_sym_gamma_hi:={}$
for i:=1:ncomp do
 for j:=1:ncomp do
  for k:=1:ncomp do
    zero_sym_gamma_hi:=num(sym_gamma_hi(i,j,k)) . zero_sym_gamma_hi$

temp_eq:=append(zero_riem_u,zero_sym_gamma_hi);

temp_eq_2:=local_splitvars(temp_eq,dep_var)$

total_eq:=filter_eqlist(temp_eq_2)$

;end;

off echo;
off nat;
linelength 70;
out <<resname>>$
for i:=1:6 do
 for j:=1:6 do
  for k:=j+1:6 do
   write "c_lo(",k,",",j,",",i"):=",
    ((for h:=1:6 sum cc(ctel:=ctel+1)*part(dep_var,h)) + cc(ctel:=ctel+1))$

write ";end;";

shut <<resname>>$
on nat;
on echo;


;end;

Local Variables:
mode:reduce
End:
