Last modified:  14, August 2021

Perfect fluid collapse in spherical symmetry with Λ = 0

Configurations

Packages

Take the notation package to make sure that any subscripted variables are treated as a single variable. 
			Otherwise, you cannot use Clear on it since Clear only works on symbols and subscripted variables are actually functions. E.g. look at (Subscript[x, a]) using FullForm. Also, you will get
			some trouble in solving for subscripted variables using NDSolve and the like since it wants the arguments to be solved for to be symbols.
			DO NOT IF POSSIBLE assign values to subscripted variables, since you will by default not assign a Downvalue to it, but a Ownvalues. The below package will make everything 
			work nonetheless by symbolizing any subscripted variable, but it is a good habit to only use subscripted variables for formal calculations or rules.

Needs["Notation`"]
			Symbolize[ParsedBoxWrapper[SubscriptBox["_","_"]]] (*Possible optional argument: WorkingForm -> TraditionalForm*)
			(*Take the notation package to make sure that any subscripted/superscripted symbols are treated as a single symbol.*)
			Symbolize[ParsedBoxWrapper[SuperscriptBox["_","_"]]]
			Symbolize[ParsedBoxWrapper[SubsuperscriptBox["_","_","_"]]]

Note that the above has some important changes as to how Mathematica views for example (Subscript[V, S]). Try with and without the above. Check with FullForm to see the difference.

The below is for pretty print purposes. Allows to use the function pdConv.

<< "/home/patrick/Documents/Wolfram Mathematica/partial_derivative_output.m"(*Allows for nice output form*)

Keyboard shortcuts

The following allows to auto-replace stuff when you write “tex[” into “TeXForm[StandardForm[]]”, which is what is needed to  output LATEX code of an equation. The StandardForm is needed if using the notation package.

CurrentValue[EvaluationNotebook[],{InputAutoReplacements,"tex"}]:=RowBox[{"TeXForm","[",RowBox[{"StandardForm","\[SelectionPlaceholder]","]"}],"]"}]

Palettes and docked buttons

Below is the full docked buttons code. In the following sections, we explain each part.

Correcting alignment

This docked button will go through the notebook and correctly align all the text.

buttonalignment = With[{styles={"Section","Subsection","Subsubsection"}},ToBoxes@Button["align",Map[Set[CurrentValue[#,{CellMargins,1,1}],
						CurrentValue[PreviousCell[#,CellStyle->styles],{CellMargins,1,1}]]&,Cells[CellStyle->"Text"]]]];

Correctly re-enable evaluation property

This part of the above code creates a docked button that easily allows to deactivate cell evaluation and re - enable it, while keeping the texts, outputs,etc default (not evaluable).  Specifically, “re-enable” in fact just sets properties back to default.

buttonevaluable = ToBoxes@Column[Button[StringForm["Evaluatable -> ``",#], CurrentValue[SelectedCells@InputNotebook[],Evaluatable]=#]&/@{False,Inherited}];

The below code does the same thing, but it creates a palette instead. Kept it for archive purposes.

(*CreatePalette@Column[Button[StringForm["Evaluatable -> ``",#],CurrentValue[SelectedCells@InputNotebook[],Evaluatable]=#]&/@{False,Inherited}]*)

Full docked buttons

Implementation of each part as a docked cell. For adding new features, simply create new data as shown for the above two buttons, i.e. ToBoxes[stuff] and then put it inside the BoxData.
				The next lines should not be touched and their purpose is to make the toolbar expand/collapse upon clicking of the bottom panel.

fullDockedCellsWithCollapseToolbar=Cell[BoxData[{buttonalignment,buttonevaluable}], 
					CellFrameLabelMargins->0,CellFrameLabels->{{None,None},{ButtonBox["",
				ButtonFunction:>Function[With[{pc=ParentCell@EvaluationCell[]},SetOptions[pc,If[CurrentValue[pc,CellSize]===0,{CellSize->Inherited,CellElementSpacings->{},
				CellFrameMargins->Inherited},{CellSize->0,CellElementSpacings->{"CellMinHeight"->0},CellFrameMargins->0}]]]], ImageSize->{Scaled[2],15},Evaluator->Automatic],None}}];
				SetOptions[EvaluationNotebook[],DockedCells->fullDockedCellsWithCollapseToolbar]
				Clear[buttonalignment,buttonevaluable]

Timestamp

This code puts a timestamp at the beginning of the document whenever one saves the notebook.

SetOptions[EvaluationNotebook[],NotebookEventActions:>{{"MenuCommand","Save"}:>Module[{dy,mn,yr},{dy,mn,yr}=
		Map[(LinkWrite[First[$FrontEnd],FrontEnd`Value[#]]; LinkRead[First[$FrontEnd]])&,{"Day","MonthName","Year"}];
			NotebookLocate["LastModified"];
			NotebookWrite[InputNotebook[],Cell[TextData[{"Last modified:  ",dy,", ",mn," ",yr}],"Text",CellTags->"LastModified"]]],PassEventsDown->True}]

Timestamp alternative

The below is a timestamp that instead updates whenever one closes the notebook. This has been made unevaluable as the previous one is usually preferred.

SetOptions[EvaluationNotebook[],NotebookEventActions:>{"WindowClose":>Module[{dy,mn,yr},{dy,mn,yr}=
	   Map[(LinkWrite[First[$FrontEnd],FrontEnd`Value[#]];
     LinkRead[First[$FrontEnd]])&,{"Day","MonthName","Second"}];NotebookLocate["LastModified"];
	     NotebookWrite[InputNotebook[],Cell[TextData[{"Last modified:  ",dy,", ",mn," ",yr}],"Text",CellTags->"LastModified"]]]}]

Option Inspector

We can set the notebook to automatically save upon closing. We however will not do that (made below unevaluatable)!  We keep the code as a basis for possible future use.
			Due to the timestamp code above, this means that a “Save Changes To” windows will always appear.

CurrentValue[$FrontEndSession,"ClosingAutoSave"] = True

DumpSave load

Packages should be loaded before the Load. This is because the saved definitions in .mx file rely on Notation to get the correct output.
			The notebook needs Notation even without loading the .mx file. If no dumpsave exist, the below simply prints this fact and does not do anything else.

Note: The dump-file’s name is assumed to have the very same name for the current notebook, with the extension “.mx” instead of “.nb”.

With[{dumpsaveFilePath = FileNameJoin[{NotebookDirectory[],StringDelete[Last[FileNameSplit[NotebookFileName[]]],".nb"]}] <> ".mx"},
			If[FileExistsQ[dumpsaveFilePath],Get[dumpsaveFilePath],Print["No DumpSave to load"]]]

Function descriptions, notation and structure

Variable names notation

Modules

In the variable naming, each name is composed of sup-name (we will call them modules).
Each new module is written in uppercase, except at the beginning of the word, except for the general modules listed below.
Below is a list of general modules used throughout the notebook (written between <>), with their meaning. They always appear in this exact format:
 <Eqn>  : This variable expresses an equation, which will always be of the form Eqn = 0, when using Solve.
 <Sol>    : the solution of an equation. It is usually preceded by the module indicating which equation is considered. It may be followed by <Rule> (see below). 
 		If not, then it is followed by the variable that is the object of the solution.
<Rule> : If it is preceded by <Sol>, then this is the rule of the solution of the considered equation. In this case, it is followed by the variable(s) that defines the rule. Otherwise, it is a standalone rule.
<tmp>  : This is always at the end of the naming, indicating that this variable is only used temporarily for a next calculation.
		The variable will afterwards not be needed anymore and should therefore be cleared.
<CSS>  : Stands for continuous self similar. This means that the variable’s expression will only depend on the coordinate x = -r/t.
<Old>   : This means that these variables do not have any impact on the rest of the notebook and are usually there for completeness purposes.
<Check>  : Stands for consistency. These variables are usually used for consistency checks and have no further use.
<Alt>    : Stands for alternative. Usually this is present in junction of another variable, which is obtained by some method (e.g. solution of some equation). 
		The <Alt> module means that this variable has been obtained using an alternative method. It is preceded by <Sol> or <Rule>.
<To>    : Seen in junction with <COC> (see below). It is preceded by “old” elements(e.g. variables,coordinates) and followed by the new ones.
<COC> : Stands for change of coordinates. I.e. we change charts. It is followed by the set of old to new variables. Example: COCxyTorθ
<COV> : Stands for change of variables.It is followed by the set of old to new variables. Example: COVfTog
<LHS> and <RHS> : Stands for left/right hand side. Usually about an equation. Example: EqnSolft and EqnSolftRHS is technically the same thing. EqnSolftRHS would be f’(t).
<Full> : Refers to the full set of EOM.
<Reduced> : Refers to the reduced EOM where we use the algebraic equation to remove one ODE.
<ODE> : Specifically signifies that the equation is an ODE. It is followed either directly by the variable(s) that it needs to be solved for which It is equivalent to writing the coordinate in front of the variable, 
		which is being differentiated; or it is followed by the specific type of Ansatz/assumptions of the equations, such as <CSS>.
<PS> : refers to power series. Refers to an equation that is power expanded. Followed by the point around which we expand.
<Order> : usually preceded by <PS> in which case it Indicates the order power series expansion.
<EM> : stands for eigenmodes (when talking about perturbation around background solution).

Notation

On the notation:
-   Some sections have been made un-evaluable since they were used for consistency checks and the like but do not contribute to the actual calculations.
    	You can set them back to begin evaluable via the tab above and: Cell -> Cell Properties -> Evaluable needs to be ticked.
-   Functional rules should be expressed as pure function. For example: rule = f[x] -> Sin[x] is not very good since doing f[y] /. rule. Will not work,although the intent is clear.
      	The rule should rather be: rulecorrect = f -> Sin. There is a way to “clean” pre-exisintg “bad” rules of their argument. The only exception would be if the obtained rule is 
      	meant to be used immediately and only for a local purpose, in which case they (should) have a <tmp> postfix attached. See:
      	 https://mathematica.stackexchange.com/questions/190612/how-to-make-functional-rules-not-depend-on-an-argument for more details.
-   If we wish to name the derivative of a preexisting variable, we add a prefix to the relevant module which denotes the derivative
	Example: fEqn1Sol is the solution of some equation called Eqn1, which is solved for f. Then: ftEqn1Sol, is the derivative (wrt t) of the expression.
-   In terms of the naming of equations, the rule is as follows:
      	- First comes the name of the equation(s) considered: Example: metricMatter
      	- Then comes the type of the equations. Example: metricMatterEqn or metricMatterODE. This is in junction with the variable names that comes after (see below).
      	- Then comes the type of ansatz considered (if applicable). Example: metricMatterODECSS.
      	-  If we consider a power series expansion, then, the <PS> comes after the <CSS>, because CSS refers to the dependence of the variables, while PS refers to something more specific in terms of what we 
      		will solve for. In that case, it is followed as a sub-module by the point around which we expand. Example: metricMatterODECSSPSOriginNAωV. If we consider the solution-rule of it, then the
      		relevant modules are reattached as a sub-module. Example: metricMatterODECSSPSOriginSolRuleNAωV. The <Sol> or <SolRule> is therefore followed by the variables solved for.
      - If you wish to consider a subset of the equations, you use the relevant module right after the type of equation. Example: metricMatterODEFullCSSPSOriginSolRuleNAωV.
 - Finally comes the name of the variables to be solved for. Example: metricMatterODECSSNAωV (this means that this is an ODE in N,A,ω,V. That is with terms: N’ A’ ω’ and V’ that makes up the ODE,
	to be solved for). Alternatively, one could have: metricMatterEqnCSSNxAxωxVx, which means the same thing, but is of course less visually appealing.
- For higher order terms, we write the derivative number immediately after the corresponding variable we diff. with respect to. Example: metricMatterEqnCSSSolNx4, for the4th derivative of the solution N. 
-  For tensors, we indicate whether the indices are “Up” or “Down” via prefixing <U> or <D> (always uppercase) at the end of the name. This also chooses their relative order.
	Variables without these prefixes are therefore NOT tensors! Example: <einsteintensorUD> would be the Einstein tensor with first index up and second index down.
- The letter “m” is used at the end of the notebook to signify “minus”. For example, if we wish to record a variable like A[-1], we would write Am1 as its variable name.
- The letter “p” after a variable’s name usually stands for “perturbation”. It refers to the perturbed variable from the background solution.
- the letter “up” stands for unperturbed.

Structure of the notebook

The alignment of each object is defined compared to the alignment of the Text. For each groupings, we use the corresponding number of Tabs, starting from Section. 
	Everything else is appropriately aligned to that and defined from the MyStyleSheet, found in \home/.Mathematica/System Files/FrontUsers/StyleSheet. 
	This can be changed from the Default, via Format >> StyleSheet.
	The Chapter and Subchapter cannot directly contain codes (Input). This is reserved from Sections onward.

General set up and functions

Pretty print

pp = {f_[x] -> f,f_[t,r] -> f,f_[τ,x] -> f, f_[y] -> f, f_[r] -> f}; (*Stands for "pretty print"*)
<< "/home/patrick/Documents/Wolfram Mathematica/partial_derivative_output.m"(*Allows for nice output form*)

Dimension and coordinate

ndim=4;
cc={t,r,θ,ϕ}; (*coordinate charts*)

Geometric objects

(Subscript[Γ,    bc]^a)

ΓChrUDD[gmetricDD_, coordinates_]:=Module[{i,j,k,l},Simplify[Table[(1/2)Sum[
Inverse[gmetricDD][[i,l]](-D[gmetricDD[[j,k]],coordinates[[l]]]+D[gmetricDD[[l,k]],coordinates[[j]]]+D[gmetricDD[[l,j]],coordinates[[k]]]),
{l,1,Length[coordinates]}], {i,1,Length[coordinates]}, {j,1,Length[coordinates]}, {k,1,Length[coordinates]}]]]

(Subscript[R,    bcd]^a)

riemUDDD[gmetricDD_, coordinates_] := Module[{i,j,k,l,m,n,Γmatrix = ΓChrUDD[gmetricDD, coordinates]},Simplify[Table[
D[Γmatrix[[l,j,k]],coordinates[[i]]]-D[Γmatrix[[l,i,k]],coordinates[[j]]]
+Sum[Γmatrix[[m,j,k]] Γmatrix[[l,i,m]]-Γmatrix[[m,i,k]] Γmatrix[[l,j,m]],
{m,1,Length[coordinates]}], {l,1,Length[coordinates]}, {k,1,Length[coordinates]}, {i,1,Length[coordinates]}, {j,1,Length[coordinates]}]]]

(Subscript[R, ab])

riccDD[gmetricDD_, coordinates_] := Module[{i,j,k,riemann = riemUDDD[gmetricDD, coordinates]},
	Simplify[Table[Sum[riemann[[k,i,k,j]],
	{k,1,Length[coordinates]}],{i,1,Length[coordinates]},{j,1,Length[coordinates]}]]]

R

rscl[gmetricDD_, coordinates_] := Module[{i,j,ricci = riccDD[gmetricDD, coordinates]},
	Simplify[Sum[Inverse[gmetricDD][[i,j]] ricci[[i,j]],
	{i,1,Length[coordinates]},{j,1,Length[coordinates]}]]]

(Subscript[G, ab]) with cosmological constant Λ

einsteinDD[gmetricDD_, coordinates_] := Module[{i,j,ricci = riccDD[gmetricDD, coordinates],rscalar = rscl[gmetricDD, coordinates]},
	Simplify[Table[ricci[[i,j]]-(1/2)gmetricDD[[i,j]] rscalar + Λ gmetricDD[[i,j]],
	{i,1,Length[coordinates]},{j,1,Length[coordinates]}]]]

(Subscript[∇, a])(V^b)

nablaTensorDU[TUp_,gmetricDD_, coordinates_] :=    Module[{i,j,k,Γmatrix = ΓChrUDD[gmetricDD, coordinates]},
	Table[D[TUp[[i]],coordinates[[j]]]+Sum[Γmatrix[[i,j,k]]TUp[[k]],
	{k,1,Length[coordinates]}],{j,1,Length[coordinates]},{i,1,Length[coordinates]}]]

(Subscript[∇, a])(T^bc)

nablaTensorDUU[TUpUp_,gmetricDD_, coordinates_] :=    Module[{i,j,k,l,Γmatrix = ΓChrUDD[gmetricDD, coordinates]},
	Table[D[TUpUp[[i,j]],coordinates[[k]]]+Sum[Γmatrix[[i,k,l]]TUpUp[[l,j]]+Γmatrix[[j,k,l]]TUpUp[[i,l]],
	{l,1,Length[coordinates]}],{k,1,Length[coordinates]},{i,1,Length[coordinates]},{j,1,Length[coordinates]}]]

Geometry and energy

Metric

Defining the metric (Subscript[g, ab]) as well as its inverse (g^ab) in generalised polar radial coordinates, where R(r) is an odd function of r. Note that we could take R as a coordinates since from metric (∂_r)R dr = dR. We will later take R=r.

gmetDD = Table[0,{i,1,ndim},{j,1,ndim}];
gmetDD[[1,1]] = -α[t,r]^2;
gmetDD[[2,2]] = a[t,r]^2 D[R[r],r]^2;
gmetDD[[3,3]] = R[r]^2;
gmetDD[[4,4]] = R[r]^2 Sin[θ]^2;
pdConv[gmetDD]   /. pp

gmetUU=FullSimplify[Inverse[gmetDD]];

Stress - Energy tensor

We consider perfect fluid (T^ab) = (p + ρ) (U^a)(U^b) + p (g^ab), with equation of state p = γ ρ. We also normalise the fluid velocity (U^a) (Subscript[U, a]) = -1 and express the fluid in terms of the coordinate velocity V =  ((a (U^r))/(α (U^t))).

fluidVelocityU = Table[0,{i,1,ndim}];
fluidVelocityU[[1]] = Ut[t,r];
fluidVelocityU[[2]] = Ur[t,r];

energy = ρ[t,r];
pressure = p[t,r];
equationOfStateRule = p -> Function[{t,r},Evaluate[γ energy]];
pressure = pressure /. equationOfStateRule;
ΓToPrimRule = Γ -> Function[{t,r},1/Sqrt[1-V[t,r]^2]];
Clear[equationOfStateRule]

Now we  express the Stress-Energy in terms of U,W just like in the Evans&Coleman paper:

uwVelocityRule = {Ut -> Function[{t,r},W[t,r]/(α[t,r])], Ur -> Function[{t,r},U[t,r]/(D[R[r],r] a[t,r])]};
stressUU =Table[(energy+pressure) fluidVelocityU[[i]] fluidVelocityU[[j]]
			+ pressure gmetUU[[i,j]],{i,1,ndim},{j,1,ndim}]/. uwVelocityRule;

We now express the Stress in terms of velocity V = U/W and make use of velocity renormalization

pdConv[(stressUU = stressUU /. {U -> Function[{t,r},V[t,r] Γ[t,r]],
						 W -> Function[{t,r},Γ[t,r]]} //Simplify)] /. pp

(stressDD = Table[Sum[stressUU[[i,j]] gmetDD[[i,k]] gmetDD[[j,l]],
				{i,1,ndim},{j,1,ndim}],{k,1,ndim},{l,1,ndim}]) /. pp;

Check it is trace-free for γ = 1/3

Sum[stressUU[[i,j]] gmetDD[[i,j]],{i,1,ndim},{j,1,ndim}] /. ΓToPrimRule//Simplify

EFE and energy conservation

General pr coordinate and Λ ≠ 0

Einstein field equations

MatrixForm[(einsteinFieldEqnDD  = Table[einsteinDD[gmetDD,cc][[i,j]] - 8 Pi stressDD[[i,j]], {i,1,ndim},{j,1,ndim}] //Simplify)] /. pp

Mass and momentum conservation from EFE

Solve EFE above for (Subscript[a, ,t]) , (Subscript[a, ,r]) , (Subscript[α, ,r])

(einsteinFieldEqn4DDReducedSolRule = Simplify[Flatten[Solve[{einsteinFieldEqnDD[[1,1]] == 0, einsteinFieldEqnDD[[1,2]] == 0, einsteinFieldEqnDD[[2,2]] == 0},{D[a[t,r],t],D[a[t,r],r],D[α[t,r],r]}]]]) /. pp

Check with Neilsen&Choptuik

Non-evaluable.

dadtNC = -4 Pi r α[t,r] a[t,r]^2 V[t,r] (1+γ) ρ[t,r] Γ[t,r]^2;
		dadrNC = a[t,r]^3 (4 Pi r((1+γ) ρ[t,r] Γ[t,r]^2 -γ ρ[t,r]) - 1/(2 r) (1- 1/a[t,r]^2));
		dαdrNC = a[t,r]^2 α[t,r] (4 Pi r ((1+γ) ρ[t,r] Γ[t,r]^2 V[t,r]^2+γ ρ[t,r]) + 1/(2 r) (1- 1/a[t,r]^2));
		Simplify[(D[a[t,r],t] /. einsteinFieldEqn4DDReducedSolRule) - dadtNC  /. R -> Function[r,r] /. Λ -> 0]
		Simplify[(D[a[t,r],r] /. einsteinFieldEqn4DDReducedSolRule) - dadrNC  /. R -> Function[r,r] /. Λ -> 0]
		Simplify[(D[α[t,r],r] /. einsteinFieldEqn4DDReducedSolRule) - dαdrNC /. R -> Function[r,r] /. Λ -> 0]
		Clear[dadtNC,dadrNC,dαdrNC]

Re-write above EFE in a better form

We can replace the α PDE in terms of a new, nicer equation, which is given by (∂_r)ln (aα). This is a bit nicer because we see that the RHS vanishes in vaccum.

Simplify[D[a[t,r],r]/a[t,r] + D[α[t,r],r]/α[t,r] /. einsteinFieldEqn4DDReducedSolRule] /. pp

Secondly, since we have a conserved current, we have a conserved quantity, the mass. We defined it as follows,

mass = R[r]/2 - R[r]/(2 a[t,r]^2) - 1/6 Λ R[r]^3;

Differentiation with respect to t and r, and plugging the above values in gives,

D[mass,t] /. einsteinFieldEqn4DDReducedSolRule /. pp//Simplify
	D[mass,r] /. einsteinFieldEqn4DDReducedSolRule /. pp//Simplify
	Clear[mass]

We see that the RHS gives up to a multiple of ± 4π the conserved variable X and flux X! We can then replace the a derivatives with the mass derivatives instead.

Stress-Energy written in conservation form

From the above, we know that the stress energy has only two non-trivial components (the “t” and “r” components). To re-write it we re-write (Subscript[∇, a]) (T^ab) = 0 as: (Subscript[∇, a]) ((Subscript[V, b]) (T^ab)) = (T^ab) (Subscript[∇, (a]) (Subscript[V, b)]), 
where the (V^a) are really are a set of two vectors  (so we suppressed an additional non-tensor index). This is re-written (Subscript[∇, a]) (j^a) = s, or in coordinate notation: (∂_t)( (Sqrt[-g]) (Subscript[V, μ]) (T^(tμ)) )  + (∂_r)( (Sqrt[-g]) (Subscript[V, μ]) (T^(rμ)) ) =  (Sqrt[-g]) s, 
which gives the conserved variables, flux and source respectively.

Neilson & Choptuik (for consistency check)

Made not evaluable.
	Here we take (Subscript[V, μ]^1) = (α/(a (r^2)),0,0,0) and (Subscript[V, μ]^2) = (0,1/(r^2),0,0) to extract to two equations. The choice of vectors here is simply to make it look the same of the one in Neilson and Choptuik. 
	Other choices are technically also ok,  as long as we pick two linearly independent vectors and of course which do not produce a trivial equation.
	In the below, the factor of Sin θ  is a constant and therefore can be factored out.

Along (Subscript[V, μ]^1)

In the below, the factor of Sin θ  is a constant and therefore can be factored out.

vector1NCD = α[t,r]/( r^2 a[t,r]) {1,0,0,0};
		vector1NCU = Table[Sum[gmetUU[[i,j]] vector1NCD[[j]],{j,1,ndim}],{i,1,ndim}];

conserved quantity

Simplify[Sum[Sqrt[-Det[gmetDD]] vector1NCD[[i]] stressUU[[1,i]],{i,1,ndim}],
			{R[r] > 0, R'[r] > 0, r > 0,a[t,r] > 0,α[t,r] > 0,Sin[θ] > 0}] /. pp

flux

Simplify[Sum[Sqrt[-Det[gmetDD]] vector1NCD[[i]] stressUU[[2,i]],{i,1,ndim}],
			{R[r] > 0, R'[r] > 0, r > 0,a[t,r] > 0,α[t,r] > 0,Sin[θ] > 0}] /. pp

Source

Note that the source (assuming EFE) is just ((-2)/r) flux! This is in line with the expression in Neilson&Choptuik.

tmp = nablaTensorDU[vector1NCU,gmetDD,cc];
			tmp2 = Table[Sum[tmp[[i,j]] gmetDD[[j,k]],{j,1ndim}],{i,1,ndim},{k,1,ndim}]; (*put index down before symmetrizing*)
			(Simplify[Sum[ Sqrt[-Det[gmetDD]] stressUU[[i,j]] (tmp2[[i,j]] + tmp2[[j,i]]) / 2,{i,1,ndim},{j,1,ndim}] /. 
			einsteinFieldEqn4DDReducedSolRule , {R[r] > 0, R'[r] > 0, r > 0,a[t,r] > 0,α[t,r] > 0,Sin[θ] > 0}]) /. pp
			Clear[tmp,tmp2]

Along (Subscript[V, μ]^2)

vector2NCD = 1/( r^2 ) {0,1,0,0};
		vector2NCU = Table[Sum[gmetUU[[i,j]] vector2NCD[[j]],{j,1,ndim}],{i,1,ndim}];

conserved quantity

Simplify[Sum[Sqrt[-Det[gmetDD]] vector2NCD[[i]] stressUU[[1,i]],{i,1,ndim}],
			{R[r] > 0, R'[r] > 0, r > 0,a[t,r] > 0,α[t,r] > 0,Sin[θ] > 0}] /. pp

flux

Simplify[Sum[Sqrt[-Det[gmetDD]] vector2NCD[[i]] stressUU[[2,i]],{i,1,ndim}],
			{R[r] > 0, R'[r] > 0, r > 0,a[t,r] > 0,α[t,r] > 0,Sin[θ] > 0}] /. pp

Source

Note that the source (assuming EFE) is just ((-2)/r) flux! This is in line with the expression in Neilson&Choptuik.

tmp = nablaTensorDU[vector2NCU,gmetDD,cc];
			tmp2 = Table[Sum[tmp[[i,j]] gmetDD[[j,k]],{j,1ndim}],{i,1,ndim},{k,1,ndim}]; (*put index down before symmetrizing*)
			(sourcetmp = Simplify[Sum[ Sqrt[-Det[gmetDD]] stressUU[[i,j]] (tmp2[[i,j]] + tmp2[[j,i]]) / 2,{i,1,ndim},{j,1,ndim}] /. 
		einsteinFieldEqn4DDReducedSolRule , {R[r] > 0, R'[r] > 0, r > 0,a[t,r] > 0,α[t,r] > 0,Sin[θ] > 0}]) /. pp
			Clear[tmp,tmp2]

Check source with Neilson&Choptuik

pcheck = κ ρ[t,r];
				τcheck = (ρ[t,r] + pcheck) Γ[t,r]^2   - pcheck;
				scheck = (ρ[t,r] + pcheck) Γ[t,r]^2 v[t,r];
				mcheck = r/2 (1-1/a[t,r]^2);
				(sigmacheck = Simplify[(scheck v[t,r] - τcheck) (8 Pi α[t,r] a[t,r] r pcheck + α[t,r] a[t,r] mcheck/r^2) + 
			α[t,r] a[t,r] pcheck mcheck/r^2 + 2 α[t,r] pcheck/(a[t,r] r)]) ;
				sigmacheck - sourcetmp/Sin[θ] /. R -> Function[{r},r] /. Λ -> 0  /. pp // FullSimplify
				Clear[pcheck, τcheck, scheck, mcheck, sigmacheck, sourcetmp]

The above is readily checked to be (2/r) * flux (= (2/r) Xf using the paper’s notation), as it should (assuming R = r). 
				This shows that both sources agree.

My choice  (in progress)

Here we take (Subscript[V, μ]^X) = (α/(a sin θ),0,0,0) and (Subscript[V, μ]^Y) = (0,R'/((R^2)sin θ),0,0) to extract to two equations. The first choice of vector here is simply to make the resulting currents j^a = (Subscript[V, b]) (T^ab) conserved: (Subscript[∇, a]) (j^a) = 0. 
	The second vector is normalised with the idea that the fluid equation is well-balanced, i.e. for flat small, with constant density at rest, the flux should be proportional to the pressure (thus a constant) and the source should be 0.

Along (Subscript[V, μ]^X)

vectorXD = α[t,r]/ (a[t,r] Sin[θ]) {1,0,0,0};
		vectorXU = Table[Sum[gmetUU[[i,j]] vectorXD[[j]],{j,1,ndim}],{i,1,ndim}];

Conserved quantity

(conservedX = Simplify[Sum[Sqrt[-Det[gmetDD]] vectorXD[[i]] stressUU[[1,i]],
		{i,1,ndim}],{R[r] > 0, R'[r] > 0, r > 0,a[t,r] > 0,α[t,r] > 0,Sin[θ] > 0}]) /. pp

Flux

(fluxX = Simplify[Sum[Sqrt[-Det[gmetDD]] vectorXD[[i]] stressUU[[2,i]],
		{i,1,ndim}],{R[r] > 0, R'[r] > 0, r > 0,a[t,r] > 0,α[t,r] > 0,Sin[θ] > 0}]) /. pp

Source

tmp = nablaTensorDU[vectorXU,gmetDD,cc];
			tmp2 = Table[Sum[tmp[[i,j]] gmetDD[[j,k]],{j,1ndim}],{i,1,ndim},{k,1,ndim}]; (*put index down before symmetrizing*)
			(sourceX = (Simplify[Sum[Sqrt[-Det[gmetDD]] stressUU[[i,j]] (tmp2[[i,j]] + tmp2[[j,i]]) / 2,{i,1,ndim},{j,1,ndim}] /. 
			einsteinFieldEqn4DDReducedSolRule , {R[r] > 0, R'[r] > 0, r > 0,a[t,r] > 0,α[t,r] > 0,Sin[θ] > 0}])) /. pp
			Clear[tmp,tmp2]

Along (Subscript[V, μ]^Y)

vectorYD = R'[r]/ (R[r]^2 Sin[θ]) {0,1,0,0};
		vectorYU = Table[Sum[gmetUU[[i,j]] vectorYD[[j]],{j,1,ndim}],{i,1,ndim}];

Conserved quantity

(conservedY = Simplify[Sum[Sqrt[-Det[gmetDD]] vectorYD[[i]] stressUU[[1,i]],{i,1,ndim}],
			{R[r] > 0, R'[r] > 0, r > 0,a[t,r] > 0,α[t,r] > 0,Sin[θ] > 0}]) /. pp

Flux

(fluxY = Simplify[Sum[Sqrt[-Det[gmetDD]] vectorYD[[i]] stressUU[[2,i]],{i,1,ndim}],
			{R[r] > 0, R'[r] > 0, r > 0,a[t,r] > 0,α[t,r] > 0,Sin[θ] > 0}]) /. pp

Source

We do not plug in the Einstein’s equations this time. This makes the modification with the 2+1 code easier when written like that.

tmp = nablaTensorDU[vectorYU,gmetDD,cc];
			tmp2 = Table[Sum[tmp[[i,j]] gmetDD[[j,k]],{j,1ndim}],{i,1,ndim},{k,1,ndim}]; (*put index down before symmetrizing*)
			(sourceY = FullSimplify[Sum[Sqrt[-Det[gmetDD]] stressUU[[i,j]] (tmp2[[i,j]] + tmp2[[j,i]]) / 2,{i,1,ndim},{j,1,ndim}] , 
		{R[r] > 0, R'[r] > 0, r > 0,a[t,r] > 0,α[t,r] > 0,Sin[θ] > 0}]) /. pp
			Clear[tmp,tmp2, einsteinFieldEqn4DDReducedSolRule]

Comparison with 2+1 source.

sigmaCheck = Γ[t,r]^2 (1+κ) ρ[t,r];
				pCheck = κ ρ[t,r];
				τCheck = sigmaCheck - pCheck;
				sourceY2p1Check = 1/a[t,r] ((w[t,r]^2 - v[t,r]^2) sigmaCheck α[t,r] R'[r]/R[r] - τCheck D[α[t,r],r]-(pCheck+v[t,r]^2 sigmaCheck) α[t,r] D[a[t,r],r]/a[t,r]
			+ R[r] w[t,r] sigmaCheck γ[t,r] - 2 v[t,r] sigmaCheck R'[r] D[a[t,r],t]);
				Simplify[sourceY - sourceY2p1Check /. {γ[t,r] -> 0, w[t,r] -> 0}] /. pp
				Clear[sigmaCheck,pCheck,τCheck,sourceY2p1Check]

Assume Λ = 0 and R(r) = r now

Apply Λ = 0 and R(r) = r

For upcoming conservation laws, we will also use the definition of Γ at this point.

gmetDD = gmetDD /. R -> Function[r,r] //Simplify
gmetUU = gmetUU /. R -> Function[r,r] //Simplify
stressUU = stressUU /. Λ -> 0 /. ΓToPrimRule  /. R -> Function[r,r] // Simplify;
stressDD = stressDD /. Λ -> 0 /. ΓToPrimRule  /. R -> Function[r,r] // Simplify;
einsteinFieldEqnDD =  einsteinFieldEqnDD /. Λ -> 0 /. ΓToPrimRule  /. R -> Function[r,r] // Simplify;

Stress - Energy conservation and Bianchi

Stress-Energy

(energyConservationEqnU = With[{nablaTabDUU = nablaTensorDUU[stressUU,gmetDD,cc]},Table[FullSimplify[Sum[nablaTabDUU[[k,k,n]] ,{k,1,ndim}]],{n,1,ndim}]]) /. pp;

Note that naively, we have 5 equations from EFE + 2 equations from energy conservation = 7 equations. On the other hand, we have only 4 variables! 3 equations need to be redundant. 
	From Bianchi, we wish to find equations that are linear combinations of other. Intuitively, it is clear that gθθ is related to gϕϕ by just a sin^2(x). Also, gθθ contains 2nd derivative, and is therefore probably just 	
	some linear combinations (include derivatives) of the other terms, modulo the Bianchi identity. To see more precisely, we will take a tensor (could be Einstein,Energy or even EFE) and write it in the general form 
	we have above. (i.e. we write for the first term just gtt,etc for all non-trivial terms). We will then see how each component is related to one another.

Bianchi Identity

Non evaluable. 
	We check out which equations in the EFE can be made redundant modulo the energy conservation.

tensorBianchiUU = Table[0,{i,1,ndim},{j,1,ndim}];
	tensorBianchiUU[[1,1]] = btt[t,r];
	tensorBianchiUU[[1,2]] = btr[t,r]; tensorBianchiUU[[2,1]] = btr[t,r];
	tensorBianchiUU[[2,2]] = brr[t,r];
	tensorBianchiUU[[3,3]] = bθθ[t,r];
	tensorBianchiUU[[4,4]] = bϕϕ[t,r];

bianchiU = Table[Sum[D[tensorBianchiUU[[l,n]],xc[[l]]]+ΓChrUDD[gmetDD][[l,l,m]] tensorBianchiUU[[m,n]]+
			ΓChrUDD[gmetDD][[n,l,m]]tensorBianchiUU[[l,m]],{l,1,ndim},{m,1,ndim}],{n,1,ndim}]//Simplify

bianchiCSSU = bianchiU /. 
	{a -> Function[{t,r}, acss[r/-t]], α -> Function[{t,r}, αcss[r/-t]], V -> Function[{t,r}, Vcss[r/-t]], ρ -> Function[{t,r}, ρcss[r/-t]/t^2], 
	btt -> Function[{t,r}, btt[r/-t]], btr -> Function[{t,r}, btr[r/-t]],
	brr -> Function[{t,r}, brr[r/-t]],bθθ -> Function[{t,r}, bθθ[r/-t]],bϕϕ -> Function[{t,r}, bϕϕ[r/-t]]};
	(bianchiCSSU = Simplify[bianchiCSSU /.  {r -> -t x,Vcss -> V,acss -> a, αcss -> α, ρcss -> ρ}]) /. pp

From Bianchi, we find indeed 3 none trivial equations. For 2nd equations, we can get rid of bθθ. Note that again as expected, it involves derivatives of brr and btr.
	3rd equation makes, say, bϕϕ redundant in exactly the way we anticipated. Note that this means that we can “forget “ about the bϕϕ equation, if we replace it via the corresponding SEC equation. 
	This equation of course turns out to be already satisfied by plugging in the relevant expressions. We could have anticipated all of this by taking bϕϕ = 1/sin^2θ bθθ from the start, in which case
	the 2rd equation is trivial. In 1st equation, can write brr as a lin. comb of other terms -> redundant. We will check its explicit redundancy at the end of the CSS Ansatz.
	We are left with btt and btr. With the SEC, which have 2 non-trivial relations, this brings us down to 4 equations for 4 unknowns. We will keep the α equation
	for now though, since we will use it in order to work with more suitable variables than a and α later on.

PDE system

metricMatterEqn = {einsteinFieldEqnDD[[1,1]], einsteinFieldEqnDD[[1,2]],einsteinFieldEqnDD[[2,2]], 
				einsteinFieldEqnDD[[3,3]],energyConservationEqnU[[1]], energyConservationEqnU[[2]]};

metricMatterEqnSolRuleatarαrtmp = Simplify[Flatten[Solve[ metricMatterEqn[[1;;3]] == 0,{D[a[t,r],r],D[a[t,r],t],D[α[t,r],r]}]]];
metricMatterEqnSolRuleρtVttmp      = Simplify[Flatten[Solve[metricMatterEqn[[5;;6]] == 0,{D[ρ[t,r],t],D[V[t,r],t]}]]];
metricMatterEqnSolat                 = Simplify[Factor[D[a[t,r],t] /. metricMatterEqnSolRuleatarαrtmp]];
metricMatterEqnSolar                 = Simplify[Factor[D[a[t,r],r] /. metricMatterEqnSolRuleatarαrtmp]];
metricMatterEqnSolαr                 = Simplify[Factor[D[α[t,r],r] /. metricMatterEqnSolRuleatarαrtmp]];
metricMatterEqnSolρt                 = FullSimplify[Factor[D[ρ[t,r],t] /. metricMatterEqnSolRuleρtVttmp] /. metricMatterEqnSolRuleatarαrtmp];
metricMatterEqnSolVt                 = FullSimplify[Factor[D[V[t,r],t] /. metricMatterEqnSolRuleρtVttmp] /. metricMatterEqnSolRuleatarαrtmp];

Integrability condition

The (Subscript[a, ,t]) and (Subscript[a, ,r]) equations need to satisfy (Subscript[a, ,tr]) = (Subscript[a, ,rt]), which is readily satisfied,

FullSimplify[D[metricMatterEqnSolat,r] - D[metricMatterEqnSolar,t] /. metricMatterEqnSolRuleρtVttmp /. metricMatterEqnSolRuleatarαrtmp]

CSS ansatz equations in the old variables (a, α, ρ, V) (old notation)

Not evaluable.
We stick to the old variables here, and check result for critfluid3+1 notebook. The most notable change is in the CSS ansatz, ρ -> ρ/t^2 instead of ρ/r^2.

CSSAnsatzRuleOld = {a -> Function[{t,r}, acss[r/-t]], α -> Function[{t,r}, αcss[r/-t]], V -> Function[{t,r}, Vcss[r/-t]], 
				 ρ -> Function[{t,r}, ρcss[r/-t]/t^2]};

(metricMatterEqnSolatCSSOld = Simplify[metricMatterEqnSolat /. CSSAnsatzRuleOld /. {r -> -t x,Vcss -> V,acss -> a, αcss -> α, ρcss -> ρ}]) /. pp;
(metricMatterEqnSolarCSSOld = Simplify[metricMatterEqnSolar /. CSSAnsatzRuleOld /. {r -> -t x,Vcss -> V,acss -> a, αcss -> α, ρcss -> ρ}]) /. pp;
(metricMatterEqnSolαrCSSOld = Simplify[metricMatterEqnSolαr /. CSSAnsatzRuleOld /. {r -> -t x,Vcss -> V,acss -> a, αcss -> α, ρcss -> ρ}]) /. pp;
(metricMatterEqnSolρtCSSOld = Simplify[metricMatterEqnSolρt /. CSSAnsatzRuleOld /. {r -> -t x,Vcss -> V,acss -> a, αcss -> α, ρcss -> ρ}]) /. pp;
(metricMatterEqnSolVtCSSOld = Simplify[metricMatterEqnSolVt /. CSSAnsatzRuleOld /. {r -> -t x,Vcss -> V,acss -> a, αcss -> α, ρcss -> ρ}]) /. pp;

(metricMatterEqnSolaxCSSOld               = Simplify[metricMatterEqnSolatCSSOld (-t/x)]) /. pp; (*This agrees with critfluid3+1 of a0' eqn, using the CSS constraint*)
(metricMatterEqnSolαxCSSOld               = Simplify[-t metricMatterEqnSolαrCSSOld]) /. pp; (*This is also consistent with the g'[x] equation in critfluid3+1*)
(metricMatterEqnalgeqnCSSOld             = Simplify[-t metricMatterEqnSolarCSSOld - metricMatterEqnSolaxCSSOld]) /. pp ;(*This agrees with CSSconstraint in critfluid3+1*)
(metricMatterEqnSolRuleρxVxCSSOldtmp =  Simplify[Flatten[Solve[{-2ρ[x]-x ρ'[x] == t^3 metricMatterEqnSolρtCSSOld,x V'[x] == -t metricMatterEqnSolVtCSSOld},{ρ'[x],V'[x]}]]]) /. pp;
(metricMatterEqnSolρxCSSOld = Simplify[Factor[ρ'[x] /. metricMatterEqnSolRuleρxVxCSSOldtmp]]) /. pp;(* The denominator has the right form. See later *)
(metricMatterEqnSolVxCSSOld = Simplify[Factor[V'[x] /. metricMatterEqnSolRuleρxVxCSSOldtmp]]) /. pp;

Consistency check and fluid's boundary

The vanishing of the denominator in ρ’ and V’ indicates the sonic (fluid) boundary. The speed of the fluid will be less than the speed of light. We can see that the boundary of causality for the fluid occurs whenever the denominator in the above vanishes. 
	V^2=1 cannot happen as this corresponds to the speed of light. In Evernote,under EvansColeman_consistency_check,we show this boundary agrees with the theoretical prediction.

Simplify[1/(2 x)*Denominator[metricMatterEqnSolρxCSSOld]] /. pp

Solving the above for x gives the fluid’s speed boundary.

α equation consistency with critfluid3+1

We plug in α -> ag in the expression for α’. We get a a’ factor, which we can resolve in two ways: simply use the equation for a’ above or
	change it first via the algebraic constraint (recall that the algebraic constraint comes from the fact that we have two possible equations for a’)

metricMatterEqnαxCSSOld = α'[x] - metricMatterEqnSolαxCSSOld;
	metricMatterEqngxCSSOldCheck = metricMatterEqnαxCSSOld /. α -> Function[x,g[x] a[x]] /.  
	a' -> Function[x,Evaluate[Simplify[-t metricMatterEqnSolarCSSOld]]];
	metricMatterEqnSolRulegxOldCheck = Simplify[Flatten[Solve[metricMatterEqngxCSSOldCheck ==0,g'[x]]]];
	(metricMatterEqnSolgxOldCheck = Simplify[Factor[g'[x] /. metricMatterEqnSolRulegxOldCheck]] )/. pp

The above matches the expression for g’[x] in the critfluid3+1 notebook. Indeed, we need to use the algebraic equation. In the above, we used the expression of a’ coming from ar. 
	We now redo the same with a’ coming from at, and deduce the algebraic equation from it.

metricMatterEqngxCSSAltOldCheck = metricMatterEqnαxCSSOld /. α -> Function[x,g[x] a[x]] /. 
	a' -> Function[x,Evaluate[Simplify[metricMatterEqnSolaxCSSOld]]];
	(metricMatterEqnSolRulegxAltOldCheck = Flatten[Simplify[Solve[metricMatterEqngxCSSAltOldCheck ==0,g'[x]]]]) /. pp;
	(metricMatterEqnSolgxAltOldCheck = Simplify[Factor[g'[x] /. metricMatterEqnSolRulegxAltOldCheck]]) /. pp

Simplify[metricMatterEqnSolgxOldCheck-metricMatterEqnSolgxAltOldCheck] /. pp

The above matches exactly the algebraic equation.

Consistency  check solving directly for the EOM in CSS

We directly solve for a’, α’, ρ’ and V’ from the EOM with the CSS ansatz. Both methods should coincide.

metricMatterEqnCSSOld = Simplify[metricMatterEqn /. CSSAnsatzRuleOld /. {r -> -t x,Vcss -> V,acss -> a, αcss -> α, ρcss -> ρ}];
	(metricMatterEqnSolRuleaxαxρxVxCSSOldCheck = Simplify[Flatten[Solve[{metricMatterEqnCSSOld[[2]] == 0,metricMatterEqnCSSOld[[3]] == 0,  metricMatterEqnCSSOld[[5;;6]] == 0},
{a'[x],α'[x],ρ'[x],V'[x]}]]]) /. pp;

(metricMatterEqnSolaxCSSOldCheck = Simplify[Factor[a'[x] /. metricMatterEqnSolRuleaxαxρxVxCSSOldCheck]]) /. pp;
	(metricMatterEqnSolαxCSSOldCheck = Simplify[Factor[α'[x] /. metricMatterEqnSolRuleaxαxρxVxCSSOldCheck]]) /. pp;
	(metricMatterEqnSolρxCSSOldCheck = Simplify[Factor[ρ'[x] /. metricMatterEqnSolRuleaxαxρxVxCSSOldCheck]]) /. pp;
	(metricMatterEqnSolVxCSSOldCheck = Simplify[Factor[V'[x] /. metricMatterEqnSolRuleaxαxρxVxCSSOldCheck]]) /. pp;

Simplify[metricMatterEqnSolaxCSSOld-metricMatterEqnSolaxCSSOldCheck]
Simplify[metricMatterEqnSolαxCSSOld-metricMatterEqnSolαxCSSOldCheck]
Simplify[metricMatterEqnSolρxCSSOld-metricMatterEqnSolρxCSSOldCheck]
Simplify[metricMatterEqnSolVxCSSOld-metricMatterEqnSolVxCSSOldCheck]

Redundancy of α’ ODE Check

By removing the α variable using the alg. eqn , we check that the α’ eqn becomes redundant:

(metricMatterEqnalgeqnSolRuleαCSSOld = Flatten[Simplify[Solve[metricMatterEqnalgeqnCSSOld ==0,α[x]]]]) /. pp;
(metricMatterEqnalgeqnSolaCSSOld    = Factor[α[x] /. metricMatterEqnalgeqnSolRuleαCSSOld]) /. pp;

Plug the result into α’ and then compare the result with RHS of metricMatterEqnSolαxCSSOld, removing all derivative terms, as well as explicit α terms:

(metricMatterEqnalgeqnaxCSSOld = Simplify[D[α[x],x] /. α -> Function[x,Evaluate[metricMatterEqnalgeqnSolaxCSSOld]]]) /. pp;
Simplify[(metricMatterEqnalgeqnaxCSSOld - metricMatterEqnSolαxCSSOld)
/. {a' -> Function[x,Evaluate[metricMatterEqnSolaxCSSOld]],
      α' -> Function[x,Evaluate[metricMatterEqnSolαxCSSOld]],
     ρ'  -> Function[x,Evaluate[metricMatterEqnSolρxCSSOld]],
     V' -> Function[x,Evaluate[metricMatterEqnSolVxCSSOld]]} /. metricMatterEqnalgeqnSolRuleαCSSOld]

Change of coordinate (t, r) -> (τ, x) and variables (a, α, ρ, V) -> (Ng, A, ω, V)

We make a change of coordinates, following Koike, Hara, Adachi,except for the CSS coordinate (differs by a log) : τ = - ln(-t) , x = -r/t.
In the same spirit, we take the same change of variable as Koike, Hara, Adachi (KHA). We called N: Ng instead since N is protected. From now on we shall work with these new variables.

COCtrToτx1Rule     = {a -> Function[{t,r}, a[-Log[-t],-r/t]], α -> Function[{t,r}, α[-Log[-t],-r/t]],
				 V -> Function[{t,r}, V[-Log[-t],-r/t]],  ρ -> Function[{t,r}, ρ[-Log[-t],-r/t]]};
COCtrToτx2Rule     = {t -> - Exp[-τ], r -> x Exp[-τ]};
COCtrToτxRule = Flatten[{COCtrToτx1Rule, COCtrToτx2Rule}];
COVaαρToNgAωRule = {a -> Function[{τ,x}, Sqrt[A[τ,x]]], α -> Function[{τ,x}, x Ng[τ,x] Sqrt[A[τ,x]]], 
				 ρ -> Function[{τ,x}, Exp[2 τ] ω[τ,x]/(4 Pi A[τ,x] x^2)]};

metricMatterEqnSolatLHS = Simplify[D[a[t,r],t] /. COCtrToτxRule /. COVaαρToNgAωRule,Element[{τ,x},Reals]];
metricMatterEqnSolarLHS = Simplify[D[a[t,r],r] /. COCtrToτxRule /. COVaαρToNgAωRule,Element[{τ,x},Reals]];
metricMatterEqnSolαrLHS = Simplify[D[α[t,r],r] /. COCtrToτxRule /. COVaαρToNgAωRule,Element[{τ,x},Reals]];
metricMatterEqnSolρtLHS = Simplify[D[ρ[t,r],t] /. COCtrToτxRule /. COVaαρToNgAωRule,Element[{τ,x},Reals]];
metricMatterEqnSolVtLHS = Simplify[D[V[t,r],t] /. COCtrToτxRule /. COVaαρToNgAωRule,Element[{τ,x},Reals]];
metricMatterEqnSolatRHS = Simplify[metricMatterEqnSolat /. COCtrToτxRule /. COVaαρToNgAωRule,Element[{τ,x},Reals]];
metricMatterEqnSolarRHS = Simplify[metricMatterEqnSolar /. COCtrToτxRule /. COVaαρToNgAωRule,Element[{τ,x},Reals]];
metricMatterEqnSolαrRHS = Simplify[metricMatterEqnSolαr /. COCtrToτxRule /. COVaαρToNgAωRule,Element[{τ,x},Reals]];
metricMatterEqnSolρtRHS = Simplify[metricMatterEqnSolρt /. COCtrToτxRule /. COVaαρToNgAωRule,Element[{τ,x},Reals]];
metricMatterEqnSolVtRHS = Simplify[metricMatterEqnSolVt /. COCtrToτxRule /. COVaαρToNgAωRule,Element[{τ,x},Reals]];

Check with KHA

Not evaluable.
	We check that all 5 eqns agree up to this point with the Koike&Adachi Paper. We plug in the values found for the derivatives of our variables wrt to x, and plug it into the relevant eqns in the paper, making the appropriate change of coordinates.

COCχTox1RuleCheck = {Ng -> Function[{τ,χ}, Ng[τ,Exp[χ]]], A -> Function[{τ,χ}, A[τ,Exp[χ]]], V -> Function[{τ,χ}, V[τ,Exp[χ]]],  ω -> Function[{τ,χ}, ω[τ,Exp[χ]]]};
	COCχTox2RuleCheck = {χ -> Log[x]};

metricMatterEqnNgχCheck = D[Ng[τ,χ],χ]/Ng[τ,χ] + 2- A[τ,χ] + (1-γ) ω[τ,χ];
	metricMatterEqnNgxCheck = metricMatterEqnNgχCheck /. COCχTox1RuleCheck /. COCχTox2RuleCheck;
	Simplify[metricMatterEqnNgxCheck /. metricMatterEqnSolNgxAτAxωxVxRuletmp]

metricMatterEqnAχCheck = D[A[τ,χ],χ]/A[τ,χ] - 1 + A[τ,χ] - 2 ω[τ,χ] (1+ γ V[τ,χ]^2)/(1-V[τ,χ]^2);
	metricMatterEqnAxCheck = metricMatterEqnAχCheck /. COCχTox1RuleCheck /. COCχTox2RuleCheck;
	Simplify[metricMatterEqnAxCheck /. metricMatterEqnSolNgxAτAxωxVxRuletmp]

metricMatterEqnAτChecktmp = D[A[τ,χ],τ]/A[τ,χ] + D[A[τ,χ],χ]/A[τ,χ] + 2 (1+γ) Ng[τ,χ] V[τ,χ] ω[τ,χ]/(1-V[τ,χ]^2);
	metricMatterEqnAτCheck = metricMatterEqnAτChecktmp /. COCχTox1RuleCheck /. COCχTox2RuleCheck;
	Simplify[metricMatterEqnAτCheck /. metricMatterEqnSolNgxAτAxωxVxRuletmp]

metricMatterEqnωχVχCheck1tmp = D[ω[τ,χ],τ]/ω[τ,χ] + (γ+1) V[τ,χ] D[V[τ,χ],τ]/(1-V[τ,χ]^2)+
	(1+Ng[τ,χ] V[τ,χ]) D[ω[τ,χ],χ]/ω[τ,χ] +
	(γ+1) (Ng[τ,χ]+V[τ,χ]) D[V[τ,χ],χ]/(1-V[τ,χ]^2) - 3/2 (1-γ) Ng[τ,χ] V[τ,χ] +
	(3+γ)/2 A[τ,χ] Ng[τ,χ] V[τ,χ] - (1-γ) Ng[τ,χ] V[τ,χ] ω[τ,χ];
	metricMatterEqnωxVxCheck1 = metricMatterEqnωχVχCheck1tmp /. COCχTox1RuleCheck /. COCχTox2RuleCheck;
	Simplify[metricMatterEqnωxVxCheck1 /. metricMatterEqnSolNgxAτAxωxVxRuletmp]

metricMatterEqnωχVχCheck2tmp = γ V[τ,χ] D[ω[τ,χ],τ]/ω[τ,χ] + (γ+1) D[V[τ,χ],τ]/(1-V[τ,χ]^2) + 
	γ (Ng[τ,χ]+V[τ,χ]) D[ω[τ,χ],χ]/ω[τ,χ] +
	(γ+1) (1+Ng[τ,χ] V[τ,χ]) D[V[τ,χ],χ]/(1-V[τ,χ]^2) + (γ-1) γ Ng[τ,χ] ω[τ,χ] -
	(7 γ +1)/2 Ng[τ,χ] + (1+3 γ)/2 A[τ,χ] Ng[τ,χ];
	 metricMatterEqnωχVχCheck2 =  metricMatterEqnωχVχCheck2tmp /. COCχTox1RuleCheck /. COCχTox2RuleCheck;
	 Simplify[ metricMatterEqnωχVχCheck2 /. metricMatterEqnSolNgxAτAxωxVxRuletmp]

Clear[metricMatterEqnSolNgxAτAxωxVxRuletmp]

PDE system in new coordinates and variables

(metricMatterEqnSolNgxAτAxωxVxRuletmp = Flatten[Simplify[Solve[{metricMatterEqnSolatLHS == metricMatterEqnSolatRHS,
metricMatterEqnSolarLHS == metricMatterEqnSolarRHS, metricMatterEqnSolαrLHS == metricMatterEqnSolαrRHS,metricMatterEqnSolρtLHS == metricMatterEqnSolρtRHS,
metricMatterEqnSolVtLHS == metricMatterEqnSolVtRHS},
{D[Ng[τ,x],x],D[A[τ,x],τ],D[A[τ,x],x],D[ω[τ,x],x],D[V[τ,x],x]}]]]) /. pp;
(metricMatterEqnSolNgx    = Simplify[Factor[D[Ng[τ,x],x] /. metricMatterEqnSolNgxAτAxωxVxRuletmp]]) /. pp;
(metricMatterEqnSolAτ      = Simplify[Factor[D[A[τ,x],τ] /. metricMatterEqnSolNgxAτAxωxVxRuletmp]]) /. pp;
(metricMatterEqnSolAx      = Simplify[Factor[D[A[τ,x],x] /. metricMatterEqnSolNgxAτAxωxVxRuletmp]]) /. pp;
(metricMatterEqnSolωx      = Simplify[Factor[D[ω[τ,x],x] /. metricMatterEqnSolNgxAτAxωxVxRuletmp]]) /. pp;
(metricMatterEqnSolVx      = Simplify[Factor[D[V[τ,x],x] /. metricMatterEqnSolNgxAτAxωxVxRuletmp]]) /. pp;

CSS ansatz equations

We now apply the CSS Ansatz. The EOM will then only depend on the variable x.

γTocsRule = γ -> (Subscript[c, s])^2;
CSSAnsatzDropτRule = {Ng -> Function[{τ,x},Ng[x]],A -> Function[{τ,x},A[x]],
				      ω -> Function[{τ,x},ω[x]],V -> Function[{τ,x},V[x]]};
(metricMatterEqnFullCSSSolNgx        = Simplify[metricMatterEqnSolNgx /. CSSAnsatzDropτRule /. γTocsRule, (Subscript[c, s]) > 0]) /. pp
(metricMatterEqnCSSalgeqn                 = Simplify[metricMatterEqnSolAτ /. CSSAnsatzDropτRule /. γTocsRule, (Subscript[c, s]) > 0]) /. pp
(metricMatterEqnFullCSSSolAxtmp   = Simplify[metricMatterEqnSolAx /. CSSAnsatzDropτRule /. γTocsRule, (Subscript[c, s]) > 0]) /. pp
(metricMatterEqnFullCSSSolωx          = Simplify[metricMatterEqnSolωx /. CSSAnsatzDropτRule /. γTocsRule, (Subscript[c, s]) > 0]) /. pp
(metricMatterEqnFullCSSSolVx          = Simplify[metricMatterEqnSolVx /. CSSAnsatzDropτRule /. γTocsRule, (Subscript[c, s]) > 0])/.pp

Now notice that we can simplify the expression for A’ through the algebraic equation (since the latter now gives a “second” equation for A’).

(metricMatterEqnFullCSSSolAx          = Simplify[metricMatterEqnFullCSSSolAxtmp + 1/x metricMatterEqnCSSalgeqn]) /. pp  (*This is ok since we require alg eqn to be 0.*)

We shall use two methods from here on and check consistency of both results at the end. We can then compare which method is numerically more efficient.
1) We will keep the equations as is and use the alg. eqn for consistency checks/requirements. This keeps the equations simpler.
2) We will use the algebraic equation to get rid of one variable. One equation will thus be redundant modulo the algebraic equation.

Nice forms for each equation

N’

Nothing to do. It cannot be made any simpler...

A’

Nothing to do here

ω’

tmp = Collect[Numerator[metricMatterEqnFullCSSSolωx]/(Ng[x] ω[x]) /. pp,ω,
				   Function[expr,Collect[expr,-1+(Subscript[c, s]^2),Function[expr2,Collect[expr2,A,Simplify]]]]]

We work on the first part of the above expression:

tmp2 = Collect[Ng+7 (Subscript[c, s])^2 Ng-2 V+10 (Subscript[c, s])^2 V+3 (-1+(Subscript[c, s])^2) Ng V,Ng,Function[expr2,Collect[expr2,V,Simplify]]]

(-2+10 (Subscript[c, s]^2)) V+Ng (1+7 (Subscript[c, s]^2)+3 (-1+(Subscript[c, s]^2)) V)
				   Clear[tmp,tmp2]

The ω' expression is now of the form: Ng ω/ (Subscript[S, sonic]) (tmp2 + the second part of the tmp)

V’

We collect the numerator, scale it, then re-arrange. We then put everything back. Unfortunately, the last term can clearly be simplified, 
				but I cannot make it work without screwing something else up.

tmp = Collect[Numerator[metricMatterEqnFullCSSSolVx]/(Ng[x] (-1+V[x]^2)) /. pp,ω,
				   Function[expr,Collect[expr,A,Function[expr2,Collect[expr2,Ng,Function[expr3,
			Collect[expr3,V,Function[expr4,Collect[expr4,-1+V^2,Simplify]]]]]]]]]

Ng (-1+V^2) tmp/(2 (Subscript[S, sonic]))
				Clear[tmp]

algebraic equation

tmp = Collect[metricMatterEqnCSSalgeqn ((-1+V[x]^2))/A[x]  /. pp,A-1,
				   Function[expr,Collect[expr,ω,Function[expr2,Collect[expr2,Ng,Simplify]]]]]

The alg eqn is then A/(-1+V^2) (the above)

TeXForm[StandardForm[tmp]]

Consistency check and fluid’s boundary

The vanishing of the denominator in ω’ and V’ indicates the sonic (fluid) boundary. The speed of the fluid will be less than the speed of light.
	We can see that the boundary of causality for the fluid occurs whenever the denominator in the above vanishes.  V^2=1 cannot happen as this corresponds to the speed of light. 
	In Evernote,under EvansColeman_consistency_check,we show this boundary agrees with the theoretical prediction. Note that we get 2 roots, corresponding to the sonic cones at x = 1 and x= -1, or equivalently at ((SubMinus[S])^x) and ((SubPlus[S])^x) = 0.

Simplify[Factor[1/(2)*Denominator[metricMatterEqnFullCSSSolωx]]] /. pp

NOTE: A posteriori, it is the first term in the above which will cause the singular behaviour in the system as it vanishes at the sonic point. From theoretical calculations (see notes), the above will be referred to as (Subscript[S, sonic]).

ODE equations

From now own, we will rather use the module <ODE> rather than <Eqn> if applicable.

Full: Keep all four variables (N,A,ω,V)

We can straightaway borrow the result from the previous section:

metricMatterODEFullCSSNAωV = Table[0,{i,1,4}];
	(metricMatterODEFullCSSNAωV[[1]] = FullSimplify[Denominator[metricMatterEqnFullCSSSolNgx] Ng'[x] - Numerator[metricMatterEqnFullCSSSolNgx]]) /. pp
	(metricMatterODEFullCSSNAωV[[2]] = FullSimplify[Denominator[metricMatterEqnFullCSSSolAx] A'[x] - Numerator[metricMatterEqnFullCSSSolAx]]) /. pp
	(metricMatterODEFullCSSNAωV[[3]] = FullSimplify[Denominator[metricMatterEqnFullCSSSolωx] ω'[x] - Numerator[metricMatterEqnFullCSSSolωx]]) /. pp
	(metricMatterODEFullCSSNAωV[[4]] = FullSimplify[Denominator[metricMatterEqnFullCSSSolVx] V'[x] - Numerator[metricMatterEqnFullCSSSolVx]]) /. pp
	(*We dont equate them to zero as Coefficient below does not accept equations. Also we write it in such a way to remove the denominator*)

Reduced: Retain three variables (N,ω,V)

The “reduced” ODE system describe evolutions of Ng, ω and V, where we substituted A = A(Ng, ρ , V) from the algebraic equation. We also make sure to remove any denominator term in the ODEs.

Redundancy Check

Unevaluable.
		The question that we may ask is which of the new variables ODE, Ng’ or A’, are redundant? It is rather clear that Ng can be left out.  After all, A only depends on a. We can then view the A’ equation as the one for a’. 
		Ng is consequentially seen as the equation for α, which is  redundant by Bianchi. Interestingly though, the above change of variable introduced a new kind of symmetry. 
	 	 Indeed, it turns out that we can now drop the A’ equation instead. Intuitively, it is because the Bianchi tells us that we really need the a’ equation,
	 	but the Ng’ equation also encodes information about a’. The information is thus not lost! See below for explicit calculations,

metricMatterEqnCSSalgeqnSolRuleAChecktmp = Flatten[Simplify[Solve[metricMatterEqnCSSalgeqn == 0,A[x]]]];
		metricMatterEqnCSSalgeqnSolRuleACheck = metricMatterEqnCSSalgeqnSolRuleAChecktmp[[2]];
		metricMatterEqnCSSalgeqnSolACheck = Factor[A[x] /. metricMatterEqnCSSalgeqnSolRuleACheck];  
		Clear[metricMatterEqnCSSalgeqnSolRuleAChecktmp];

metricMatterEqnCSSalgeqnSolAxCheck = Simplify[D[metricMatterEqnCSSalgeqnSolACheck,x]];
		metricMatterEqnFullCSSSolRuleNgx = Ng' -> Function[x,Evaluate[metricMatterEqnFullCSSSolNgx]];
		metricMatterEqnFullCSSSolRuleωx  = ω' -> Function[x,Evaluate[metricMatterEqnFullCSSSolωx]];
		metricMatterEqnFullCSSSolRuleVx   = V' -> Function[x,Evaluate[metricMatterEqnFullCSSSolVx]];
		Simplify[metricMatterEqnCSSalgeqnSolAxCheck - metricMatterEqnFullCSSSolAx /.
		{metricMatterEqnFullCSSSolRuleNgx,metricMatterEqnFullCSSSolRuleωx,metricMatterEqnFullCSSSolRuleVx} /.  metricMatterEqnCSSalgeqnSolRuleACheck]

Note that the last rule where we re-sub in the expression for A from the alg eqn is in general needed since from the expression for A’ that is implied from the alg equation, we cannot go back!
		There is a loss of information (a constant). We therefore need to use the explicit expression again. FOr the above case, it happens to not matter, but if we tried for Ng instead, it actually would. 
		We shall therefore drop the A’ equation. Note that we of course could remove ω. This is consistent with the alg. eqn in a similar way as above.
		Of course we won’t, since ω’ comes from Bianchi, and the whole point was to “replace” some EFE by the Bianchi (involving ω’ and V’) in the first place.

Solving algebraic equation in terms of A

metricMatterEqnCSSalgeqnSolRuleAtmp = Flatten[Simplify[Solve[metricMatterEqnCSSalgeqn == 0,A[x]]]];
		metricMatterEqnCSSalgeqnSolRuleAtmp        = metricMatterEqnCSSalgeqnSolRuleAtmp[[2]];	
		metricMatterEqnCSSalgeqnSolRuleA = A -> Block[{x},Function @@ List[{x}, A[x] /. metricMatterEqnCSSalgeqnSolRuleAtmp]];
		Clear[metricMatterEqnCSSalgeqnSolRuleAtmp];

Reduced ODE

(metricMatterEqnReducedCSSSolNgx        = Simplify[metricMatterEqnFullCSSSolNgx /.  metricMatterEqnCSSalgeqnSolRuleA]) /. pp;
		(metricMatterEqnReducedCSSSolωx          = Simplify[metricMatterEqnFullCSSSolωx /.  metricMatterEqnCSSalgeqnSolRuleA]) /. pp;
		(metricMatterEqnReducedCSSSolVx          = Simplify[metricMatterEqnFullCSSSolVx /.  metricMatterEqnCSSalgeqnSolRuleA]) /. pp;

metricMatterODEReducedCSSNωV = Table[0,{i,1,3}];
		(metricMatterODEReducedCSSNωV[[1]] = FullSimplify[Denominator[metricMatterEqnReducedCSSSolNgx] Ng'[x] - Numerator[metricMatterEqnReducedCSSSolNgx]]) /. pp
		(metricMatterODEReducedCSSNωV[[2]] = FullSimplify[Denominator[metricMatterEqnReducedCSSSolωx] ω'[x] - Numerator[metricMatterEqnReducedCSSSolωx]]) /. pp
		(metricMatterODEReducedCSSNωV[[3]] = FullSimplify[Denominator[metricMatterEqnReducedCSSSolVx] V'[x] - Numerator[metricMatterEqnReducedCSSSolVx]])/. pp

Note that for ω and V, we still have the familiar sonic boundary expression in the “denominator”.

Power series solution at origin

We solve the Power Series expansion first for the Full (4 variables) ODEs, then the Reduced (3 variables) ODEs and see if the results match.
We solve the equation as a power series near x = 0 (at finite time, which is equivalent to r = 0). In what follows, we will denote X = (Ng, ω, V).
Made the Full ODEs and the Check below not evaluable. The results have been checked to be identical to the reduced system below.

Power series ansatz near x = 0

We do not gauge fix α (and thus Ng), because we use the gauge freedom later to fix sonic point (Subscript[x, s]) = 1. Also, regularity of the data implies that the power series must only contain even powers of r for
a,  α and ρ (scalars) and odd powers for V (vector). To avoid conical singularity, we also require a(0) = 1. A posteriori, we see that Ng0[-1] and ω0[2] will remain arbitrary and we thus solve all other coefficients
as functions of them. KEEP the powertermOrigin even!! (See notes). Otherwise, the psUnkownAtOrigin is not correct. At each odd term, we can solve only for an additional new variable (a coefficient of V) 
compared to the previous even order. At each new even power, we can solve for a new “set of” coefficients, which is nicer and simpler.

For defining the below properly, we first need to clear all the symbolized structures  and we re - instore the notation by evaluating the Initialization cells afterwards:

PSOrderOrigin = 4; (* Order of the poly expansion. We call this n in comments. KEEP THIS EVEN*)
PSAnsatzOriginRule = 
{Ng -> Function[x,Evaluate[Sum[(Ng^c)[n] x^n,{n,-1,PSOrderOrigin,2}]]],
A -> Function[x,Evaluate[1+Sum[(A^c)[n] x^n,{n,2,PSOrderOrigin,2}]]], 
ω -> Function[x,Evaluate[Sum[(ω^c)[n] x^n,{n,2, PSOrderOrigin,2}]]],
V -> Function[x,Evaluate[Sum[(V^c)[n] x^n,{n,1,PSOrderOrigin,2}]]]};
PSUnknownOrigin = {Table[(Ng^c)[n],{n,1,PSOrderOrigin,2}],Table[(A^c)[n],{n,2,PSOrderOrigin,2}], Table[(ω^c)[n],{n,4,PSOrderOrigin,2}],Table[(V^c)[n],{n,1,PSOrderOrigin,2}]};
	(*The list of all unknowns that we solve for, where we remove the terms Ng0[-1] and ω0[2] since they should remain arbitrary (we fixed the "initial" values of A and V already)*)

Full ODEs

Unevaluable.

Check structure of equations

We check the structure of the equations. We expect to remain two free variables. The singularity at x = 0, will be used to parametrize (V^c)[1] in terms of (Ng^c)[-1] 
	(note that we could have done it the other way around). Similarly, we shall take (ω^c)[2] to remain arbitrary, so we check that we have the necessary amount of equations.
	 We wish to restructure the equations in such a way that that each new step, we solve for the next order coefficients.

Note, here we use Series and Coefficients separately, instead of using SeriesCoefficients. Internally, they are treated differently, since with the former you can “cut” up to which order you want to consider and 
	checking higher order afterwards with Coefficient gives you 0. With SeriesCoefficient,  Mathematica will try to calculate all requested order “correctly”, making things longer.

metricMatterODEFullCSSPSOriginNAωVtmp = Simplify[Series[metricMatterODEFullCSSNAωV /.PSAnsatzOriginRule,{x,0,PSOrderOrigin}]];
	(*Note that ρ and V equations have no 0th order term. We could rescale by approriate 1/x factors. See below*)
	MatrixPlot[metricMatterODEFullCSSPSOriginNAωVtmp]
	Clear[metricMatterODEFullCSSPSOriginNAωVtmp];

We see that there are no 0th order eqns. The above does not show it, because it stops at 0th order, but we also have a -1th order equation in V.  We get two 1st order eqn (coming from Ng’ and V’ respectively) and 
a two 2nd order equation coming from A’ and ω’. For n=2, then, we have 5 equations!  Whereas we only want 4 (the leading orders in the expansion of the variables)! By comparing with the n=3 case, we see that the 1st order equation in V’ is actually incomplete at n=2. 
Indeed, it misses contribution from (V^c)[3]. We therefore need to rescale this properly. The pattern continues like that at higher orders. We added an extra line to make sure we do not get any extra equations. 
This is normal as the n+1th line should be ignored in our PS expansion.

We start by rescaling the V’ equations by x. We can then solve for the leading order in V (we can already do that at n=1), which will now be a 0th order equation. We can solve the leading order equations of the other 3 variables, with the exception for ω, 
which needs to wait until n=4. In a sense, the resolution of the coefficients in ω are always “one step behind” the others. We will therefore need scale it one point down. So, schematically: at 0th order in equations, we now solve for leading term in V’, 
at 1st order, solve leading terms in N and A, then at 2nd order,  solve for 2nd coeff. of V. At 3rd order, can finally solve for leading order in ω.  The pattern afterwards is clear. (See notes for more details). 
In summary: at n=1 (0th order eqn), solve for (V^c)[-1], at n=2 (1st order eqn), solve for (N^c)[1] and (A^c)[2]. For n=3 (2nd order eqn), solve for (V^c)[3], n=4 (3rd order eqn), for (N^c)[3], (A^c)[4], (ω^c)[4], etc...
 Also, we will now suppress the explicit variables name in the naming of the EOM as this is self-understood.

Because it is a 1st order ODE, the nth term in one variable can affect the n-1th order equations due to the derivative. That is why if we consider up to n terms, we solve for the n-1 first equations. 
Cannot solve for the nth equations as it will get contributions from the n+1th terms etc.

Rescale equations

metricMatterODEFullCSSPSOriginNAωV =Simplify[Table[SeriesCoefficient[{1,1/x,x,x} metricMatterODEFullCSSNAωV /.
	PSAnsatzOriginRule,{x,0,n}],{n,0,PSOrderOrigin-1}]];
	(*Note that we go only up to n-1 instead of n as before. The rescaling needs to be done INSIDE the Series function!*)
	MatrixPlot[metricMatterODEFullCSSPSOriginNAωV]

Solve the system

metricMatterODEFullCSSPSOriginSolRuleNAωV = Flatten[Simplify[Solve[Map[# == 0 &, metricMatterODEFullCSSPSOriginNAωV], Flatten[PSUnknownOrigin]]]] 
	(*The Map is used to extract all the elements in metricMatter... to put them as individual equations*)

Algebraic equation consistency check

We easily check that the solution is consistent with the algebraic equation. 
	Plugging the solution above into the algebraic equation should make all terms ~ O((x^n)) vanish. In fact, we only get terms ~ 0((x^(n+2))) remaining, since each term in the alg eqn will have an even power expansion!

Simplify[Series[metricMatterEqnCSSalgeqn (-1+V[x]^2)/A[x] /. PSAnsatzOriginRule /. metricMatterODEFullCSSPSOriginSolRuleNAωV, {x,0,PSOrderOrigin}]]

Reduced ODEs

Check structure of equations

metricMatterODEReducedCSSPSOriginNωVtmp = Simplify[Series[metricMatterODEReducedCSSNωV /.PSAnsatzOriginRule,{x,0,PSOrderOrigin}]];
	(*Note that ρ and V equations have no 0th order term. We could rescale by approriate 1/x factors. See below*)
	MatrixPlot[Table[Coefficient[metricMatterODEReducedCSSPSOriginNωVtmp,x,n],{n,0,PSOrderOrigin+1}]]
	Clear[metricMatterODEReducedCSSPSOriginNωVtmp];

Rescale equations

Since at a specific n, we solve the first n-1 equations (because it is a 1st order ODE, so we only go up to n-1 now). We first solve for the 3 remaining variables X:

metricMatterODEReducedCSSPSOriginNωV = 
	Simplify[Table[SeriesCoefficient[{1,x,x} metricMatterODEReducedCSSNωV /.PSAnsatzOriginRule,{x,0, n}],{n,0,PSOrderOrigin-1}]];
	(*Note that we go only up to n-1 instead of n as before. The rescaling needs to be done INSIDE the SERIES function!*)
	MatrixPlot[metricMatterODEReducedCSSPSOriginNωV]

Solve the system

Solve reduced ODE for N,ω,V

Since at a specific n, we solve the first n-1 equations (because it is a 1st order ODE, so we only go up to n-1 now). We first solve for the 3 remaining variables X = (N,ω,V):

metricMatterODEReducedCSSPSOriginSolRuleNωVtmp = Flatten[Simplify[Solve[Map[# == 0 &,metricMatterODEReducedCSSPSOriginNωV],Flatten[PSUnknownOrigin[[{1,3,4}]]]]]];

A(x) calculation from algebraic constraint

We now solve for A[x], by imposing the consistency with the algebraic equation. This is an algebraic equation, so unlike the 1st order ODE, we solve for the first n equations to fix the n coefficients (in general).

metricMatterEqnCSSalgeqnPSOrigin = Simplify[Table[SeriesCoefficient[metricMatterEqnCSSalgeqn /. PSAnsatzOriginRule,{x,0,n}],{n,0,PSOrderOrigin}]];
		metricMatterEqnCSSalgeqnPSOriginSolRuleA =  Flatten[Simplify[Solve[Map[# == 0 &,metricMatterEqnCSSalgeqnPSOrigin] , Flatten[PSUnknownOrigin[[{2}]]]]]];
		metricMatterEqnCSSalgeqnPSOriginSolA = Simplify[metricMatterEqnCSSalgeqnPSOriginSolRuleA /. metricMatterODEReducedCSSPSOriginSolRuleNωVtmp];

Compile full solution

Compile the solutions for X and A:

metricMatterODEReducedCSSPSOriginSolRuleNωV = Flatten[Simplify[{metricMatterODEReducedCSSPSOriginSolRuleNωVtmp,metricMatterEqnCSSalgeqnPSOriginSolA}]];
		Clear[metricMatterODEReducedCSSPSOriginSolRuleNωVtmp];

Nice form of the solution

Putting things in a slightly nicer form:

tmp = Collect[metricMatterODEReducedCSSPSOriginSolRuleNωV,(ω^c)[2],Simplify]

Check between both methods

Made this unevaluable

Simplify[(PSUnknownOrigin /. metricMatterODEFullCSSPSOriginSolRuleNAωV) - (PSUnknownOrigin /. metricMatterODEReducedCSSPSOriginSolRuleNωV)]

Power series solution at sonic point

Now, we solve near the sonic boundary. 
We solve the Power Series expansion first for the Full (4 variables) ODEs, then the Reduced (3 variables) ODEs and see if the results match.
Made everything below the Reduced ODEs section non-evaluable this time. Again, results are the same but full system is a bit faster and neater.

Power series ansatz near sonic point: x = (Subscript[x, s]) = 1

The regularity condition and sonic point causes a degeneracy in the 1st order solutions (see below). We therefore solved those “manually”. 
Later, there is no more degeneracy and we can thus automate the solution. We therefore start for the Unknowns at 2nd order.  We will express the solution of the nth order coefficients in terms of the n-1 coefficients afterwards.

PSOrderUnit = 2;
PSAnsatzUnitRule = 
{Ng -> Function[x,Evaluate[Sum[(Ng^s)[n] (x-1)^n,{n,0,PSOrderUnit}]]],
A -> Function[x,Evaluate[Sum[(A^s)[n] (x-1)^n,{n,0,PSOrderUnit}]]],
ω -> Function[x,Evaluate[Sum[(ω^s)[n] (x-1)^n,{n,0,PSOrderUnit}]]],
V -> Function[x,Evaluate[Sum[(V^s)[n] (x-1)^n,{n,0,PSOrderUnit}]]]};
PSUnknownReducedUnit = {Table[(Ng^s)[n],{n,2,PSOrderUnit}],
Table[(ω^s)[n],{n,2,PSOrderUnit}],Table[(V^s)[n],{n,2,PSOrderUnit}]};
PSUnknownFullUnit = {Table[(Ng^s)[n],{n,2,PSOrderUnit}],Table[(A^s)[n],{n,2,PSOrderUnit}],
Table[(ω^s)[n],{n,2,PSOrderUnit}],Table[(V^s)[n],{n,2,PSOrderUnit}]};

Also,we now have a “full” expansion, compared to the one near the origin. We don’t need to expand, say in even powers (which was due to regularity ar origin) because we are “faraway” from it.
The only free parameter should be ρS[0], so it is the only one we wont/cant solve for and all other coefficients will be solved as functions of it. The other 0th order coefficient will be fixed via analyticity condition at x = 1. 
For convenience, we have arranged the unknowns in a matrix. 1st column are the Ng’s, 2nd column the ω’s and 3rd column the V’s.

Full ODEs

We reinforce the sonic boundary to be at x = 1. This corresponds to the “left” (for positive t) (past) “sonic cone”. We then want our fluid to stay to the right of it,  i.e. t > -r  => x < 1. This is good as we want later to match with the solution at r = 0 => x = 0. 
This forces the denominator of ω’ and V’ to vanish.  Regularity implies that we also need the respective numerators to vanish.  We shall view this as conditions on 0th order terms (Ng^s)[0], (ω^s)[0], (A^s)[0]. 
We have 3 equations (both denominators vanish simultaneously),  but we shall see that 1 is redundant, leaves us with, say, (V^s)[0] arbitrary.  Afterwards, we manually solve the 1st order equations (in terms of (V^s)[0]).

Sonic regularity constraint

Set up

We impose the sonic boundary at x = (Subscript[x, s]). This implies that the denominator in ω’ and V’ needs to vanish at that point. Note that in these variables, the sonic point conditions actually do not depend on (Subscript[x, s])! We first extract the relevant parts,

metricMatterEqnFullCSSSolωxNumerator     = Simplify[Numerator[metricMatterEqnFullCSSSolωx]];
		metricMatterEqnFullCSSSolVxNumerator     = Simplify[Numerator[metricMatterEqnFullCSSSolVx]];
		metricMatterEqnFullCSSSolωxDenominator = Simplify[Denominator[metricMatterEqnFullCSSSolωx]];
		metricMatterEqnFullCSSSolVxDenominator = Simplify[Denominator[metricMatterEqnFullCSSSolVx]];

Last one is actually redundant since we see that the denominator of V’ and ω’ are proportional.
			  We evaluate the Numerators/Denominators at x = (Subscript[x, s]), which by definition is really just a change of labelling (only the 0th order coefficients count).

PSSonicAnsatzRule = {Ng -> Function[x,(Ng^s)[0]],A -> Function[x,(A^s)[0]] , ω -> Function[x,(ω^s)[0]], 
						    V -> Function[x,(V^s)[0]], x -> (Subscript[x, s])};
		metricMatterEqnFullCSSSolωxNumeratorSonic      = Simplify[metricMatterEqnFullCSSSolωxNumerator /. PSSonicAnsatzRule];
		metricMatterEqnFullCSSSolVxNumeratorSonic      = Simplify[metricMatterEqnFullCSSSolVxNumerator /. PSSonicAnsatzRule];
		metricMatterEqnFullCSSSolωxDenominatorSonic = Simplify[metricMatterEqnFullCSSSolωxDenominator /. PSSonicAnsatzRule];
		metricMatterEqnFullCSSSolVxDenominatorSonic = Simplify[metricMatterEqnFullCSSSolVxDenominator /. PSSonicAnsatzRule];

Set denominator to 0

We now want to solve for (Ng^s)[0], (A^s)[0], (ω^s)[0], (V^s)[0]. The above form indeed 3 independent equations. We FIRST solve for the denominator, in terms of Ng:

assumptionscsVxsRule = {(Subscript[c, s])>0,-1<(V^s)[0]<1, (Subscript[x, s])>0};
		RegularitySolRuleNgSonicFulltmp = Flatten[Simplify[Solve[metricMatterEqnFullCSSSolωxDenominatorSonic == 0,(Ng^s)[0]],assumptionscsVxsRule]];
		RegularitySolRuleNgSonicFull = RegularitySolRuleNgSonicFulltmp[[2]]
		Clear[RegularitySolRuleNgSonicFulltmp];

We picked the second solution for (Ng^s)[0]. We want positive (ingoing one) since α should be positive from the metric and hence Ng should. 
		We easily see that at fluid rest ((V^s)[0] = 0), only the 2nd solution is indeed positive. On a different way, the first solution would make  (A^s)[0] < 1, which would make the evolution of it decreasing, which is not good, since we want A -> 1 as x -> 0. 
		(See Koike,Hara,Adachi: Renorm. crit. collapse). As a side note, we could have tried solving for V, but this makes the equations much messier later one.

Update numerators

We now plug this back into the Numerators, before solving for them. Note that both expressions agree, up to some none zero factors!

metricMatterEqnFullCSSSolωxNumeratorSonic2 = 
		Simplify[metricMatterEqnFullCSSSolωxNumeratorSonic /. RegularitySolRuleNgSonicFull];
		metricMatterEqnFullCSSSolVxNumeratorSonic2 =
		Simplify[metricMatterEqnFullCSSSolVxNumeratorSonic /. RegularitySolRuleNgSonicFull];

So, it turns out that we have only 1 constraint left. We solve ω.

Set numerator to 0 and define temporary sonic regularity rule

RegularitySolRuleωSonicFull = Flatten[FullSimplify[Solve[metricMatterEqnFullCSSSolωxNumeratorSonic2  == 0,(ω^s)[0]],assumptionscsVxsRule]];
		RegularitySonicRuleFulltmp = {RegularitySolRuleωSonicFull[[2]], RegularitySolRuleNgSonicFull};
		RegularitySolωSonicFull = Factor[(ω^s)[0] /. RegularitySonicRuleFulltmp];

Sanity check

As a sanity check, let us see if the numerators and Denominators indeed vanish:

Simplify[{metricMatterEqnFullCSSSolωxNumerator, metricMatterEqnFullCSSSolVxNumerator,
		metricMatterEqnFullCSSSolωxDenominator, metricMatterEqnFullCSSSolVxDenominator} /. PSSonicAnsatzRule /. RegularitySonicRuleFulltmp]

Use algebraic equation as additional constraint

Now, we fix the value of (A^s)[0] by reinforcing consistency with the algebraic equation:

RegularitySonicSolRuleAωtmp =
		Simplify[Solve[{(metricMatterEqnCSSalgeqn /. PSSonicAnsatzRule /. RegularitySonicRuleFulltmp)  == 0, RegularitySolωSonicFull == (ω^s)[0]},{(A^s)[0],(ω^s)[0]}]];
		RegularitySonicSolRuleAω = RegularitySonicSolRuleAωtmp[[2]]       
		Clear[RegularitySonicSolRuleAωtmp];

Sonic regularity condition

RegularitySonicRuleFull = Flatten[{RegularitySonicSolRuleAω,RegularitySolRuleNgSonicFull}]

Notice that the three coefficients are all non-negative for all (V^s)[0] and (Subscript[c, s]) as it should be!
		From now onwards, we choose (Subscript[x, s])=1 (gauge choice). (Alternatively, we can fix (Ng^s)[0] = 1 (equivalent to α[0] = 1) and keep (Subscript[x, s]) arbitrary). 
		Note that the above implies that -1 < (V^s)[0] < (Subscript[c, s])!

Solution of 1st order coefficients

Check structure of equations

The sonic condition causes the 0th order coefficient for ω’ and V’ to vanish. We therefore check that this is indeed the case.
		This means that on solving the PS series, the ω’ and V’ equations are 1 “step” ahead, in that they start straight with 1 order.

metricMatterODEFullCSSPSUnitNAωVtmp = 
		Simplify[Series[metricMatterODEFullCSSNAωV /.PSAnsatzUnitRule /. RegularitySonicRuleFull,{x,1,PSOrderUnit}]];
		MatrixPlot[Table[Coefficient[metricMatterODEFullCSSPSUnitNAωVtmp,x-1,n],{n,0,PSOrderUnit+1}]]
		Clear[metricMatterODEFullCSSPSUnitNAωVtmp];

We see that the 0th order equations for ω’ and V’ are gone. This is to be expected since the regularity condition precisely make the 0th order terms of the denominator and numerator to vanish. 
		So, we therefore “start” at 1st order straight away. Now, we need to bring the above structure into the correct form. Intuitively, the Ng’ and A’ equations are “1 step behind” compared to the other equations  (or the other 2 are one step ahead). 
		So, we shall take, say for n=1, the two 0th order equations (Ng’ and A’) and the two ω’ and V’ equations at 1st order, with the same pattern at higher orders. 
		This is anyway obvious, since you should always try to solve the “first” lowest orders of each equation before going to next order. Here, we shall choose to bring the ω’ and V’ equations down, instead of bringing Ng’ equation up.  See notes for more details.

Rescale and separate equations

We make a matrix of type (order,variables). In this case, it would be (order,4).
		First column collects all the equations coming from N’ eqn, 2nd column from A’ , 3rd from ω and 4th from V’.

metricMatterODEFullCSSPSUnitNAωV = Table[Simplify[SeriesCoefficient[{1,1,1/(x-1),1/(x-1)}metricMatterODEFullCSSNAωV 
	/.PSAnsatzUnitRule /. RegularitySonicRuleFull,{x,1,n}]],{n,0,PSOrderUnit-1}]

Because of the (3-fold) degeneracy of V, we will explicitly split the components and also solve the equations individually at 1st order.

metricMatterODEFullCSSPSUnitN = metricMatterODEFullCSSPSUnitNAωV[[1;;All,1]];
		 metricMatterODEFullCSSPSUnitA = metricMatterODEFullCSSPSUnitNAωV[[1;;All,2]];
		metricMatterODEFullCSSPSUnitω =  metricMatterODEFullCSSPSUnitNAωV[[1;;All,3]];
		metricMatterODEFullCSSPSUnitV =  metricMatterODEFullCSSPSUnitNAωV[[1;;All,4]];

Solve for metric fields

We can solve for linear order of N and A separately. For the rest of this section, we will ONLY consider the 0th order equation (encoding the linear terms of the variables).
		This corresponds to the first element of each of the above.

metricMatterODEFullCSSPSUnitSolRuleN1 = Flatten[FullSimplify[Solve[metricMatterODEFullCSSPSUnitN[[1]] == 0,(Ng^s)[1]]]]
		metricMatterODEFullCSSPSUnitSolRuleA1 = Flatten[FullSimplify[Solve[metricMatterODEFullCSSPSUnitA[[1]] == 0,(A^s)[1]]]]

Update ω’ and V’ equations and solve ω’ equation

assumptionsRulecsV = {(Subscript[c, s])>0,-1<(V^s)[0]<(Subscript[c, s])};
		metricMatterODEFullCSSPSUnitSolω1Update = Simplify[metricMatterODEFullCSSPSUnitω[[1]] /. metricMatterODEFullCSSPSUnitSolRuleN1 /. metricMatterODEFullCSSPSUnitSolRuleA1];	
		metricMatterODEFullPSUnitSolV1Update =Simplify[metricMatterODEFullCSSPSUnitV[[1]] /. metricMatterODEFullCSSPSUnitSolRuleN1 /. metricMatterODEFullCSSPSUnitSolRuleA1];
		 metricMatterODEFullCSSPSUnitSolRuleω1tmp = Flatten[FullSimplify[Solve[metricMatterODEFullCSSPSUnitSolω1Update == 0,(ω^s)[1]],assumptionsRulecsV]]

Update V' equation and solve it

Update V equation (0th order) and solve for (Subscript[V, S])[1]:

metricMatterODEFullCSSPSUnitSolV1Update2 = Simplify[metricMatterODEFullPSUnitSolV1Update /.  metricMatterODEFullCSSPSUnitSolRuleω1tmp];
		metricMatterODEFullCSSPSUnitSolRuleV1 = FullSimplify[Solve[metricMatterODEFullCSSPSUnitSolV1Update2 == 0,(V^s)[1]],assumptionsRulecsV]

Plot degeneracy of V

Plot[{(V^s)[1] /. metricMatterODEFullCSSPSUnitSolRuleV1[[1]] /. (Subscript[c, s]) -> 1/Sqrt[3],
			(V^s)[1] /. metricMatterODEFullCSSPSUnitSolRuleV1[[2]] /. (Subscript[c, s]) -> 1/Sqrt[3],
			(V^s)[1] /. metricMatterODEFullCSSPSUnitSolRuleV1[[3]] /. (Subscript[c, s]) -> 1/Sqrt[3]},{(V^s)[0],-1,1},
		PlotLegends-> Placed[{"(Subscript[v, 1, 1]^s)","(Subscript[v, 1, 2]^s)","(Subscript[v, 1, 3]^s)"},{0.7,0.4}], AxesLabel-> {"(Overscript[v, ˇ])","(Subscript[v, 1]^s)"},LabelStyle->{Bold}]

The above shows that the sonic point and regularity condition imply a 3-fold degeneracy in the possible values of (V^s)[1]. We shall refer to them as (Subscript[(V^s)[1], i]), i=1,2,3
		in the future, and similarly for the (ω^s)[1], when we plug-in the values for (V^s)[1]. Note that (V^s)[0] only goes up to (Subscript[c, s]), but we went all the way to 1 for esthetics.

Compile solutions

We compile the 1st order solution (Ng^s)[1], (A^s)[1], (ω^s)[1], (V^s)[1] in terms of 0th order coefficients.

metricMatterODEFullCSSPSUnitSolRuleω1 = Simplify[metricMatterODEFullCSSPSUnitSolRuleω1tmp /. metricMatterODEFullCSSPSUnitSolRuleV1];			   
		metricMatterODEFullCSSPSUnitSolRuleDegeneracy =
		{metricMatterODEFullCSSPSUnitSolRuleN1,metricMatterODEFullCSSPSUnitSolRuleA1,
		metricMatterODEFullCSSPSUnitSolRuleω1,metricMatterODEFullCSSPSUnitSolRuleV1}
		Clear[metricMatterODEFullCSSPSUnitSolRuleω1tmp,metricMatterODEFullCSSPSUnitSolRuleN1,metricMatterODEFullCSSPSUnitSolRuleA1,
			metricMatterODEFullCSSPSUnitSolRuleω1,metricMatterODEFullCSSPSUnitSolRuleV1];

The above is NOT Flattened. The first two elements are rules for (Ng^s)[1] and (A^s)[1] respectively. Third element regroups all 3 possible (ω^s)[1] values and similarly for 4th, which contains all the (V^s)[1].

Solution of 2nd order coefficients

Made the section non evaluable.

To solve for the second order coefficients, we need to solve for the 2nd row of metricMatterODEReducedCSSPSUnitNωV. We have used the regularity condition, but keep the dependence on the linear terms explicit.

metricMatterODEFullCSSPSUnitSolRuleNg2A2ω2V2 = Flatten[Simplify[Solve[Map[# == 0 &, metricMatterODEFullCSSPSUnitNAωV[[2]]],Flatten[PSUnknownFullUnit]]]]

metricMatterODEFullCSSPSUnitSolRuleNg2A2ω2V2 /.  Flatten[Extract[metricMatterODEFullCSSPSUnitSolRuleDegeneracy ,{{1},{2},{3,3},{4,3}}]] /. {(Subscript[V, S])[0] -> 0.4, (Subscript[c, S]) -> 0.5} 
	(*This works if you just do not do any simplification*)

Reduced ODEs

We proceed in a similar fashion here. The main difference concerns the sonic point, where the alg eqn has already been used,  causing to have only 2 indep. eqns (for (Ng^s)[0] and (ω^s)[0]), leaving again (V^s)[0] arbitrary.

Sonic regularity constraint

Set up

We impose the sonic boundary at x = (Subscript[x, s]). This implies that the denominator in ω’ and V’ needs to vanish at that point. 
		Note that in these variables, the sonic point conditions actually do not depend on (Subscript[x, s])!  We first extract the relevant parts:

metricMatterEqnReducedCSSSolωxNumerator      = Simplify[Numerator[metricMatterEqnReducedCSSSolωx]];
		metricMatterEqnReducedCSSSolVxNumerator      = Simplify[Numerator[metricMatterEqnReducedCSSSolVx]];
		metricMatterEqnReducedCSSSolωxDenominator  = Simplify[Denominator[metricMatterEqnReducedCSSSolωx]];
		metricMatterEqnReducedCSSSolVxDenominator  = Simplify[Denominator[metricMatterEqnReducedCSSSolVx]];

Again, both denominators agree up to a multiple. We evaluate the Numerators/Denominators at x = (Subscript[x, s]), which by definition is really just  a change of labelling (only the 0th order coefficients count).

PSSonicAnsatzRule = {Ng -> Function[x,(Ng^s)[0]],A -> Function[x,(A^s)[0]] ,
						    ω -> Function[x,(ω^s)[0]], V -> Function[x,(V^s)[0]], x -> (Subscript[x, s])};
		metricMatterEqnReducedCSSSolωxNumeratorSonic      = Simplify[metricMatterEqnReducedCSSSolωxNumerator /. PSSonicAnsatzRule];
		metricMatterEqnReducedCSSSolVxNumeratorSonic      = Simplify[metricMatterEqnReducedCSSSolVxNumerator /. PSSonicAnsatzRule];
		metricMatterEqnReducedCSSSolωxDenominatorSonic = Simplify[metricMatterEqnReducedCSSSolωxDenominator /. PSSonicAnsatzRule];
		metricMatterEqnReducedCSSSolVxDenominatorSonic = Simplify[metricMatterEqnReducedCSSSolVxDenominator/. PSSonicAnsatzRule];

Set numerator to 0

We now want to solve for (Ng^s)[0], (A^s)[0], (ω^s)[0], (V^s)[0]. The above form indeed 2 independent equations. We FIRST solve for the denominator, in terms of Ng:

assumptionscsVxsRule = {(Subscript[c, s])>0,-1<(V^s)[0]<1, (Subscript[x, s]) > 0};
		RegularitySolRuleNgSonicReducedtmp = Flatten[Simplify[Solve[ metricMatterEqnReducedCSSSolωxDenominatorSonic== 0,(Ng^s)[0]],assumptionscsVxsRule]];
		RegularitySolRuleNgSonicReduced = RegularitySolRuleNgSonicReducedtmp[[2]];
		Clear[RegularitySolRuleNgSonicReducedtmp];

We picked the second solution for (Ng^s)[0]. We want positive (ingoing one) since α should be positive from the metric and hence Ng should. 
		We easily see that at fluid rest ((V^s)[0] = 0), only the 2nd solution is indeed positive. As a side note, we could have tried solving for V, but this makes the equations much messier later one.

Update numerators

We now plug this back into the Numerators, before solving for them. Note that both expressions agree, up to some none zero factors!

metricMatterEqnReducedCSSSolωxNumeratorSonic2 = Simplify[ metricMatterEqnReducedCSSSolωxNumeratorSonic /. RegularitySolRuleNgSonicReduced];
		metricMatterEqnReducedCSSSolVxNumeratorSonic2 = Simplify[ metricMatterEqnReducedCSSSolVxNumeratorSonic /. RegularitySolRuleNgSonicReduced];

Simplify[metricMatterEqnReducedCSSSolωxNumeratorSonic2/metricMatterEqnReducedCSSSolVxNumeratorSonic2]

So, it turns out that we have only 1 constraint left.

Set numerator to 0 and define temporary sonic regularity rule

We solve ω.

RegularitySolRuleωSonicReduced = Flatten[FullSimplify[Solve[metricMatterEqnReducedCSSSolωxNumeratorSonic2  == 0,(ω^s)[0]],assumptionscsVxsRule]];
		RegularitySonicRuleReducedtmp = {RegularitySolRuleωSonicReduced[[2]], RegularitySolRuleNgSonicReduced};
		RegularitySolωSonicReduced = Factor[(ω^s)[0] /. RegularitySonicRuleReducedtmp];       
		Clear[RegularitySolRuleNgSonicReduced]

Sanity check

As a sanity check, let us see if the numerators and Denominators indeed vanish:

Simplify[{metricMatterEqnReducedCSSSolωxNumerator, metricMatterEqnReducedCSSSolVxNumerator,
		metricMatterEqnReducedCSSSolωxDenominator, metricMatterEqnReducedCSSSolVxDenominator} /. PSSonicAnsatzRule /. RegularitySonicRuleReducedtmp]

Use algebraic equation as additional constraint

The alg eqn automatically fixes the value of (A^s)[0] (and all orders). In this case, we require the 0th order to disappear:

metricMatterEqnCSSalgeqnPSSolRuleA0tmp = Simplify[Solve[metricMatterEqnCSSalgeqn == 0 /. PSSonicAnsatzRule /. RegularitySonicRuleReducedtmp ,(A^s)[0]]];
		metricMatterEqnCSSalgeqnPSSolRuleA0 = FullSimplify[metricMatterEqnCSSalgeqnPSSolRuleA0tmp[[2]]]
		Clear[metricMatterEqnCSSalgeqnPSSolRuleA0tmp];

Sonic regularity condition

RegularitySonicRuleReduced = Flatten[{ metricMatterEqnCSSalgeqnPSSolRuleA0,RegularitySonicRuleReducedtmp}] (*This agrees with the Full version above.*)
		Clear[metricMatterEqnReducedCSSSolωxNumeratorSonic,metricMatterEqnReducedCSSSolVxNumeratorSonic,
			  metricMatterEqnReducedCSSSolωxDenominatorSonic,metricMatterEqnReducedCSSSolVxDenominatorSonic,metricMatterEqnCSSalgeqnPSSolRuleA0]

From now onwards, we choose (Subscript[x, s])=1 (gauge choice). (Alternatively, we could fix (Ng^s)[0] = 1 (equivalent to α[0] = 1) and keep (Subscript[x, s]) arbitrary). Note that the above implies that -1 < (V^s)[0] < (Subscript[c, s])!

Solution of 1st order coefficients

Check structure of equations

The sonic condition causes the 0th order coefficient for ω’ and V’ to vanish. We therefore check that this is indeed the case.
		This means that on solving the PS series, the ω’ and V’ equations are 1 “step” ahead, in that they start straight with 1 order.

metricMatterODEReducedCSSPSUnitNωVtmp = Simplify[Series[metricMatterODEReducedCSSNωV /.PSAnsatzUnitRule /. RegularitySonicRuleReduced,{x,1,PSOrderUnit}]];
		MatrixPlot[Table[Coefficient[metricMatterODEReducedCSSPSUnitNωVtmp,x-1,n],{n,0,PSOrderUnit+1}]]
		Clear[metricMatterODEReducedCSSPSUnitNωVtmp];

We see that the 0th order equations for ω’ and V’ are gone. This is to be expected since the regularity condition precisely make the 0th order terms of the denominator and numerator to vanish. So, we therefore “start” at 1st order straight away. 
		Now, we need to bring the above structure into the correct form. Intuitively, the Ng’ equation is “1 step behind” compared  to the other  equations  (or rather the other 2 are one step ahead). So, we shall take, say for n=1, 
		the 0th order equation (Ng’) and the two ω’ and V’ equations at 1st order, with the same pattern at higher orders. Here, we shall choose to bring the ω’ and V’ equations down, instead of bringing Ng’ equation up. See notes for more details.

Rescale and separate equations

Because of the (3-fold) degeneracy of V, we will explicitly split the components and also solve the equations individually at 1st order.

metricMatterODEReducedCSSPSUnitNωV =  Table[Simplify[SeriesCoefficient[{1,1/(x-1),1/(x-1)}metricMatterODEReducedCSSNωV /.
	PSAnsatzUnitRule /. RegularitySonicRuleReduced,{x,1,n}]],{n,0,PSOrderUnit-1}]

metricMatterODEReducedCSSPSUnitN = metricMatterODEReducedCSSPSUnitNωV[[1;;All,1]];
		metricMatterODEReducedCSSPSUnitω = metricMatterODEReducedCSSPSUnitNωV[[1;;All,2]];
		metricMatterODEReducedCSSPSUnitV = metricMatterODEReducedCSSPSUnitNωV[[1;;All,3]];

Solve for metric field N

metricMatterODEReducedCSSPSUnitSolRuleN1 = Flatten[FullSimplify[Solve[metricMatterODEReducedCSSPSUnitN[[1]] == 0 ,(Ng^s)[1]]]]

Update ω’ and V’ equations and solve ω’ equation

assumptionsRulecsV = {(Subscript[c, s])>0,-1<(V^s)[0]<(Subscript[c, s])};
		metricMatterODEReducedCSSPSUnitω1Update = Simplify[metricMatterODEReducedCSSPSUnitω[[1]] /. metricMatterODEReducedCSSPSUnitSolRuleN1];
		metricMatterODEReducedCSSPSUnitV1Update = Simplify[metricMatterODEReducedCSSPSUnitV[[1]] /. metricMatterODEReducedCSSPSUnitSolRuleN1];
		metricMatterODEReducedCSSPSUnitSolRuleω1tmp=Flatten[FullSimplify[Solve[metricMatterODEReducedCSSPSUnitω1Update == 0,(ω^s)[1]],assumptionsRulecsV]]
		Clear[metricMatterODEReducedCSSPSUnitω1Update]

Update V’ equation and solve it

Update V equation and solve for (V^s)[1]:

metricMatterODEReducedCSSPSUnitV1Update2 = Simplify[metricMatterODEReducedCSSPSUnitV1Update /. metricMatterODEReducedCSSPSUnitSolRuleω1tmp];
		metricMatterODEReducedCSSPSUnitSolRuleV1 = FullSimplify[Solve[metricMatterODEReducedCSSPSUnitV1Update2== 0,(V^s)[1]],assumptionsRulecsV]
		Clear[metricMatterODEReducedCSSPSUnitV1Update,metricMatterODEReducedCSSPSUnitV1Update2]

Plot degeneracy of V

Plot[{(V^s)[1] /. metricMatterODEReducedCSSPSUnitSolRuleV1[[1]] /. (Subscript[c, s]) -> 1/Sqrt[3],
			 (V^s)[1] /. metricMatterODEReducedCSSPSUnitSolRuleV1[[2]] /. (Subscript[c, s]) -> 1/Sqrt[3],
			(V^s)[1] /. metricMatterODEReducedCSSPSUnitSolRuleV1[[3]] /. (Subscript[c, s]) -> 1/Sqrt[3]},{(V^s)[0],-1,1},
		PlotLegends-> Placed[{"(V^s)[1]_1","(V^s)[1]_2","(V^s)[1]_3"},{0.7,0.4}], AxesLabel-> {"(V^s)[0]","(V^s)[1]"},LabelStyle->{Bold}]

(A^s)[1] calculation from algebraic equation

We shall find (A^s)[1] using two different methods. Because of the 3-fold degeneracy in (V^s)[1], we obtain 3 possible values fro (A^s)[1]. Recall that for the Full ODE, we obtain a single value for (A^s)[1], regardless of the degeneracy of (V^s)[1].

By differentiation of the algebraic equation

metricMatterEqnCSSalgeqnxSolRuleAxtmp = Simplify[Flatten[Solve[D[metricMatterEqnCSSalgeqn,x] == 0,A'[x]]]];
			PSAnsatzUnitTo1Order1 = {A'[x] -> (A^s)[1],Ng'[x] -> (Ng^s)[1],ω'[x] -> (ω^s)[1],V'[x] -> (V^s)[1]}; (*True to 1st order*)
			PSAnsatzUnitTo1Order2 = {A[x] -> (A^s)[0],Ng[x] -> (Ng^s)[0],ω[x] -> (ω^s)[0],V[x] -> (V^s)[0]};
			metricMatterEqnCSSalgeqnxSolRuleAxtmp2 = metricMatterEqnCSSalgeqnxSolRuleAxtmp /. PSAnsatzUnitTo1Order1 /. PSAnsatzUnitTo1Order2;
			metricMatterEqnCSSalgeqnxSolRuleA1 = Simplify[metricMatterEqnCSSalgeqnxSolRuleAxtmp2 /. RegularitySonicRuleFull /.
			metricMatterODEReducedCSSPSUnitSolRuleN1 /. metricMatterODEReducedCSSPSUnitSolRuleω1tmp /. metricMatterODEReducedCSSPSUnitSolRuleV1]
			Clear[metricMatterEqnCSSalgeqnxSolRuleAxtmp,metricMatterEqnCSSalgeqnxSolRuleAxtmp2];

By expanding  the algebraic equation to 1st order

metricMatterEqnCSSPSUnitalgeqn = Series[metricMatterEqnCSSalgeqn /. PSAnsatzUnitRule,{x,1,PSOrderUnit}];
			metricMatterEqnCSSalgeqnxSolRuleAltA1tmp = Simplify[Flatten[Solve[Coefficient[metricMatterEqnCSSPSUnitalgeqn,x-1,1] == 0,(A^s)[1]]]];
			metricMatterEqnCSSalgeqnxSolRuleAltA1 = Simplify[metricMatterEqnCSSalgeqnxSolRuleAltA1tmp /. RegularitySonicRuleReduced /.
			metricMatterODEReducedCSSPSUnitSolRuleN1 /. metricMatterODEReducedCSSPSUnitSolRuleω1tmp /. metricMatterODEReducedCSSPSUnitSolRuleV1]
			Clear[metricMatterEqnCSSalgeqnxSolRuleAltA1tmp];

Consistency check between both method

Simplify[((A^s)[1] /. metricMatterEqnCSSalgeqnxSolRuleA1) - ((A^s)[1] /. metricMatterEqnCSSalgeqnxSolRuleAltA1)]

Both methods agree. Note that the last two values coincide with the value of (A^s)[1] obtained from the A’ equation. This is NOT the case for the first value of course.

Compile solutions

We compile the 1st order solution rules, for each possible (V^s)[1]:

metricMatterODEReducedCSSPSUnitSolRuleω1 = Simplify[metricMatterODEReducedCSSPSUnitSolRuleω1tmp /. metricMatterODEReducedCSSPSUnitSolRuleV1]; (*NOT Flattened*)
		Clear[ metricMatterODEReducedCSSPSUnitSolRuleω1tmp];			   
		metricMatterODEReducedCSSPSUnitSolRuleDegeneracy = {metricMatterODEReducedCSSPSUnitSolRuleN1,metricMatterEqnCSSalgeqnxSolRuleA1,
		metricMatterODEReducedCSSPSUnitSolRuleω1,metricMatterODEReducedCSSPSUnitSolRuleV1} ;(*FullSimplify does not do a better job. Also, we do not Flatten*)
		Clear[metricMatterODEReducedCSSPSUnitSolRuleN1,metricMatterEqnCSSalgeqnxSolRuleA1,metricMatterODEReducedCSSPSUnitSolRuleω1,metricMatterODEReducedCSSPSUnitSolRuleV1]

First element is the rule for (Ng^s)[1]. Second element regroups all the (three) rules for (A^s)[1]. Similarly for the Third and Fourth elements, regrouping the rules for (ω^s)[1] and (V^s)[1] respectively.

Solution of 2nd order coefficients

This section is made non evaluable because calculations are long and the result coincides with the full system, up to computational errors of less than 10^(-10) for the (A^s)[2] expression.
	To solve for the second order coefficients, we need to solve for the 2nd row of metricMatterODEReducedCSSPSUnitNωV. We have used the regularity condition, but keep the dependence on the linear terms explicit.

metricMatterODEReducedCSSPSUnitSolRuleNg2ω2V2 = Flatten[Simplify[Solve[Map[# == 0 &, metricMatterODEReducedCSSPSUnitNωV[[2]]],Flatten[PSUnknownReducedUnit]]]]

metricMatterODEReducedCSSPSUnitSolRuleNg2ω2V2 /.  Flatten[Extract[metricMatterODEReducedCSSPSUnitSolRuleDegeneracy ,{{1},{3,3},{4,3}}]] /. {(Subscript[V, S])[0] -> 0.4, (Subscript[c, S]) -> 0.5}
	(*This works if you just do not do any simplification*)

We check that this agrees with the expression obtained via the full system:

Simplify[({Ng[x],ω[x],V[x]} /. metricMatterODEFullCSSPSUnitSolRuleNg2A2ω2V2) -  ({Ng[x],ω[x],V[x]} /. metricMatterODEReducedCSSPSUnitSolRuleNg2ω2V2)]

We now find corresponding term for A(x) via the algebraic equation:

(A^s)[2] calculation from algebraic equation

We shall find (A^s)[2] using two different methods. We keep the dependence on the linear terms explicit.

By differentiation of the algebraic equation

Note the factor 2 in the substitution below because of the discrepancy in our definition of the power series and taylor expansion.

metricMatterEqnCSSalgeqnx2tmp = D[metricMatterEqnCSSalgeqn,{x,2}];
			metricMatterEqnCSSalgeqnx2SolRuleAx2tmp = Simplify[Flatten[Solve[metricMatterEqnCSSalgeqnx2tmp == 0/.PSAnsatzUnitTo2Order1 /. PSAnsatzUnitTo2Order2 /. PSAnsatzUnitTo2Order3,(Subscript[A, S])[2]]]];

metricMatterEqnCSSPSUnitalgeqntmp = SeriesCoefficient[metricMatterEqnCSSalgeqn /. PSAnsatzUnitRule,{x,1,2}];
			metricMatterEqnCSSalgeqnx2SolRuleAltA2tmp = Simplify[Flatten[Solve[metricMatterEqnCSSPSUnitalgeqntmp == 0,(Subscript[A, S])[2]]]];

metricMatterEqnCSSalgeqnx2tmp = D[metricMatterEqnCSSalgeqn,{x,2}];
			PSAnsatzUnitTo2Order1 = {A''[x] -> 2 (Subscript[A, S])[2],Ng''[x] -> 2 (Subscript[Ng, S])[2],ω''[x] -> 2 (Subscript[ω, S])[2],V''[x] -> 2 (Subscript[V, S])[2]}; (*True to 2nd order*)
			PSAnsatzUnitTo2Order2 = {A'[x] -> (Subscript[A, S])[1],Ng'[x] -> (Subscript[Ng, S])[1],ω'[x] -> (Subscript[ω, S])[1],V'[x] -> (Subscript[V, S])[1]}; 
			PSAnsatzUnitTo2Order3 = {A[x] -> (Subscript[A, S])[0],Ng[x] -> (Subscript[Ng, S])[0],ω[x] -> (Subscript[ω, S])[0],V[x] -> (Subscript[V, S])[0]};
			metricMatterEqnCSSalgeqnx2SolRuleAx2tmp = Simplify[Flatten[Solve[metricMatterEqnCSSalgeqnx2tmp == 0/.
		PSAnsatzUnitTo2Order1 /. PSAnsatzUnitTo2Order2 /. PSAnsatzUnitTo2Order3,(Subscript[A, S])[2]]]];
			metricMatterEqnCSSalgeqnx2SolRuleA2 = Simplify[metricMatterEqnCSSalgeqnx2SolRuleAx2tmp /. RegularitySonicRuleReduced/.metricMatterODEReducedCSSPSUnitSolRuleNg2ω2V2]
			Clear[metricMatterEqnCSSalgeqnx2tmp];

By expanding  the algebraic equation to 2nd order

metricMatterEqnCSSPSUnitalgeqntmp = SeriesCoefficient[metricMatterEqnCSSalgeqn /. PSAnsatzUnitRule,{x,1,2}];
			metricMatterEqnCSSalgeqnx2SolRuleAltA2tmp = Simplify[Flatten[Solve[metricMatterEqnCSSPSUnitalgeqntmp == 0,(Subscript[A, S])[2]]]];
			metricMatterEqnCSSalgeqnx2SolRuleAltA2 = Simplify[metricMatterEqnCSSalgeqnx2SolRuleAltA2tmp /.
			RegularitySonicRuleReduced /. metricMatterODEReducedCSSPSUnitSolRuleNg2ω2V2]
			Clear[metricMatterEqnCSSPSUnitalgeqntmp,metricMatterEqnCSSalgeqnx2SolRuleAltA2tmp];

One checks that they are the same, by comparing them before we substitute in the coefficients:

Simplify[((Subscript[A, S])[2] /. metricMatterEqnCSSalgeqnx2SolRuleAx2tmp) - ((Subscript[A, S])[2] /. metricMatterEqnCSSalgeqnx2SolRuleAltA2tmp)]
		Clear[metricMatterEqnCSSalgeqnx2SolRuleAx2tmp,metricMatterEqnCSSalgeqnx2SolRuleAltA2tmp]

After the substitution, there is a difference due to computational errors, and one cannot evaluate it in general since the answer is too big.
		Instead, we can plug in different values for our parameters an check if they agree. The error term is at most of the scale ~ 10^(-10).

Simplify[((Subscript[A, S])[2] /. metricMatterEqnCSSalgeqnx2SolRuleA2) - ((Subscript[A, S])[2] /. metricMatterEqnCSSalgeqnx2SolRuleAltA2) /.  
		Flatten[Extract[metricMatterODEReducedCSSPSUnitSolRuleDegeneracy ,{{1},{2},{3,2},{4,2}}]] /. {(Subscript[V, S])[0] -> 0.6, (Subscript[c, S]) -> 0.7}]

Anyway we  check that it agrees with the (A^s)[2] expression from the full system

Simplify[(Subscript[A, S])[2] /. metricMatterEqnCSSalgeqnx2SolRuleA2 /. Flatten[Extract[metricMatterODEReducedCSSPSUnitSolRuleDegeneracy ,{{1},{2,3},{3,3},{4,3}}]] /. {(Subscript[V, S])[0] -> 0.4, (Subscript[c, S]) -> 0.5}]

For the value of the second order term (and in fact all higher order terms), we will pick the one obtained from the full system, which is much better!

Consistency check of 1st order solution b/w Full and Reduced

Unevaluable.
We check the expressions for (Ng^s)[1], (A^s)[1], (ω^s)[1] and (A^s)[1] between the Full and Reduced approach.

Simplify[((Ng^s)[1]/. metricMatterODEFullCSSPSUnitSolRuleDegeneracy[[1]]) - ((Ng^s)[1]/. metricMatterODEReducedCSSPSUnitSolRuleDegeneracy[[1]])]
Simplify[((A^s)[1]/. metricMatterODEFullCSSPSUnitSolRuleDegeneracy[[2]]) - ((A^s)[1]/. metricMatterODEReducedCSSPSUnitSolRuleDegeneracy[[2]])]
Simplify[((ω^s)[1]/. metricMatterODEFullCSSPSUnitSolRuleDegeneracy[[3]]) - ((ω^s)[1]/. metricMatterODEReducedCSSPSUnitSolRuleDegeneracy[[3]])]
Simplify[((V^s)[1]/. metricMatterODEFullCSSPSUnitSolRuleDegeneracy[[4]]) - ((V^s)[1]/. metricMatterODEReducedCSSPSUnitSolRuleDegeneracy[[4]])]

We note that, as previously mentioned, the (Ng^s)[1] and (V^s)[1] agree. Concerning (ω^s)[1] and (A^s)[1], they only agree for the last two values of (V^s)[1]. Note that this means that (Subscript[(V^s)[1], 1]) is then not admissible.
Indeed, the fact that the mass term ((A^s)[1]) does not agree, 
means that at least one of them (in fact the one coming from the Full eqn) will not be consistent with the alg eqn. Indeed note that the Full eqns only provide a single possible value for (A^s)[1]. 
This value (see above) coincide will the value we get for (A^s)[1] from the Reduced system, except for (Subscript[(V^s)[1], 1]). Since by construction, the (A^s)[1] in the Reduced system is obtained by making the algebraic eqn to
explicitly vanish at 1st order, this means that the expression for (A^s)[1] from the Full system will NOT   be consistent with the alg eqn in the case of (Subscript[(V^s)[1], 1]). All this points towards concluding that (Subscript[(V^s)[1], 1]) is not an
admissible solution. The (Subscript[(V^s)[1], 1]) solution is also special in that it SEPARATELY satisfies the LHS and RHS of the V’ equation. See notes for more details.

Analysis of the (Subscript[(V^s)[1], 2]) and (Subscript[(V^s)[1], 3]) solutions

Unevaluable. This will also need the full system solution.
To find which of the remaining two (Subscript[VS[1], i]) is the most relevant, we shall investigate the causal structure of a point near x=1. If we denote by (S^a) the tangent vector at the sonic point, 
one can calculate the ratio (Subscript[S, R]) = (S^x)/(S^τ) as a function of x and X, A. Note that the sonic condition occurs at (Subscript[S, R]) = 0. Below, we worked out (see notes) the equation for (Subscript[S, R]).

SonicConeEqntmp = Simplify[α[τ,x]^2/((Subscript[S, R])-x)^2+a[τ,x]^2 V[τ,x]^2-2a[τ,x] α[τ,x] V[τ,x]/((Subscript[S, R])-x) - (α[τ,x]^2/((Subscript[S, R])-x)^2 - a[τ,x]^2) (1-V[τ,x]^2)/(1-(Subscript[c, s])^2)];
(SonicConeEqnCSS = Simplify[Factor[SonicConeEqntmp /. COVaαρToNgAωRule /. {Ng[τ,x]->Ng[x],V[τ,x] -> V[x]}]]) /.pp
Clear[SonicConeEqntmp];

Notice that as expected (Subscript[S, R]) = 0 corresponds to the sonic condition. We now solve for (Subscript[S, R]).

SonicConeEqnCSSSolRuleStmp = Simplify[Solve[SonicConeEqnCSS == 0,(Subscript[S, R])]]

The 2 solutions corresponds to the 2 (future) directed sonic-cones. For our purposes, we need to pick the”left” light cone. This is because we wish to find which of the VS[0] is the correct solution, and for the left sonic-cone,  we need (Subscript[S, R])' > 0 at x = 1 (see notes). 
Indeed, we have that for the “left” cone: ((SubMinus[S])^x) = 0 at the sonic point, negative before and positive after. The right sonic-cone always has ((SubPlus[S])^x) > 0 for all x.  For V = 0, the world-line of the fluid is just a straight vertical line.This is because V=0 corresponds 
in the initial variables to W = 1 (∝ (U^t)) and U = 0 (∝ (U^r)). I.e. corresponds to moving along time direction. Anyway, the fact that V = 0 is a straight line means that we restrict the allowed movements to this line. 
This line is good though to check (Subscript[S, R]) as there are points on that line that have x < 1 and x > 1.

SonicConeEqnCSSSolRuleStmp /. V[x] -> 0 /. pp

The 2nd solution is always positive, characterising ((SubPlus[S])^x), while the first can be + or -. In particular, one can solve for (Subscript[S, R]) = 0, to get the sonic point condition.

SonicConeEqnCSSSolRuleS= SonicConeEqnCSSSolRuleStmp[[1]];
SonicConeEqnCSSSolS = (Subscript[S, R]) /. SonicConeEqnCSSSolRuleS
Clear[SonicConeEqnCSSSolRuleStmp];

We now wish to find which values of (Subscript[(V^s)[1], i]) does (SubMinus[((Subscript[S, R])')]) > 0. We therefore differentiate the above. Then, to linear order, X -> (Subscript[X, 0]) and X’ -> (Subscript[X, 1]), etc.

PSAnsatzUnitTo1Order1 = {A'[x] -> (A^s)[1],Ng'[x] -> (Ng^s)[1],ω'[x] -> (ω^s)[1],V'[x] -> (V^s)[1]}; (*True to 1st order*)
PSAnsatzUnitTo1Order2 = {A[x] -> (A^s)[0],Ng[x] -> (Ng^s)[0],ω[x] -> (ω^s)[0],V[x] -> (V^s)[0]};
SonicConeEqnCSSSolSxtmp = Simplify[D[SonicConeEqnCSSSolS,x]];
SonicConeEqnCSSSolSx = SonicConeEqnCSSSolSxtmp  /. PSAnsatzUnitTo1Order1 /. PSAnsatzUnitTo1Order2 /. x-> 1
Clear[SonicConeEqnCSSSolSxtmp];

We plug in respectively the set ((Ng^s)[1], (A^s)[1],(Subscript[(ω^s)[1], i]),(Subscript[(V^s)[1], i])) for i = 2,3.

SonicConeEqnCSSSolSx2= FullSimplify[SonicConeEqnCSSSolSx/. RegularitySonicRuleFull /. Flatten[Extract[metricMatterODEFullCSSPSUnitSolRuleDegeneracy,{{1},{2},{3,2},{4,2}}]]]
SonicConeEqnCSSSolSx3 = FullSimplify[SonicConeEqnCSSSolSx /. RegularitySonicRuleFull /. Flatten[Extract[metricMatterODEFullCSSPSUnitSolRuleDegeneracy,{{1},{2},{3,3},{4,3}}]]]

First notice that we get a restriction on the allowed values for (V^s)[0].  The value inside the square note is not always non-negative! This already comes from the two (V^s)[1] solutions. 
We check for which values of (V^s)[0] both are positive and allowed (real)

Show[RegionPlot[SonicConeEqnCSSSolSx2 > 0 &&  -1<(V^s)[0]<(Subscript[c, s]),{(Subscript[c, s]),0,1},{(V^s)[0],-1,1},FrameLabel-> {"(Sqrt[κ])","(Overscript[v, ˇ])"},RotateLabel->False,PlotPoints->100,  PlotStyle->None,
BoundaryStyle-> {Black,Thickness[0.001]},Mesh -> 13, MeshFunctions->{#1 - #2 &},MeshStyle->Red,AspectRatio->0.8],
RegionPlot[SonicConeEqnCSSSolSx3 > 0 &&  -1<(V^s)[0]<(Subscript[c, s]),{(Subscript[c, s]),0,1},{(V^s)[0],-1,1},FrameLabel-> {"(Sqrt[κ])","(Overscript[v, ˇ])"},RotateLabel->False,PlotPoints->100,  PlotStyle->None,
BoundaryStyle-> {Black,Thickness[0.001]},Mesh -> 20, MeshFunctions->{#1 + #2 &},MeshStyle->Blue]]

This is not conclusive on which solutions are allowed. We might have a preference for (Subscript[(V^s)[0], 3]) since it is always positive (except for unphysical case or when its value becomes complex).
(Subscript[(V^s)[0], 2]) on the other hand seems to have an odd “additional constraint” attached to it. Aka, it is NOT always positive and so is probably unphysical. Nonetheless, a formal reasoning is missing.

Shooting for background fields

Let us proceed to shooting. We consider the reduced system, with the initial condition expansion up to 2nd order: X(ϵ) = X[0]+ϵ X[1]+ϵ^2 X[2] (except for Ng, since it starts at (x^(-1))). We then solve the system with NDSolve up to x = 0.5 with those IC (initial conditions). 
This allows us “to start” away from the degeneracy. The solution formally depends on our arbitrary variables (Ng^c)[-1] and (ω^c)[2]. We will fix it later via FindRoot.
The reason as to why we go up to 2nd order and not first is because up to 1st order and in radiation fluid, the IC, do not depend on (ω^c)[2] (see below)! We will therefore not be able to solve for it later. 
Even for non-radiation fluid, it only occurs in the IC of N(x). However, its contribution is negligible compared to the first term, as it has factor difference of x^2.

Initial conditions and parameters set - up

Set-up

myϵ = 10^(-6);
myc = 1/Sqrt[3];
mycRule = (Subscript[c, s]) -> myc;
myEvaluation = 0.5; (*The point at which we will evaluate the mismatch between the two shootings*)

IC at origin

ICOriginOrder1[N0_,ω0_,ϵ_,cs_] := {(((Ng^c)[-1])/x)+(Ng^c)[1] x ,(ω^c)[2] x^2,(V^c)[1] x} /. metricMatterODEReducedCSSPSOriginSolRuleNωV/. {(Subscript[c, s]) -> cs,x -> ϵ , (Ng^c)[-1] -> N0, (ω^c)[2] -> ω0}

Note that for radiation fluid, the linear term for N is actually 0. It would anyway not make any difference compared to the ~ 0(1/x) term.

IC at sonic point

Now doing the same thing for the x = 1 expansion for both of the (Subscript[(Subscript[V, S])[1], 2]) and (Subscript[(Subscript[V, S])[1], 3]) solution. We will check after the shooting which solution is most appropriate. WE DO NOT go to second order here, but only up to 1st order. 
The reason is that the result changes very little between 1st and 2nd order here (unlike above), although computational times increases noticeably. The values of our variables after FindRoot only differ by less than ~ 10^(-10). 
We wrote the code for it below for reference.

ICUnitOrder1V2[VS_,ϵ_,cs_] := Simplify[{(Ng^s)[0]+(x-1) (Ng^s)[1],(ω^s)[0]+(x-1) (ω^s)[1],(V^s)[0]+(x-1) (V^s)[1]}  /. Flatten[Extract[metricMatterODEFullCSSPSUnitSolRuleDegeneracy ,{{1},{2},{3,2},{4,2}}]] /. 
RegularitySonicRuleFull /.  {(Subscript[c, s]) -> cs,x ->1-ϵ, (V^s)[0] -> VS }]
ICUnitOrder1V3[VS_,ϵ_,cs_] := Simplify[{(Ng^s)[0]+(x-1) (Ng^s)[1],(ω^s)[0]+(x-1) (ω^s)[1],(V^s)[0]+(x-1) (V^s)[1]}  /. Flatten[Extract[metricMatterODEFullCSSPSUnitSolRuleDegeneracy ,{{1},{2},{3,3},{4,3}}]] /. 
RegularitySonicRuleFull /.  {(Subscript[c, s]) -> cs,x ->1-ϵ, (V^s)[0] -> VS }]

2nd order IC

This is in case one wants to go 2nd order accurate. Simply change the corresponding IC in the two RightExpansion’s.

ICUnitOrder2V2[VS_,ϵ_,c_] := Simplify[{(Subscript[Ng, S])[0]+(x-1) (Subscript[Ng, S])[1]+(x-1)^2 (Subscript[Ng, S])[2],(Subscript[ω, S])[0]+(x-1) (Subscript[ω, S])[1]+(x-1)^2 (Subscript[ω, S])[2],(Subscript[V, S])[0]+(x-1) (Subscript[V, S])[1]+(x-1)^2 (Subscript[V, S])[2]} /.
	metricMatterODEFullCSSPSUnitSolRuleNg2A2ω2V2 /. Flatten[Extract[metricMatterODEFullCSSPSUnitSolRuleDegeneracy ,{{1},{2},{3,2},{4,2}}]] /. RegularitySonicRuleFull /. {(Subscript[c, S]) -> c,x ->1-ϵ, (Subscript[V, S])[0] -> VS }]
	ICUnitOrder2V3[VS_,ϵ_,c_] := Simplify[{(Subscript[Ng, S])[0]+(x-1) (Subscript[Ng, S])[1]+(x-1)^2 (Subscript[Ng, S])[2],(Subscript[ω, S])[0]+(x-1) (Subscript[ω, S])[1]+(x-1)^2 (Subscript[ω, S])[2],(Subscript[V, S])[0]+(x-1) (Subscript[V, S])[1]+(x-1)^2 (Subscript[V, S])[2]} /. 
	metricMatterODEFullCSSPSUnitSolRuleNg2A2ω2V2 /. Flatten[Extract[metricMatterODEFullCSSPSUnitSolRuleDegeneracy ,{{1},{2},{3,3},{4,3}}]] /. RegularitySonicRuleFull /. {(Subscript[c, S]) -> c,x -> 1-ϵ, (Subscript[V, S])[0] -> VS }]

Left and right shootings and mismatch resolution

Left expansion shooting, x = 0

Solve the ODE system. The 2nd function has as additional input the evaluation of the solution at a given point. We define both the rule and the corresponding evaluations.

metricMatterODEReducedCSSShootingLeftExpansionRule[evaluation_?NumericQ,N0_?NumericQ,ω0_?NumericQ,ϵ_?NumericQ,cs_?NumericQ] := 
	Flatten[NDSolve[{metricMatterODEReducedCSSNωV[[1]] == 0  /. (Subscript[c, s]) -> cs,metricMatterODEReducedCSSNωV[[2]] == 0 /. (Subscript[c, s]) -> cs, metricMatterODEReducedCSSNωV[[3]] == 0  /. 
(Subscript[c, s]) -> cs, Ng[ϵ] == ICOriginOrder1[N0,ω0,ϵ,cs][[1]], ω[ϵ] == ICOriginOrder1[N0,ω0,ϵ,cs][[2]],V[ϵ] == ICOriginOrder1[N0,ω0,ϵ,cs][[3]]},{Ng,ω,V},{x,ϵ,evaluation}]]
 metricMatterODEReducedCSSShootingLeftExpansion[evaluation_?NumericQ,N0_?NumericQ,ω0_?NumericQ,ϵ_?NumericQ,cs_?NumericQ] := 
	{Ng[evaluation],ω[evaluation],V[evaluation]} /. metricMatterODEReducedCSSShootingLeftExpansionRule[evaluation,N0,ω0,ϵ,cs]

Testing if the above is fine with some arbitrary input. CAREFUL: depending on the input values, NDSolve stops prematurely due to stiffness. Recall also that some values (e.g. of velocity) are not allowed (look at previous analysis above).

leftPlottmp = metricMatterODEReducedCSSShootingLeftExpansionRule[myEvaluation,1,10,myϵ,myc]
metricMatterODEReducedCSSShootingLeftExpansion[myEvaluation, 1,10,myϵ,myc]
Plot[Evaluate[{x Ng[x],ω[x],V[x]} /. leftPlottmp],{x,myϵ,myEvaluation},PlotLegends-> Placed[{"x N(x)","ω(x)","V(x)"},{1,0.5}]]
Clear[leftPlottmp];

Right Expansion Shooting, x = 1

We similarly define the shooting process for both of the degenerate solutions:

metricMatterODEReducedCSSShootingRightExpansionV2Rule[evaluation_?NumericQ,VS_?NumericQ,ϵ_?NumericQ,cs_?NumericQ] := 
	Flatten[NDSolve[{metricMatterODEReducedCSSNωV[[1]] == 0 /. (Subscript[c, s]) -> cs,metricMatterODEReducedCSSNωV[[2]] == 0  /. (Subscript[c, s]) -> cs,metricMatterODEReducedCSSNωV[[3]] == 0  /. 
(Subscript[c, s]) -> cs,Ng[1-ϵ] == ICUnitOrder1V2[VS,ϵ,cs][[1]], ω[1-ϵ] == ICUnitOrder1V2[VS,ϵ,cs][[2]],V[1-ϵ] == ICUnitOrder1V2[VS,ϵ,cs][[3]]},{Ng,ω,V},{x,1-ϵ,evaluation}]]
metricMatterODEReducedCSSShootingRightExpansionV3Rule[evaluation_?NumericQ,VS_?NumericQ,ϵ_?NumericQ,cs_?NumericQ] := 
	Flatten[NDSolve[{metricMatterODEReducedCSSNωV[[1]] == 0 /. (Subscript[c, s]) -> cs,metricMatterODEReducedCSSNωV[[2]] == 0  /. (Subscript[c, s]) -> cs,metricMatterODEReducedCSSNωV[[3]] == 0  /. 
(Subscript[c, s]) -> cs,Ng[1-ϵ] == ICUnitOrder1V3[VS,ϵ,cs][[1]], ω[1-ϵ] == ICUnitOrder1V3[VS,ϵ,cs][[2]],V[1-ϵ] == ICUnitOrder1V3[VS,ϵ,cs][[3]]}, {Ng,ω,V},{x,1-ϵ,evaluation}]]
metricMatterODEReducedCSSShootingRightExpansionV2[evaluation_?NumericQ,VS_?NumericQ,ϵ_?NumericQ,cs_?NumericQ] := 
	{Ng[evaluation],ω[evaluation],V[evaluation]} /. metricMatterODEReducedCSSShootingRightExpansionV2Rule[evaluation,VS,ϵ,cs]
 metricMatterODEReducedCSSShootingRightExpansionV3[evaluation_?NumericQ,VS_?NumericQ,ϵ_?NumericQ,cs_?NumericQ] := 
	{Ng[evaluation],ω[evaluation],V[evaluation]} /. metricMatterODEReducedCSSShootingRightExpansionV3Rule[evaluation,VS,ϵ,cs]

metricMatterODEReducedCSSShootingRightExpansionV2Rule[myEvaluation,0.5,myϵ,myc]
metricMatterODEReducedCSSShootingRightExpansionV3Rule[myEvaluation,0.5,myϵ,myc]
metricMatterODEReducedCSSShootingRightExpansionV2[0.5,0.5,myϵ,myc]
metricMatterODEReducedCSSShootingRightExpansionV3[0.5,0.5,myϵ,myc]

rightPlottmp = metricMatterODEReducedCSSShootingRightExpansionV3Rule[myEvaluation,0.5,myϵ,myc]
Plot[Evaluate[{x Ng[x],ω[x],V[x]} /. rightPlottmp],{x,myEvaluation,1},PlotLegends-> Placed[{"x N(x)","ω(x)","V(x)"},{1,0.5}]]
Clear[rightPlottmp];

Mismatch between the two shootings at evaluation point

Here, we define the mismatch at the “midpoint” and solve for the variables (Ng^c)[-1], (ω^c)[2] and (V^s)[0] so that the mismatch is negligible.
Note that we have 3 variables to solve for and we will get a non-linear system of 3 equation. We denote the above 3 variables as "\"\!\(\n\*SuperscriptBox[\(N\), \(c\)]\)", (ω^c), (V^s)” respectively.

metricMatterODEReducedCSSShootingMismatchV2[evaluation_?NumericQ,N0_?NumericQ,ω0_?NumericQ,VS_?NumericQ, ϵ_?NumericQ,cs_?NumericQ] :=
	metricMatterODEReducedCSSShootingLeftExpansion[evaluation,N0,ω0,ϵ,cs] - metricMatterODEReducedCSSShootingRightExpansionV2[evaluation,VS,ϵ,cs]
metricMatterODEReducedCSSShootingMismatchV3[evaluation_?NumericQ,N0_?NumericQ,ω0_?NumericQ,VS_?NumericQ,ϵ_?NumericQ, cs_?NumericQ] := 
	metricMatterODEReducedCSSShootingLeftExpansion[evaluation,N0,ω0,ϵ,cs] -  metricMatterODEReducedCSSShootingRightExpansionV3[evaluation,VS,ϵ,cs]

For the Shooting, we need starting values. Therefore, we manually do some trial and error until we obtain a low mismatch:

metricMatterODEReducedCSSShootingMismatchV2[myEvaluation,1,1,0.1,myϵ,myc]
metricMatterODEReducedCSSShootingMismatchV3[myEvaluation,1.3,3,0.1,myϵ,myc]

Finally, solving for the variables:

FindRoot[metricMatterODEReducedCSSShootingMismatchV2[myEvaluation,(Ng^c)[-1],(ω^c)[2],(V^s)[0],myϵ,myc], {{(Ng^c)[-1],1},{(ω^c)[2],1},{(V^s)[0],0.1}}]

We see that this does not seem to work. This reinforce the idea that this solution is indeed fallacious. The above has been made unevaluatable as a consequence.

Ngm1ω2V0Rule = FindRoot[metricMatterODEReducedCSSShootingMismatchV3[myEvaluation,(Ng^c)[-1],(ω^c)[2],(V^s)[0],myϵ,myc], {{(Ng^c)[-1],1},{(ω^c)[2],1},{(V^s)[0],0.1}}]

This works and below, we see that the mismatch is very close to 0!

metricMatterODEReducedCSSShootingMismatchV3[myEvaluation,(Ng^c)[-1],(ω^c)[2],(V^s)[0],myϵ,myc] /. Ngm1ω2V0Rule

The above shows that the (Subscript[(V^s)[1], 2]) solution is likely wrong and the 3rd solution is the right one.
Plotting the whole solution (both left and right) now, to see how they match up at x = 0.5. We consider x Ng[x], since Ng[x] blows up at x = 0, making the plot a bit nicer.

myNgm1 = (Ng^c)[-1] /. Ngm1ω2V0Rule;
myω0 = (ω^c)[2] /. Ngm1ω2V0Rule;
myV0 = (V^s)[0] /. Ngm1ω2V0Rule;
plotleft = metricMatterODEReducedCSSShootingLeftExpansionRule[myEvaluation,myNgm1,myω0,myϵ,myc];
plotright = metricMatterODEReducedCSSShootingRightExpansionV3Rule[myEvaluation,myV0,myϵ,myc];
Show[Plot[Evaluate[{x Ng[x],ω[x],V[x]} /. plotleft],{x,0,myEvaluation}],Plot[{x Ng[x],ω[x],V[x]} /. plotright,{x,myEvaluation,1}],PlotRange -> All]

We see that both sides nicely coincide.  Now that we have the “correct” values for our free variables, we shall extend the shooting. The left expansion goes as before from 0 to 0.5 and the right expansion will have initial value.

Full range shooting and solution

Full shooting

Now that we have the values for our variables, we perform the shooting with them on a bigger interval.

Interval of shooting

intervalRight = 1000; (*We will shoot to get a solution on the interval (0,intervalRight). Above we stopped at 1.*)

IC at origin

TrueICOriginOrder1[ϵ_,cs_] := {(((Ng^c)[-1])/x)+(Ng^c)[1] x ,(ω^c)[2] x^2,(V^c)[1] x}  /. metricMatterODEReducedCSSPSOriginSolRuleNωV /. Ngm1ω2V0Rule/. {(Subscript[c, s]) -> cs,x -> ϵ , (Ng^c)[-1] -> N0, (ω^c)[2] -> ω0}

IC at sonic point

TrueICUnitOrder1[ϵ_,cs_] := Simplify[{(Ng^s)[0]+(x-1) (Ng^s)[1],(ω^s)[0]+(x-1) (ω^s)[1],(V^s)[0]+(x-1) (V^s)[1]} /. Flatten[Extract[metricMatterODEFullCSSPSUnitSolRuleDegeneracy ,{{1},{2},{3,3},{4,3}}]]
	/. RegularitySonicRuleFull /. Ngm1ω2V0Rule /.  {(Subscript[c, s]) -> cs,x -> 1-ϵ, (V^s)[0] -> VS }]

Left expansion

TrueMetricMatterODEReducedCSSShootingLeftExpansionRule[ϵ_?NumericQ,cs_?NumericQ] := Flatten[NDSolve[{metricMatterODEReducedCSSNωV[[1]] == 0  /. (Subscript[c, s]) -> cs,metricMatterODEReducedCSSNωV[[2]] == 0 /.(Subscript[c, s]) -> cs,
	 metricMatterODEReducedCSSNωV[[3]] == 0  /. (Subscript[c, s]) -> cs, Ng[ϵ] == TrueICOriginOrder1[ϵ,cs][[1]],  ω[ϵ] == TrueICOriginOrder1[ϵ,cs][[2]], V[ϵ] == TrueICOriginOrder1[ϵ,cs][[3]]},{Ng,ω,V},{x,ϵ,myEvaluation}]]

Right expansion

TrueMetricMatterODEReducedCSSShootingRightExpansionRule[ϵ_?NumericQ,cs_?NumericQ] := Flatten[NDSolve[{metricMatterODEReducedCSSNωV[[1]] == 0 /. (Subscript[c, s]) -> cs,metricMatterODEReducedCSSNωV[[2]] == 0  /. 
	(Subscript[c, s]) -> cs, metricMatterODEReducedCSSNωV[[3]] == 0  /. (Subscript[c, s]) -> cs,Ng[1-ϵ] == TrueICUnitOrder1[ϵ,cs][[1]],
	ω[1-ϵ] == TrueICUnitOrder1[ϵ,cs][[2]], V[1-ϵ] == TrueICUnitOrder1[ϵ,cs][[3]]},{Ng,ω,V},{x,myEvaluation,intervalRight}]]

Full background solution

We can patch together the solution obtained above, to write the the css solutions of our fields, which we will from now on denote as: ((Subscript[Ng, css]),(Subscript[A, css]),(Subscript[ω, css]),(Subscript[V, css])).

We plug in the expansion for the unperturbed terms. We simply use the function obtained from the shooting. Note that left-hand piece is defined only up to the evaluation point, typically it should be 0.5, while the right-hand piece starts from 0.5 up to 1000 typically.

upCoefficientsLeftRule = TrueMetricMatterODEReducedCSSShootingLeftExpansionRule[myϵ,myc] /. {Ng -> (Subscript[Ng, css]),ω -> (Subscript[ω, css]),V -> (Subscript[V, css])};
upCoefficientsRightRule = TrueMetricMatterODEReducedCSSShootingRightExpansionRule[myϵ,myc] /. {Ng -> (Subscript[Ng, css]),ω -> (Subscript[ω, css]),V -> (Subscript[V, css])};

We can use the above to define the unperturbed variables over the full range in one go, as piecewise functions:

IMPORTANT NOTE on the below: the input for the rules DO NOT evaluate the the Interpolating function at said point. It really it just to tell which functions to pick (left or right).
It would have been best if we could define myNgupRule etc to take string input like “left”, “right” and output the obvious from there; but I could not make this work. 
So, to evaluate the lhs, put as input evaluation/2 and for rhs, just plug in 3/2 evaluation. So, we will define those evaluation points below.
NOTE THAT the ≤ actually matters or else evaluation at that point gives 0, which is not true of course! This makes the end result a bit less accurate (typically influences 6th digit of calculation for the free parameters and κ).

myNgupRule[xcoord_?NumericQ, evaluation_?NumericQ] := Piecewise[{{upCoefficientsLeftRule[[1]],0 < xcoord ≤ evaluation}, {upCoefficientsRightRule[[1]],evaluation < xcoord < intervalRight}}];				 
myNgup[xcoord_?NumericQ, evaluation_?NumericQ] :=  (Subscript[Ng, css])[xcoord] /.   myNgupRule[xcoord, evaluation]; 
myωupRule[xcoord_?NumericQ, evaluation_?NumericQ] := Piecewise[{{upCoefficientsLeftRule[[2]],0 < xcoord ≤ evaluation}, {upCoefficientsRightRule[[2]],evaluation < xcoord < intervalRight}}];
myωup[xcoord_?NumericQ, evaluation_?NumericQ] :=  (Subscript[ω, css])[xcoord] /. myωupRule[xcoord, evaluation];
myVupRule[xcoord_?NumericQ, evaluation_?NumericQ] := Piecewise[{{upCoefficientsLeftRule[[3]],0 < xcoord ≤evaluation}, {upCoefficientsRightRule[[3]],evaluation < xcoord < intervalRight}}];
myVup[xcoord_?NumericQ, evaluation_?NumericQ] :=  (Subscript[Ng, css])[xcoord] /. myVupRule[xcoord, evaluation];

Note that the calculate the derivative of a field, one needs to use the rule, NOT the evaluation of the rule! We can also express (Subscript[A, CSS]) in terms of the above, via the algebraic equation.

myAupRule[xcoord_?NumericQ, evaluation_?NumericQ] := (metricMatterEqnCSSalgeqnSolRuleA /. {Ng -> (Subscript[Ng, css]),A -> (Subscript[A, css]), ω -> (Subscript[ω, css]), V -> (Subscript[V, css])}) /. mycRule /. 
myNgupRule[xcoord, evaluation] /.  myωupRule[xcoord, evaluation] /.  myVupRule[xcoord, evaluation];
myAup[xcoord_?NumericQ, evaluation_?NumericQ] := (Subscript[A, css])[xcoord] /. myAupRule[xcoord, evaluation];

We bundle all the background rules together and evaluate it at myEvalaution. NOTE: the LHS does not depend on it anymore. In particular for perturbed case, my may take a different value for myEvaluation.

backgroundFieldsRule[xcoord_?NumericQ] := Flatten[{myNgupRule[xcoord, myEvaluation],myAupRule[xcoord, myEvaluation],myωupRule[xcoord, myEvaluation],myVupRule[xcoord, myEvaluation]}];

leftShootingEval = myEvaluation/2;
rightShootingEval = 3 myEvaluation/2;

NOTE: We emphasize again: for the rules, the argument is only there to decide which piece will be used. IT DOES NOT evaluate at that specific point!! So, to evaluate it for the left, just use as argument evaluation/2 (cannot really use 0 unfortunately).
Otherwise, use, say, 3/4 > 1/2.  The former makes everything directly depend on the evaluation point.  Normally, this just stays at 0.5. So, in principle, we could take some input between 0 and 0.5, but with this, it will always work even if the evaluation point changes.

Background solution plot and literature comparison

Evans and Coleman comparison

We now try to reproduce the exact graph in Evans and Coleman.
In Evans and Coleman, log ξ is the log of base 10. Use formula: ln ξ = 2.3 log ξ. So, we do a change of basis: x = e^(ln x) = e^(b log x), where b = 1/log e, and we call log x the new variable. We will draw all 4 variables.
We also rescale α by a factor 1/6, to make the end result match perfectly. Note that this rescaling is a bit dodgey... The next plot is much better/rigourous.

b = N[1/Log[10,Exp[1]]];
Show[Plot[{Sqrt[(Subscript[A, css])[Exp[b logx]]] /. backgroundFieldsRule[leftShootingEval] ,
	Exp[b logx] (Subscript[Ng, css])[Exp[b logx]] Sqrt[(Subscript[A, css])[Exp[b logx]]]/6 /. backgroundFieldsRule[leftShootingEval] ,   
	 (Subscript[ω, css])[Exp[b logx]]/((Subscript[A, css])[Exp[b logx]])  /. backgroundFieldsRule[leftShootingEval] ,(Subscript[V, css])[Exp[b logx]] /. backgroundFieldsRule[leftShootingEval] },
		 {logx,-1.2,Log[10,myEvaluation]}, PlotLegends-> Placed[{"a(x)","α(x)","4((πR)^2)ρ","v(x)"},{0.8,0.35}], AxesLabel-> {"ln(x)","y"},LabelStyle->{Bold}],
	Plot[{Sqrt[(Subscript[A, css])[Exp[b logx]]] /. backgroundFieldsRule[rightShootingEval],
	 Exp[b logx] (Subscript[Ng, css])[Exp[b logx]] Sqrt[(Subscript[A, css])[Exp[b logx]]]/6 /. backgroundFieldsRule[rightShootingEval],
	  (Subscript[ω, css])[Exp[b logx]]/((Subscript[A, css])[Exp[b logx]]) /. backgroundFieldsRule[rightShootingEval], (Subscript[V, css])[Exp[b logx]] /. backgroundFieldsRule[rightShootingEval]},
		{logx,Log[10,myEvaluation], Log[10,intervalRight]}], PlotRange -> {{-1.2,2},{-0.2,1.5}},AspectRatio -> 2,AxesOrigin -> {-1.2,-0.2}]
Clear[b]

Plot in terms of a, α, ρ (e^(-2τ)), V on linear plot

Recall the gauge freedom t -> ct that we still have. This allows us to arbitrarily rescale α -> α/c so that αdt is functionally the same, say at the origin. Such a change would also rescale ρ (e^(-2τ)) = (t^2)ρ -> (t^2)ρ (c^2).
On the other hand, note that by definition also that V is invariant. Indeed, the denominator is α (dt/(dτ)) and the combination α dt is invariant under a t transformation.
Overall, the relation N = (a/(αx)) stays functional invariant and so does the formula for ω = 4 π (a^2) (x^2) (e^(-2τ))ρ. On the other hand, note that this also causes for all the variables to be re-evaluated at f(x) -> f(x/c).
This is the point of view of active transformation. For example, consider N(x) = (a/(αx)) -> ((ac^2)/(αx)) = (c^2)N(x/c). Then, from inverting, α (x)= xa(x)N(x). Apply transformation, now that we know how each
part transforms, -> α(x/c) = x a(x/c) N(x/c). And now, if we do a change of variable this just reads: α(x) = c x a(x) N(x). This α indeed satisfies α(0)=1. This is the difference between the active ↔ passive
transformation viewpoints.

c = 1/(0.0001 (Subscript[Ng, css])[0.0001] Sqrt[(Subscript[A, css])[0.0001]] /.  backgroundFieldsRule[leftShootingEval]); (*rescale α at the origin so that α(0)=1*)
Show[Plot[{Sqrt[(Subscript[A, css])[x/c]] /. backgroundFieldsRule[leftShootingEval] ,
	x (Subscript[Ng, css])[x/c] Sqrt[(Subscript[A, css])[x/c]] /.  backgroundFieldsRule[leftShootingEval],   
	(Subscript[ω, css])[x/c]/(4 Pi x^2 (Subscript[A, css])[x/c]) /. backgroundFieldsRule[leftShootingEval],(Subscript[V, css])[x/c] /. backgroundFieldsRule[leftShootingEval]}, {x,0.0001,myEvaluation c},
		PlotLegends-> Placed[{"a(x)","α(x)","ρ(x)","V(x)"},{1,0.35}], AxesLabel-> {"x","y(x)"},LabelStyle->{Bold}],
	Plot[{Sqrt[(Subscript[A, css])[x/c]] /.  backgroundFieldsRule[rightShootingEval],
	 x (Subscript[Ng, css])[x/c] Sqrt[(Subscript[A, css])[x/c]] /.  backgroundFieldsRule[rightShootingEval],
	  (Subscript[ω, css])[x/c]/(4 Pi x^2 (Subscript[A, css])[x/c]) /. backgroundFieldsRule[rightShootingEval], (Subscript[V, css])[x/c]  /. backgroundFieldsRule[rightShootingEval]},{x,myEvaluation c, 4}],
		PlotRange -> {{0,2.5},{-0.5,3.5}},AspectRatio -> 1,AxesOrigin -> {0,-0.5}]
Clear[c]

KHA comparison

We reproduce the graph in Koike, Hara, Adachi. Note that the paper is wrong in its plot for ω, as it is not even compatible with the regularity constraint.
Note that we can do a change of coordinate τ -> aτ, which would only affect ω by scaling it. This means that one can scale ω however one likes!  
The meaning of ρ is the same, but via CSS, we essentially do: ρ(τ,x) -> (Subscript[ρ, new])(x)/r^2 and now (Subscript[ρ, new]) is different for different τ.

Show[Plot[{(Subscript[A, css])[Exp[logx]] /.  backgroundFieldsRule[leftShootingEval],
		Log[(Subscript[Ng, css])[Exp[logx]]] /.  backgroundFieldsRule[leftShootingEval],   
		(Subscript[ω, css])[Exp[logx]]/.  backgroundFieldsRule[leftShootingEval],
		(Subscript[V, css])[Exp[logx]] /.  backgroundFieldsRule[leftShootingEval]}, {logx,-7,Log[myEvaluation]}, 
			PlotLegends-> Placed[{"A(x)","ln N(x)","ω(x)","v(x)"},{0.8,0.8}], AxesLabel-> {"ln(x)","y"},LabelStyle->{Bold},AxesOrigin->{-7,-0.5}],
	Graphics[{Dashed,Line[{{0,-0.5},{0,2.5}}]}], Graphics[{Dashed,Line[{{-7,0},{7,0}}]}],
	Plot[{(Subscript[A, css])[Exp[logx]] /.  backgroundFieldsRule[rightShootingEval],
		 Log[(Subscript[Ng, css])[Exp[logx]]]/.  backgroundFieldsRule[rightShootingEval],
		(Subscript[ω, css])[Exp[logx]] /.  backgroundFieldsRule[rightShootingEval],
		(Subscript[V, css])[Exp[logx]] /.  backgroundFieldsRule[rightShootingEval]},{logx,Log[myEvaluation], Log[intervalRight]}], PlotRange -> {All,{-0.5,2.5}},AspectRatio -> 0.93]

Comparison with numerics

dataa117      = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","a_critical_117.txt"}], "Table"];
dataα117      = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","alpha_critical_117.txt"}], "Table"];
dataR2ρ117 = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","r2rhocritical_117.txt"}], "Table"];
datav117      = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","v_critical_117.txt"}], "Table"];
dataa109      = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","a_critical_109.txt"}], "Table"];
dataα109      = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","alpha_critical_109.txt"}], "Table"];
dataR2ρ109 = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","r2rho_critical_109.txt"}], "Table"];
datav109      = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","v_critical_109.txt"}], "Table"];
dataa101      = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","a_critical_101.txt"}], "Table"];
dataα101      = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","alpha_critical_101.txt"}], "Table"];
dataR2ρ101 = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","r2rho_critical_101.txt"}], "Table"];
datav101      = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","v_critical_101.txt"}], "Table"];
dataa093      = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","a_critical_093.txt"}], "Table"];
dataα093      = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","alpha_critical_093.txt"}], "Table"];
dataR2ρ093 = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","r2rho_critical_093.txt"}], "Table"];
datav093      = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","v_critical_093.txt"}], "Table"];

tstar = 1.1719;
myt085 = 0.85000059078769519;
myt093 = 0.93000150851547114;
myt101 = 1.0100003277424465;
myt109 = 1.0900016695384940;
myt117 = 1.1700857263058830;
dataa117modified = dataa117; dataα117modified = dataα117; dataR2ρ117modified = dataR2ρ117; datav117modified = datav117;
Do[dataa117modified[[n,1]] = dataa117[[n,1]]/(tstar-myt117),{n,1,Length[dataa117]}]
Do[dataα117modified[[n,1]] = dataα117[[n,1]]/(tstar-myt117),{n,1,Length[dataα117]}]
Do[dataR2ρ117modified[[n,1]] = dataR2ρ117[[n,1]]/(tstar-myt117),{n,1,Length[dataR2ρ117]}]
Do[datav117modified[[n,1]] = datav117[[n,1]]/(tstar-myt117),{n,1,Length[datav117]}]
dataa109modified = dataa109; dataα109modified = dataα109; dataR2ρ109modified = dataR2ρ109; datav109modified = datav109;
Do[dataa109modified[[n,1]] = dataa109[[n,1]]/(tstar-myt109),{n,1,Length[dataa109]}]
Do[dataα109modified[[n,1]] = dataα109[[n,1]]/(tstar-myt109),{n,1,Length[dataα109]}]
Do[dataR2ρ109modified[[n,1]] = dataR2ρ109[[n,1]]/(tstar-myt109),{n,1,Length[dataR2ρ109]}]
Do[datav109modified[[n,1]] = datav109[[n,1]]/(tstar-myt109),{n,1,Length[datav109]}]
dataa101modified = dataa101; dataα101modified = dataα101; dataR2ρ101modified = dataR2ρ101; datav101modified = datav101;
Do[dataa101modified[[n,1]] = dataa101[[n,1]]/(tstar-myt101),{n,1,Length[dataa101]}]
Do[dataα101modified[[n,1]] = dataα101[[n,1]]/(tstar-myt101),{n,1,Length[dataα101]}]
Do[dataR2ρ101modified[[n,1]] = dataR2ρ101[[n,1]]/(tstar-myt101),{n,1,Length[dataR2ρ101]}]
Do[datav101modified[[n,1]] = datav101[[n,1]]/(tstar-myt101),{n,1,Length[datav101]}]
dataa093modified = dataa093; dataα093modified = dataα093; dataR2ρ093modified = dataR2ρ093; datav093modified = datav093;
Do[dataa093modified[[n,1]] = dataa093[[n,1]]/(tstar-myt093),{n,1,Length[dataa093]}]
Do[dataα093modified[[n,1]] = dataα093[[n,1]]/(tstar-myt093),{n,1,Length[dataα093]}]
Do[dataR2ρ093modified[[n,1]] = dataR2ρ093[[n,1]]/(tstar-myt093),{n,1,Length[dataR2ρ093]}]
Do[datav093modified[[n,1]] = datav093[[n,1]]/(tstar-myt093),{n,1,Length[datav093]}]
scale= (0.000001 (Subscript[Ng, css])[0.000001] Sqrt[(Subscript[A, css])[0.000001]] /.  backgroundFieldsRule[leftShootingEval]);
linethickness = 0.002;
Show[{ListPlot[{dataa117modified,dataa109modified,dataa101modified, dataa093modified}, PlotRange->{{0,4.},{1,1.4}}, Frame->True, Joined->True,
PlotMarkers->{Automatic,4}, FrameLabel->{"x","a"},PlotStyle->{Thickness[linethickness]}],
Plot[{Sqrt[(Subscript[A, css])[scale x]]/.  backgroundFieldsRule[leftShootingEval]}, {x,0,myEvaluation/scale},PlotStyle->{Black,Thickness[linethickness+0.001]}],
Plot[{Sqrt[(Subscript[A, css])[scale x]] /.  backgroundFieldsRule[rightShootingEval]},{x,myEvaluation/scale, 4},PlotStyle->{Black,Thickness[linethickness+0.001]}]}]
Show[{ListPlot[{dataα117modified,dataα109modified,dataα101modified, dataα093modified}, PlotRange->{{0,4.},{1,4.5}}, Frame->True, Joined->True,
PlotMarkers->{Automatic,4}, FrameLabel->{"x","α"},PlotStyle->{Thickness[linethickness]}],
Plot[{scale x (Subscript[Ng, css])[scale x] Sqrt[(Subscript[A, css])[scale x]] / scale /.  backgroundFieldsRule[leftShootingEval]},
{x,0.0001,myEvaluation/scale},PlotStyle->{Black,Thickness[linethickness+0.001]}],
Plot[{scale x (Subscript[Ng, css])[scale x] Sqrt[(Subscript[A, css])[scale x]] / scale /.  
backgroundFieldsRule[rightShootingEval]},{x,myEvaluation/scale, 4},PlotStyle->{Black,Thickness[linethickness+0.001]}]}]
Show[{ListPlot[{dataR2ρ117modified,dataR2ρ109modified,dataR2ρ101modified, dataR2ρ093modified}, PlotRange->{{0,4.},{0,0.03}}, Frame->True,
PlotLegends->Placed[{"numerics, t=1.17","numerics, t=1.09","numerics, t=1.01","numerics, t=0.93"},{0.75,0.73}],
Joined->True, PlotMarkers->{Automatic,4}, FrameLabel->{"","(R^2)ρ"},PlotStyle->{Thickness[linethickness]},
FrameTicksStyle->{{Automatic,Automatic},{Directive[FontOpacity->0,FontSize->0],Automatic}}],
Plot[{(Subscript[ω, css])[scale x]/(4 Pi (Subscript[A, css])[scale x])/.  backgroundFieldsRule[leftShootingEval]}, {x,0.0001,myEvaluation/scale},
PlotStyle->{Black,Thickness[linethickness+0.001]},PlotLegends-> Placed[{"CSS solution"},{0.72,0.455}]],
Plot[{(Subscript[ω, css])[scale x]/(4 Pi (Subscript[A, css])[scale x]) /.  backgroundFieldsRule[rightShootingEval]},{x,myEvaluation/scale, 1},PlotStyle->{Black,Thickness[linethickness+0.001]}],
Plot[{(Subscript[ω, css])[scale x]/(4 Pi (Subscript[A, css])[scale x]) /.  backgroundFieldsRule[rightShootingEval]},{x,1, 4},PlotStyle->{Black,Thickness[linethickness+0.001]}]}]
Show[{ListPlot[{datav117modified,datav109modified,datav101modified, datav093modified}, PlotRange->{{0,4.},{-0.18,0.8}}, Frame->True, FrameLabel->{"","v"},
AxesOrigin -> {0,-0.18},PlotMarkers->{Automatic,4},PlotStyle->{Thickness[linethickness]},
FrameTicksStyle->{{Automatic,Automatic},{Directive[FontOpacity->0,FontSize->0],Automatic}}],
Plot[{(Subscript[V, css])[scale x]/.  backgroundFieldsRule[leftShootingEval]}, {x,0.,myEvaluation/scale},PlotStyle->{Black,Thickness[linethickness+0.001]}],
Plot[{(Subscript[V, css])[scale x] /.  backgroundFieldsRule[rightShootingEval]},{x,myEvaluation/scale, 4},PlotStyle->{Black,Thickness[linethickness+0.001]}]}]

Mathematica -> gnuplot converter

Not evaluable.
The below scripts convert the functions for the background variables by interpolating data points and then writing them in an ascii file, which can then be read and plotted by gnuplot.

a converter

This part is set up and can be edited,

filename = "a_mm.gp";
xmin = 0.0001;
xmax = 2.5;
interpolationpts = 200;

Don’t edit the below, except if you know what you are doing. The options inside NumberForm ensure that the transcription of the corresponding value is faithful (no rounding/scientific notation,etc).

filepath = FileNameJoin[{NotebookDirectory[],filename}];
OpenWrite[filepath];
dx = (xmax-xmin)/interpolationpts;
c = 1/(0.0001 (Subscript[Ng, css])[0.0001] Sqrt[(Subscript[A, css])[0.0001]] /.  backgroundFieldsRule[leftShootingEval]); (*rescale α at the origin so that α(0)=1*)

Do[x = xmin + i dx; If[x < 0.5 c,datainput = StringJoin[ToString[x], "   ",
					StringDelete[ToString[NumberForm[Sqrt[(Subscript[A, css])[x/c]] /. backgroundFieldsRule[leftShootingEval],Infinity,ExponentFunction->(Null&)]],"`"]]; 
						WriteLine[filepath, datainput],
					datainput = StringJoin[ToString[x], "   ",
					StringDelete[ToString[NumberForm[Sqrt[(Subscript[A, css])[x/c]] /. backgroundFieldsRule[rightShootingEval],Infinity,ExponentFunction->(Null&)]],"`"]]; 
						WriteLine[filepath, datainput]], {i,0,interpolationpts}]
Close[filepath]; Clear[filename,xmin,xmax,interpolationpts,filepath,dx,x,datainput, c]

α converter

This part is set up and can be edited,

filename = "alpha_mm.gp";
xmin = 0.0001;
xmax = 2.5;
interpolationpts = 200;

Don’t edit the below, except if you know what you are doing. The options inside NumberForm ensure that the transcription of the corresponding value is faithful (no rounding/scientific notation,etc).

filepath = FileNameJoin[{NotebookDirectory[],filename}];
OpenWrite[filepath];
dx = (xmax-xmin)/interpolationpts;
c = 1/(0.0001 (Subscript[Ng, css])[0.0001] Sqrt[(Subscript[A, css])[0.0001]] /.  backgroundFieldsRule[leftShootingEval]); (*rescale α at the origin so that α(0)=1*)

Do[x = xmin + i dx; If[x < 0.5 c,datainput = StringJoin[ToString[x], "   ",
					StringDelete[ToString[NumberForm[x (Subscript[Ng, css])[x/c] Sqrt[(Subscript[A, css])[x/c]]  /. backgroundFieldsRule[leftShootingEval],
					Infinity,ExponentFunction->(Null&)]],"`"]]; WriteLine[filepath, datainput], (*from there, it is "else" part in if statement*)
					datainput = StringJoin[ToString[x], "   ",
					StringDelete[ToString[NumberForm[x (Subscript[Ng, css])[x/c] Sqrt[(Subscript[A, css])[x/c]]  /. backgroundFieldsRule[rightShootingEval],
					Infinity,ExponentFunction->(Null&)]],"`"]];  WriteLine[filepath, datainput]], {i,0,interpolationpts}]
Close[filepath]; Clear[filename,xmin,xmax,interpolationpts,filepath,dx,x,datainput, c]

ρ converter

This part is set up and can be edited,

filename = "rho_mm.gp";
xmin = 0.0001;
xmax = 2.5;
interpolationpts = 200;

Don’t edit the below, except if you know what you are doing. The options inside NumberForm ensure that the transcription of the corresponding value is faithful (no rounding/scientific notation,etc).

filepath = FileNameJoin[{NotebookDirectory[],filename}];
OpenWrite[filepath];
dx = (xmax-xmin)/interpolationpts;
c = 1/(0.0001 (Subscript[Ng, css])[0.0001] Sqrt[(Subscript[A, css])[0.0001]] /.  backgroundFieldsRule[leftShootingEval]); (*rescale α at the origin so that α(0)=1*)

Do[x = xmin + i dx; If[x < 0.5 c,datainput = StringJoin[ToString[x], "   ",
					StringDelete[ToString[NumberForm[(Subscript[ω, css])[x/c]/(4 Pi x^2 (Subscript[A, css])[x/c]) /. backgroundFieldsRule[leftShootingEval],
					Infinity,ExponentFunction->(Null&)]],"`"]]; WriteLine[filepath, datainput],
					datainput = StringJoin[ToString[x], "   ",
					StringDelete[ToString[NumberForm[(Subscript[ω, css])[x/c]/(4 Pi x^2 (Subscript[A, css])[x/c]) /. backgroundFieldsRule[rightShootingEval],
					Infinity,ExponentFunction->(Null&)]],"`"]]; WriteLine[filepath, datainput]], {i,0,interpolationpts}]
Close[filepath]; Clear[filename,xmin,xmax,interpolationpts,filepath,dx,x,datainput, c]

v converter

This part is set up and can be edited,

filename = "v_mm.gp";
xmin = 0.0001;
xmax = 2.5;
interpolationpts = 200;

Don’t edit the below, except if you know what you are doing. The options inside NumberForm ensure that the transcription of the corresponding value is faithful (no rounding/scientific notation,etc).

filepath = FileNameJoin[{NotebookDirectory[],filename}];
OpenWrite[filepath];
dx = (xmax-xmin)/interpolationpts;
c = 1/(0.0001 (Subscript[Ng, css])[0.0001] Sqrt[(Subscript[A, css])[0.0001]] /.  backgroundFieldsRule[leftShootingEval]); (*rescale α at the origin so that α(0)=1*)

Do[x = xmin + i dx; If[x < 0.5 c,datainput = StringJoin[ToString[x], "   ",
					StringDelete[ToString[NumberForm[(Subscript[V, css])[x/c] /. backgroundFieldsRule[leftShootingEval],
					Infinity,ExponentFunction->(Null&)]],"`"]]; WriteLine[filepath, datainput],
					datainput = StringJoin[ToString[x], "   ",
					StringDelete[ToString[NumberForm[(Subscript[V, css])[x/c] /. backgroundFieldsRule[rightShootingEval],
					Infinity,ExponentFunction->(Null&)]],"`"]]; WriteLine[filepath, datainput]], {i,0,interpolationpts}]
Close[filepath]; Clear[filename,xmin,xmax,interpolationpts,filepath,dx,x,datainput, c]

Linear perturbation

We now proceed to calculate the linear perturbation around the CSS solution. We work closely with the variables in KHA. The linear perturbation term will break CSS. To simplify the calculation, 
we shall introduce a more convenient set of variables: (OverBar[h]) = log(h), where h = (N,A,ω).  We then consider a perturbation: (OverBar[h])(τ,x) = (Subscript[(OverBar[h]), CSS])(x) + ϵ (Subscript[(OverBar[h]), p])(τ,x). Note that, if we want to keep working with the usual variables, as:
h(τ,x) = (Subscript[h, CSS])(x) + ϵ (Subscript[h, p])(τ,x), we then easily find the relation: (Subscript[h, p]) = (Subscript[h, CSS]) (Subscript[(OverBar[h]), p]).

Old attempt

Made everything not evaluable.

PDE system of perturbed variables

Let us calculate the PDE system of the perturbed variables.	So, let us first make the relevant change of variable:

COVNgAωToLogscaleRule = {Ng -> Function[{τ,x},Exp[Ngbar[τ,x]]], A -> Function[{τ,x},Exp[Abar[τ,x]]],
						       ω -> Function[{τ,x},Exp[ωbar[τ,x]]]};
	   metricMatterEqnSolNgbarxtmp = D[Ngbar [τ,x],x] /. Flatten[Simplify[Solve[D[Ng[τ,x],x] - metricMatterEqnSolNgx  == 0 /.
   COVNgAωToLogscaleRule /. γTocsRule,D[Ngbar [τ,x],x]]]];
	   metricMatterEqnSolAbarxtmp   = D[Abar [τ,x],x] /. Flatten[Simplify[Solve[D[A[τ,x],x] - metricMatterEqnSolAx  == 0 /. 
   COVNgAωToLogscaleRule /. γTocsRule,D[Abar [τ,x],x]]]];
	   metricMatterEqnSolAbarτtmp   = D[Abar [τ,x],τ] /. Flatten[Simplify[Solve[D[A[τ,x],τ] - metricMatterEqnSolAτ  == 0 /.
   COVNgAωToLogscaleRule /. γTocsRule,D[Abar [τ,x],τ]]]];
	   metricMatterEqnSolωbarxtmp   = D[ωbar [τ,x],x] /. Flatten[Simplify[Solve[D[ω[τ,x],x] - metricMatterEqnSolωx  == 0 /. 
   COVNgAωToLogscaleRule /. γTocsRule,D[ωbar [τ,x],x]]]];
	   metricMatterEqnSolVxtmp          = metricMatterEqnSolVx /. COVNgAωToLogscaleRule /. γTocsRule ;

We now introduce the perturbations: We extract the linear term by differentiating wrt to ϵ and then setting ϵ = 0.

VariablesNAωVLinearPerturbationRule = 
	   {Ngbar -> Function[{τ,x},(Subscript[Ngbar, CSS])[x]+ϵ (Subscript[Ngbar, p])[τ,x]],Abar -> Function[{τ,x},(Subscript[Abar, CSS])[x]+ϵ (Subscript[Abar, p])[τ,x]],
	   ωbar -> Function[{τ,x},(Subscript[ωbar, CSS])[x]+ϵ (Subscript[ωbar, p])[τ,x]],V -> Function[{τ,x},(Subscript[V, CSS])[x]+ϵ (Subscript[V, p])[τ,x]]};

metricMatterEqnSolNgbarpxtmp = D[metricMatterEqnSolNgbarxtmp /.VariablesNAωVLinearPerturbationRule,ϵ] /. ϵ -> 0;
	   metricMatterEqnSolAbarpxtmp   = D[metricMatterEqnSolAbarxtmp /.VariablesNAωVLinearPerturbationRule,ϵ] /. ϵ -> 0;
	   metricMatterEqnSolAbarpτtmp   = D[metricMatterEqnSolAbarτtmp /.VariablesNAωVLinearPerturbationRule,ϵ] /. ϵ -> 0;
	   metricMatterEqnSolωbarpxtmp   = D[metricMatterEqnSolωbarxtmp /.VariablesNAωVLinearPerturbationRule,ϵ] /. ϵ -> 0;
	   metricMatterEqnSolVpxtmp          = D[metricMatterEqnSolVxtmp /.VariablesNAωVLinearPerturbationRule,ϵ] /. ϵ -> 0;
	   Clear[metricMatterEqnSolNgbarxtmp,metricMatterEqnSolAbarxtmp,metricMatterEqnSolAbarτtmp,
		     metricMatterEqnSolωbarxtmp,metricMatterEqnSolVxtmp]

We can now simplify things by noting that (Subscript[(OverBar[h]), CSS]) = log((Subscript[h, CSS])).

LeadingOrderVariablesSimplificationRule = 
	   {(Subscript[Ngbar, CSS]) -> Function[x,Log[(Subscript[Ng, CSS])[x]]],(Subscript[Abar, CSS]) -> Function[x,Log[(Subscript[A, CSS])[x]]],(Subscript[ωbar, CSS]) -> Function[x,Log[(Subscript[ω, CSS])[x]]]};
	   metricMatterEqnSolNgbarpx = Simplify[metricMatterEqnSolNgbarpxtmp /. LeadingOrderVariablesSimplificationRule];
	   metricMatterEqnSolAbarpx   = Simplify[metricMatterEqnSolAbarpxtmp /. LeadingOrderVariablesSimplificationRule];
	   metricMatterEqnSolAbarpτ   = Simplify[metricMatterEqnSolAbarpτtmp /. LeadingOrderVariablesSimplificationRule];
	   metricMatterEqnSolωbarpx   = Simplify[metricMatterEqnSolωbarpxtmp /. LeadingOrderVariablesSimplificationRule];
	   metricMatterEqnSolVpx          = Simplify[metricMatterEqnSolVpxtmp /. LeadingOrderVariablesSimplificationRule];
	   Clear[metricMatterEqnSolNgbarpxtmp,metricMatterEqnSolAbarpxtmp,
		     metricMatterEqnSolAbarpτtmp,metricMatterEqnSolωbarpxtmp,metricMatterEqnSolVpxtmp]

The above are our system of PDE. Note that as for unperturbed case, both of the (OverBar[A]) equations induces an integrability condition. 
	This should be satisfied, using the above relations (for perturbed) and the unperturbed ones as well.

Check with KHA

(*Un-evaluable*)

We check that the equations obtained are the same as in KHA. We will first define the equations in KHA and 
			substitute in the above expressions of derivatives of (Subscript[(OverBar[h]), p]) and see if we get 0.

asCheck  = 1;
			   bsCheck  = (γ+1) (Subscript[V, CSS])[x]/(1-(Subscript[V, CSS])[x]^2);
			   csCheck  = γ (Subscript[V, CSS])[x];
			   dsCheck  = (γ+1)/(1-(Subscript[V, CSS])[x]^2);
			   axCheck  = 1+(Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x];
			   bxCheck  = (γ+1) ((Subscript[Ng, CSS])[x]+(Subscript[V, CSS])[x])/(1-(Subscript[V, CSS])[x]^2);
			   cxCheck  = γ ((Subscript[Ng, CSS])[x]+(Subscript[V, CSS])[x]);
			   dxCheck  = (γ+1) (1+(Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x])/(1-(Subscript[V, CSS])[x]^2);
			   e1Check  = -(γ+3) (Subscript[A, CSS])[x] (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x]/2;
			   e2Check  = (3-3 γ) (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x]/2-(3+γ) (Subscript[A, CSS])[x] (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x]/2+(1-γ) (Subscript[ω, CSS])[x] (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x] - 
					   (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x] x D[(Subscript[ω, CSS])[x],x]/(Subscript[ω, CSS])[x]- (γ+1) (Subscript[Ng, CSS])[x] x D[(Subscript[V, CSS])[x],x]/(1-(Subscript[V, CSS])[x]^2);
			   e3Check = (1-γ) (Subscript[ω, CSS])[x] (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x];
			   e4Check  = (3-3 γ) (Subscript[Ng, CSS])[x]/2-(3+γ) (Subscript[A, CSS])[x] (Subscript[Ng, CSS])[x]/2 +(1-γ) (Subscript[ω, CSS])[x] (Subscript[Ng, CSS])[x] - (Subscript[Ng, CSS])[x] x D[(Subscript[ω, CSS])[x],x]/(Subscript[ω, CSS])[x]-
					   (γ+1) (1+2 (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x]+(Subscript[V, CSS])[x]^2) x D[(Subscript[V, CSS])[x],x]/ (1-(Subscript[V, CSS])[x]^2)^2;
			   f1Check = -(1+3 γ) (Subscript[A, CSS])[x] (Subscript[Ng, CSS])[x]/2;
			   f2Check = (1-γ) γ (Subscript[ω, CSS])[x] (Subscript[Ng, CSS])[x]+(7 γ +1) (Subscript[Ng, CSS])[x]/2-(1+3 γ) (Subscript[A, CSS])[x] (Subscript[Ng, CSS])[x]/2-γ (Subscript[Ng, CSS])[x] x D[(Subscript[ω, CSS])[x],x]/(Subscript[ω, CSS])[x]-
					   (γ+1) (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x] x D[(Subscript[V, CSS])[x],x]/(1-(Subscript[V, CSS])[x]^2);
			   f3Check = (1-γ) γ (Subscript[ω, CSS])[x] (Subscript[Ng, CSS])[x];
			   f4Check = -γ x D[(Subscript[ω, CSS])[x],x]/(Subscript[ω, CSS])[x] - (γ+1) ((Subscript[Ng, CSS])[x]+2 (Subscript[V, CSS])[x] + (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x]^2) x D[(Subscript[V, CSS])[x],x]/(1-(Subscript[V, CSS])[x]^2)^2;
			   g1Check = -(Subscript[A, CSS])[x];
			   g3Check = 2 (1+γ (Subscript[V, CSS])[x]^2) (Subscript[ω, CSS])[x]/(1-(Subscript[V, CSS])[x]^2);
			   g4Check = 4 (γ+1) (Subscript[ω, CSS])[x] (Subscript[V, CSS])[x]/(1-(Subscript[V, CSS])[x]^2)^2;
			   h1Check =  (Subscript[A, CSS])[x];
			   h3Check = (γ-1)  (Subscript[ω, CSS])[x];

ApeqnCheck = x D[(Subscript[Abar, p])[τ,x],x] - g1Check (Subscript[Abar, p])[τ,x] - g3Check (Subscript[ωbar, p])[τ,x] - g4Check (Subscript[V, p])[τ,x] /. γTocsRule // Simplify;
			   NgpeqnCheck = x D[(Subscript[Ngbar, p])[τ,x],x] - h1Check (Subscript[Abar, p])[τ,x] - h3Check (Subscript[ωbar, p])[τ,x] /. γTocsRule // Simplify;
			   ωpVpeqn1Check = asCheck D[(Subscript[ωbar, p])[τ,x],τ] + bsCheck D[(Subscript[V, p])[τ,x],τ] + axCheck x D[(Subscript[ωbar, p])[τ,x],x] + 
			   bxCheck x D[(Subscript[V, p])[τ,x],x] - e1Check (Subscript[Abar, p])[τ,x] -e2Check (Subscript[Ngbar, p])[τ,x]- e3Check (Subscript[ωbar, p])[τ,x] - e4Check (Subscript[V, p])[τ,x] /. 
			      γTocsRule // Simplify;
			   ωpVpeqn2Check = csCheck D[(Subscript[ωbar, p])[τ,x],τ] + dsCheck D[(Subscript[V, p])[τ,x],τ] + cxCheck x D[(Subscript[ωbar, p])[τ,x],x] + 
			   dxCheck x D[(Subscript[V, p])[τ,x],x] - f1Check (Subscript[Abar, p])[τ,x] -f2Check (Subscript[Ngbar, p])[τ,x]- f3Check (Subscript[ωbar, p])[τ,x] - f4Check (Subscript[V, p])[τ,x] /. 
			      γTocsRule // Simplify;
			   algeqnCheck = D[(Subscript[Abar, p])[τ,x],τ] + x D[(Subscript[Abar, p])[τ,x],x] +
			   2 (γ+1) (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x] (Subscript[ω, CSS])[x] ((Subscript[Ngbar, p])[τ,x]+(Subscript[ωbar, p])[τ,x])/(1-(Subscript[V, CSS])[x]^2) +
			   2 (γ+1) (Subscript[Ng, CSS])[x] (Subscript[ω, CSS])[x] (1+(Subscript[V, CSS])[x]^2)(Subscript[V, p])[τ,x]/(1-(Subscript[V, CSS])[x]^2)^2 /. γTocsRule // Simplify;

We check the N, A and “algeqn” equations:

Simplify[NgpeqnCheck /. D[(Subscript[Ngbar, p])[τ,x],x] -> Evaluate[metricMatterEqnSolNgbarpx]]
			   Simplify[ApeqnCheck /. D[(Subscript[Abar, p])[τ,x],x] -> Evaluate[metricMatterEqnSolAbarpx]]
			   Simplify[algeqnCheck /. {D[(Subscript[Abar, p])[τ,x],τ] -> Evaluate[metricMatterEqnSolAbarpτ],
				     D[(Subscript[Abar, p])[τ,x],x] -> Evaluate[metricMatterEqnSolAbarpx]}]

For ω and V, things are a bit more complicated. KHA equations were not solved for (Subscript[ω, x]) or (Subscript[V, x]) and were thus of the form: h*f = g. 
			In our case, we have it like: f = g/h. If we expand it both systems and check the linear order, they differ by: ((Subscript[g, 0])/(Subscript[h, 0])-(Subscript[f, 0]))(Subscript[h, 1]), which is zero, but only if we assume that 
			the leading order term equation is reinforced. In our case, the “f” is for the x-derivative of (Subscript[(OverBar[ω]), p]) and (Subscript[(OverBar[V]), p]) respectively and we see in KHA that “h” is only dependent 
			on N and V. So, we will also have to reinforce the leading order equation here.o much for him

metricMatterEqnFullCSSSolωxCheck = 
			   metricMatterEqnFullCSSSolωx /. {A[x] -> (Subscript[A, CSS])[x],Ng[x] -> (Subscript[Ng, CSS])[x],V[x] -> (Subscript[V, CSS])[x],ω[x] -> (Subscript[ω, CSS])[x]};
			   metricMatterEqnFullCSSSolVxCheck = metricMatterEqnFullCSSSolVx /. 
			{A[x] -> (Subscript[A, CSS])[x],Ng[x] -> (Subscript[Ng, CSS])[x],V[x] -> (Subscript[V, CSS])[x],ω[x] -> (Subscript[ω, CSS])[x]};
			   ωxRuleCheck = D[(Subscript[ω, CSS])[x],x] -> Evaluate[metricMatterEqnFullCSSSolωxCheck];
			   VxRuleCheck = D[(Subscript[V, CSS])[x],x] -> Evaluate[metricMatterEqnFullCSSSolVxCheck];

Simplify[ωpVpeqn1Check /. {D[(Subscript[ωbar, p])[τ,x],x] -> Evaluate[metricMatterEqnSolωbarpx], 
				        D[(Subscript[V, p])[τ,x],x] -> Evaluate[metricMatterEqnSolVpx], ωxRuleCheck, VxRuleCheck}]
			   Simplify[ωpVpeqn2Check /. {D[(Subscript[ωbar, p])[τ,x],x] -> Evaluate[metricMatterEqnSolωbarpx], 
				        D[(Subscript[V, p])[τ,x],x] -> Evaluate[metricMatterEqnSolVpx], ωxRuleCheck, VxRuleCheck}]

ODE system for Eigenmodes solutions

We shall now look for eigenmodes solutions: (Subscript[h, p])(τ,x) = (Subscript[h, p])(x) (e^(κτ)). Where κ is given in KHA to be approx 2.81.

VariablesNpApωpVpEMRule = {(Subscript[Ngbar, p]) -> Function[{τ,x},((Subscript[Ngbar, p])^EM)[x] Exp[κ τ]],(Subscript[Abar, p]) -> Function[{τ,x},((Subscript[Abar, p])^EM)[x] Exp[κ τ]],
							   (Subscript[ωbar, p]) -> Function[{τ,x},((Subscript[ωbar, p])^EM)[x] Exp[κ τ]],(Subscript[V, p]) -> Function[{τ,x},((Subscript[V, p])^EM)[x] Exp[κ τ]]};
	   metricMatterEqnSolNgbarpEMx = D[((Subscript[Ngbar, p])^EM)[x],x] /. Flatten[Solve[D[(Subscript[Ngbar, p])[τ,x],x] - metricMatterEqnSolNgbarpx == 0 /.
							   VariablesNpApωpVpEMRule,D[((Subscript[Ngbar, p])^EM)[x],x]]] // Simplify
	   metricMatterEqnSolAbarpEMx = D[((Subscript[Abar, p])^EM)[x],x] /. Flatten[Solve[D[(Subscript[Abar, p])[τ,x],x] - metricMatterEqnSolAbarpx == 0 /.
							   VariablesNpApωpVpEMRule,D[((Subscript[Abar, p])^EM)[x],x]]] // FullSimplify
	   metricMatterEqnalgeqnpEM = Exp[-κ τ](D[(Subscript[Abar, p])[τ,x],τ] - metricMatterEqnSolAbarpτ  /.  VariablesNpApωpVpEMRule) // FullSimplify
	   metricMatterEqnSolωbarpEMx = D[((Subscript[ωbar, p])^EM)[x],x] /. Flatten[Solve[D[(Subscript[ωbar, p])[τ,x],x] - metricMatterEqnSolωbarpx == 0 /.
							   VariablesNpApωpVpEMRule,D[((Subscript[ωbar, p])^EM)[x],x]]] // Simplify
	   metricMatterEqnSolVpEMx = D[((Subscript[V, p])^EM)[x],x] /. Flatten[Solve[D[(Subscript[V, p])[τ,x],x] - metricMatterEqnSolVpx == 0 /.
							   VariablesNpApωpVpEMRule,D[((Subscript[V, p])^EM)[x],x]]] // Simplify

Note that as before,  the (∂_τ)(OverBar[A]) equation has become an algebraic equation. We shall use it as a consistency check.
	Also note that the denominator in the matter equations is the same as for the perturbed case. Now of course, it is “fixed” as it depends only on the background variables.
	At this point, we shall take it for granted which variable we solve for and thus will suppress the “bar” part in the variables’ namings.

metricMatterODEFullNpApωpVp = Table[0,{i,1,4}];
	   (metricMatterODEFullNpApωpVp[[1]] = 
	   Simplify[Denominator[metricMatterEqnSolNgbarpEMx] ((Subscript[Ngbar, p])^EM)'[x] - Numerator[metricMatterEqnSolNgbarpEMx]]) /. pp
	   (metricMatterODEFullNpApωpVp[[2]] = 
	   Simplify[Denominator[metricMatterEqnSolAbarpEMx] ((Subscript[Abar, p])^EM)'[x] - Numerator[metricMatterEqnSolAbarpEMx]] ) /. pp
	   (metricMatterODEFullNpApωpVp[[3]] = 
	   Simplify[Denominator[metricMatterEqnSolωbarpEMx] ((Subscript[ωbar, p])^EM)'[x] - Numerator[metricMatterEqnSolωbarpEMx]]) /. pp
	   (metricMatterODEFullNpApωpVp[[4]] = 
	   Simplify[Denominator[metricMatterEqnSolVpEMx] ((Subscript[V, p])^EM)'[x] - Numerator[metricMatterEqnSolVpEMx]]) /. pp

The above are the compiled ODE system of 4 equations.

We now move on to solving the system. As for the unperturbed case, the expansion near the origin works to “high” orders, but at Unit, Mathematica has already some trouble for 
the linear order calculation. The end result should not-depend on its higher order terms (as for up case), and so we will focus on the 1st order.

Power series solution at Origin

Power Series Ansatz near x = 0

Recall that most variables are logs! In order to avoid conical singularity, we impose regularity at the center: (Subscript[(OverBar[A]), p])(τ,0) = 0. 
		One also imposes the condition that (Subscript[V, p])(τ,0) = 0, since the velocity should be an odd function of x. This fixes the leading order terms in the variables’ respective 
		expansions. Both of these condition can be seen to be reinforced at the leading order of the equations anyway.

We define the expansion for both unperturbed (up) and perturbed (p) variables. The unperturbed expansion are of of course known 
		(see: Power series solution at Origin), and in particular their expansion is readily known. The perturbed ones’ are really ansätze. 
		A posteriori, one can improve on it as the first 3 turn out to be even and the last one odd. See the end of next section for more details.

PSpOrderOrigin = 3;
		   PSupAnsatzOriginRule = 
		   {(Subscript[Ng, CSS]) -> Function[x,Evaluate[Sum[(Subscript[Ng, CSS0])[n] x^n,{n,-1,PSpOrderOrigin,2}]]],
		   (Subscript[A, CSS]) -> Function[x,Evaluate[1+Sum[(Subscript[A, CSS0])[n] x^n,{n,2,PSpOrderOrigin,2}]]], 
		   (Subscript[ω, CSS]) -> Function[x,Evaluate[Sum[(Subscript[ω, CSS0])[n] x^n,{n,2, PSpOrderOrigin,2}]]],
	 	  (Subscript[V, CSS]) -> Function[x,Evaluate[Sum[(Subscript[V, CSS0])[n] x^n,{n,1,PSpOrderOrigin,2}]]]};
		   PSpAnsatzOriginRule = 
		   {((Subscript[Ngbar, p])^EM) -> Function[x,Evaluate[Sum[((Subscript[Ngbar, p0])^EM)[n] x^n,{n,0,PSpOrderOrigin}]]],
		   ((Subscript[Abar, p])^EM) -> Function[x,Evaluate[Sum[((Subscript[Abar, p0])^EM)[n] x^n,{n,1,PSpOrderOrigin}]]], 
		   ((Subscript[ωbar, p])^EM) -> Function[x,Evaluate[Sum[((Subscript[ωbar, p0])^EM)[n] x^n,{n,0, PSpOrderOrigin}]]],
	 	  ((Subscript[V, p])^EM) -> Function[x,Evaluate[Sum[((Subscript[V, p0])^EM)[n] x^n,{n,1,PSpOrderOrigin}]]]};

Also, we write down at each order, which variables we will solve for:

PSpUnknownOrigin = {Table[((Subscript[Ngbar, p0])^EM)[n],{n,1,PSpOrderOrigin}],Table[((Subscript[Abar, p0])^EM)[n],{n,1,PSpOrderOrigin}],
						     Table[((Subscript[ωbar, p0])^EM)[n],{n,1,PSpOrderOrigin}],Table[((Subscript[V, p0])^EM)[n],{n,1,PSpOrderOrigin}]};

Full ODEs PS solution

We check the structure of the equations. We expect as before (Subscript[Ngbar, p])[0] and (Subscript[ωbar, p])[0] to remain arbitrary, so we check that we have the necessary amount of 
		equations. Again, one can check that this is the case by just looking at the equations order by order.

MatrixPlot[Simplify[Table[SeriesCoefficient[metricMatterODEFullNpApωpVp /.PSupAnsatzOriginRule /. PSpAnsatzOriginRule,
				   {x,0,n}] ,{n,0,PSpOrderOrigin-1}]]]
					   (*Made it non-evaluable*)

The first two slots are trivial using the constraints on the leading order coefficients of the perturbed variables.
		By inspection, one sees that the matter equations have terms up to ~ 1/x^3. We therefore multiply it by x^3 and bring the other 2 equations one,
		to make everything on the same level.
		This means that now, we solve the leading order equations ~ 0(1) for the linear coefficients, the ~0(x) equations will be solved for the 2nd order coefficients,etc.
		So, for a given expansion order n, we will therefore solve the first n-1 order equations.
		This makes also the calculations much faster, since before, going to say 2nd order means that the matter equations will have 6 terms, 
		ranging from ~0(1/x^3) to ~0(x^2), which is overkill, if we want only to know the first few terms in the expansion. This is why the below is much quicker.

metricMatterODEFullPSpOriginNpApωpVp =
		Simplify[Table[SeriesCoefficient[{1/x,1/x,x^3,x^3}metricMatterODEFullNpApωpVp /.PSupAnsatzOriginRule /. 
	PSpAnsatzOriginRule,{x,0,n}],{n,0, PSpOrderOrigin-1}]];
		   (*Note that we go only up to n-1 instead of n as before. The rescaling needs to be done INSIDE the Series function!*)
		   MatrixPlot[metricMatterODEFullPSpOriginNpApωpVp]

metricMatterODEFullPSpOriginSolRuleNpApωpVp =
		   Flatten[Simplify[Solve[Map[# == 0 &, metricMatterODEFullPSpOriginNpApωpVp],Flatten[PSpUnknownOrigin]]]] 
		   (*The Map is used to extract all the elements in metricMatter... to put them as individual equations*)

Note that the above strongly suggest that we could refine our ansatz, by making (OverBar[N]), (OverBar[ω]) and (OverBar[A]) even functions, while we take V to be odd.
		It might sound odd that we need say (OverBar[N]) to be even, although the unperturbed version and in fact the full function really needs to be odd. 
		The reason is because one consider the Log of the function. Roughly (see notes): Log [(Subscript[c, -1])/x + (Subscript[c, 1])x + ... ] = Log[1/x] + Log[(Subscript[c, -1]) +(Subscript[c, 1]) (x^2)+...]. 
		Last part gives an even expansion. The first part is a bit of a problem, but I believe that inside the equations and with the appropriate constraints made
		 in the PS of our variables, this term drops out. For example, the ω variable has an expansion starting as 0(x^2). This leans that similarly, its Log expansion
		 will exhibit a term Log[x^2], which probably cancels out with the above somewhere down the line....

Algebraic Equation Consistency check

We easily check that the solution is consistent with the algebraic equation. 
				Plugging the solution above into the algebraic equation should make all terms ~ O((x^n)) vanish. 
				Note that to make this happen, one needs to use the regularity condition: (Subscript[lim, x -> 0]) NV = -2/(3(1+(Subscript[c, S])^2)), for the unperturbed variables.

ruletmp = (Subscript[Ng, CSS0])[-1] -> -2/(3 (Subscript[V, CSS0])[1] (1+(Subscript[c, S])^2));
				   Simplify[Series[metricMatterEqnalgeqnpEM /.  PSupAnsatzOriginRule /. PSpAnsatzOriginRule /.
					     metricMatterODEFullPSpOriginSolRuleNpApωpVp /. ruletmp,{x,0,PSpOrderOrigin}]]
				   Clear[ruletmp];

Power series solution at Unit

We have a gauge freedom that comes from the unperturbed part of N (see notes). For simplicity, we shall take ((Subscript[(OverBar[N]), p])^EM)(1) = 0 as gauge choice.

Power Series Ansatz near x = 1

Similarly as before, we define the relevant expansions. Note the N starts at linear order due to the gauge choice.

PSpOrderUnit = 1;
		   PSupAnsatzUnitRule = 
		   {(Subscript[Ng, CSS]) -> Function[x,Evaluate[Sum[(Subscript[Ng, CSS1])[n] (x-1)^n,{n,0,PSpOrderUnit}]]],
		   (Subscript[A, CSS]) -> Function[x,Evaluate[Sum[(Subscript[A, CSS1])[n] (x-1)^n,{n,0,PSpOrderUnit}]]], 
		   (Subscript[ω, CSS]) -> Function[x,Evaluate[Sum[(Subscript[ω, CSS1])[n] (x-1)^n,{n,0, PSpOrderUnit}]]],
	 	  (Subscript[V, CSS]) -> Function[x,Evaluate[Sum[(Subscript[V, CSS1])[n] (x-1)^n,{n,0,PSpOrderUnit}]]]};
		   PSpAnsatzUnitRule = 
		   {((Subscript[Ngbar, p])^EM) -> Function[x,Evaluate[Sum[((Subscript[Ngbar, p1])^EM)[n] (x-1)^n,{n,1,PSpOrderUnit}]]],
		   ((Subscript[Abar, p])^EM) -> Function[x,Evaluate[Sum[((Subscript[Abar, p1])^EM)[n] (x-1)^n,{n,0,PSpOrderUnit}]]], 
		   ((Subscript[ωbar, p])^EM) -> Function[x,Evaluate[Sum[((Subscript[ωbar, p1])^EM)[n] (x-1)^n,{n,0, PSpOrderUnit}]]],
	 	  ((Subscript[V, p])^EM) -> Function[x,Evaluate[Sum[((Subscript[V, p1])^EM)[n] (x-1)^n,{n,0,PSpOrderUnit}]]]};

Also, we write down at each order, which variables we will solve for:

PSpUnknownUnit = {Table[((Subscript[Ngbar, p1])^EM)[n],{n,1,PSpOrderUnit}],Table[((Subscript[Abar, p1])^EM)[n],{n,1,PSpOrderUnit}],
						Table[((Subscript[ωbar, p1])^EM)[n],{n,1,PSpOrderUnit}],Table[((Subscript[V, p1])^EM)[n],{n,1,PSpOrderUnit}]};

Sonic boundary constraint (Old)

Old version. THIS IS NOT CORRECT. I keep it though for exercise purpose and a reminder on what can go wrong when dealing with singular behaviour. 
All 3 methods below agree.

Sonic boundary constraint (Old)

This was the old attempt that calculating the constraint. The logic is technically the same as the two section2 below, 
			but a bit more obtuse... but it makes an interesting exercise, so I keep it anyway.

Note that this time around, the denominator does not depend on the perturbed variables! And we know that it vanished at x = (Subscript[x, S]) = 1.
			So, we need to adjust both numerators so that it also vanishes at that point. This allows us to leave ((Subscript[(OverBar[A]), p1])^EM)[0] as the only free parameter (N is gauge fixed).
			NOTE: it will not suffice to take the numerator, since the denominator has the same singular structure as for unperturbed case, but WITH A SQUARE!
			So, the numerator, as it is, will have a factor of the denominator with it (BUT ONLY AT X=1 !!), and thus is zero when evaluating it. 
			In general, it has not the same structure as the denominator. In particular, it will have A and ω factors, which can be related to V via the regularity condition, but
			only when we are at the x=1, otherwise not.

First, let us check out again the expression that causes the irregularity:

Simplify[Factor[-1+2 (-1+(Subscript[c, S]^2)) (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x]+(Subscript[c, S]^2) (((Subscript[V, CSS])[x])^2)+(((Subscript[Ng, CSS])[x])^2) ((Subscript[c, S]^2)-(((Subscript[V, CSS])[x])^2))]]

It is the first term that is 0 once we apply the regularity condition:

singularityexpressiontmp = (-1+(Subscript[Ng, CSS])[x] ((Subscript[c, S])-(Subscript[V, CSS])[x])+(Subscript[c, S]) (Subscript[V, CSS])[x]);

We evaluate the Numerators/Denominators at x = 1, which by definition is really just a change of labelling of the up and p variables
			(only the 0th order coefficients count). We also rewrite the needed regular conditions rules with the correct namings. 
			Again, note the special treatment of N due to gauge fixing.

PSupUnitRule = {(Subscript[Ng, CSS]) -> Function[x,(Subscript[Ng, CSS1])[0]],(Subscript[A, CSS]) -> Function[x,(Subscript[A, CSS1])[0]] , (Subscript[ω, CSS]) -> Function[x,(Subscript[ω, CSS1])[0]], 
								(Subscript[V, CSS]) -> Function[x,(Subscript[V, CSS1])[0]]};
			   PSpUnitRule = {((Subscript[Ngbar, p])^EM) -> Function[x,0],((Subscript[Abar, p])^EM) -> Function[x,((Subscript[Abar, p1])^EM)[0]] , 
								((Subscript[ωbar, p])^EM) -> Function[x,((Subscript[ωbar, p1])^EM)[0]], ((Subscript[V, p])^EM) -> Function[x,((Subscript[V, p1])^EM)[0]]};
			   singularityexpression = singularityexpressiontmp /. PSupUnitRule;
			   ruletmp = {(Subscript[Ng, S])[0] -> (Subscript[Ng, CSS1])[0], (Subscript[A, S])[0] -> (Subscript[A, CSS1])[0],(Subscript[ω, S])[0] -> (Subscript[ω, CSS1])[0], (Subscript[V, S])[0] -> (Subscript[V, CSS1])[0]};
			   RegularitySonicRuleFullup = RegularitySonicRuleFull /. ruletmp;
			   Clear[singularityexpressiontmp,ruletmp];

First, let us plug-in the regularity condition from the unperturbed variables, except for N. Otherwise, we will get 0. 
			We then factor the result to extract the singular part of the numerator which is meant to be simplified with one of the two copies present in the denominator. 
			Here, we don’t do the simplification, we just extract the relevant factor which needs to be set to zero.

metricMatterEqnSolωbarpEMxNumeratorUnit = 
			   Simplify[Numerator[metricMatterEqnSolωbarpEMx /. PSupUnitRule /.
			 PSpUnitRule /. RegularitySonicRuleFullup[[1;;2]]]];
			   metricMatterEqnSolVpEMxNumeratorUnit        =
			    Simplify[Numerator[metricMatterEqnSolVpEMx /. PSupUnitRule /.
			 PSpUnitRule /. RegularitySonicRuleFullup[[1;;2]]]];

Remove the singular part. Note the simplification applied BEFORE we apply the full regularity condition and simplify again.

metricMatterEqnSolωbarpEMxNumeratorUnitNormalized = 
			   Simplify[Factor[metricMatterEqnSolωbarpEMxNumeratorUnit]/singularityexpression] /. 
			   RegularitySonicRuleFullup // Simplify;
		   	metricMatterEqnSolVpEMxNumeratorUnitNormalized = 
			   Simplify[Factor[metricMatterEqnSolVpEMxNumeratorUnit]/singularityexpression] /. 
			   RegularitySonicRuleFullup // Simplify;

One check that the numerators are in fact proportional to each other. There is therefore only 1 condition, like in up case:

Simplify[metricMatterEqnSolωbarpEMxNumeratorUnitNormalized/metricMatterEqnSolVpEMxNumeratorUnitNormalized]

We therefore proceed to solving one of them, say ω :

RegularitySonicRuleFullPerturbationωtmp = 
			   Simplify[Flatten[Solve[metricMatterEqnSolωbarpEMxNumeratorUnitNormalized == 0, ((Subscript[ωbar, p1])^EM)[0]]]];

NOTE: BE CAREFUL when handling singular stuff. As an example, try the following: do not work with the normalised numerators and try to solve for both ω and V.
			After that, update the results (rules) by the remaining regularity condition (for N). This WILL WORK and you will get a pair of solutions for ω and N as functions of
			unperturbed variable only!!! This makes little sense since we know that, first the numerators are actually zero after the full regular update. Now, it could be that 
			during “Solve”, Mathematica noticed the factorization and did the cancel itself. Still, the “leftover” part should coincide with the normalised numerators above, 			which have been shown to be ∝. So, why do we get nonetheless 2 well-define solutions (which can be checked to indeed work!). The reason is that the “real” 	
			solution, say ω which depends on (Subscript[V, p]) is a solution to the system FOR ANY (Subscript[V, p]). In particular, one could take (Subscript[V, p]) to be some function of the unperturbed variable; in 
			which case ω will also only depend on it. This is precisely the solution given if you do as suggested. 
			In other words, the solution is only for a particular choice of (Subscript[V, p]) which is presented as “the solution” of the linear system. To convince yourself, do the above, 
			then update the “true” solution ω (depending on (Subscript[V, p])) with the (Subscript[V, p]) “solution” obtained and you will see that this ω (now depending only on the unperturbed 
			variable) will coincide with the other ω obtained. I am not sure how this is possible, as I would have anticipated the above to NOT work due to some division by 
			zero.... Anyway, the moral in the end is to be VERY careful when handling stuff like that as you might get seemingly “correct” results.

Alright, we now make use of the algebraic equation (the perturbed one). Together with the above allows us to have only, say, ((Subscript[A, p1])^EM)[0] as the free parameter.

metricMatterEqnalgeqnpEMtmp = Simplify[metricMatterEqnalgeqnpEM /. PSupUnitRule /. 
		        PSpUnitRule /. RegularitySonicRuleFullup];
			   regularityconditionstmp = Simplify[Flatten[Solve[(((Subscript[ωbar, p1])^EM)[0] /. RegularitySonicRuleFullPerturbationωtmp) == ((Subscript[ωbar, p1])^EM)[0] && 
			   metricMatterEqnalgeqnpEMtmp == 0, {((Subscript[ωbar, p1])^EM)[0],((Subscript[V, p1])^EM)[0]}]]];
			   Clear[metricMatterEqnalgeqnpEMtmp,RegularitySonicRuleFullPerturbationωtmp];

Let us compile the full regularity condition at perturbation level, including the gauge fixing.

RegularitySonicRuleFullPerturbedOld = Flatten[{regularityconditionstmp,((Subscript[Ngbar, p1])^EM)[0] -> 0}] // FullSimplify
			   Clear[regularityconditionstmp];

Sonic constraint

First, let us check out again the expression that causes the irregularity:

Simplify[Factor[-1+2 (-1+(Subscript[c, S]^2)) (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x]+(Subscript[c, S]^2) (((Subscript[V, CSS])[x])^2)+(((Subscript[Ng, CSS])[x])^2) ((Subscript[c, S]^2)-(((Subscript[V, CSS])[x])^2))]]

It is the first term that is 0 once we apply the regularity condition:

singularityexpressiontmp = (-1+(Subscript[Ng, CSS])[x] ((Subscript[c, S])-(Subscript[V, CSS])[x])+(Subscript[c, S]) (Subscript[V, CSS])[x]);

We evaluate the Numerators/Denominators at x = 1, which by definition is really just a change of labelling of the up and p variables
			(only the 0th order coefficients count). We also rewrite the needed regular conditions rules with the correct namings. 
			Again, note the special treatment of N due to gauge fixing.

PSupUnitRule = {(Subscript[Ng, CSS]) -> Function[x,(Subscript[Ng, CSS1])[0]],(Subscript[A, CSS]) -> Function[x,(Subscript[A, CSS1])[0]] , (Subscript[ω, CSS]) -> Function[x,(Subscript[ω, CSS1])[0]], 
								(Subscript[V, CSS]) -> Function[x,(Subscript[V, CSS1])[0]]};
			   PSpUnitRule = {((Subscript[Ngbar, p])^EM) -> Function[x,0],((Subscript[Abar, p])^EM) -> Function[x,((Subscript[Abar, p1])^EM)[0]] , 
								((Subscript[ωbar, p])^EM) -> Function[x,((Subscript[ωbar, p1])^EM)[0]], ((Subscript[V, p])^EM) -> Function[x,((Subscript[V, p1])^EM)[0]]};
			   singularityexpression = singularityexpressiontmp /. PSupUnitRule;
			   ruletmp = {(Subscript[Ng, S])[0] -> (Subscript[Ng, CSS1])[0], (Subscript[A, S])[0] -> (Subscript[A, CSS1])[0],(Subscript[ω, S])[0] -> (Subscript[ω, CSS1])[0], (Subscript[V, S])[0] -> (Subscript[V, CSS1])[0]};
			   RegularitySonicRuleFullup = RegularitySonicRuleFull /. ruletmp;
			   Clear[singularityexpressiontmp,ruletmp];

We now evaluate say the ω equation above at x = 1. This is just a relabeling of the variables. NOte that we apply the reg. cond. except for the last one,
			as otherwise we get the denominator zero of course. Note that the denominator which was initially SQUARED in its singularity is now only “linear” once we apply
			the regularity. This means that near x = 1, the numerator actually also had singular term which was cancelled out.
			In that respect, the previous attempt was correct.

NumωSetTo0 = 
			   Simplify[Numerator[Factor[metricMatterEqnSolωbarpEMx /. PSupUnitRule /. PSpUnitRule /. 
		    RegularitySonicRuleFullup[[1;;2]] /. γTocsRule]]];

RegularityPerturbationω = Flatten[Simplify[Solve[NumωSetTo0 == 0, ((Subscript[ωbar, p1])^EM)[0]] /. RegularitySonicRuleFullup]]

Of course, we should do the same for the V equation, although, we expect the answer to be the same:

NumVSetTo0 =
			   Simplify[Numerator[Factor[metricMatterEqnSolVpEMx /. PSupUnitRule /. PSpUnitRule /. 
		 RegularitySonicRuleFullup[[1;;2]] /. γTocsRule]]];

RegularityPerturbationV = Flatten[Simplify[Solve[NumVSetTo0 == 0, ((Subscript[ωbar, p1])^EM)[0]] /. RegularitySonicRuleFullup]]

One sees that they are indeed the same:

Simplify[((Subscript[ωbar, p1]^EM)[0] /. RegularityPerturbationω) - ((Subscript[ωbar, p1]^EM)[0] /. RegularityPerturbationV) ]

We have a second algebraic equation via the algebraic equation. This leaves only one parameter free.

metricMatterEqnalgeqnpEMtmp = Simplify[metricMatterEqnalgeqnpEM /. PSupUnitRule /. 
		        PSpUnitRule /. RegularitySonicRuleFullup];
			   regularityconditionstmp = Simplify[Flatten[Solve[(((Subscript[ωbar, p1])^EM)[0] /. RegularityPerturbationω) == ((Subscript[ωbar, p1])^EM)[0] && 
			   metricMatterEqnalgeqnpEMtmp == 0, {((Subscript[ωbar, p1])^EM)[0],((Subscript[V, p1])^EM)[0]}]]];
			   Clear[metricMatterEqnalgeqnpEMtmp];

Let us compile the full regularity condition at perturbation level, including the gauge fixing.

RegularitySonicRuleFullPerturbed = Flatten[{regularityconditionstmp,((Subscript[Ngbar, p1])^EM)[0] -> 0}] // FullSimplify
			   Clear[regularityconditionstmp];

Sonic constraint from KHA

The above has been checked to agree with the above method.

PSupUnitRule = {(Subscript[Ng, CSS]) -> Function[x,(Subscript[Ng, CSS1])[0]],(Subscript[A, CSS]) -> Function[x,(Subscript[A, CSS1])[0]] , (Subscript[ω, CSS]) -> Function[x,(Subscript[ω, CSS1])[0]], 
								(Subscript[V, CSS]) -> Function[x,(Subscript[V, CSS1])[0]]};
			   PSpUnitRule = {((Subscript[Ngbar, p])^EM) -> Function[x,0],((Subscript[Abar, p])^EM) -> Function[x,((Subscript[Abar, p1])^EM)[0]] , 
								((Subscript[ωbar, p])^EM) -> Function[x,((Subscript[ωbar, p1])^EM)[0]], ((Subscript[V, p])^EM) -> Function[x,((Subscript[V, p1])^EM)[0]]};
			   singularityexpression = singularityexpressiontmp /. PSupUnitRule;
			   ruletmp = {(Subscript[Ng, S])[0] -> (Subscript[Ng, CSS1])[0], (Subscript[A, S])[0] -> (Subscript[A, CSS1])[0],(Subscript[ω, S])[0] -> (Subscript[ω, CSS1])[0], (Subscript[V, S])[0] -> (Subscript[V, CSS1])[0]};
			   RegularitySonicRuleFullup = RegularitySonicRuleFull /. ruletmp;
			   Clear[singularityexpressiontmp,ruletmp];

asKHA  = 1;
			   bsKHA  = ((Subscript[c, S])^2+1) (Subscript[V, CSS])[x]/(1-(Subscript[V, CSS])[x]^2);
			   csKHA  = (Subscript[c, S])^2 (Subscript[V, CSS])[x];
			   dsKHA  = ((Subscript[c, S])^2+1)/(1-(Subscript[V, CSS])[x]^2);
			   axKHA  = 1+(Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x];
			   bxKHA  = ((Subscript[c, S])^2+1) ((Subscript[Ng, CSS])[x]+(Subscript[V, CSS])[x])/(1-(Subscript[V, CSS])[x]^2);
			   cxKHA  = (Subscript[c, S])^2 ((Subscript[Ng, CSS])[x]+(Subscript[V, CSS])[x]);
			   dxKHA  = ((Subscript[c, S])^2+1) (1+(Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x])/(1-(Subscript[V, CSS])[x]^2);
			   e1KHA  = -((Subscript[c, S])^2+3) (Subscript[A, CSS])[x] (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x]/2;
			   e2KHA  = (3-3 (Subscript[c, S])^2) (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x]/2-(3+(Subscript[c, S])^2) (Subscript[A, CSS])[x] (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x]/2+(1-(Subscript[c, S])^2) (Subscript[ω, CSS])[x] (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x] - 
					   (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x] x D[(Subscript[ω, CSS])[x],x]/(Subscript[ω, CSS])[x]- ((Subscript[c, S])^2+1) (Subscript[Ng, CSS])[x] x D[(Subscript[V, CSS])[x],x]/(1-(Subscript[V, CSS])[x]^2);
			   e3KHA = (1-(Subscript[c, S])^2) (Subscript[ω, CSS])[x] (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x];
			   e4KHA  = (3-3 (Subscript[c, S])^2) (Subscript[Ng, CSS])[x]/2-(3+(Subscript[c, S])^2) (Subscript[A, CSS])[x] (Subscript[Ng, CSS])[x]/2 +(1-(Subscript[c, S])^2) (Subscript[ω, CSS])[x] (Subscript[Ng, CSS])[x] - (Subscript[Ng, CSS])[x] x D[(Subscript[ω, CSS])[x],x]/(Subscript[ω, CSS])[x]-
					   ((Subscript[c, S])^2+1) (1+2 (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x]+(Subscript[V, CSS])[x]^2) x D[(Subscript[V, CSS])[x],x]/ (1-(Subscript[V, CSS])[x]^2)^2;
			   f1KHA = -(1+3 (Subscript[c, S])^2) (Subscript[A, CSS])[x] (Subscript[Ng, CSS])[x]/2;
			   f2KHA = (1-(Subscript[c, S])^2) γ (Subscript[ω, CSS])[x] (Subscript[Ng, CSS])[x]+(7 (Subscript[c, S])^2 +1) (Subscript[Ng, CSS])[x]/2-(1+3 (Subscript[c, S])^2) (Subscript[A, CSS])[x] (Subscript[Ng, CSS])[x]/2-(Subscript[c, S])^2 (Subscript[Ng, CSS])[x] x D[(Subscript[ω, CSS])[x],x]/(Subscript[ω, CSS])[x]-
					   ((Subscript[c, S])^2+1) (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x] x D[(Subscript[V, CSS])[x],x]/(1-(Subscript[V, CSS])[x]^2);
			   f3KHA = (1-(Subscript[c, S])^2) γ (Subscript[ω, CSS])[x] (Subscript[Ng, CSS])[x];
			   f4KHA = -(Subscript[c, S])^2 x D[(Subscript[ω, CSS])[x],x]/(Subscript[ω, CSS])[x] - ((Subscript[c, S])^2+1) ((Subscript[Ng, CSS])[x]+2 (Subscript[V, CSS])[x] + (Subscript[Ng, CSS])[x] (Subscript[V, CSS])[x]^2) x D[(Subscript[V, CSS])[x],x]/(1-(Subscript[V, CSS])[x]^2)^2;
			   g1KHA = -(Subscript[A, CSS])[x];
			   g3KHA = 2 (1+(Subscript[c, S])^2 (Subscript[V, CSS])[x]^2) (Subscript[ω, CSS])[x]/(1-(Subscript[V, CSS])[x]^2);
			   g4KHA = 4 ((Subscript[c, S])^2+1) (Subscript[ω, CSS])[x] (Subscript[V, CSS])[x]/(1-(Subscript[V, CSS])[x]^2)^2;
			   h1KHA =  (Subscript[A, CSS])[x];
			   h3KHA = ((Subscript[c, S])^2-1)  (Subscript[ω, CSS])[x];

Let us now construct the relevant matrices:

matrixX = Table[0,{i,1,ndim},{j,1,ndim}];
			   matrixX[[1,1]] = 1; matrixX[[2,2]] = 1;
			   matrixX[[3,3]] = axKHA;
			   matrixX[[3,4]] = bxKHA;
			   matrixX[[4,3]] = cxKHA;
			   matrixX[[4,4]] = dxKHA;

matrixS = Table[0,{i,1,ndim},{j,1,ndim}];
			   matrixS[[3,3]] = -κ asKHA;
			   matrixS[[3,4]] = -κ bsKHA;
			   matrixS[[4,3]] = -κ csKHA;
			   matrixS[[4,4]] = -κ dsKHA;

matrixA = Table[0,{i,1,ndim},{j,1,ndim}];
			   matrixA[[1,1]] = g1KHA;
			   matrixA[[1,3]] = g3KHA;
			   matrixA[[1,4]] = g4KHA;
			   matrixA[[2,1]] = h1KHA;
			   matrixA[[2,3]] = h3KHA;
			   matrixA[[3,1]] = e1KHA;
			   matrixA[[3,2]] = e2KHA;
			   matrixA[[3,3]] = e3KHA;
			   matrixA[[3,4]] = e4KHA;
			   matrixA[[4,1]] = f1KHA;
			   matrixA[[4,2]] = f2KHA;
			   matrixA[[4,3]] = f3KHA;
			   matrixA[[4,4]] = f4KHA;

The matrix that we are looking for is of the form X^-1 (A+S)v  and we wish for its 3rd and 4th row to vanish. 
			These two rows should in fact be proportional so that this is really only one algebraic condition.

matrixXm1 = Simplify[Inverse[matrixX]];
			   matrixAS = Simplify[matrixA+matrixS];
			   singularmatrix = Simplify[Table[Sum[matrixXm1[[i,k]] matrixAS[[k,j]],{k,1,ndim}],{i,1,ndim},{j,1,ndim}]];

vectorPerturbationVariables = Table[0,{i,1,ndim}] ;
			   vectorPerturbationVariables[[1]] = ((Subscript[Abar, p])^EM)[x];
			   vectorPerturbationVariables[[2]] = ((Subscript[Ngbar, p])^EM)[x];
			   vectorPerturbationVariables[[3]] = ((Subscript[ωbar, p])^EM)[x];
			   vectorPerturbationVariables[[4]] = ((Subscript[V, p])^EM)[x];

Multiply the matrix with vectors and look at the 3rd and 4th row:

singularRow3tmp = Simplify[Sum[singularmatrix[[3,j]] vectorPerturbationVariables[[j]],{j,1,ndim}]];
			   singularRow4tmp = Simplify[Sum[singularmatrix[[4,j]] vectorPerturbationVariables[[j]],{j,1,ndim}]];

Let us now get rid of the derivatives of the unperturbed variables, making use the the CSS equations.

metricMatterEqnFullCSSSolωxtmp = 
			   metricMatterEqnFullCSSSolωx /. {A[x] -> (Subscript[A, CSS])[x],Ng[x] -> (Subscript[Ng, CSS])[x],V[x] -> (Subscript[V, CSS])[x],ω[x] -> (Subscript[ω, CSS])[x]};
			   metricMatterEqnFullCSSSolVxtmp = metricMatterEqnFullCSSSolVx /. 
			{A[x] -> (Subscript[A, CSS])[x],Ng[x] -> (Subscript[Ng, CSS])[x],V[x] -> (Subscript[V, CSS])[x],ω[x] -> (Subscript[ω, CSS])[x]};
			   ωxRuletmp = D[(Subscript[ω, CSS])[x],x] -> Evaluate[metricMatterEqnFullCSSSolωxtmp];
			   VxRuletmp = D[(Subscript[V, CSS])[x],x] -> Evaluate[metricMatterEqnFullCSSSolVxtmp];
			   singularRow3 = Simplify[singularRow3tmp /. ωxRuletmp /. VxRuletmp];
			   singularRow4 = Simplify[singularRow4tmp /. ωxRuletmp /. VxRuletmp];
			   Clear[singularRow3tmp,singularRow4tmp,metricMatterEqnFullCSSSolωxtmp,metricMatterEqnFullCSSSolVxtmp,
				     ωxRuletmp,VxRuletmp]

We now evaluate the above at x = 1. This is just a relabeling of the variables:

Num3SetTo0 = 
			   Simplify[Numerator[Factor[singularRow3 /. PSupUnitRule /. PSpUnitRule /. 
		RegularitySonicRuleFullup[[1;;2]] /. γTocsRule]]];

RegularityPerturbationω3 = Flatten[Simplify[Solve[Num3SetTo0 == 0, ((Subscript[ωbar, p1])^EM)[0]] /. RegularitySonicRuleFullup]]

Of course, we should do the same for the other numerator, although, we expect the answer to be the same:

Num4SetTo0 =
			   Simplify[Numerator[Factor[singularRow4 /. PSupUnitRule /. PSpUnitRule /. 
		RegularitySonicRuleFullup[[1;;2]] /. γTocsRule]]];

RegularityPerturbationω4 = Flatten[Simplify[Solve[Num4SetTo0 == 0, ((Subscript[ωbar, p1])^EM)[0]] /. RegularitySonicRuleFullup]]

One sees that they are indeed the same:

Simplify[((Subscript[ωbar, p1]^EM)[0] /. RegularityPerturbationω3) - ((Subscript[ωbar, p1]^EM)[0] /. RegularityPerturbationω4) ]

metricMatterEqnalgeqnpEMtmp = Simplify[metricMatterEqnalgeqnpEM /. PSupUnitRule /. 
		        PSpUnitRule /. RegularitySonicRuleFullup];
			   regularityconditionstmp = Simplify[Flatten[Solve[(((Subscript[ωbar, p1])^EM)[0] /. RegularityPerturbationω3) == ((Subscript[ωbar, p1])^EM)[0] && 
			   metricMatterEqnalgeqnpEMtmp == 0, {((Subscript[ωbar, p1])^EM)[0],((Subscript[V, p1])^EM)[0]}]]];
			   Clear[metricMatterEqnalgeqnpEMtmp];

Let us compile the full regularity condition at perturbation level, including the gauge fixing.

RegularitySonicRuleFullPerturbedKHA = Flatten[{regularityconditionstmp,((Subscript[Ngbar, p1])^EM)[0] -> 0}] // FullSimplify
			   Clear[regularityconditionstmp];

Numerical approximation of the Unperturbed solutions

Since Mathematica has trouble above to keep working in closed form, we shall plug-in the calculated values for the unperturbed variables.

General Set-up

Here, we set up the solutions of the p coefficients. We also define the parameter κ found in KHA.

myκ = 2.81055255;
				   myκRule = κ -> myκ;

Numerical set-up of unperturbed coefficients

We write up  all the solutions we have for the unperturbed coefficients, by plugging in the values obtained from the Shooting.

ruletmp = {(Subscript[Ng, 0]) -> (Subscript[Ng, CSS0]),(Subscript[A, 0]) -> (Subscript[A, CSS0]),(Subscript[ω, 0]) -> (Subscript[ω, CSS0]),(Subscript[V, 0]) -> (Subscript[V, CSS0]),(Subscript[Ng, S]) -> (Subscript[Ng, CSS1]),(Subscript[A, S]) -> (Subscript[A, CSS1]),(Subscript[ω, S]) -> (Subscript[ω, CSS1]),(Subscript[V, S]) -> (Subscript[V, CSS1])};
				   RegularitySonicRuleFullUnperturbed = RegularitySonicRuleFull /. ruletmp;
				   Ngm1ω2V0RuleUnperturbed = Ngm1ω2V0Rule /. ruletmp;

metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbed = metricMatterODEReducedCSSPSOriginSolRuleNωV /. ruletmp;

metricMatterODEFullCSSPSUnitSolRuleLinear = 
				   Flatten[Extract[metricMatterODEFullCSSPSUnitSolRuleDegeneracy ,{{1},{2},{3,3},{4,3}}]] /. ruletmp;
				   Clear[ruletmp];

metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbedNumerictmp = 
				   Simplify[metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbed /. Ngm1ω2V0RuleUnperturbed /. mycRule];
				   metricMatterODEFullCSSPSUnitSolRuleLinearNumerictmp = 
				   Simplify[metricMatterODEFullCSSPSUnitSolRuleLinear /. Ngm1ω2V0RuleUnperturbed /. mycRule];
				   RegularitySonicRuleFullUnperturbedNumeric = 
				   Simplify[RegularitySonicRuleFullUnperturbed /. Ngm1ω2V0RuleUnperturbed /. mycRule];

The above are the respective values for the unperturbed coefficients at x = 0 and x = 1 expansions. 
				Recall that the regularity condition also fixes 3 out of 4 leading order coefficients. For completeness, we shall compile all the values together:

metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbedNumeric = 
				   Flatten[{(Subscript[A, CSS0])[0] -> 1, Ngm1ω2V0RuleUnperturbed[[1;;2]],
				                   metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbedNumerictmp}];
				   Clear[metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbedNumerictmp]
				   metricMatterODEFullCSSPSUnitSolRuleLinearNumeric =
				   Flatten[{RegularitySonicRuleFullUnperturbedNumeric,Ngm1ω2V0RuleUnperturbed[[3]],
				                   metricMatterODEFullCSSPSUnitSolRuleLinearNumerictmp}];
				   Clear[metricMatterODEFullCSSPSUnitSolRuleLinearNumerictmp]

Sonic constraint Correct

We give below 2 different ways on how to obtain the constraint.

More numerical

The denominator has the singular part squared. the numerator is already 0 at x = 1, so using Hôpital, we require its derivative to also disappear.
				We plug in the numerics since the calculations are too heavy analytically.

numeratorx = D[Numerator[metricMatterEqnSolωbarpEMx],x];
				   ruletmp = {(Subscript[Ng, CSS])[x] -> (Subscript[Ng, CSS1])[0], (Subscript[V, CSS])[x] -> (Subscript[V, CSS1])[0], (Subscript[A, CSS])[x] -> (Subscript[A, CSS1])[0],(Subscript[ω, CSS])[x] -> (Subscript[ω, CSS1])[0],
					   	(Subscript[Ng, CSS])'[x] -> (Subscript[Ng, CSS1])[1], (Subscript[V, CSS])'[x] -> (Subscript[V, CSS1])[1], (Subscript[A, CSS])'[x] -> (Subscript[A, CSS1])[1],(Subscript[ω, CSS])'[x] -> (Subscript[ω, CSS1])[1]};
				   numeratorxNumerictmp = numeratorx /. ruletmp;
				   numeratorxNumerictmp2 = 
				   Simplify[numeratorxNumerictmp /. metricMatterODEFullCSSPSUnitSolRuleLinearNumeric /. mycRule /. myκRule]

NbarRule = ((Subscript[Ngbar, p])^EM)' -> Function[x,Evaluate[metricMatterEqnSolNgbarpEMx]];
				   AbarRule = ((Subscript[Abar, p])^EM)' -> Function[x,Evaluate[metricMatterEqnSolAbarpEMx]];
				   ωbarRule = ((Subscript[ωbar, p])^EM)' -> Function[x,Evaluate[metricMatterEqnSolωbarpEMx]];
				   VRule = ((Subscript[V, p])^EM)' -> Function[x,Evaluate[metricMatterEqnSolVpEMx]];

numeratorxNumerictmp3 = 
				   Simplify[numeratorxNumerictmp2  /. NbarRule /. AbarRule /. ωbarRule /. VRule /. ruletmp /. 
				   metricMatterODEFullCSSPSUnitSolRuleLinearNumeric]

All the values are very small except the first few. The very small values can be assumed to be zero (so that radiation fluid is in fact not a problem as it is 
				here.) Also use gauge.

ruletmp = {((Subscript[Ngbar, p])^EM)[x] -> ((Subscript[Ngbar, p1])^EM)[0],((Subscript[Abar, p])^EM)[x] -> ((Subscript[Abar, p1])^EM)[0],((Subscript[ωbar, p])^EM)[x] -> ((Subscript[ωbar, p1])^EM)[0],((Subscript[V, p])^EM)[x] -> ((Subscript[V, p1])^EM)[0]};
				   NumSetTo0 = 0.` +35.740801269154176` (Subscript[Abar, p]^EM)[x]-15.113506032380842` (Subscript[Ngbar, p]^EM)[x]+37.7326792472522` (Subscript[V, p]^EM)[x]-
				   17.497147233940524` (Subscript[ωbar, p]^EM)[x] /. ruletmp /. x -> 1;

metricMatterEqnalgeqnpEMtmp = Simplify[metricMatterEqnalgeqnpEM /. PSupUnitRule /. 
				 PSpUnitRule /. RegularitySonicRuleFullup];
				   regularityconditionstmp = Simplify[Flatten[Solve[NumSetTo0 == 0&& 
			   metricMatterEqnalgeqnpEMtmp == 0, {((Subscript[ωbar, p1])^EM)[0],((Subscript[V, p1])^EM)[0]}]] /. mycRule /. metricMatterODEFullCSSPSUnitSolRuleLinearNumeric];
			   	Clear[metricMatterEqnalgeqnpEMtmp];

The above should have the advantage that the linear order in the denominator to also be zero. Let us check:

RegularitySonicRuleFullPerturbedNumeric = Simplify[regularityconditionstmp /. (Subscript[Ngbar, p1]^EM)[0] -> 0]

metricMatterODEFullωpVpNumerictmp =    Simplify[SeriesCoefficient[
				   metricMatterODEFullNpApωpVp[[3;;4]] /.  PSupAnsatzUnitRule /.  PSpAnsatzUnitRule /.
				   RegularitySonicRuleFullPerturbedNumeric /. RegularitySonicRuleFullUnperturbedNumeric /. 
				   metricMatterODEFullCSSPSUnitSolRuleLinearNumeric /. mycRule /. myκRule,{x,1,1}]]

More analytical

It is the same thing as looking at say ω equations, take linear order and set it to zero:

lineartermωtmp =    SeriesCoefficient[metricMatterODEFullNpApωpVp[[3]] /.  PSupAnsatzUnitRule /.  PSpAnsatzUnitRule /. 
				   RegularitySonicRuleFullup,{x,1,1}]

lineartermω = lineartermωtmp /. RegularitySonicRuleFullUnperturbed // Simplify

metricMatterEqnalgeqnpEMtmp = Simplify[metricMatterEqnalgeqnpEM /. PSupUnitRule /. 
				   PSpUnitRule /. RegularitySonicRuleFullup];
				   regularityconditionstmp = Simplify[Flatten[Solve[lineartermω == 0&& 
				 metricMatterEqnalgeqnpEMtmp == 0, {((Subscript[ωbar, p1])^EM)[0],((Subscript[V, p1])^EM)[0]}]]];
			   	Clear[metricMatterEqnalgeqnpEMtmp];

metricMatterODEFullωpVpNumerictmp = Simplify[SeriesCoefficient[
				   metricMatterODEFullNpApωpVp[[3;;4]] /.  PSupAnsatzUnitRule /.  PSpAnsatzUnitRule /.  regularityconditionstmp  /. 
			   RegularitySonicRuleFullUnperturbedNumeric /. metricMatterODEFullCSSPSUnitSolRuleLinearNumeric /. mycRule /.
				 myκRule,{x,1,1}]]

Full ODEs PS solution

This is a bit outdated......!!!

As usual, let us check the structure of the equations. Note that we do not apply any the regularity cond. (see later) because Mathematica cannot handle it....
		So, not surprising that there is no trivial term...

MatrixPlot[Simplify[Table[Series[metricMatterODEFullNpApωpVp /.  PSupUnitRule /.  PSpAnsatzUnitRule,
				   {x,1,n}] ,{n,0,PSpOrderUnit-1}]]]

We solve the system now. Since the calculations are very expensive, we will do it term by term.
		Notice that for the N and A equations, we simply solve the leading order term. For the matter equations, (NOOOOOOOO) note that we need to go to 2nd order.
		0th order term is gone 
		due to the up regularity condition and the linear term is gone due to combination of up and p regularity condition. The latter is difficult to be explicitly since 
		Mathematica runs out of memory before that happens unfortunately, however it is clear why this is true theoretically. We not that the linear term (assuming only 
		the up reg. condition) does NOT depend on the linear term we wish to solve for. It therefore has to in fact be zero, if we were to also assume the p reg. cond..
		So, for N and A, we solve the full thing. For ω and V, we only plug in the up reg. cond.. We will update it afterwards with the numerical values.

So, we solve for N and A. Not that the corresponding equations only depend on the respective variable. Here the equations are simple enough that we can afford
		to plug-in all the substitutions (up and p).

NgbarEMLinearTermRule = Flatten[Simplify[Solve[
	   SeriesCoefficient[metricMatterODEFullNpApωpVp[[1]] /.  PSupAnsatzUnitRule /.  PSpAnsatzUnitRule /. RegularitySonicRuleFullup /.
	   RegularitySonicRuleFullPerturbed,{x,1,0}] == 0, ((Subscript[Ngbar, p1])^EM)[1]]]];
		   NgbarEMLinearTerm = ((Subscript[Ngbar, p1])^EM)[1] /. NgbarEMLinearTermRule

AbarEMLinearTermRule = Flatten[Simplify[Solve[
	   SeriesCoefficient[metricMatterODEFullNpApωpVp[[2]] /.  PSupAnsatzUnitRule /.  PSpAnsatzUnitRule /. RegularitySonicRuleFullup /. 
	   RegularitySonicRuleFullPerturbed,{x,1,0}] == 0, ((Subscript[Abar, p1])^EM)[1]]]];
		   AbarEMLinearTerm = ((Subscript[Abar, p1])^EM)[1] /. AbarEMLinearTermRule

Now, solving for ω and V. Unfortunately, Mathematica is not able to handle everything in closed form. We will therefore first plug in the numerical approximations
		and then solve the matter equations. As stated above, for those equations, we will need to look at the 2nd order term. 0th order is 0, assuming the up coefficients
		and the linear term is gone assuming the up and p coefficients. Again, cannot check the latter explicitly as Mathematica runs out of memory before then.
		But one can still check that the linear order term in fact do not depend on the coefficients we want to solve for, i.e. depend only on leading order coefficients,
		so they better round up to 0!!

ωbarEMLinearTermRuletmp = Flatten[Simplify[Solve[
	   SeriesCoefficient[metricMatterODEFullNpApωpVp[[3]] /.  PSupAnsatzUnitRule /.  PSpAnsatzUnitRule /. RegularitySonicRuleFullup,
		{x,1,2}] == 0, ((Subscript[ωbar, p1])^EM)[1]]]];
		   ωbarEMLinearTerm = ((Subscript[ωbar, p1])^EM)[1] /. ωbarEMLinearTermRule

I do not update it as this is too much for it:

ωbarEMLinearTerm = Simplify[ωbarEMLinearTerm /. NgbarEMLinearTermRule];
ωbarEMLinearTerm = Simplify[ωbarEMLinearTerm /. AbarEMLinearTermRule];

VEMLinearTermRule = Flatten[Simplify[Solve[
	      SeriesCoefficient[metricMatterODEFullNpApωpVp[[4]] /.  PSupAnsatzUnitRule /.  PSpAnsatzUnitRule /. RegularitySonicRuleFullup,
		   {x,1,2}] == 0, ((Subscript[V, p1])^EM)[1]]]];
		   VEMLinearTerm = ((Subscript[V, p1])^EM)[1] /. VEMLinearTermRule

Again, let us compile all the rules above:

metricMatterODEFullPSpUnitSolRuleNpApωpVp = 
		   Flatten[{NgbarEMLinearTermRule,AbarEMLinearTermRule,ωbarEMLinearTermRule,VEMLinearTermRule}];

Numerical approximation of the perturbed solutions

Since Mathematica has trouble above to keep working in closed form, we shall plug-in the calculated values for the perturbed variables.

Numerical solutions of the perturbed coefficients at Origin

Applying the assumptions in the General Set-up section, we update the solutions found above:

metricMatterODEFullPSpOriginSolRuleNpApωpVpNumeric = 
				   Simplify[metricMatterODEFullPSpOriginSolRuleNpApωpVp /.
					     metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbedNumeric /. mycRule /. myκRule];

Numerical solutions of the perturbed coefficients at Unit

We can now proceed to do the same for the Unit coefficients. Recall that we still need to find ω and V. We first approx the solutions for N and A and
update the equations to be solved with it.

RegularitySonicRuleFullPerturbedNumeric = Simplify[RegularitySonicRuleFullPerturbed /. metricMatterODEFullCSSPSUnitSolRuleLinearNumeric /. mycRule /. myκRule]

NgbarEMLinearTermRuleNumeric = Simplify[NgbarEMLinearTermRule /. metricMatterODEFullCSSPSUnitSolRuleLinearNumeric /. mycRule /. myκRule];
AbarEMLinearTermRuleNumeric = Simplify[AbarEMLinearTermRule /. metricMatterODEFullCSSPSUnitSolRuleLinearNumeric /. mycRule /. myκRule];

metricMatterODEFullωpVpNumerictmp = Simplify[SeriesCoefficient[metricMatterODEFullNpApωpVp[[3;;4]] /.  PSupAnsatzUnitRule /.  PSpAnsatzUnitRule /. RegularitySonicRuleFullPerturbedNumeric /. RegularitySonicRuleFullUnperturbedNumeric /. metricMatterODEFullCSSPSUnitSolRuleLinearNumeric /. NgbarEMLinearTermRuleNumeric /. AbarEMLinearTermRuleNumeric /. mycRule /. myκRule,{x,1,1}]]

FullNumericRule = Simplify[metricMatterODEFullPSpUnitSolRuleNpApωpVp /. metricMatterODEFullCSSPSUnitSolRuleLinearNumeric /. mycRule /. myκRule]

PDE system of perturbed variables

Change of variable

Let us calculate the PDE system of the perturbed variables.	So, let us first make the relevant change of variable,

COVNgAωToLogscaleRule = {Ng -> Function[{τ,x},Exp[(OverBar[Ng])[τ,x]]], A -> Function[{τ,x},Exp[(OverBar[A])[τ,x]]], ω -> Function[{τ,x},Exp[(OverBar[ω])[τ,x]]]};
metricMatterEqnSolNgbarxtmp = D[(OverBar[Ng]) [τ,x],x] /. Flatten[Simplify[Solve[D[Ng[τ,x],x] - metricMatterEqnSolNgx  == 0 /. COVNgAωToLogscaleRule /. γTocsRule,D[(OverBar[Ng]) [τ,x],x]]]];
metricMatterEqnSolAbarxtmp   =  D[(OverBar[A]) [τ,x],x] /. Flatten[Simplify[Solve[D[A[τ,x],x] - metricMatterEqnSolAx  == 0 /. COVNgAωToLogscaleRule /. γTocsRule,D[(OverBar[A]) [τ,x],x]]]];
metricMatterEqnSolAbarτtmp   =  D[(OverBar[A]) [τ,x],τ] /. Flatten[Simplify[Solve[D[A[τ,x],τ] - metricMatterEqnSolAτ  == 0 /. COVNgAωToLogscaleRule /. γTocsRule,D[(OverBar[A]) [τ,x],τ]]]];
metricMatterEqnSolωbarxtmp   = D[(OverBar[ω])  [τ,x],x] /. Flatten[Simplify[Solve[D[ω[τ,x],x] - metricMatterEqnSolωx  == 0 /. COVNgAωToLogscaleRule /. γTocsRule,D[(OverBar[ω]) [τ,x],x]]]];
metricMatterEqnSolVxtmp          = metricMatterEqnSolVx /. COVNgAωToLogscaleRule /. γTocsRule ;

Introduce perturbations

We now introduce the perturbations: We extract the linear term by differentiating wrt to ϵ and then setting ϵ = 0.  We can readily do that for the N and A equations:

VariablesNAωVLinearPerturbationRule = {(OverBar[Ng]) -> Function[{τ,x},(Subscript[(OverBar[Ng]), css])[x]+ϵ (Subscript[(OverBar[Ng]), p])[τ,x]],(OverBar[A]) -> Function[{τ,x},(Subscript[(OverBar[A]), css])[x]+ϵ (Subscript[(OverBar[A]), p])[τ,x]], (OverBar[ω]) -> Function[{τ,x},(Subscript[(OverBar[ω]), css])[x]+ϵ (Subscript[(OverBar[ω]), p])[τ,x]],V -> Function[{τ,x},(Subscript[V, css])[x]+ϵ (Subscript[V, p])[τ,x]]};

metricMatterEqnSolNgbarpxtmp = D[metricMatterEqnSolNgbarxtmp /.VariablesNAωVLinearPerturbationRule,ϵ] /. ϵ -> 0;
metricMatterEqnSolAbarpxtmp   = D[metricMatterEqnSolAbarxtmp /.VariablesNAωVLinearPerturbationRule,ϵ] /. ϵ -> 0;
metricMatterEqnSolAbarpτtmp   = D[metricMatterEqnSolAbarτtmp /.VariablesNAωVLinearPerturbationRule,ϵ] /. ϵ -> 0;
Clear[metricMatterEqnSolNgbarxtmp,metricMatterEqnSolAbarxtmp,metricMatterEqnSolAbarτtmp]

For ω and V, we do something different. We could do the same as the above, however, the equations are of the form: f/s, where s is 0 at x = 1.  If we linearize it like that, we will get a 1/s^2 term by the end of the day. 
This will make the sonic constraint calculation difficult as the numerator will then already be 0 at x =1, without imposing anything on the perturbed fields. This will require a bit of trickery to “extract” the correct part. 
So, here will will instead keep stuff linear by writing the linear term in terms of unperturbed ω’ (i.e., we DO NOT use the CSS  equation to expand this!). After all, we know its (linear) PS expansion of ω! Here, ω’ is just (Subscript[ω, css])[1] (at x = 1) and we now what that is!
In the old attempt, we analytically wrote ω’ in terms of the background fields. As we said, this makes things complicated.

ωbarx = fω/sω;
Vx = fV/sV;
ωbarxPerturbationtmp = Series[(fω+ϵ δfω)/(sω+ϵ δsω),{ϵ,0,1}];
VxPerturbationtmp = Series[(fV+ϵ δfV)/(sV+ϵ δsV),{ϵ,0,1}];

We see that a 1/(s^2) emerges. We can remove it by writing this term as a function of ω’. We take the linear term.

ωbarpx = Coefficient[ωbarxPerturbationtmp /. fω -> (Subscript[ω, css])'[x] sω/(Subscript[ω, css])[x],ϵ,1] // Simplify; (*Using that (Subscript[(OverBar[ω]), css])' = (Subscript[ω, css])'/(Subscript[ω, css])*)
Vpx     = Coefficient[VxPerturbationtmp /. fV -> (Subscript[V, css])'[x] sV ,ϵ,1]// Simplify;

The power expansion of these CSS values are known. Here of course, we only need to go to 1st order, so they are in fact just constants! We will assume this later. We can now plug in the relevant expressions:

myδfω = SeriesCoefficient[Numerator[metricMatterEqnSolωbarxtmp] /. VariablesNAωVLinearPerturbationRule, {ϵ,0,1}];
 myδsω = SeriesCoefficient[Denominator[metricMatterEqnSolωbarxtmp] /. VariablesNAωVLinearPerturbationRule, {ϵ,0,1}];
myδfV = SeriesCoefficient[Numerator[metricMatterEqnSolVxtmp] /. VariablesNAωVLinearPerturbationRule, {ϵ,0,1}];
myδsV = SeriesCoefficient[Denominator[metricMatterEqnSolVxtmp] /. VariablesNAωVLinearPerturbationRule, {ϵ,0,1}];
metricMatterEqnSolωbarpxtmp   = ωbarpx  /. sω -> Denominator[metricMatterEqnSolωbarxtmp]/. VariablesNAωVLinearPerturbationRule /. ϵ -> 0 /. δfω -> myδfω /. δsω -> myδsω;
metricMatterEqnSolVpxtmp      = Vpx  /. sV -> Denominator[metricMatterEqnSolVxtmp]/. VariablesNAωVLinearPerturbationRule /. ϵ -> 0 /. δfV -> myδfV /. δsV -> myδsV;

Simplify

We can now simplify things by noting that (Subscript[(OverBar[h]), CSS]) = log((Subscript[h, CSS])).

LeadingOrderVariablesSimplificationRule = {(Subscript[(OverBar[Ng]), css]) -> Function[x,Log[(Subscript[Ng, css])[x]]],(Subscript[(OverBar[A]), css]) -> Function[x,Log[(Subscript[A, css])[x]]], (Subscript[(OverBar[ω]), css]) -> Function[x,Log[(Subscript[ω, css])[x]]]};	     
metricMatterEqnSolNgbarpx =Simplify[metricMatterEqnSolNgbarpxtmp /. LeadingOrderVariablesSimplificationRule];
metricMatterEqnSolAbarpx   = Simplify[metricMatterEqnSolAbarpxtmp /. LeadingOrderVariablesSimplificationRule];
metricMatterEqnSolAbarpτ   = Simplify[metricMatterEqnSolAbarpτtmp /. LeadingOrderVariablesSimplificationRule];
metricMatterEqnSolωbarpx   = Simplify[metricMatterEqnSolωbarpxtmp /. LeadingOrderVariablesSimplificationRule];
metricMatterEqnSolVpx          = Simplify[metricMatterEqnSolVpxtmp /. LeadingOrderVariablesSimplificationRule];
Clear[metricMatterEqnSolNgbarpxtmp,metricMatterEqnSolAbarpxtmp, metricMatterEqnSolAbarpτtmp,metricMatterEqnSolωbarpxtmp,metricMatterEqnSolVpxtmp]

The above are our system of PDE. Note that as for unperturbed case, both of the (OverBar[A]) equations induces an integrability condition.  This should be satisfied, using the above relations (for perturbed) and the unperturbed ones as well.

Check with KHA

Unevaluable.
We check that the equations obtained are the same as in KHA. We will first define the equations in KHA and substitute in the above expressions of derivatives of (Subscript[(OverBar[h]), p]) and see if we get 0.

asCheck  = 1;
bsCheck  = (γ+1) (Subscript[V, css])[x]/(1-(Subscript[V, css])[x]^2);
csCheck  = γ (Subscript[V, css])[x];
dsCheck  = (γ+1)/(1-(Subscript[V, css])[x]^2);
axCheck  = 1+(Subscript[Ng, css])[x] (Subscript[V, css])[x];
bxCheck  = (γ+1) ((Subscript[Ng, css])[x]+(Subscript[V, css])[x])/(1-(Subscript[V, css])[x]^2);
cxCheck  = γ ((Subscript[Ng, css])[x]+(Subscript[V, css])[x]);
dxCheck  = (γ+1) (1+(Subscript[Ng, css])[x] (Subscript[V, css])[x])/(1-(Subscript[V, css])[x]^2);
e1Check  = -(γ+3) (Subscript[A, css])[x] (Subscript[Ng, css])[x] (Subscript[V, css])[x]/2;
e2Check  = (3-3 γ) (Subscript[Ng, css])[x] (Subscript[V, css])[x]/2-(3+γ) (Subscript[A, css])[x] (Subscript[Ng, css])[x] (Subscript[V, css])[x]/2+(1-γ) (Subscript[ω, css])[x] (Subscript[Ng, css])[x] (Subscript[V, css])[x] - (Subscript[Ng, css])[x] (Subscript[V, css])[x] x D[(Subscript[ω, css])[x],x]/(Subscript[ω, css])[x]- (γ+1) (Subscript[Ng, css])[x] x D[(Subscript[V, css])[x],x]/(1-(Subscript[V, css])[x]^2);
e3Check = (1-γ) (Subscript[ω, css])[x] (Subscript[Ng, css])[x] (Subscript[V, css])[x];
e4Check  = (3-3 γ) (Subscript[Ng, css])[x]/2-(3+γ) (Subscript[A, css])[x] (Subscript[Ng, css])[x]/2 +(1-γ) (Subscript[ω, css])[x] (Subscript[Ng, css])[x] - (Subscript[Ng, css])[x] x D[(Subscript[ω, css])[x],x]/(Subscript[ω, css])[x]-(γ+1) (1+2 (Subscript[Ng, css])[x] (Subscript[V, css])[x]+(Subscript[V, css])[x]^2) x D[(Subscript[V, css])[x],x]/ (1-(Subscript[V, css])[x]^2)^2;
f1Check = -(1+3 γ) (Subscript[A, css])[x] (Subscript[Ng, css])[x]/2;
f2Check = (1-γ) γ (Subscript[ω, css])[x] (Subscript[Ng, css])[x]+(7 γ +1) (Subscript[Ng, css])[x]/2-(1+3 γ) (Subscript[A, css])[x] (Subscript[Ng, css])[x]/2-γ (Subscript[Ng, css])[x] x D[(Subscript[ω, css])[x],x]/(Subscript[ω, css])[x]- (γ+1) (Subscript[Ng, css])[x] (Subscript[V, css])[x] x D[(Subscript[V, css])[x],x]/(1-(Subscript[V, css])[x]^2);
f3Check = (1-γ) γ (Subscript[ω, css])[x] (Subscript[Ng, css])[x];
f4Check = -γ x D[(Subscript[ω, css])[x],x]/(Subscript[ω, css])[x] - (γ+1) ((Subscript[Ng, css])[x]+2 (Subscript[V, css])[x] + (Subscript[Ng, css])[x] (Subscript[V, css])[x]^2) x D[(Subscript[V, css])[x],x]/(1-(Subscript[V, css])[x]^2)^2;
g1Check = -(Subscript[A, css])[x];
g3Check = 2 (1+γ (Subscript[V, css])[x]^2) (Subscript[ω, css])[x]/(1-(Subscript[V, css])[x]^2);
g4Check = 4 (γ+1) (Subscript[ω, css])[x] (Subscript[V, css])[x]/(1-(Subscript[V, css])[x]^2)^2;
h1Check =  (Subscript[A, css])[x];
h3Check = (γ-1)  (Subscript[ω, css])[x];

ApeqnCheck = x D[(Subscript[(OverBar[A]), p])[τ,x],x] - g1Check (Subscript[(OverBar[A]), p])[τ,x] - g3Check (Subscript[(OverBar[ω]), p])[τ,x] - g4Check (Subscript[V, p])[τ,x] /. γTocsRule // Simplify;
NgpeqnCheck = x D[(Subscript[(OverBar[Ng]), p])[τ,x],x] - h1Check (Subscript[(OverBar[A]), p])[τ,x] - h3Check (Subscript[(OverBar[ω]), p])[τ,x] /. γTocsRule // Simplify;
ωpVpeqn1Check = asCheck D[(Subscript[(OverBar[ω]), p])[τ,x],τ] + bsCheck D[(Subscript[V, p])[τ,x],τ] + axCheck x D[(Subscript[(OverBar[ω]), p])[τ,x],x] + bxCheck x D[(Subscript[V, p])[τ,x],x] - e1Check (Subscript[(OverBar[A]), p])[τ,x] -e2Check (Subscript[(OverBar[Ng]), p])[τ,x]- e3Check (Subscript[(OverBar[ω]), p])[τ,x] - e4Check (Subscript[V, p])[τ,x] /.  γTocsRule // Simplify;
ωpVpeqn2Check = csCheck D[(Subscript[(OverBar[ω]), p])[τ,x],τ] + dsCheck D[(Subscript[V, p])[τ,x],τ] + cxCheck x D[(Subscript[(OverBar[ω]), p])[τ,x],x] + dxCheck x D[(Subscript[V, p])[τ,x],x] - f1Check (Subscript[(OverBar[A]), p])[τ,x] -f2Check (Subscript[(OverBar[Ng]), p])[τ,x]- f3Check (Subscript[(OverBar[ω]), p])[τ,x] - f4Check (Subscript[V, p])[τ,x] /. γTocsRule // Simplify;
algeqnCheck = D[(Subscript[(OverBar[A]), p])[τ,x],τ] + x D[(Subscript[(OverBar[A]), p])[τ,x],x] +2 (γ+1) (Subscript[Ng, css])[x] (Subscript[V, css])[x] (Subscript[ω, css])[x] ((Subscript[(OverBar[Ng]), p])[τ,x]+(Subscript[(OverBar[ω]), p])[τ,x])/(1-(Subscript[V, css])[x]^2) + 2 (γ+1) (Subscript[Ng, css])[x] (Subscript[ω, css])[x] (1+(Subscript[V, css])[x]^2)(Subscript[V, p])[τ,x]/(1-(Subscript[V, css])[x]^2)^2 /. γTocsRule // Simplify;

We check the N, A and “algeqn” equations:

Simplify[NgpeqnCheck/.  D[(Subscript[(OverBar[Ng]), p])[τ,x],x] -> Evaluate[metricMatterEqnSolNgbarpx]]
Simplify[ApeqnCheck /. D[(Subscript[(OverBar[A]), p])[τ,x],x] -> Evaluate[metricMatterEqnSolAbarpx]]
Simplify[algeqnCheck /. {D[(Subscript[(OverBar[A]), p])[τ,x],τ] -> Evaluate[metricMatterEqnSolAbarpτ], D[(Subscript[(OverBar[A]), p])[τ,x],x] -> Evaluate[metricMatterEqnSolAbarpx]}]

For ω and V, things are a bit more complicated. KHA equations were not solved for (Subscript[ω, x]) or (Subscript[V, x]) and were thus of the form: h*f = g. In our case, we have it like: f = g/h. If we expand it both systems and check the linear order, they differ by: ((Subscript[g, 0])/(Subscript[h, 0])-(Subscript[f, 0]))(Subscript[h, 1]), 
which is zero, but only if we assume that the leading order term equation is reinforced. In our case, the “f” is for the x-derivative of (Subscript[(OverBar[ω]), p]) and (Subscript[(OverBar[V]), p]) respectively and we see in KHA that “h” is only dependent  on N and V. 
So, we will also have to reinforce the leading order equation here.o much for him

metricMatterEqnFullCSSSolωxCheck = metricMatterEqnFullCSSSolωx /. {A[x] -> (Subscript[A, css])[x],Ng[x] -> (Subscript[Ng, css])[x],V[x] -> (Subscript[V, css])[x],ω[x] -> (Subscript[ω, css])[x]};
metricMatterEqnFullCSSSolVxCheck = metricMatterEqnFullCSSSolVx /. {A[x] -> (Subscript[A, css])[x],Ng[x] -> (Subscript[Ng, css])[x],V[x] -> (Subscript[V, css])[x],ω[x] -> (Subscript[ω, css])[x]};
ωxRuleCheck = D[(Subscript[ω, css])[x],x] -> Evaluate[metricMatterEqnFullCSSSolωxCheck];
VxRuleCheck = D[(Subscript[V, css])[x],x] -> Evaluate[metricMatterEqnFullCSSSolVxCheck];

Simplify[ωpVpeqn1Check /. {D[(Subscript[(OverBar[ω]), p])[τ,x],x] -> Evaluate[metricMatterEqnSolωbarpx], D[(Subscript[V, p])[τ,x],x] -> Evaluate[metricMatterEqnSolVpx]} /.  ωxRuleCheck /.  VxRuleCheck]
Simplify[ωpVpeqn2Check /. {D[(Subscript[(OverBar[ω]), p])[τ,x],x] -> Evaluate[metricMatterEqnSolωbarpx], D[(Subscript[V, p])[τ,x],x] -> Evaluate[metricMatterEqnSolVpx]}/.  ωxRuleCheck /.  VxRuleCheck]

ODE system for eigenmodes solutions

Eigenmodes ansatz and equations

We shall now look for eigenmodes (em) solutions: (Subscript[h, p])(τ,x) = (Subscript[h, p])(x) (e^(κτ)). Where κ is given in KHA to be approx 2.81.

VariablesNpApωpVpEMRule = {(Subscript[(OverBar[Ng]), p]) -> Function[{τ,x},(Subscript[(OverBar[Ng]), p]^em)[x] Exp[κ τ]], (Subscript[(OverBar[A]), p]) -> Function[{τ,x}, (Subscript[(OverBar[A]), p]^em)[x] Exp[κ τ]], (Subscript[(OverBar[ω]), p]) -> Function[{τ,x},(Subscript[(OverBar[ω]), p]^em)[x] Exp[κ τ]],
(Subscript[V, p]) -> Function[{τ,x},(Subscript[V, p]^em)[x] Exp[κ τ]]};
metricMatterEqnSolNgbarpEMx = D[(Subscript[(OverBar[Ng]), p]^em)[x],x] /. Flatten[Solve[D[(Subscript[(OverBar[Ng]), p])[τ,x],x] - metricMatterEqnSolNgbarpx == 0 /.VariablesNpApωpVpEMRule,D[(Subscript[(OverBar[Ng]), p]^em)[x],x]]] // Simplify
metricMatterEqnSolAbarpEMx = D[(Subscript[(OverBar[A]), p]^em)[x],x] /. Flatten[Solve[D[(Subscript[(OverBar[A]), p])[τ,x],x] - metricMatterEqnSolAbarpx == 0 /.VariablesNpApωpVpEMRule,D[(Subscript[(OverBar[A]), p]^em)[x],x]]] // FullSimplify
metricMatterEqnalgeqnpEM = Exp[-κ τ](D[(Subscript[(OverBar[A]), p])[τ,x],τ] - metricMatterEqnSolAbarpτ  /. VariablesNpApωpVpEMRule) // FullSimplify
metricMatterEqnSolωbarpEMx = D[(Subscript[(OverBar[ω]), p]^em)[x],x] /. Flatten[Solve[D[(Subscript[(OverBar[ω]), p])[τ,x],x] - metricMatterEqnSolωbarpx == 0 /. VariablesNpApωpVpEMRule,D[(Subscript[(OverBar[ω]), p]^em)[x],x]]] // Simplify
metricMatterEqnSolVpEMx = D[(Subscript[V, p]^em)[x],x] /. Flatten[Solve[D[(Subscript[V, p])[τ,x],x] - metricMatterEqnSolVpx == 0 /. VariablesNpApωpVpEMRule,D[(Subscript[V, p]^em)[x],x]]] // Simplify

Note that as before,  the (∂_τ)(OverBar[A]) equation has become an algebraic equation. We shall use it as a consistency check. Also note that the denominator in the matter equations is the same as for the perturbed case. 
Now of course, it is “fixed” as it depends only on the background variables. At this point, we shall take it for granted which variable we solve for and thus will suppress the “bar” part in the variables’ namings.

Algebraic equation consistency check

Unevaluable.
	Here we check that the algebraic equation is consistent with the above system of 4 ODEs. We differentiate the algebraic equation wrt to x and plug in all the relevant ODEs (background and perturbed) to remove all the derivatives.
	The final result should be ∝ to the algebraic equation.

algeqnx = D[metricMatterEqnalgeqnpEM,x];
	ruleCheck = {Ng -> (Subscript[Ng, css]),A -> (Subscript[A, css]),ω -> (Subscript[ω, css]),V -> (Subscript[V, css])};
	NgxCSSeqnRule = D[Ng[x],x] -> Evaluate[metricMatterEqnFullCSSSolNgx] /. ruleCheck;
	AxCSSeqnRule = D[A[x],x] -> Evaluate[metricMatterEqnFullCSSSolAx] /. ruleCheck;
	ωxCSSeqnRule = D[ω[x],x] -> Evaluate[metricMatterEqnFullCSSSolωx] /. ruleCheck;
	VxCSSeqnRule = D[V[x],x] -> Evaluate[metricMatterEqnFullCSSSolVx] /. ruleCheck;

algeqnxnoCSSder = algeqnx /. {NgxCSSeqnRule,AxCSSeqnRule,ωxCSSeqnRule,VxCSSeqnRule} // Simplify;

NgbarxpeqnRule = D[(Subscript[(OverBar[Ng]), p]^em)[x],x] -> Evaluate[metricMatterEqnSolNgbarpEMx];
	AbarxpeqnRule = D[(Subscript[(OverBar[A]), p]^em)[x],x] -> Evaluate[metricMatterEqnSolAbarpEMx];
	ωbarxpeqnRule = D[(Subscript[(OverBar[ω]), p]^em)[x],x] -> Evaluate[metricMatterEqnSolωbarpEMx];
	VxpeqnRule = D[(Subscript[V, p]^em)[x],x] -> Evaluate[metricMatterEqnSolVpEMx];

algeqnxNoCSSderNoPerturbedDer = algeqnxnoCSSder /. NgbarxpeqnRule /. AbarxpeqnRule/. ωbarxpeqnRule /. VxpeqnRule  // Simplify;

algeeqnMultiple = algeqnxNoCSSderNoPerturbedDer /. {NgxCSSeqnRule,AxCSSeqnRule,ωxCSSeqnRule,VxCSSeqnRule} // Simplify

Simplify[metricMatterEqnalgeqnpEM/algeeqnMultiple](*This shows they are multiple of each other*)

Full system

metricMatterODEFullNpApωpVp = Table[0,{i,1,4}];
	   (metricMatterODEFullNpApωpVp[[1]] = 
	   Simplify[Denominator[metricMatterEqnSolNgbarpEMx] (Subscript[(OverBar[Ng]), p]^em)'[x] - Numerator[metricMatterEqnSolNgbarpEMx]]) /. pp
	   (metricMatterODEFullNpApωpVp[[2]] = 
	   Simplify[Denominator[metricMatterEqnSolAbarpEMx] (Subscript[(OverBar[A]), p]^em)'[x] - Numerator[metricMatterEqnSolAbarpEMx]] ) /. pp
	   (metricMatterODEFullNpApωpVp[[3]] = 
	   Simplify[Denominator[metricMatterEqnSolωbarpEMx] (Subscript[(OverBar[ω]), p]^em)'[x] - Numerator[metricMatterEqnSolωbarpEMx]]) /. pp
	   (metricMatterODEFullNpApωpVp[[4]] = 
	   Simplify[Denominator[metricMatterEqnSolVpEMx] (Subscript[V, p]^em)'[x] - Numerator[metricMatterEqnSolVpEMx]]) /. pp

The above are the compiled ODE system of 4 equations.

Reduced system

We also compile the Reduced system equations, which will be used when shooting.

AbarSolRuletmp = Flatten[Simplify[Solve[metricMatterEqnalgeqnpEM == 0,(Subscript[(OverBar[A]), p]^em)[x]]]];
	   AbarSolRule = Block[{x}, (Subscript[(OverBar[A]), p]^em) -> Function @@ List[{x},(Subscript[(OverBar[A]), p]^em)[x] /.  AbarSolRuletmp]];
	   metricMatterODEReducedNpApωpVp = Table[0,{i,1,3}];
	    (metricMatterODEReducedNpApωpVp[[1]] = 
	   Simplify[Denominator[metricMatterEqnSolNgbarpEMx] (Subscript[(OverBar[Ng]), p]^em)'[x] - Numerator[metricMatterEqnSolNgbarpEMx] /. AbarSolRule]) /. pp
	    (metricMatterODEReducedNpApωpVp[[2]] = 
	   Simplify[Denominator[metricMatterEqnSolωbarpEMx] (Subscript[(OverBar[ω]), p]^em)'[x] - Numerator[metricMatterEqnSolωbarpEMx]/. AbarSolRule]) /. pp
	    (metricMatterODEReducedNpApωpVp[[3]] = 
	   Simplify[Denominator[metricMatterEqnSolVpEMx] (Subscript[V, p]^em)'[x] - Numerator[metricMatterEqnSolVpEMx]/. AbarSolRule] ) /. pp
	   Clear[AbarSolRuletmp];

Power series solution at origin

Power series ansatz near x = 0

Recall that most variables are logs! In order to avoid conical singularity, we impose regularity at the center: (Subscript[(OverBar[A]), p])(τ,0) = 0.  One also imposes the condition that (Subscript[V, p])(τ,0) = 0, since the velocity should be an odd function of x. 
This fixes the leading order terms in the variables’ respective expansions. Both of these condition can be seen to be reinforced at the leading order of the equations anyway.

We define the expansion for both unperturbed (up) and perturbed (p) variables. The unperturbed expansion are of of course known  (see: Power series solution at Origin), and in particular their expansion is readily known. 
The perturbed ones’ are really ansätze.  A posteriori, one can improve on it as the first 3 turn out to be even and the last one odd. See the end of next section for more details.

Note: be very careful on how you decide how many coefficients are enough. For example n=4 is needed in order to solve for (OverBar[ω])[2]  correctly. The reason is now, we expand not only in the p variables, but also the up variables! 
It turns out that a factor ~(Subscript[ω, css])[4] is involved!! This is because of the (Subscript[ω, css])’[x] (starts at ~x), with “enough” factors of (Subscript[Ng, css]) (which starts at ~1/x) to “bring the term down”.

PSpOrderOrigin = 2; (*Make sure there are enough up coefficients for later simplification*)
PSupAnsatzOriginRule = 
{(Subscript[Ng, css]) -> Function[x,Evaluate[Sum[(Subscript[Ng, css]^c)[n] x^n,{n,-1,PSpOrderOrigin,2}]]],
(Subscript[A, css]) -> Function[x,Evaluate[1+Sum[(Subscript[A, css]^c)[n] x^n,{n,2,PSpOrderOrigin,2}]]], 
(Subscript[ω, css]) -> Function[x,Evaluate[Sum[(Subscript[ω, css]^c)[n] x^n,{n,2, PSpOrderOrigin+2,2}]]], (*Notice the +2*)
(Subscript[V, css]) -> Function[x,Evaluate[Sum[(Subscript[V, css]^c)[n] x^n,{n,1,PSpOrderOrigin,2}]]]};
PSpAnsatzOriginRule = 
{(Subscript[(OverBar[Ng]), p]^em) -> Function[x,Evaluate[Sum[(Subscript[(OverBar[Ng]), p]^(em,c))[n] x^n,{n,0,PSpOrderOrigin}]]],
(Subscript[(OverBar[A]), p]^em) -> Function[x,Evaluate[Sum[(Subscript[(OverBar[A]), p]^(em,c))[n] x^n,{n,1,PSpOrderOrigin}]]], 
(Subscript[(OverBar[ω]), p]^em) -> Function[x,Evaluate[Sum[(Subscript[(OverBar[ω]), p]^(em,c))[n] x^n,{n,0, PSpOrderOrigin}]]],
(Subscript[V, p]^em) -> Function[x,Evaluate[Sum[(Subscript[V, p]^(em,c))[n] x^n,{n,1,PSpOrderOrigin}]]]};

Also, we write down at each order, which variables we will solve for:

PSpUnknownOrigin = {Table[(Subscript[(OverBar[Ng]), p]^(em,c))[n],{n,1,PSpOrderOrigin}],Table[(Subscript[(OverBar[A]), p]^(em,c))[n],{n,1,PSpOrderOrigin}], Table[(Subscript[(OverBar[ω]), p]^(em,c))[n],{n,1,PSpOrderOrigin}],Table[(Subscript[V, p]^(em,c))[n],{n,1,PSpOrderOrigin}]};

Full ODEs PS solution

Structure of equations

We check the structure of the equations. We expect as before (Subscript[(OverBar[Ng]), p])[0] and (Subscript[(OverBar[ω]), p])[0] to remain arbitrary, so we check that we have the necessary amount of equations.  Again, one can check that this is the case by just looking at the equations order by order.

MatrixPlot[Simplify[Table[SeriesCoefficient[metricMatterODEFullNpApωpVp /.PSupAnsatzOriginRule /. PSpAnsatzOriginRule, {x,0,n}] ,{n,0,PSpOrderOrigin-1}]]] (*Made it non-evaluable*)

The first two slots are trivial using the constraints on the leading order coefficients of the perturbed variables. By inspection, one sees that the matter equation of V has a term up to ~ 1/x.  
	We therefore multiply it by x and bring the equation down by one, to make everything on the same level. This means that now, we solve the leading order equations ~ 0(1) for the linear coefficients, the ~0(x) equations will be solved 
	for the 2nd order coefficients,etc. So, for a given expansion order n, we will therefore solve the first n-1 order equations. This makes also the calculations much faster, since before, going to say 2nd order means that the matter equations will have 6 terms, 
	ranging from ~0(1/x) to ~0(x^2), which is overkill, if we want only to know the first few terms in the expansion. This is why the below is much quicker. The 1/x term is in KHA what is referred (in the x -> - ∞ analysis) the expanding mode. 
	The solution to make this vanish corresponds to the V[1] solution. This is a bit like in the unperturbed case.

Rescale equations

metricMatterODEFullPSpOriginNpApωpVp = Simplify[Table[SeriesCoefficient[{1/x,1/x,1/x,x}metricMatterODEFullNpApωpVp /. PSupAnsatzOriginRule /. PSpAnsatzOriginRule,{x,0,n}],{n,0, PSpOrderOrigin-1}]];
	(*Note that we go only up to n - 1 instead of n as before. The rescaling needs to be done INSIDE the Series function!*)
	MatrixPlot[metricMatterODEFullPSpOriginNpApωpVp]

Solve the system

metricMatterODEFullPSpOriginSolRuleNpApωpVptmp = Flatten[Simplify[Solve[Map[# == 0&,metricMatterODEFullPSpOriginNpApωpVp],Flatten[PSpUnknownOrigin]]]]; 
	(*The Map is used to extract all the elements in metricMatter... to put them as individual equations*)

We express all the unperturbed coefficients in terms of the free variables (Subscript[Ng, CSS0])[-1] and (Subscript[ω, CSS0])[2].

ruletmp = {(Ng^c) -> (Subscript[Ng, css]^c),(A^c) -> (Subscript[A, css]^c),(ω^c) -> (Subscript[ω, css]^c),(V^c) -> (Subscript[V, css]^c)};
	metricMatterODEReducedCSSPSOriginSolRuleNωVup = metricMatterODEReducedCSSPSOriginSolRuleNωV /. ruletmp;
	metricMatterODEFullPSpOriginSolRuleNpApωpVp = Simplify[metricMatterODEFullPSpOriginSolRuleNpApωpVptmp /. metricMatterODEReducedCSSPSOriginSolRuleNωVup]
	Clear[ruletmp]

Note that the above strongly suggest that we could refine our ansatz, by making (OverBar[N]), (OverBar[ω]) and (OverBar[A]) even functions, while we take V to be odd. It might sound odd that we need say (OverBar[N]) to be even, although the unperturbed version and the full function really needs to be odd. 
	The reason is because one consider the Log of the function. Roughly (see notes): Log [(Subscript[c, -1])/x + (Subscript[c, 1])x + ... ] = Log[1/x] + Log[(Subscript[c, -1]) +(Subscript[c, 1]) (x^2)+...].  Last part gives an even expansion. The first part is a bit of a problem, but I believe that inside the equations and 
	with the appropriate constraints made in the PS of our variables, this term drops out. For example, the ω variable has an expansion starting as 0(x^2).  
	This means that, its Log expansion will exhibit a term Log[x^2], which probably cancels out with the above somewhere down the line...

Algebraic Equation Consistency check

We easily check that the solution is consistent with the algebraic equation.  Plugging the solution above into the algebraic equation should make all terms ~ O((x^n)) vanish. 
		Note that to make this happen, one needs to use the regularity condition: (Subscript[lim, x -> 0]) NV = -2/(3(1+(Subscript[c, S])^2)),  for the unperturbed variables.

Simplify[Series[metricMatterEqnalgeqnpEM /.  PSupAnsatzOriginRule /. PSpAnsatzOriginRule /. metricMatterODEFullPSpOriginSolRuleNpApωpVp /. 
		metricMatterODEReducedCSSPSOriginSolRuleNωVup,{x,0,PSpOrderOrigin}]]
		Clear[ruletmp];

Power series solution at sonic

We have a gauge freedom that comes from the unperturbed part of N (see notes). For simplicity, we shall take (Subscript[(OverBar[N]), p]^em)(x = 1) = 0 as gauge choice.
Note: I DON’T think that this gauge choice can also be seen as coming from the scale invariance of the perturbed equations (since linear order equations are scale invariant virtually by definition).

Power series ansatz near x = 1

Similarly as before, we define the relevant expansions. Note the N starts at linear order due to the gauge choice.

PSpOrderUnit = 1;
PSupAnsatzUnitRule = 
{(Subscript[Ng, css]) -> Function[x,Evaluate[Sum[(Subscript[Ng, css]^s)[n] (x-1)^n,{n,0,PSpOrderUnit}]]],
(Subscript[A, css]) -> Function[x,Evaluate[Sum[(Subscript[A, css]^s)[n] (x-1)^n,{n,0,PSpOrderUnit}]]], 
(Subscript[ω, css]) -> Function[x,Evaluate[Sum[(Subscript[ω, css]^s)[n] (x-1)^n,{n,0, PSpOrderUnit}]]],
(Subscript[V, css]) -> Function[x,Evaluate[Sum[(Subscript[V, css]^s)[n] (x-1)^n,{n,0,PSpOrderUnit}]]]};
PSpAnsatzUnitRule = 
{(Subscript[(OverBar[Ng]), p]^em) -> Function[x,Evaluate[Sum[(Subscript[(OverBar[Ng]), p]^(em,s))[n] (x-1)^n,{n,1,PSpOrderUnit}]]],
(Subscript[(OverBar[A]), p]^em) -> Function[x,Evaluate[Sum[(Subscript[(OverBar[A]), p]^(em,s))[n] (x-1)^n,{n,0,PSpOrderUnit}]]], 
(Subscript[(OverBar[ω]), p]^em) -> Function[x,Evaluate[Sum[(Subscript[(OverBar[ω]), p]^(em,s))[n] (x-1)^n,{n,0, PSpOrderUnit}]]],
(Subscript[V, p]^em) -> Function[x,Evaluate[Sum[(Subscript[V, p]^(em,s))[n] (x-1)^n,{n,0,PSpOrderUnit}]]]};

Also, we write down at each order, which variables we will solve for:

PSpUnknownUnit = {Table[(Subscript[(OverBar[Ng]), p]^(em,s))[n],{n,1,PSpOrderUnit}],Table[(Subscript[(OverBar[A]), p]^(em,s))[n],{n,1,PSpOrderUnit}], Table[(Subscript[(OverBar[ω]), p]^(em,s))[n],{n,1,PSpOrderUnit}],Table[(Subscript[V, p]^(em,s))[n],{n,1,PSpOrderUnit}]}; (*This variable is not used I believe*)

Sonic constraint

Like for the unperturbed case, we require the numerator of both ω and V equations to be zero at the sonic point. Note that the denominator is only dependent on the up variables, so there is nothing to change here.
Note that had we explicitly expanded (Subscript[ω, css])’ in terms of the CSS variables, we would have gotten and additional singular factor in the denominator! This was what was done in the Old Attempt. 
This makes things complicated since after all, 
this causes a degeneracy in the data, which we already solved for, so it is best to leave it like that and only expand it as a power series where coefficients are known as there were previously calculated.

Set up for numerators of matter field equations

metricMatterEqnSolωbarpEMxNumerator = Numerator[metricMatterEqnSolωbarpEMx];
	metricMatterEqnSolVpEMxNumerator        = Numerator[metricMatterEqnSolVpEMx];

We power expand the above near x = 1 and evaluate the above at x = 1.

metricMatterEqnSolωbarpEMxNumeratorLeadingOrder =  metricMatterEqnSolωbarpEMxNumerator /. PSupAnsatzUnitRule /. PSpAnsatzUnitRule /. x -> 1;
	metricMatterEqnSolVpEMxNumeratorLeadingOrder = metricMatterEqnSolVpEMxNumerator /. PSupAnsatzUnitRule /. PSpAnsatzUnitRule /. x -> 1;

Use regularity condition for background fields

Both numerators should be proportional to each other once we apply the reg. condition at that point. Note that we already applied the gauge condition in the PS expansion.

Let us first update the regularity at sonic point for unperturbed coefficients:

ruletmp = {(Ng^s)[0] -> (Subscript[Ng, css]^s)[0], (A^s)[0] -> (Subscript[A, css]^s)[0],(ω^s)[0] -> (Subscript[ω, css]^s)[0], (V^s)[0] -> (Subscript[V, css]^s)[0]};
	RegularitySonicRuleFullup = RegularitySonicRuleFull /. ruletmp;
	Clear[ruletmp];

Set ω numerator to 0 and check consistency with V numerator

VpLeadingOrderRegularitytmp =  Simplify[Flatten[Solve[metricMatterEqnSolVpEMxNumeratorLeadingOrder == 0, (Subscript[V, p]^(em,s))[0]] /. RegularitySonicRuleFullup]];

We check that this indeed makes the numerator of V equation disappear:

ruletmp = {(Ng^s)[0] -> (Subscript[Ng, css]^s)[0], (A^s)[0] -> (Subscript[A, css]^s)[0],(ω^s)[0] -> (Subscript[ω, css]^s)[0], (V^s)[0] -> (Subscript[V, css]^s)[0], (Ng^s)[1] -> (Subscript[Ng, css]^s)[1], (A^s)[1] -> (Subscript[A, css]^s)[1],(ω^s)[1] -> (Subscript[ω, css]^s)[1], (V^s)[1] -> (Subscript[V, css]^s)[1]};   
	metricMatterODEFullCSSPSUnitSolRuleLinear = Flatten[Extract[metricMatterODEFullCSSPSUnitSolRuleDegeneracy,{{1},{2},{3,3},{4,3}}]] /. ruletmp; 
	Simplify[metricMatterEqnSolωbarpEMxNumeratorLeadingOrder /. RegularitySonicRuleFullup /.VpLeadingOrderRegularitytmp] /. metricMatterODEFullCSSPSUnitSolRuleLinear // Simplify
	Clear[ruletmp,VpLeadingOrderRegularitytmp];

Note the use of double Simplify. This makes things faster, to first simplify as much as possible before plugging in the up sonic linear coefficients.

Use algebraic equation as additional constraint to find regularity rule for perturbed fields

We have a second algebraic relation at our disposal, via the leading order term in the algebraic equation. We use this in junction with the above to only leave leading term in A free.
	Note, we chose to solve the V equation instead of ω, because the solutions are more compact.
	Note: from alg eqn of (Subscript[A, p]), we see that at the solution at the sonic point is really fully determined actually.

metricMatterEqnalgeqnpEMtmp = Simplify[metricMatterEqnalgeqnpEM /. PSupAnsatzUnitRule /. PSpAnsatzUnitRule /. x -> 1];
	RegularitySonicRuleFullp = Simplify[Flatten[Solve[metricMatterEqnSolVpEMxNumeratorLeadingOrder == 0 && metricMatterEqnalgeqnpEMtmp == 0, {(Subscript[(OverBar[ω]), p]^(em,s))[0],(Subscript[V, p]^(em,s))[0]}]] /. RegularitySonicRuleFullup]
	Clear[metricMatterEqnalgeqnpEMtmp];

Full ODEs PS solution

Structure of equations

As usual, let us check the structure of the equations.

MatrixPlot[Simplify[Table[SeriesCoefficient[metricMatterODEFullNpApωpVp /.  PSupAnsatzUnitRule /.  PSpAnsatzUnitRule /. 
RegularitySonicRuleFullup /. RegularitySonicRuleFullp, {x,1,n}] ,{n,0,PSpOrderUnit-1}]]] (* Un-evaluable since a bit expensive*)

Note that by construction the 0th order V term disappears. The ω equation also disappears, but we also need to plug in the  expressions for ω[1] and V[1], but this is a bit much for the above, so we do it here. This only causes the ω equation to vanishes. 
	The leading terms of N and A equations remain non-trivial. Note the use of two Simplify. This is because the last rule is very expensive and we first wish for the computer to simplify things before doing this substitution. Otherwise, the calculation is MUCH longer.

Simplify[metricMatterODEFullNpApωpVp[[3]] /. PSupAnsatzUnitRule /. PSpAnsatzUnitRule /. x -> 1 /. RegularitySonicRuleFullup /. RegularitySonicRuleFullp] /.  metricMatterODEFullCSSPSUnitSolRuleLinear // Simplify

Solve for N and A

Since the equations are relatively big, we will split the calculations in 4 parts. We can first solve for N and A separately.

NgbarEMLinearTermRule = Flatten[Simplify[Solve[SeriesCoefficient[metricMatterODEFullNpApωpVp[[1]] /.  PSupAnsatzUnitRule /.  PSpAnsatzUnitRule /.
RegularitySonicRuleFullp /. RegularitySonicRuleFullup ,{x,1,0}] == 0, (Subscript[(OverBar[Ng]), p]^(em,s))[1]]]];
	NgbarEMLinearTerm = (Subscript[(OverBar[Ng]), p]^(em,s))[1] /. NgbarEMLinearTermRule

AbarEMLinearTermRule = Flatten[Simplify[Solve[SeriesCoefficient[
	   metricMatterODEFullNpApωpVp[[2]] /.  PSupAnsatzUnitRule /.  PSpAnsatzUnitRule /. 
	   RegularitySonicRuleFullup /.   RegularitySonicRuleFullp,{x,1,0}] == 0, (Subscript[(OverBar[A]), p]^(em,s))[1]]]];
		   AbarEMLinearTerm = (Subscript[(OverBar[A]), p]^(em,s))[1] /. AbarEMLinearTermRule

Solve for ω and V

Now, solving for ω and V. Here, this is a system of two equations. We DO NOT use the p regularity condition, as this is too much work. We saw that leading order vanishes (assuming we plug everything in) as so, we solve the linear order.

ωPSpEquation = Simplify[SeriesCoefficient[metricMatterODEFullNpApωpVp[[3]] /.  PSupAnsatzUnitRule /.  PSpAnsatzUnitRule,{x,1,1}] /. RegularitySonicRuleFullup];
	VPSpEquation = Simplify[SeriesCoefficient[metricMatterODEFullNpApωpVp[[4]] /.  PSupAnsatzUnitRule /.  PSpAnsatzUnitRule,{x,1,1}] /. RegularitySonicRuleFullup];

ωbarVEMLinearTermRuletmp = Flatten[Solve[ωPSpEquation == 0 && VPSpEquation == 0,{(Subscript[(OverBar[ω]), p]^(em,s))[1],(Subscript[V, p]^(em,s))[1]}]]; 
	(*Do not ask for a Simplify! This is too big and we will use the numerics now anyway*)

Note that the solution depends on the values of the linear order coefficients of N and A.

ωbarEMLinearTermRule = ωbarVEMLinearTermRuletmp[[1]];
	ωbarEMLinearTerm          = (Subscript[(OverBar[ω]), p]^(em,s))[1] /. ωbarEMLinearTermRule;
	VEMLinearTermRule        = ωbarVEMLinearTermRuletmp[[2]];
	VEMLinearTerm                 = (Subscript[V, p]^(em,s))[1] /. VEMLinearTermRule;

Compile solution

Again, let us compile all the rules above:

metricMatterODEFullPSpUnitSolRuleNpApωpVp = Flatten[{NgbarEMLinearTermRule,AbarEMLinearTermRule,ωbarEMLinearTermRule,VEMLinearTermRule}];

We see that we are somewhat reaching the limits of what Mathematica can do here. We shall therefore proceed to use the known numerical values for the unperturbed coefficients. 
We shall only retain κ and the unknown p coefficients as symbolic of course. We will plug in the value of κ for the shooting.

Numerics of unperturbed and perturbed coefficients

Numerical approximation of the unperturbed solutions

Since Mathematica has trouble above to keep working in closed form, we shall plug-in the calculated values for the unperturbed variables. This is of course also needed for the shooting.

Numerical set-up of unperturbed coefficients

We write up  all the solutions we have for the unperturbed coefficients, by plugging in the values obtained from the Shooting.
mycRule should have been defined when shooting for the background variables!!

ruletmp = {(Ng^c) -> (Subscript[Ng, css]^c),(A^c) -> (Subscript[A, css]^c),(ω^c) -> (Subscript[ω, css]^c),(V^c) -> (Subscript[V, css]^c),(Ng^s) -> (Subscript[Ng, css]^s),(A^s) -> (Subscript[A, css]^s), (ω^s) -> (Subscript[ω, css]^s),(V^s) -> (Subscript[V, css]^s)};
	RegularitySonicRuleFullup = RegularitySonicRuleFull /. ruletmp; (*Already defined before*)
	Ngm1ω2V0RuleUnperturbed = Ngm1ω2V0Rule /. ruletmp;

metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbed = metricMatterODEReducedCSSPSOriginSolRuleNωV /. ruletmp;

metricMatterODEFullCSSPSUnitSolRuleLinear = Flatten[Extract[metricMatterODEFullCSSPSUnitSolRuleDegeneracy ,{{1},{2},{3,3},{4,3}}]] /. ruletmp; 
	Clear[ruletmp];(*Already defined above*)

metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbedNumerictmp = Simplify[metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbed /. Ngm1ω2V0RuleUnperturbed /. mycRule];
	metricMatterODEFullCSSPSUnitSolRuleLinearNumerictmp = Simplify[metricMatterODEFullCSSPSUnitSolRuleLinear /. Ngm1ω2V0RuleUnperturbed /. mycRule];
	RegularitySonicRuleFullUnperturbedNumeric = Simplify[RegularitySonicRuleFullup /. Ngm1ω2V0RuleUnperturbed /. mycRule];

The above are the respective values for the unperturbed coefficients at x = 0 and x = 1 expansions. Recall that the regularity condition also fixes 3 out of 4 leading order coefficients. 
	For completeness, we shall compile all the values together:

metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbedNumeric = Flatten[{(Subscript[A, css]^c)[0] -> 1, Ngm1ω2V0RuleUnperturbed[[1;;2]], metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbedNumerictmp}];
	metricMatterODEFullCSSPSUnitSolRuleLinearNumeric =Flatten[{RegularitySonicRuleFullUnperturbedNumeric, Ngm1ω2V0RuleUnperturbed[[3]], metricMatterODEFullCSSPSUnitSolRuleLinearNumerictmp}];
	Clear[metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbedNumerictmp,metricMatterODEFullCSSPSUnitSolRuleLinearNumerictmp]

Numerical approximation of the perturbed solutions

Since Mathematica has trouble above to keep working in closed form, we shall plug-in the calculated numerical values for the perturbed variables.

Numerical solutions of the perturbed coefficients at origin

Applying the assumptions in the General Set-up section, we update the solutions found above:

metricMatterODEFullPSpOriginSolRuleNpApωpVpNumeric = Simplify[metricMatterODEFullPSpOriginSolRuleNpApωpVp /. metricMatterODEReducedCSSPSOriginSolRuleNωVUnperturbedNumeric /. mycRule]

Numerical solutions of the perturbed coefficients at unit

We can now proceed to do the same for the Unit coefficients. Recall that we still need to find ω and V.  We first approx the solutions for N and A and update the equations to be solved with it.
	Note that for ω and V, we also plug in the obtained numeric values for N and A.

Numerically approximate each coefficient individually

RegularitySonicRuleFullPerturbedNumeric = Simplify[RegularitySonicRuleFullp /. metricMatterODEFullCSSPSUnitSolRuleLinearNumeric /. mycRule]

NgbarEMLinearTermRuleNumeric = Simplify[NgbarEMLinearTermRule /. metricMatterODEFullCSSPSUnitSolRuleLinearNumeric /. mycRule];
		NgbarEMLinearTermNumeric          = (Subscript[(OverBar[Ng]), p]^(em,s))[1] /. NgbarEMLinearTermRuleNumeric;
		AbarEMLinearTermRuleNumeric = Simplify[AbarEMLinearTermRule /. metricMatterODEFullCSSPSUnitSolRuleLinearNumeric /. mycRule];
		AbarEMLinearTermNumeric          = (Subscript[(OverBar[A]), p]^(em,s))[1] /. AbarEMLinearTermRuleNumeric;
		ωbarEMLinearTermRuleNumeric = Simplify[ωbarEMLinearTermRule /. metricMatterODEFullCSSPSUnitSolRuleLinearNumeric /. NgbarEMLinearTermRuleNumeric /. AbarEMLinearTermRuleNumeric /.
		RegularitySonicRuleFullPerturbedNumeric  /. mycRule];
		ωbarEMLinearTermNumeric          = (Subscript[(OverBar[ω]), p]^(em,s))[1] /. ωbarEMLinearTermRuleNumeric;
		VEMLinearTermRuleNumeric = Simplify[VEMLinearTermRule /. metricMatterODEFullCSSPSUnitSolRuleLinearNumeric /. NgbarEMLinearTermRuleNumeric /. AbarEMLinearTermRuleNumeric /.
		RegularitySonicRuleFullPerturbedNumeric  /. mycRule];
		VEMLinearTermNumeric          = (Subscript[V, p]^(em,s))[1] /. VEMLinearTermRuleNumeric;

Compile numerics

Again let us compile everything:

metricMatterODEFullPSpUnitSolRuleNpApωpVpNumeric = Flatten[{RegularitySonicRuleFullPerturbedNumeric,NgbarEMLinearTermRuleNumeric,AbarEMLinearTermRuleNumeric,
		ωbarEMLinearTermRuleNumeric,VEMLinearTermRuleNumeric}];

Shooting for perturbed fields

Let us proceed to shooting. We considered the full system up till now. For the shooting, we wish to fix the three free coefficients (two from Origin expansion and one from Unit). This means that it is easiest to have
3 ODEs instead of 4. 
Again, the algebraic equation allows us to remove, say, the A’ ODE. We are thus left with a system of 3 ODEs in N, ω and V. For the IC  (initial conditions) at the origin, we go up to 1st order.
They are all of the form: X(ϵ) = X[0]+ϵ X[1]. We then solve the system with NDSolve up to x = 0.5 with those IC. This allows us “to start” away from the degeneracy. The solution formally depends on our arbitrary
variables (Subscript[(OverBar[Ng]), p]^(em,s))[0] and (Subscript[(OverBar[ω]), p]^(em,s))[0] for this expansion. We will also do and expansion at x = 1, depending on (Subscript[(OverBar[A]), p]^(em,s))[0]. The mismatch between those two expansions will be checked at x = 0.5, fixing the coefficients
(we will use FindRoot). The reason as to why in the perturbed case, we do not need to go up to 2nd order,  unlike the unperturbed case, is because we see that each of the variables are non-trivial to linear order.
Before, recall that ω needed to go to 2nd order to be non-trivial and the IC would not depend on (ω^c)[2] making the system unsolvable later. This is not the case here.

Initial conditions and parameters set-up

Set-up

The value (Subscript[c, S])has been defined in the background shooting and of course has to be the same here.

κKHA = 2.8105525488; (*Found in KHA. This is really for double check with the κ we will find below*)
κKHARule = κ -> κKHA;

Note that  the point at which we will evaluate the mismatch between the two shootings, i.e. myEvaluation, NEEDS to be the same as the one used for background case. It can be made to be independent, but not worth the additional trouble....

IC at origin

ICPerturbedOriginOrder1[Nbar0_,ωbar0_,ϵpara_,κpara_] := {(Subscript[(OverBar[Ng]), p]^(em,c))[0]+x (Subscript[(OverBar[Ng]), p]^(em,c))[1] ,(Subscript[(OverBar[ω]), p]^(em,c))[0]+x (Subscript[(OverBar[ω]), p]^(em,c))[1],x (Subscript[V, p]^(em,c))[1]} /. 
metricMatterODEFullPSpOriginSolRuleNpApωpVpNumeric/. {κ -> κpara,x -> ϵpara , (Subscript[(OverBar[Ng]), p]^(em,c))[0] -> Nbar0, (Subscript[(OverBar[ω]), p]^(em,c))[0] -> ωbar0}

Note that for radiation fluid, the linear term for N is actually 0. It would anyway not make any difference compared to the ~ 0(1/x) term. Also, note that we do not specify (Subscript[c, S]) as it is already assumed to be radiation fluid.

IC at sonic point

Now doing the same thing for the x = 1 expansion.We also go to 1st order. As for unperturbed case, for small enough ϵ,  we do not expect 2nd order to make a significant difference.

ICPerturbedUnitOrder1[Abars_,ϵpara_,κpara_] := Simplify[{(-1+x) (Subscript[(OverBar[Ng]), p]^(em,s))[1],(Subscript[(OverBar[ω]), p]^(em,s))[0]+(-1+x) (Subscript[(OverBar[ω]), p]^(em,s))[1],(Subscript[V, p]^(em,s))[0]+(-1+x) (Subscript[V, p]^(em,s))[1]} /. 
metricMatterODEFullPSpUnitSolRuleNpApωpVpNumeric /. {κ -> κpara,x ->1-ϵpara, (Subscript[(OverBar[A]), p]^(em,s))[0] -> Abars}]

Left and right shootings and mismatch resolution

Left expansion shooting, x = 0

Solve the ODE system. The 2nd function has as additional input the evaluation of the solution at a given point. We define both the rule and the corresponding evaluations.
NDSOLVE does not seem to being able to handle subscripts etc, so, we will remove them from the equations:

metricMatterODEPerturbationReducedShootingLeftExpansionRule[evaluation_?NumericQ,Nbarp0_?NumericQ,ωbarp0_?NumericQ, ϵpara_?NumericQ, κpara_?NumericQ] := Flatten[NDSolve[
{metricMatterODEReducedNpApωpVp[[1]] == 0 /. backgroundFieldsRule[leftShootingEval]  /. mycRule /. κ -> κpara,
metricMatterODEReducedNpApωpVp[[2]] == 0 /. backgroundFieldsRule[leftShootingEval] /. mycRule  /. κ -> κpara,
metricMatterODEReducedNpApωpVp[[3]] == 0  /. backgroundFieldsRule[leftShootingEval] /. mycRule  /. κ -> κpara, 
(Subscript[(OverBar[Ng]), p]^em)[ϵpara] == ICPerturbedOriginOrder1[Nbarp0,ωbarp0,ϵpara,κpara][[1]],
(Subscript[(OverBar[ω]), p]^em)[ϵpara] == ICPerturbedOriginOrder1[Nbarp0,ωbarp0,ϵpara,κpara][[2]],
(Subscript[V, p]^em)[ϵpara] == ICPerturbedOriginOrder1[Nbarp0,ωbarp0,ϵpara,κpara][[3]]},{(Subscript[(OverBar[Ng]), p]^em),(Subscript[(OverBar[ω]), p]^em),(Subscript[V, p]^em)},{x,ϵpara,evaluation}]]
metricMatterODEPerturbationReducedShootingLeftExpansion[evaluation_?NumericQ,N0_?NumericQ,ω0_?NumericQ, ϵpara_?NumericQ,κpara_?NumericQ] := 
	{(Subscript[(OverBar[Ng]), p]^em)[evaluation],(Subscript[(OverBar[ω]), p]^em)[evaluation],(Subscript[V, p]^em)[evaluation]} /. metricMatterODEPerturbationReducedShootingLeftExpansionRule[evaluation,N0,ω0,ϵpara,κpara]

Testing if the above is fine with some arbitrary input.

metricMatterODEPerturbationReducedShootingLeftExpansionRule[myEvaluation,1,10,myϵ,κKHA]

leftPlottmp = metricMatterODEPerturbationReducedShootingLeftExpansionRule[myEvaluation,1,10,myϵ,κKHA];
metricMatterODEPerturbationReducedShootingLeftExpansion[myEvaluation,1,10,myϵ,κKHA];
Plot[Evaluate[{(Subscript[(OverBar[Ng]), p]^em)[x],(Subscript[(OverBar[ω]), p]^em)[x],(Subscript[V, p]^em)[x]} /. leftPlottmp],{x,myϵ,myEvaluation}]
Clear[leftPlottmp];

Right expansion shooting, x = 1

We similarly define the shooting process for both of the degenerate solutions:

metricMatterODEPerturbationReducedShootingRightExpansionRule[evaluation_?NumericQ,Abars_?NumericQ,ϵpara_?NumericQ, κpara_?NumericQ] := Flatten[NDSolve[
{metricMatterODEReducedNpApωpVp[[1]] == 0 /. backgroundFieldsRule[rightShootingEval]/. mycRule /. κ -> κpara,
metricMatterODEReducedNpApωpVp[[2]] == 0 /. backgroundFieldsRule[rightShootingEval]/. mycRule /. κ -> κpara,
metricMatterODEReducedNpApωpVp[[3]] == 0  /. backgroundFieldsRule[rightShootingEval] /. mycRule /. κ -> κpara, 
(Subscript[(OverBar[Ng]), p]^em)[1-ϵpara] == ICPerturbedUnitOrder1[Abars,ϵpara,κpara][[1]], (Subscript[(OverBar[ω]), p]^em)[1-ϵpara] == ICPerturbedUnitOrder1[Abars,ϵpara,κpara][[2]],
(Subscript[V, p]^em)[1-ϵpara] == ICPerturbedUnitOrder1[Abars,ϵpara,κpara][[3]]},{(Subscript[(OverBar[Ng]), p]^em), (Subscript[(OverBar[ω]), p]^em),(Subscript[V, p]^em)},{x,1-ϵpara,evaluation}]]
metricMatterODEPerturbationReducedShootingRightExpansion[evaluation_?NumericQ,Abars_?NumericQ,ϵpara_?NumericQ,κpara_?NumericQ] := 
	{(Subscript[(OverBar[Ng]), p]^em)[evaluation],(Subscript[(OverBar[ω]), p]^em)[evaluation],(Subscript[V, p]^em)[evaluation]} /.  metricMatterODEPerturbationReducedShootingRightExpansionRule[evaluation,Abars,ϵpara,κpara]

metricMatterODEPerturbationReducedShootingRightExpansionRule[myEvaluation,10,myϵ,κKHA]
metricMatterODEPerturbationReducedShootingRightExpansion[myEvaluation,0.5,myϵ,κKHA]

rightPlottmp = metricMatterODEPerturbationReducedShootingRightExpansionRule[myEvaluation,10,myϵ,κKHA];
Plot[Evaluate[{(Subscript[(OverBar[Ng]), p]^em)[x],(Subscript[(OverBar[ω]), p]^em)[x],(Subscript[V, p]^em)[x]} /. rightPlottmp],{x,myEvaluation,1-myϵ}]
Clear[rightPlottmp];

Mismatch between the two shootings at evaluation point

Here, we define the mismatch at the “midpoint” and solve for the variables (Ng^c)[-1], (ω^c)[2] and (V^s)[0] so that the mismatch is negligible.
Note that we have 3 variables to solve for and we will get a non-linear system of 3 equation. We denote the above 3 variables as "N0, ω0, VS” respectively.

metricMatterODEReducedPerturbationShootingMismatch[evaluation_?NumericQ,Nbar0_?NumericQ,ωbar0_?NumericQ, Abars_?NumericQ,ϵpara_?NumericQ,κpara_?NumericQ] :=
	metricMatterODEPerturbationReducedShootingLeftExpansion[evaluation,Nbar0,ωbar0,ϵpara,κpara] - metricMatterODEPerturbationReducedShootingRightExpansion[evaluation,Abars,ϵpara,κpara]

For the Shooting, we need starting values. Therefore, we manually do some trial and error until we obtain a low mismatch:

metricMatterODEReducedPerturbationShootingMismatch[myEvaluation,-1,0.5,0.2,myϵ,2]

Given the correct κ, we can solve the system. This is not great because finding κ should be part of the problem and the system is anyway not well defined, because the system is homogenous and thus has a scaling invariance!
The answer happens to be correct however. We keep it for archiving purposes:

Solve the mismatch

Solving for the variables given κ (old)

This has been made unevaluatable. It does not work really well and see next section as to why. Solving for the variables,

Ngbarp0ωbarp0Abarp1Rule = FindRoot[metricMatterODEReducedPerturbationShootingMismatch[myEvaluation,(Subscript[(OverBar[Ng]), p]^(em,c))[0],(Subscript[(OverBar[ω]), p]^(em,c))[0], (Subscript[(OverBar[A]), p]^(em,s))[0],myϵ,myκ],{{(Subscript[(OverBar[Ng]), p]^(em,c))[0],0.4},{(Subscript[(OverBar[ω]), p]^(em,c))[0],0.3},{(Subscript[(OverBar[A]), p]^(em,s))[0],0.3}}]

Checking accuracy of the solution:

metricMatterODEReducedPerturbationShootingMismatch[myEvaluation,-0.5919539546205757`,0.8001027621653967`, 0.29991647567699886`,myϵ,κKHA]

plotleft = metricMatterODEPerturbationReducedShootingLeftExpansionRule[myEvaluation,-0.591953954620`,0.800102762165`,myϵ,κKHA]
	plotright = metricMatterODEPerturbationReducedShootingRightExpansionRule[myEvaluation,0.29991647567699886`,myϵ,κKHA]		   
	Show[Plot[{(Subscript[(OverBar[Ng]), p]^em)[x] /. plotleft,(Subscript[(OverBar[ω]), p]^em)[x] /. plotleft,(Subscript[V, p]^em)[x] /. plotleft},{x,myϵ,0.5},
		PlotLegends-> Placed[{"N(x)","ω(x)","V(x)"},{0.3,0.65}], AxesLabel-> {"x","y"},LabelStyle->{Bold}],
		Plot[{(Subscript[(OverBar[Ng]), p]^em)[x] /. plotright,(Subscript[(OverBar[ω]), p]^em)[x] /. plotright,(Subscript[V, p]^em)[x] /. plotright},{x,0.5,1-myϵ}], PlotRange -> All]
	Clear[plotleft,plotright]

Solve variables and κ by gauging one variable (homogenous equations)

Unevaluable. Unlike old version section before, this is a more “correct” method on how to approach it. The idea is to fix the value of one unknown, say N and then solve for the remaining 2 as well as κ. For some reason, 
	the computer has a lot of trouble and the answer is not very good although the general shape looks correct.  For some reason, changing h makes things worse, although it should not matter. The answer is  also not very stable. I have no idea why this does not work....
	This might be because fixing (Subscript[N, p])[-1] = 0 is like fixing the scale invariance? Look at alg eqn for (Subscript[A, p]). It is scale invariant as it should be, but fixing (Subscript[N, p])[-1] to some value fixes the rest maybe? Although it is zero in this case?

h = 1;
	TESTNgbarp0ωbarp0Abarp1Ruletmp = FindRoot[metricMatterODEReducedPerturbationShootingMismatch[myEvaluation,-0.6 h,(Subscript[(OverBar[ω]), p]^(em,c))[0] h,(Subscript[(OverBar[A]), p]^(em,s))[0] h,myϵ,κ],
	{{(Subscript[(OverBar[ω]), p]^(em,c))[0],0.8 h},{(Subscript[(OverBar[A]), p]^(em,s))[0], 0.3 h},{κ,2.8}}]

metricMatterODEReducedPerturbationShootingMismatch[myEvaluation,-0.6,(Subscript[(OverBar[ω]), p]^(em,c))[0],(Subscript[(OverBar[A]), p]^(em,s))[0],myϵ,κ] /.  TESTNgbarp0ωbarp0Abarp1Ruletmp

plotleft = metricMatterODEPerturbationReducedShootingLeftExpansionRule[myEvaluation,-0.6,(Subscript[(OverBar[ω]), p]^(em,c))[0],myϵ,κ] /. TESTNgbarp0ωbarp0Abarp1Ruletmp;
	plotright = metricMatterODEPerturbationReducedShootingRightExpansionRule[myEvaluation,(Subscript[(OverBar[A]), p]^(em,s))[0],myϵ,κ] /. TESTNgbarp0ωbarp0Abarp1Ruletmp;		   
	Show[Plot[{(Subscript[(OverBar[Ng]), p]^em)[x] /. plotleft,(Subscript[(OverBar[ω]), p]^em)[x] /. plotleft,(Subscript[V, p]^em)[x] /. plotleft},{x,myϵ,0.5},
		PlotLegends-> Placed[{"N(x)","ω(x)","V(x)"},{0.3,0.65}], AxesLabel-> {"x","y"},LabelStyle->{Bold}],
		Plot[{(Subscript[(OverBar[Ng]), p]^em)[x] /. plotright,(Subscript[(OverBar[ω]), p]^em)[x] /. plotright,(Subscript[V, p]^em)[x] /. plotright},{x,0.5,1-myϵ}], PlotRange -> All]
	Clear[plotleft,plotright]

Determinant method

Find κ

The mismatch is of the form: m = A(κ)*f, where A is a matrix of κ and f is the vector of the 3 unknowns. To find a non-trivial solution, we require det A = 0, giving a non-linear equation for κ. 
		This κ means that the matrix A will have an eigenvalue which is close to zero. We solve for the associated eigenvector. This vector then satisfies m = 0 (to a good order).

MisMatchMatrix[κpara_?NumericQ] := Transpose[
		{metricMatterODEReducedPerturbationShootingMismatch[myEvaluation,1,0,0,myϵ,κpara],
		metricMatterODEReducedPerturbationShootingMismatch[myEvaluation,0,1,0,myϵ,κpara],
		metricMatterODEReducedPerturbationShootingMismatch[myEvaluation,0,0,1,myϵ,κpara]}];
		MisMatchMatrixdet[κpara_?NumericQ] := Det[MisMatchMatrix[κpara]]

Plot[MisMatchMatrixdet[k],{k,0,3},PlotPoints->2,AxesLabel -> {"(Subscript[λ, 0])", "det A"}]

Note that we have 3 possible growing eigenmodes! The last one, is the same as for Evans and Coleman. The middle one (~ can be seen to make function only (C^0) at the midpoint 0.5). As a side note, this is the drawback of this method.
			We only require the mismatch to be very small at the evaluation (by default, it is 0.5), but not regular. 
			The middle point is wrong also for a different reason. By changing the evaluation point, myEvaluation, the middle root actually changes as well! This of course should not be the case. The smallest and largest value do not change though.
			The largest value is the Evans and Coleman eigenmode. The first one is a pure gauge mode, see Koike Hara Adachi “Renormalization group and critical behaviour in gravitational collapse” section F. and G.2). Recall we fix gauge
			at the sonic point: (Subscript[Nbar, p])(s, (Subscript[x, s]))=0, we get (Subscript[κ, gauge]) = - (Subscript[dN, css])/dx ((Subscript[x, s]))~ 0.3557. We will therefore move one with the only remaining physical mode.

myκRule = FindRoot[MisMatchMatrixdet[κ] == 0,{κ,2.8},WorkingPrecision-> 6];
			myκ = κ /. myκRule

Checking the error with the value from KHA:

κKHA/myκ - 1

This works better than the old mismatch attempt 2 sections above, since the system does not depend on scaling, so the first attempt is ill defined.

Find free coefficients as eigenvalue problem

Here, we look for an eigenvector corresponding to this κ (which produces an eigenvalue close to 0). This gives a solution for the 3 variables but again only up to scaling, which is what it should be.

Eigensystem[MisMatchMatrix[myκ]]

The eigenvector of interest is the one associated with the eigenvalue close to zero. So, we take:

Ngbarp0ωbarp0Abarp1 = Flatten[Extract[Eigensystem[MisMatchMatrix[myκ]],{{2,3}}]]
		Ngbarp0ωbarp0Abarp1Rule = {(Subscript[(OverBar[Ng]), p]^(em,c))[0] -> Ngbarp0ωbarp0Abarp1[[1]],(Subscript[(OverBar[ω]), p]^(em,c))[0] -> Ngbarp0ωbarp0Abarp1[[2]],(Subscript[(OverBar[A]), p]^(em,s))[0] -> Ngbarp0ωbarp0Abarp1[[3]]}

Double-check the precision obtained:

Dot[MisMatchMatrix[myκ],Ngbarp0ωbarp0Abarp1]

metricMatterODEReducedPerturbationShootingMismatch[myEvaluation,(Subscript[(OverBar[Ng]), p]^(em,c))[0],(Subscript[(OverBar[ω]), p]^(em,c))[0],(Subscript[(OverBar[A]), p]^(em,s))[0],myϵ,myκ] /. Ngbarp0ωbarp0Abarp1Rule

Plot between center and sonic point

We can now plot the whole shooting with those values:

plotleft   = metricMatterODEPerturbationReducedShootingLeftExpansionRule[myEvaluation,(Subscript[(OverBar[Ng]), p]^(em,c))[0],(Subscript[(OverBar[ω]), p]^(em,c))[0],myϵ,myκ] /. Ngbarp0ωbarp0Abarp1Rule;
plotright = metricMatterODEPerturbationReducedShootingRightExpansionRule[myEvaluation,(Subscript[(OverBar[A]), p]^(em,s))[0],myϵ,myκ] /. Ngbarp0ωbarp0Abarp1Rule; 
Show[Plot[{(Subscript[(OverBar[Ng]), p]^em)[x] /. plotleft,(Subscript[(OverBar[ω]), p]^em)[x] /. plotleft,(Subscript[V, p]^em)[x] /. plotleft},{x,myϵ,0.5},
	PlotLegends-> Placed[{"N(x)","ω(x)","V(x)"},{0.3,0.65}], AxesLabel-> {"x","y"},LabelStyle->{Bold}],
	Plot[{(Subscript[(OverBar[Ng]), p]^em)[x] /. plotright,(Subscript[(OverBar[ω]), p]^em)[x] /. plotright,(Subscript[V, p]^em)[x] /. plotright},{x,0.5,1-myϵ}], PlotRange -> All]
Clear[plotleft,plotright]

We also do a log plot:

plotleft = metricMatterODEPerturbationReducedShootingLeftExpansionRule[myEvaluation,(Subscript[(OverBar[Ng]), p]^(em,c))[0],(Subscript[(OverBar[ω]), p]^(em,c))[0],myϵ,myκ] /. Ngbarp0ωbarp0Abarp1Rule;
plotright = metricMatterODEPerturbationReducedShootingRightExpansionRule[myEvaluation,(Subscript[(OverBar[A]), p]^(em,s))[0],myϵ,myκ] /. Ngbarp0ωbarp0Abarp1Rule;
Show[Plot[{(Subscript[(OverBar[Ng]), p]^em)[Exp[logx]] /. plotleft,(Subscript[(OverBar[ω]), p]^em)[Exp[logx]] /. plotleft,(Subscript[V, p]^em)[Exp[logx]] /. plotleft},{logx,-8,Log[0.5]},
	PlotLegends-> Placed[{"N(x)","ω(x)","V(x)"},{0.3,0.65}], AxesLabel-> {"x","y"},LabelStyle->{Bold}],
	Plot[{(Subscript[(OverBar[Ng]), p]^em)[Exp[logx]] /. plotright,(Subscript[(OverBar[ω]), p]^em)[Exp[logx]] /. plotright,(Subscript[V, p]^em)[Exp[logx]] /. plotright},{logx,Log[0.5],Log[1-myϵ]}], PlotRange -> All,AspectRatio -> 1.2]
Clear[plotleft,plotright]

Full shooting

Now that we have the values for our variables, we perform the shooting with them on a bigger interval.

Interval of shooting

intervalRight = 1000; (*We will shoot to get a solution on the interval (0,intervalRight). Above we stopped at 1.
	Make sure that this is consistent with the background field case! It should be no bigger. Above we stopped at 1.*)

IC at origin

TrueICPerturbedOriginOrder1[ϵpara_] :=  {(Subscript[(OverBar[Ng]), p]^(em,c))[0]+x (Subscript[(OverBar[Ng]), p]^(em,c))[1] ,(Subscript[(OverBar[ω]), p]^(em,c))[0]+x (Subscript[(OverBar[ω]), p]^(em,c))[1],x (Subscript[V, p]^(em,c))[1]} /. metricMatterODEFullPSpOriginSolRuleNpApωpVpNumeric /. Ngbarp0ωbarp0Abarp1Rule /. {κ -> myκ,x -> ϵpara}

IC at sonic point

The “minus” and “plus” expansion, close to x = 1.

TrueICPerturbedUnitmOrder1[ϵpara_] := Simplify[{(-1+x) (Subscript[(OverBar[Ng]), p]^(em,s))[1],(Subscript[(OverBar[ω]), p]^(em,s))[0]+(-1+x) (Subscript[(OverBar[ω]), p]^(em,s))[1],(Subscript[V, p]^(em,s))[0]+(-1+x) (Subscript[V, p]^(em,s))[1]} /. metricMatterODEFullPSpUnitSolRuleNpApωpVpNumeric /.
Ngbarp0ωbarp0Abarp1Rule /. {κ -> myκ,x ->1-ϵpara}]

TrueICPerturbedUnitpOrder1[ϵpara_] := Simplify[{(-1+x) (Subscript[(OverBar[Ng]), p]^(em,s))[1],(Subscript[(OverBar[ω]), p]^(em,s))[0]+(-1+x) (Subscript[(OverBar[ω]), p]^(em,s))[1],(Subscript[V, p]^(em,s))[0]+(-1+x) (Subscript[V, p]^(em,s))[1]} /.  metricMatterODEFullPSpUnitSolRuleNpApωpVpNumeric /.
Ngbarp0ωbarp0Abarp1Rule /. {κ -> myκ,x ->1+ϵpara}]

Expansions and partial shootings

Left expansion

TrueMetricMatterODEPerturbationReducedShootingLeftExpansionRule[evaluation_?NumericQ,ϵ_?NumericQ] := Flatten[NDSolve[
{metricMatterODEReducedNpApωpVp[[1]] == 0 /. backgroundFieldsRule[leftShootingEval] /. mycRule /. myκRule,
metricMatterODEReducedNpApωpVp[[2]] == 0 /. backgroundFieldsRule[leftShootingEval] /. mycRule /. myκRule,
metricMatterODEReducedNpApωpVp[[3]] == 0  /. backgroundFieldsRule[leftShootingEval] /. mycRule /. myκRule, 
(Subscript[(OverBar[Ng]), p]^em)[ϵ] == TrueICPerturbedOriginOrder1[ϵ][[1]],(Subscript[(OverBar[ω]), p]^em)[ϵ] == TrueICPerturbedOriginOrder1[ϵ][[2]], (Subscript[V, p]^em)[ϵ] == TrueICPerturbedOriginOrder1[ϵ][[3]]},{(Subscript[(OverBar[Ng]), p]^em),(Subscript[(OverBar[ω]), p]^em),(Subscript[V, p]^em)},{x,ϵ,evaluation}]]

Now, for the Right expansion, NDSolve finds the system too stiff/ a singularity too close to x = 1. So, we need to explicitly avoid it. We therefore do an expansion close to 1 from the left and right respectively.

Right expansion up to (SuperMinus[1])

TrueMetricMatterODEPerturbationReducedShootingRightmExpansionRule[evaluation_?NumericQ,ϵ_?NumericQ] := Flatten[NDSolve[
{metricMatterODEReducedNpApωpVp[[1]] == 0 /. backgroundFieldsRule[rightShootingEval] /. mycRule /. myκRule,
metricMatterODEReducedNpApωpVp[[2]] == 0 /. backgroundFieldsRule[rightShootingEval] /. mycRule /. myκRule,
metricMatterODEReducedNpApωpVp[[3]] == 0  /. backgroundFieldsRule[rightShootingEval] /. mycRule /. myκRule, 
(Subscript[(OverBar[Ng]), p]^em)[1-ϵ] == TrueICPerturbedUnitmOrder1[ϵ][[1]],(Subscript[(OverBar[ω]), p]^em)[1-ϵ] == TrueICPerturbedUnitmOrder1[ϵ][[2]], (Subscript[V, p]^em)[1-ϵ] == TrueICPerturbedUnitmOrder1[ϵ][[3]]},{(Subscript[(OverBar[Ng]), p]^em),(Subscript[(OverBar[ω]), p]^em),(Subscript[V, p]^em)},{x,evaluation,1-ϵ}]]

Shooting up to 1

We shoot from the left of x = 1, to the evaluation (typically 0.5). Note that ϵ should not be too small, as explained above. We also plot A, obtained via perturbed algebraic equation.

plotleft = TrueMetricMatterODEPerturbationReducedShootingLeftExpansionRule[myEvaluation,myϵ];
plotright = TrueMetricMatterODEPerturbationReducedShootingRightmExpansionRule[myEvaluation,myϵ]; 
Show[Plot[{(Subscript[(OverBar[Ng]), p]^em)[Exp[logx]] /. plotleft,
		(Subscript[(OverBar[A]), p]^em)[Exp[logx]] /. AbarSolRule /. mycRule /. backgroundFieldsRule[leftShootingEval] /. myκRule  /. plotleft,
		 (Subscript[(OverBar[ω]), p]^em)[Exp[logx]] /. plotleft,
		(Subscript[V, p]^em)[Exp[logx]] /. plotleft},{logx,-8,Log[0.5]},
		PlotLegends-> Placed[{"N(x)","A(x)","ω(x)","V(x)"},{0.8,1}], AxesLabel-> {"ln(x)","y"},LabelStyle->{Bold}],
	Plot[{(Subscript[(OverBar[Ng]), p]^em)[Exp[logx]] /. plotright,
		(Subscript[(OverBar[A]), p]^em)[Exp[logx]] /. AbarSolRule /. mycRule /. backgroundFieldsRule[rightShootingEval] /. myκRule /. plotright,
		(Subscript[(OverBar[ω]), p]^em)[Exp[logx]] /. plotright,
		(Subscript[V, p]^em)[Exp[logx]] /. plotright}, {logx,Log[0.5],Log[1-myϵ]}], PlotRange -> All]
Clear[plotleft,plotright]

Right expansion from (SuperPlus[1])

The expansion starting slightly from the right of x = 1. Again, be careful not to make ϵ too small.  This is because for too small ϵ, NDSolve finds a singularity or the equations too stiff.

TrueMetricMatterODEPerturbationReducedShootingRightpExpansionRule[evaluation_?NumericQ,ϵ_?NumericQ] := Flatten[NDSolve[
{metricMatterODEReducedNpApωpVp[[1]] == 0 /. backgroundFieldsRule[rightShootingEval] /. mycRule /. myκRule,
metricMatterODEReducedNpApωpVp[[2]] == 0 /. backgroundFieldsRule[rightShootingEval] /. mycRule /. myκRule,
metricMatterODEReducedNpApωpVp[[3]] == 0  /. backgroundFieldsRule[rightShootingEval] /. mycRule /. myκRule, 
(Subscript[(OverBar[Ng]), p]^em)[1+ϵ] == TrueICPerturbedUnitpOrder1[ϵ][[1]],(Subscript[(OverBar[ω]), p]^em)[1+ϵ] == TrueICPerturbedUnitpOrder1[ϵ][[2]], (Subscript[V, p]^em)[1+ϵ] == TrueICPerturbedUnitpOrder1[ϵ][[3]]},{(Subscript[(OverBar[Ng]), p]^em),(Subscript[(OverBar[ω]), p]^em),(Subscript[V, p]^em)},{x,1+ϵ,intervalRight}]]

Shooting from (SuperPlus[1])

plotright = TrueMetricMatterODEPerturbationReducedShootingRightpExpansionRule[myEvaluation,myϵ]; 
Plot[{(Subscript[(OverBar[Ng]), p]^em)[Exp[logx]] /. plotright,
	(Subscript[(OverBar[A]), p]^em)[Exp[logx]] /. AbarSolRule /. mycRule /. backgroundFieldsRule[rightShootingEval] /. myκRule/. plotright,
	 (Subscript[(OverBar[ω]), p]^em)[Exp[logx]] /. plotright,(Subscript[V, p]^em)[Exp[logx]] /. plotright},{logx,Log[1+myϵ],Log[intervalRight]}, PlotLegends-> Placed[{"N(x)","A(x)","ω(x)","V(x)"},{0.8,1}], 
	 AxesLabel-> {"ln(x)","y"},LabelStyle->{Bold}]
Clear[plotright]

Full shooting plot

Set up

Now that we have all the functions, from x = 0 to (SuperMinus[1]) and from (SuperPlus[1]) to 1000, we can all plug it together in a single plot. We will use here not Show, like before, but we will first piece together the function and then plot it. 
Mind that the region between (SuperMinus[1]) and (SuperPlus[1]) is really not defined unfortunately....
This is similar than what was done for the background coefficients. We also define the different evaluation for left, rightm (right minus for up to (SuperMinus[1])) and rightp (right plus for starting at (SuperPlus[1])).

perturbedcoefficientsRuleLeft     = TrueMetricMatterODEPerturbationReducedShootingLeftExpansionRule[myEvaluation,myϵ];
perturbedcoefficientsRuleRightm = TrueMetricMatterODEPerturbationReducedShootingRightmExpansionRule[myEvaluation,myϵ];
perturbedcoefficientsRuleRightp = TrueMetricMatterODEPerturbationReducedShootingRightpExpansionRule[myEvaluation,myϵ];
myNgbarpRule[xcoord_] := Piecewise[{{perturbedcoefficientsRuleLeft[[1]],0 < xcoord ≤ myEvaluation},
{perturbedcoefficientsRuleRightm[[1]],myEvaluation < xcoord ≤ 1-myϵ},
{perturbedcoefficientsRuleRightp[[1]],1+myϵ ≤ xcoord ≤ intervalRight}}];
myNgbarp[xcoord_] := (Subscript[(OverBar[Ng]), p]^em)[xcoord] /. myNgbarpRule[xcoord];
myωbarpRule[xcoord_] := Piecewise[{{perturbedcoefficientsRuleLeft[[2]],0 < xcoord ≤ myEvaluation},
{perturbedcoefficientsRuleRightm[[2]],myEvaluation < xcoord ≤ 1-myϵ},
{perturbedcoefficientsRuleRightp[[2]],1+myϵ ≤ xcoord ≤ intervalRight}}];
myωbarp[xcoord_] := (Subscript[(OverBar[ω]), p]^em)[xcoord] /. myωbarpRule[xcoord];
myVpRule[xcoord_] := Piecewise[{{perturbedcoefficientsRuleLeft[[3]],0 < xcoord ≤ myEvaluation},
{perturbedcoefficientsRuleRightm[[3]],myEvaluation < xcoord ≤ 1-myϵ},
{perturbedcoefficientsRuleRightp[[3]],1+myϵ ≤ xcoord ≤ intervalRight}}];
myVp[xcoord_] := (Subscript[V, p]^em)[xcoord] /. myVpRule[xcoord];

We can then write A as a function of the above, via the perturbed algebraic equation:

myAbarpRule[xcoord_] :=   AbarSolRule /. backgroundFieldsRule[xcoord] /. myNgbarpRule[xcoord] /. myωbarpRule[xcoord] /. myVpRule[xcoord] /. mycRule /. myκRule;
myAbarp[xcoord_] := (Subscript[(OverBar[A]), p]^em)[xcoord] /. myAbarpRule[xcoord];

(OverBar[N]), (OverBar[A]), (OverBar[ω]), V variables

We plot everything and scale it by up 40 (recall that the perturbed fields are only defined up to a scale) in order to match the KHA picture.

Show[Plot[{40 myNgbarp[Exp[logx]], 40 myAbarp[Exp[logx]], 40 myωbarp[Exp[logx]],40 myVp[Exp[logx]]},{logx,-8,Log[intervalRight]},  AxesLabel-> {"ln(x)"},
LabelStyle->{Bold}, 
AxesOrigin -> {-8,-30}, PlotLegends -> Placed[{"(Subscript[(OverBar[N]), 1])","(Subscript[(OverBar[A]), 1])","(Subscript[(OverBar[ω]), 1])","(Subscript[v, 1])"},{0.5, 1}]], Graphics[{Dashed,Line[{{0,-30},{0,40}}]}],Graphics[{Dashed,Line[{{-8,0},{8,0}}]}]]

α, a, 4π (R^2)ρ, V variables

Show[Plot[{x (Subscript[Ng, css]) [x] Sqrt[(Subscript[A, css])[x]] (myNgbarp[x] + myAbarp[x]/2)  /.  backgroundFieldsRule[leftShootingEval],
Sqrt[(Subscript[A, css])[x]] myAbarp[x]/2 /.  backgroundFieldsRule[leftShootingEval],
(Subscript[ω, css])[x] (myωbarp[x] - myAbarp[x])/( (Subscript[A, css])[x]) /.  backgroundFieldsRule[leftShootingEval],
myVp[x] /.  backgroundFieldsRule[leftShootingEval]} ,
	{x,0.00001,myEvaluation}, PlotRange->All, AxesLabel-> {"x"},AxesOrigin -> {0,-0.8},LabelStyle->{Bold},PlotLegends -> Placed[{"(Subscript[α, 1])","(Subscript[a, 1])","4((πR)^2)(Subscript[ρ, 1])","(Subscript[v, 1])"},{0.5, 1}]],
Plot[{x (Subscript[Ng, css]) [x] Sqrt[(Subscript[A, css])[x]] (myNgbarp[x] + myAbarp[x]/2)  /.  backgroundFieldsRule[rightShootingEval],
Sqrt[(Subscript[A, css])[x]] myAbarp[x]/2 /.  backgroundFieldsRule[rightShootingEval],
(Subscript[ω, css])[x] (myωbarp[x] - myAbarp[x])/((Subscript[A, css])[x]) /.  backgroundFieldsRule[rightShootingEval],
myVp[x] /.  backgroundFieldsRule[rightShootingEval]} ,
	{x,myEvaluation, 4}, PlotRange->All, AxesLabel-> {"x"},LabelStyle->{Bold}],
 Graphics[{Dashed,Line[{{0,0},{4,0}}]}]]

Comparison with numerics

Coordinate transformation so that (Subscript[α, p])=0 at the centre.

myfs = f[s] /. Flatten[DSolve[myNgbarp[0.000001] +  myAbarp[0.000001]/2 + f[s] ((Subscript[Ng, css]) '[0.000001]/(Subscript[Ng, css]) [0.000001] + (Subscript[A, css])' [0.000001]/(Subscript[A, css])[0.000001]/2) + f'[s] == 0 
/.  backgroundFieldsRule[leftShootingEval],f,s]]

datavpert = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","v_critical_pert.txt"}], "Table"];
tstar = 1.17214;
mytpert =1.1687903055861089;
datavpertmodified = datavpert;
Do[datavpertmodified[[n,1]] = datavpert[[n,1]]/(tstar-mytpert),{n,1,Length[datavpert]}]
myvcssarray = datavpertmodified;
Do[If[myvcssarray[[n,1]] < myEvaluation/scale,myvcssarray[[n,2]] = (Subscript[V, css])[scale myvcssarray[[n,1]]]/.  backgroundFieldsRule[leftShootingEval],
myvcssarray[[n,2]] = (Subscript[V, css])[scale myvcssarray[[n,1]]]/.  backgroundFieldsRule[rightShootingEval]],{n,1,Length[datavpertmodified]}]
vnumcssDiffarray = myvcssarray;
ϵscale = -4.;
myintegcons = -myfs /. C[1] -> 0;
Do[vnumcssDiffarray[[n,2]] =  ϵscale (datavpertmodified[[n,2]] - myvcssarray[[n,2]]),{n,1,Length[myvcssarray]}]
Show[ListPlot[{vnumcssDiffarray} , PlotRange->{{0.0001,4.},Automatic},Frame->True, FrameLabel->{"","(Subscript[v, 1])"},
PlotMarkers->{Automatic,4},PlotStyle->{Black,Thickness[linethickness]}, FrameTicksStyle->{{Automatic,Automatic},{Directive[FontOpacity->0,FontSize->0],Automatic}}],
Plot[(myVp[scale x] + myfs (Subscript[V, css])[scale x] /.  backgroundFieldsRule[leftShootingEval] /. s -> 0 /. C[1] -> myintegcons),{x,0.00001, myEvaluation/scale}],
Plot[(myVp[scale x] + myfs (Subscript[V, css])[scale x] /.  backgroundFieldsRule[rightShootingEval]/. s -> 0 /. C[1] -> myintegcons),{x,myEvaluation/scale, 4}]]

dataapert = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","a_critical_pert.txt"}], "Table"];
dataapertmodified = dataapert;
Do[dataapertmodified[[n,1]] = dataapert[[n,1]]/(tstar-mytpert),{n,1,Length[dataapert]}]
myacssarray = dataapertmodified;
Do[If[myacssarray[[n,1]] < myEvaluation/scale,myacssarray[[n,2]] = Sqrt[(Subscript[A, css])[scale myacssarray[[n,1]]]]/.  backgroundFieldsRule[leftShootingEval],
myacssarray[[n,2]] = Sqrt[(Subscript[A, css])[scale myacssarray[[n,1]]]]/.  backgroundFieldsRule[rightShootingEval]],{n,1,Length[dataapertmodified]}]
anumcssDiffarray = myacssarray;
Do[anumcssDiffarray[[n,2]] =  ϵscale (dataapertmodified[[n,2]] - myacssarray[[n,2]]),{n,1,Length[myacssarray]}]
Show[ListPlot[{anumcssDiffarray} , PlotRange->{{0.0001,4.},Automatic},Frame->True, FrameLabel->{"x","(Subscript[a, 1])"},
PlotMarkers->{Automatic,4},PlotStyle->{Black,Thickness[linethickness]}, FrameTicksStyle->{{Automatic,Automatic}}],
Plot[(Sqrt[(Subscript[A, css])[scale x]] (myAbarp[scale x]+ myfs (Subscript[A, css])[scale x])/2  /.  backgroundFieldsRule[leftShootingEval]/. s -> 0 /. C[1] -> myintegcons),{x,0.00001, myEvaluation/scale}],
Plot[(Sqrt[(Subscript[A, css])[scale x]] (myAbarp[scale x]+ myfs (Subscript[A, css])[scale x])/2  /.  backgroundFieldsRule[rightShootingEval]/. s -> 0 /. C[1] -> myintegcons),{x,myEvaluation/scale, 4}]]

I did not add the correction from the coordinate transformation here because we choose f((Subscript[s, 0]))=0 anyway.

dataR2ρpert = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","r2rho_critical_pert.txt"}], "Table"];
dataR2ρpertmodified = dataR2ρpert;
Do[dataR2ρpertmodified[[n,1]] = dataR2ρpert[[n,1]]/(tstar-mytpert),{n,1,Length[dataR2ρpert]}]
myR2ρcssarray = dataR2ρpertmodified;
Do[If[myR2ρcssarray[[n,1]] < myEvaluation/scale,myR2ρcssarray[[n,2]] = (Subscript[ω, css])[scale myR2ρcssarray[[n,1]]]/(4 Pi (Subscript[A, css])[scale myR2ρcssarray[[n,1]]])/.  backgroundFieldsRule[leftShootingEval],
myR2ρcssarray[[n,2]] = (Subscript[ω, css])[scale myR2ρcssarray[[n,1]]]/(4 Pi (Subscript[A, css])[scale myR2ρcssarray[[n,1]]])/.  backgroundFieldsRule[rightShootingEval]],{n,1,Length[dataR2ρpertmodified]}]
R2ρnumcssDiffarray = myR2ρcssarray;
Do[R2ρnumcssDiffarray[[n,2]] =  ϵscale (dataR2ρpertmodified[[n,2]] - myR2ρcssarray[[n,2]]),{n,1,Length[myR2ρcssarray]}]
Show[ListPlot[{R2ρnumcssDiffarray} , PlotRange->{{0.0001,4.},{-0.003,0.017}},Frame->True, FrameLabel->{"","(R^2)(Subscript[ρ, 1])"},
PlotMarkers->{Automatic,4},PlotStyle->{Black,Thickness[linethickness]}, FrameTicksStyle->{{Automatic,Automatic},{Directive[FontOpacity->0,FontSize->0],Automatic}}],
Plot[((Subscript[ω, css])[scale x] (myωbarp[scale x] - myAbarp[scale x])/(4 Pi  (Subscript[A, css])[scale x]) /.  backgroundFieldsRule[leftShootingEval]),{x,0.00001, myEvaluation/scale}],
Plot[((Subscript[ω, css])[scale x] (myωbarp[scale x] - myAbarp[scale x])/(4 Pi  (Subscript[A, css])[scale x]) /.  backgroundFieldsRule[leftShootingEval]),{x,0.4, 0.5}],
Plot[((Subscript[ω, css])[scale x] (myωbarp[scale x] - myAbarp[scale x])/(4 Pi  (Subscript[A, css])[scale x])  /.  backgroundFieldsRule[rightShootingEval]),{x,0.5, 0.6}],
Plot[((Subscript[ω, css])[scale x] (myωbarp[scale x] - myAbarp[scale x])/(4 Pi  (Subscript[A, css])[scale x])  /.  backgroundFieldsRule[rightShootingEval]),{x,myEvaluation/scale, 4}]]

For α, I have to add a weird re-scaling. I have no idea where it comes from but it is presumably related to the fact that we use different gauges.

dataαpert = Import[FileNameJoin[{NotebookDirectory[],"Mathematica_plots","alpha_critical_pert.txt"}], "Table"];
dataαpertmodified = dataαpert;
Do[dataαpertmodified[[n,1]] = dataαpert[[n,1]]/(tstar-mytpert),{n,1,Length[dataαpert]}]
myαcssarray = dataαpertmodified;
Do[If[myαcssarray[[n,1]] < myEvaluation/scale,myαcssarray[[n,2]] = scale myαcssarray[[n,1]] (Subscript[Ng, css])[scale myαcssarray[[n,1]]] Sqrt[(Subscript[A, css])[scale myαcssarray[[n,1]]]]/scale/.  backgroundFieldsRule[leftShootingEval],
myαcssarray[[n,2]] = scale myαcssarray[[n,1]] (Subscript[Ng, css])[scale myαcssarray[[n,1]]] Sqrt[(Subscript[A, css])[scale myαcssarray[[n,1]]]]/scale/.  backgroundFieldsRule[rightShootingEval]],{n,1,Length[dataαpertmodified]}]
αnumcssDiffarray = myαcssarray;
ϵscale = -4.;
myintegcons =-myfs /. C[1] -> 0;
weirdscale = 1.14;
Do[αnumcssDiffarray[[n,2]] =  ϵscale (dataαpertmodified[[n,2]] - myαcssarray[[n,2]]),{n,1,Length[myαcssarray]}]
Show[ListPlot[{αnumcssDiffarray} , PlotRange->{{0.0001,4.},{0,3}},Frame->True, FrameLabel->{"x","(Subscript[α, 1])"},
PlotMarkers->{Automatic,4},PlotStyle->{Black,Thickness[linethickness]}, FrameTicksStyle->{{Automatic,Automatic}}],
Plot[(scale x (Subscript[Ng, css]) [scale x] Sqrt[(Subscript[A, css])[scale x]] (myNgbarp[scale x] + myAbarp[scale x]/2 + 
myfs ((Subscript[Ng, css]) '[scale x]/(Subscript[Ng, css]) [scale x] + (Subscript[Ng, css]) '[scale x]/(Subscript[A, css])[scale x]/2) + D[myfs,s]))/scale/weirdscale /.  backgroundFieldsRule[leftShootingEval]
		 /. s -> 0 /. C[1] -> myintegcons,{x,0.00001, myEvaluation/scale}],
Plot[(scale x (Subscript[Ng, css]) [scale x] Sqrt[(Subscript[A, css])[scale x]] (myNgbarp[scale x] + myAbarp[scale x]/2 + 
myfs ((Subscript[Ng, css]) '[scale x]/(Subscript[Ng, css]) [scale x] + (Subscript[Ng, css]) '[scale x]/(Subscript[A, css])[scale x]/2) + D[myfs,s]))/scale/weirdscale /.  backgroundFieldsRule[rightShootingEval]
		/. s -> 0 /. C[1] -> myintegcons,{x,myEvaluation/scale, 4}]]

DumpSave

Check CPU time used so far during this kernel session.

TimeUsed[]

Create the dumpsave. The naming will be the same as the notebook, with the extension “.mx” instead of “.nb”. The convention needs to be consistent with the way the dumpsave load is constructed in Configurations!

With[{context = $Context},DumpSave[FileNameJoin[{NotebookDirectory[],StringDelete[Last[FileNameSplit[NotebookFileName[]]],".nb"]}] <> ".mx", 
		{context,NotationMakeBoxes,NotationMakeExpression}]];

Other Dump methods

The below are equivalent methods.  I keep them for posterity. For clarity, we will call the file path simply “file”. Made it unevaluable of course.

With[{context = Context[]},DumpSave["filename", {context,NotationMakeBoxes,NotationMakeExpression}]]

Function[x,DumpSave["filename",x]]@$Context

DumpSave["filename",{"Global`",NotationMakeBoxes,NotationMakeExpression}]

The above assumes that the current context is in fact Global`!

DumpSave["filename",#]&@$Context

DumpSave["filename",Evaluate@$Context]

Function[x,DumpSave["filename",x]]@$Context

DumpSave["filename",Evaluate[{Context[],NotationMakeBoxes,NotationMakeExpression}]]

Or succinctly using the @ shortcut to mean that RHS is the argument of LHS. Or that LHS is “applied” to RHS. Actual Apply uses two: @@ instead.

DumpSave["filename",Evaluate@{Context[],NotationMakeBoxes,NotationMakeExpression}]

Note on the last two, the need to put Evaluate at the very front. This is because DumpSave has attribute HoldRest, making it not read/evaluate the arguments at level 2 or lower.
			In this case, the 1st level argument of interest would be {...}. The stuff inside is at “2nd level”. I.e., DumbSave sees its 2nd argument: {...} but because of HoldRest does not “dig deeper”. 
			This is overridden by putting Evaluate on the 1st level (and therefore {...} is now 2nd level and the stuff inside 3rd).