/* Following "Hydrodynamics II" by Dr. Dullemond at http://www.mpia.de/homes/dullemon/lectures/fluiddynamics/ */"";

/* eigenvector helper functions.  TODO put these elsewhere, in a file of their own */"";

/* maxima returns two lists: one of unique eigenvalues and one of multiplicity.
this duplicates those entries to create a correct list to pass to a diagonal matrix */
eigenvalueList(eigenvectorResults) := flatten(makelist(makelist(eigenvectorResults[1][1][i],eigenvectorResults[1][2][i]), i, 1, length(eigenvectorResults[1][1])));

eigenvalueMatrix(eigenvectorResults) := diag(eigenvalueList(eigenvectorResults));

/* ... and this takes the 2nd element, containing the eigenvectors and their associated eigenvalues, grouped by eigenvalue multiplicity,
and returns a list of vectors that runs parallel to the eigenvalueList function */
eigenvectorList(eigenvectorResults) := apply(append, eigenvectorResults[2]);

eigenvectorMatrix(eigenvectorResults) :=
    block([el,n],
        el : eigenvectorList(eigenvectorResults),
        n : length(el),
        genmatrix(lambda([i,j], el[j][i]), n,n)
    );

/* convince diff to not treat variables as constants */ depends(P, %rho);

/* density = particle number density times mean weight of gas particle */ %rho_from_N_%mu : %rho = N * %mu;

N_from_%rho_%mu : solve(%rho_from_N_%mu, N)[1];

/* specific energy - kinetic, internal, and total */"";

/* internal energy = density times internal specific energy */ E = %rho * e;

v : [vx, vy, vz];

/* fluid velocity */ vLenSq_from_v : vLen^2 = v.v;

v_from_vLenSq : rhs(vLenSq_from_v) = lhs(vLenSq_from_v);

/* specific kinetic energy */
eKin_from_vLen : eKin = vLen^2/2;

eKin_from_v : subst([vLenSq_from_v], eKin_from_vLen);

eTotal_from_eKin_e : eTotal = eKin + e;

e_from_eTotal_eKin : solve(eTotal_from_eKin_e, e)[1];

/* Pressure */"";

/* ideal gas law */ P_from_N_k_T : P = N * k * T;

P_from_k_T_%rho_%mu : P_from_N_k_T, N_from_%rho_%mu;

/* another ideal gas law property */ P_from_%rho_e : P = (%gamma - 1) * %rho * e;

e_from_P_%rho : solve(P_from_%rho_e, e)[1];

eTotal_from_eKin_%rho_P : subst([e_from_P_%rho], eTotal_from_eKin_e);

P_from_%rho_eTotal_vLen : subst([e_from_eTotal_eKin, eKin_from_vLen], P_from_%rho_e);

P_from_%rho_eTotal_v : subst([vLenSq_from_v], P_from_%rho_eTotal_vLen);

eTotal_from_%rho_v_P : subst([eKin_from_v], eTotal_from_eKin_%rho_P);

/* internal specific enthalpy */"";

h_from_e_P_%rho : h = e + P / %rho;

h_from_P_%rho : ratsimp(subst([e_from_P_%rho], h_from_e_P_%rho));

h_from_e : ratsimp(subst([P_from_%rho_e], h_from_e_P_%rho));

/* total specific enthalpy */"";

hTotal_from_h_eKin : hTotal = h + eKin;

h_from_hTotal_eKin : solve(hTotal_from_h_eKin, h)[1];

hTotal_from_eTotal_P_%rho : hTotal = P / %rho + eTotal;

hTotal_from_P_%rho : subst([eTotal_from_eKin_%rho_P], hTotal_from_eTotal_P_%rho);

/* speed of sound */"";

assume(Cs > 0);

/* adiabatic compression/expansion */
P_from_K_%rho_%gamma : P = K * %rho ^ %gamma;

K_%rho_%gamma_from_P : rhs(P_from_K_%rho_%gamma) = lhs(P_from_K_%rho_%gamma);

/* adiabatic sound speed: Cs^2 = dP/d%rho */
CsSq_from_K_%rho_%gamma : Cs^2 = diff(subst(P_from_K_%rho_%gamma, P), %rho);

/* ...in terms of pressure */
CsSq_from_P_%rho : lhs(CsSq_from_K_%rho_%gamma) = rhs(CsSq_from_K_%rho_%gamma) * lhs(P_from_K_%rho_%gamma) / rhs(P_from_K_%rho_%gamma);

CsSq_from_P_%rho / %gamma$
rhs(%) = lhs(%)$
P_%rho_from_CsSq : %;

P_from_%rho_CsSq : P_%rho_from_CsSq * %rho;

/* in terms of specific internal energy */
CsSq_from_e : lhs(CsSq_from_P_%rho) = rhs(CsSq_from_P_%rho) * lhs(e_from_P_%rho) / rhs(e_from_P_%rho);

/* in terms of enthalpy */
CsSq_from_h : lhs(CsSq_from_e) = ratsimp(rhs(CsSq_from_e) * lhs(h_from_e) / rhs(h_from_e));

