gMuNuGeneric={{-f[x], 0 ,0,0}, {0, 1/f[x], 0, 0}, {0, 0, C[x]^2, 0}, {0, 0, 0,C[x]^2}};

MatrixForm[gMuNuGeneric]

GMuNuGeneric=Inverse[gMuNuGeneric];

coord2D={t, x, y, z};

sqrtngGeneric=Simplify[Sqrt[-Det[gMuNuGeneric]], {C[x]>0}];

box4DGeneric=0;box4D2Generic=0;

Do[ {box4D2Generic=1/sqrtngGeneric*(D[sqrtngGeneric*GMuNuGeneric[[i,j]]*D[Theta[t,x]/C[x],coord2D[[j]]] ,coord2D[[i]]]),box4DGeneric=box4DGeneric+box4D2Generic}, {i, 1, 2}, {j, 1, 2}]

box4DGenericDimple=Collect[Simplify[box4DGeneric], {Derivative[0,1][Theta][t,x], Derivative[2,0][Theta][t,x], Derivative[0,2][Theta][t,x],Theta[t,x]}];

box4DGenericDimpleCorrected=Simplify[box4DGenericDimple*C[x]];

PotentialGeneric=Coefficient[box4DGenericDimpleCorrected,Theta[t,x]];

EffectivePotentialGeneric=PotentialGeneric*f[x]

A1[x_]=(c[x]^2-v^2)/c[x];
DA1[x_]=D[A1[x], x];
B1[x_]=1/(Sqrt[c[x]]);
DB1[x_]=D[B1[x], x];
DDB1[x_]=D[DB1[x], x];

Potential2013=Expand[(PotentialGeneric/.{f[x]->A1[x], f'[x]->DA1[x], C[x]->B1[x],C'[x]->DB1[x] ,C''[x]->DDB1[x] })];

EffectivePotential2013=Expand[(EffectivePotentialGeneric/.{f[x]->A1[x], f'[x]->DA1[x], C[x]->B1[x],C'[x]->DB1[x] ,C''[x]->DDB1[x] })]

c1=Sqrt[(1/2)^2+1/2*((1)^2-(1/2)^2)*(1+(2/Pi)*ArcTan[(x+(8*Tan[(Pi/((1)^2-(1/2)^2))*((3/4)^2-1/2*((1/2)^2+1^2))]))/(8)])];
dc1=D[c1, x];
ddc1=D[dc1,x];

Plot[c1,  {x,-800, 800}]

v0=3/4;
xinitial1=N[10000, 60];
xfinal=N[10^-18,60];
xfinal2=N[10^-18,60];
x1=xfinal2;
x3=x1;
x2=-x1;
x4=x2;

g=FullSimplify[v0/(c1^2-v0^2)];
Dg=FullSimplify[D[g, x]];
t[y_]:=NIntegrate[(g), {x,  x1,y}, WorkingPrecision->60, PrecisionGoal->50, MaxRecursion->50]
h=FullSimplify[c1/(c1^2-v0^2)];
Dh=FullSimplify[D[h, x]];
xstar[y_]:=NIntegrate[(h), {x,  x1,y}, WorkingPrecision->60, PrecisionGoal->50, MaxRecursion->50]
a=NIntegrate[1/(c1+v0), {x, x2,x1}];
tmxstar=FullSimplify[-1/(c1-v0)];
tpxstar=FullSimplify[1/(c1+v0)];
uK[y_]:=NIntegrate[(tmxstar), {x,  x1,y}, WorkingPrecision->60, PrecisionGoal->50, MaxRecursion->50]
vK[y_]:=NIntegrate[(tpxstar), {x,  x1,y}, WorkingPrecision->60, PrecisionGoal->50, MaxRecursion->50]

EffectivePotential2013Values=EffectivePotential2013/.{c[x]->c1, c'[x]->dc1, c''[x]->ddc1, v->v0};
N[EffectivePotential2013Values/.x->5]

TIRIofOmegaVeff=Table[{(i/25)*10^(-4),
s1Veff=NDSolve[{1/h^2*y1Veff''[x]-Dh/h^3*y1Veff'[x]-(-((i/25)*10^(-4))^2-EffectivePotential2013Values)*y1Veff[x]==0,y1Veff[xinitial1]==(Exp[I*(i/25)*10^(-4)*xstar[xinitial1]]),y1Veff'[xinitial1]==((I*(i/25)*10^(-4)*h*Exp[I*(i/25)*10^(-4)*xstar[xinitial1]])/.x->xinitial1)},y1Veff,{x,xinitial1,xfinal2}, WorkingPrecision->40, PrecisionGoal->20, AccuracyGoal->20, MaxSteps->10000000,InterpolationOrder->All];
1/(Evaluate[Exp[-I*(i/25)*10^(-4)*xstar[xfinal2]]]/2*(Evaluate[y1Veff[xfinal2]/.s1Veff]-(I/((i/25)*10^(-4)*h)/.x->xfinal2)*Evaluate[y1Veff'[xfinal2]/.s1Veff])),
(Evaluate[Exp[I*(i/25)*10^(-4)*xstar[xfinal2]]]/2*(Evaluate[y1Veff[xfinal2]/.s1Veff]+(I/((i/25)*10^(-4)*h)/.x->xfinal2)*Evaluate[y1Veff'[xfinal2]/.s1Veff])) / (Evaluate[Exp[-I*(i/25)*10^(-4)*xstar[xfinal2]]]/2*(Evaluate[y1Veff[xfinal2]/.s1Veff]-(I/((i/25)*10^(-4)*h)/.x->xfinal2)*Evaluate[y1Veff'[xfinal2]/.s1Veff])) }, {i,1,25}];

Omega1Veff=Flatten[TIRIofOmegaVeff[[All, 1]]];
TI1Veff=Flatten[Map[Abs,TIRIofOmegaVeff[[All, 2]]]];
RI1Veff=Flatten[Map[Abs,TIRIofOmegaVeff[[All, 3]]]];
dataTIVeff=Transpose[{Omega1Veff, TI1Veff}];
dataRIVeff=Transpose[{Omega1Veff, RI1Veff}];

ThPlotVeff=ListLogLinearPlot[dataTIVeff,PlotStyle->Automatic,AxesLabel->{"ω"}, PlotLegends->{"|T_H|"}, PlotRange->All]

TableForm[Transpose[{Reverse[dataTIVeff[[ All, 1]]], N[Reverse[dataTIVeff[[ All, 2]]], 6]}]]

Export["D:\\Dropbox\\BH\\BEC\\nofxcofxvofx\\Writeup\\6\\Th2013PlotVeff42v2.jpg",ThPlotVeff]

Export["D:\\Dropbox\\BH\\BEC\\nofxcofxvofx\\Writeup\\6\\THRH2013TableData42v2.mx",TIRIofOmegaVeff]