/* isothermal sound speed ... not used */
csSq_from_e : cs^2 = (%gamma - 1) * e;

h_from_hTotal_vLen : subst([eKin_from_vLen], solve(hTotal_from_h_eKin, h)[1]);

CsSq_from_hTotal : subst([h_from_hTotal_vLen], CsSq_from_h);

hTotal_from_CsSq_vLen : solve(CsSq_from_hTotal, hTotal)[1];

hTotal_from_CsSq_v : subst([vLenSq_from_v], hTotal_from_CsSq_vLen);

CsSq_from_eTotal_vLen : subst([e_from_eTotal_eKin, eKin_from_vLen], CsSq_from_e);

/* take the positive root */ Cs_from_eTotal_vLen : solve(CsSq_from_eTotal_vLen, Cs)[2];

eTotal_v_from_Cs : subst([vLenSq_from_v], rhs(Cs_from_eTotal_vLen) = lhs(Cs_from_eTotal_vLen));

/* Euler equations of motion */"";

xs : [x,y,z];

primitives : append([%rho], v, [eTotal]);

states : [q1, q2, q3, q4, q5];

depends(append(primitives, states, [P]), append([t],xs));

/* equations, separate */"";

primitive_eqn_density : 'diff(%rho, t) + sum('diff(%rho * v[i], xs[i]),i,1,3) = 0;

primitive_eqn_velocity : create_list('diff(%rho * v[j], t) + sum('diff(%rho * v[j] * v[i] + kron_delta(j,i)*P, xs[i]), i,1,3) = 0, j, [1,2,3]);

primitive_eqn_energy : 'diff(%rho * eTotal, t) + sum('diff(v[i] * (%rho * eTotal + P), xs[i]),i,1,3) = 0;

/* Euler equations using primitive variables */
append([primitive_eqn_density], primitive_eqn_velocity, [primitive_eqn_energy])$
subst([P_from_%rho_eTotal_v, vLenSq_from_v], %)$
primitive_eqns : %;

/* state variables in terms of primitive variables */
states_from_primitives : [q1 = %rho, q2 = %rho * vx, q3 = %rho * vy, q4 = %rho * vz, q5 = %rho * eTotal];

/* primitive variables from state variables */ primitives_from_states : solve(states_from_primitives, primitives)[1];

state_eqns : subst(primitives_from_states, primitive_eqns);

dt_from_state_eqns : create_list(lhs(state_eqns[i]) - 'diff(states[i],t) = rhs(state_eqns[i]) -'diff(states[i],t),i,[1,2,3,4,5]);

dt_from_state_eqns_lhs : create_list(lhs(eqn), eqn, dt_from_state_eqns);

dt_from_state_eqns_rhs : create_list(rhs(eqn), eqn, dt_from_state_eqns);

state_eqns_from_dt_matrix : genmatrix(lambda([i,j], dt_from_state_eqns_lhs[i]),5,1) = genmatrix(lambda([i,j], dt_from_state_eqns_rhs[i]),5,1);

state_eqns_from_dt_matrix_ev : expand(ev(state_eqns_from_dt_matrix, diff));

state_eqns_diffx_jacobian : genmatrix(lambda([i,j], ratsimp(coeff(lhs(state_eqns_from_dt_matrix_ev)[i,1], diff(states[j],x)))), 5, 5);

primitive_eqns_diffx_jacobian : ratsimp(subst(states_from_primitives, state_eqns_diffx_jacobian));

/* would be great if I could declare a matrix multiply without it expanding... 
so I could show the original equation with the state vector derivative factored out */
state_eqns_diffx_jacobian . genmatrix(lambda([i,j], diff(states[i],x)), 5, 1) = rhs(state_eqns_from_dt_matrix_ev);

/* now to find the eigenvalues and eigenvectors of the state_eqn matrix */"";

diffx_jacobian_eigenvector_results : eigenvectors(primitive_eqns_diffx_jacobian);

eigenvalueList(diffx_jacobian_eigenvector_results)$
create_list(subst(eTotal_v_from_Cs, expand(eqn)), eqn, %)$
diffx_jacobian_eigenvalues : %;

load(diag);

diffx_jacobian_eigenvalue_matrix : diag(diffx_jacobian_eigenvalues);

eigenvectorList(diffx_jacobian_eigenvector_results)$
% : expand(%)$
genmatrix(lambda([i,j], subst([eTotal_v_from_Cs], %[j][i])), 5, 5)$
/* now that Maxima has put a "v" in the middle of the components that make up Cs,
there is no way to move the "v" to the left side of the multiplication,
and there is no way to substitute in the Cs.  HAVE TO DO IT BY HAND, THANK YOU MAXIMA.
TODO: find a way to rearrange elements of a product ... or just split a sum or product into a list. */
% : subst([sqrt(%gamma) * sqrt(1-%gamma) * vx * sqrt(vx^2+vy^2+vz^2-2*eTotal)/sqrt(2) = vx*Cs], %)$
% : subst([%gamma*eTotal - %gamma*vz^2/2 + vz^2/2 - %gamma*vy^2/2 + vy^2/2 - %gamma*vx^2/2 + vx^2/2 - Cs*vx = hTotal - Cs*vx], %)$
% : subst([%gamma*eTotal - %gamma*vz^2/2 + vz^2/2 - %gamma*vy^2/2 + vy^2/2 - %gamma*vx^2/2 + vx^2/2 + Cs*vx = hTotal + Cs*vx], %)$
diffx_jacobian_eigenvectors : %;

ratsimp(invert(diffx_jacobian_eigenvectors))$
ratsimp(subst([hTotal_from_CsSq_v], %))$
diffx_jacobian_eigenvectors_inverse : %;

/* could go for one last vSq substitution ... */"";

/* verify that the eigenvector and eigenvector inverse matrices are inverses */
diffx_jacobian_eigenvectors . diffx_jacobian_eigenvectors_inverse$
subst([hTotal_from_CsSq_v], %)$
ratsimp(%);
is(equal(%, ident(5)));

/* verify that the eigenvectors reconstruct to the original matrix */
diffx_jacobian_eigenvectors . diffx_jacobian_eigenvalue_matrix . diffx_jacobian_eigenvectors_inverse$
subst([hTotal_from_CsSq_v], %)$
ratsimp(%)$
subst([CsSq_from_eTotal_vLen, vLenSq_from_v], %)$
ratsimp(%);
is(equal(%, primitive_eqns_diffx_jacobian));
primitive_eqns_diffx_jacobian;

/* verify that the eigenvectors do scale by the eigenvalue */"";
for i : 1 thru 5 do (
    block([x],
        x : col(diffx_jacobian_eigenvectors, i),
        x : primitive_eqns_diffx_jacobian . x = diffx_jacobian_eigenvalues[i] * x,
        x : subst([hTotal_from_CsSq_v], x),
        x : ratsimp(x),
        x : subst([eTotal_from_eKin_e, eKin_from_vLen, vLenSq_from_v, solve(CsSq_from_e, e)[1]], x),
        x : ratsimp(x),
        print(x),
        print(is(equal(lhs(x), rhs(x))))
));

/* verify that the eigenvectors do scale by the eigenvalue */"";
for i : 1 thru 5 do (
    block([x],
        x : row(diffx_jacobian_eigenvectors_inverse, i),
        x : x . primitive_eqns_diffx_jacobian = diffx_jacobian_eigenvalues[i] * x,
        x : subst([hTotal_from_CsSq_v], x),
        x : ratsimp(x),
        x : subst([eTotal_from_eKin_e, eKin_from_vLen, vLenSq_from_v, solve(CsSq_from_e, e)[1]], x),
        x : ratsimp(x),
        print(x),
        print(is(equal(lhs(x), rhs(x))))
));

/* rather than solving the derivative of the flux with regards to the conservative variables directly,
more advanced systems solve the derivative of the flux with regards to the primitive variables
and then the derivative of the conservatives with regards to the primitives
(like Trangenstein, J.) */"";

primitives2 : append([%rho], v, [P]);

subst(append(states_from_primitives, [eTotal_from_%rho_v_P]), states)$
expand(%)$
states_from_primitives2 : %;

jacobian(states_from_primitives2, primitives2)$
ratsimp(%)$
diff_state_wrt_primitives2 : %;

diff_primitives2_wrt_state : invert(diff_state_wrt_primitives2);

primitive_eqns$
subst([eTotal_from_%rho_v_P], %)$
create_list(lhs(%[i]), i, [1,2,3,4,5])$
expand(ev(%, diff))$
genmatrix(lambda([i,j], ratsimp(coeff(lhs(%)[i], diff(primitives2[j],x)))), 5, 5)$
diff_flux_wrt_primitives2 : %;

/* verify dF/du = dF/dw (du/dw)^-1 */
diff_flux_wrt_primitives2 . diff_primitives2_wrt_state$
subst([P_from_%rho_eTotal_v], %)$
ratsimp(%);
is(equal(%, primitive_eqns_diffx_jacobian));
primitive_eqns_diffx_jacobian;

/* Trangenstein calculates (du/dw)^-1 dF/dw ... 
and subtracts out the diagonal to get the Acoustic matrix */
diff_primitives2_wrt_state . diff_flux_wrt_primitives2$
ratsimp(%)$
Acoustic_plus_velocity : %;

Acoustic : Acoustic_plus_velocity - ident(5) * vx;

Acoustic_eigenvector_results : eigenvectors(Acoustic);

eigenvalueList(Acoustic_eigenvector_results)$
subst([P_%rho_from_CsSq], %)$
diag(%)$
Acoustic_eigenvalue_matrix : %;

eigenvectorMatrix(Acoustic_eigenvector_results)$
subst([P_from_%rho_CsSq], %)$
% * %rho$
Acoustic_eigenvector_matrix : %;

invert(Acoustic_eigenvector_matrix)$
Acoustic_eigenvector_inverse_matrix : %;

/* now the acoustic eigenvector matrix times the jacobian of primitives wrt states should be the eigenvectors of the jacobian of the flux wrt the state (right?)*/
diff_primitives2_wrt_state . Acoustic_eigenvector_matrix$
ratsimp(%)$
%;