SetDirectory[NotebookDirectory[]];

Clear[v,m,f,g,gamma,h,h1];
Vphi[t_,x_]=(f[t,x]^2-1)^2/2;
V[t_,x_]=Vphi[t,x];
dV[t_,x_]=D[Vphi[t,x],f[t,x]];
dd=1-2m/r ;
m=0;
pde={D[f[t,r],t] ==g[t,r],r^2 D[g[t,r],t]/(1-2m/r )== D[r^2 (1-2m/r ) D[f[t,r],r],r]-dV[t,r] r^2};
(* parameters for initial conditions and boundary conditions *)
rmax=100; (* right end of simulation range *)
rmin=10; (* left end of simulation range *)
r0=rmin+70; (* initial position of wall *)
tmax=100; (* time for which evolution is run. *)
(* function to be used to specify initial conditions *)
h[t_,r_]=Tanh[r-r0];
h1[t_,r_]=D[h[t,r],t]; (* time derivative of h[t,x] *)
(* initial and boundary conditions  *)
bc={f[0,r]==h[0,r],
g[0,r]==h1[0,r],f[t,rmin]==-1,g[t,rmin]==0,f[t,rmax]==1,g[t,rmax]==0};
(* Now solve pde using NDSolve. *)
solution=NDSolve[{pde,bc},{f,g},{r,rmin,rmax},{t,0,tmax},StartingStepSize->{Automatic,rmax/30},PrecisionGoal->2];
fsol0[t_,r_]:=f[t,r] /. solution;
plm0t0=Plot[fsol0[0,r],{r,rmin,rmax},PlotRange->{-2,2},Frame->True,PlotStyle->{Blue,Thick,Dashed}];
plm0t80=Plot[fsol0[80,r],{r,rmin,rmax},PlotRange->{-2,2},Frame->True,PlotStyle->{Black,Dashed}];

m=5;
pde={D[f[t,r],t] ==g[t,r],r^2 D[g[t,r],t]/(1-2m/r )== D[r^2 (1-2m/r ) D[f[t,r],r],r]-dV[t,r] r^2};

(* Now solve pde using NDSolve. *)
solution5=NDSolve[{pde,bc},{f,g},{r,rmin,rmax},{t,0,tmax},StartingStepSize->{Automatic,rmax/30},PrecisionGoal->2];
fsol5[t_,r_]:=f[t,r] /. solution5;
plm5t0=Plot[fsol5[0,r],{r,rmin,rmax},PlotRange->{-2,2},Frame->True,PlotStyle->{Blue}];
plm5t80=Plot[fsol5[80,r],{r,rmin,rmax},PlotRange->{-2,2},Frame->True,PlotStyle->{Red}];phivstbh=Show[plm5t0,plm5t80,plm0t0,plm0t80,Graphics[{Inset["m=0, t=0",{85,0.3},BaseStyle->Directive[Medium,Italic]]}],Graphics[{Inset["m=5, t=0",{85,0.1},BaseStyle->Directive[Medium,Italic]]}],Graphics[{Inset["m=0, t=80",{30,0.3},BaseStyle->Directive[Medium,Italic]]}],Graphics[{Inset["m=5, t=80",{45,0.3},BaseStyle->Directive[Medium,Italic]]}],PlotRange->{-2,2},Frame->True,FrameLabel->{"r","Φ(r,t)"},BaseStyle->{Large,FontFamily->"Times",Italic},LabelStyle->Directive[Black,Large]]
Export["phivstbh.pdf",phivstbh,ImageResolution->1000,ImageSize->Scaled[2]]

g[tr_]:=Piecewise[{{0.638,97≤tr≤ 100},{0.63,96≤tr≤ 96},{0.62,93≤tr≤ 96},{0.61,89≤tr≤ 92},{0.60,86≤tr≤ 88},{0.57,80≤tr≤ 85},{0.56,77≤tr≤ 79},{0.54,72≤tr≤ 76},{0.52,68≤tr≤ 71},{0.48,60≤tr≤ 67},{0.43,50≤tr≤ 60},{0.39,40≤tr≤ 50},{0.3,30≤tr≤ 40},{0.20,0≤tr≤ 30}}];
rr[tr_]:=FindRoot[fsol0[tr,r],{r,r0-tr  g[tr]},PrecisionGoal->2][[1,2]];
t1=0; t2=tmax;npts=100;dt=(t2-t1)/npts;
rttab0=Table[{i dt,rr[i dt]},{i,0,npts}];
plnum0=ListPlot[%,Frame->True,PlotStyle->Black];
nlm0=NonlinearModelFit[rttab0,a Cos[(b  x/30)]+0.01 x^2  /c,{a,b,c},x]
plnlm0=Plot[nlm0[x],{x,0,100},PlotRange->{0,83},PlotStyle->Black];

g[tr_]:=Piecewise[{{0.52,90≤tr≤ 100},{0.51,80≤tr≤ 90},{0.496,70≤tr≤ 80},{0.47,60≤tr≤ 70},{0.43,50≤tr≤ 60},{0.4,40≤tr≤ 50},{0.3,30≤tr≤ 40},{0.20,0≤tr≤ 30}}]
rr[tr_]:=FindRoot[fsol5[tr,r],{r,r0-tr  g[tr]},PrecisionGoal->2][[1,2]];
t1=0; t2=tmax;npts=100;dt=(t2-t1)/npts;
rttab5=Table[{i dt,rr[i dt]},{i,0,npts}];
plnum5=ListPlot[%,Frame->True,PlotStyle->Red];
nlm5=NonlinearModelFit[rttab5,a Cos[(b  x/30)]+0.01 x^2  /c,{a,b,c},x]
plnlm5=Plot[nlm5[x],{x,0,100},PlotRange->{0,83}];

rvstbh=Show[plnum0,plnlm0,plnum5,plnlm5,Graphics[{Inset["m=0",{75,35},BaseStyle->Directive[Large,Italic]]}],Graphics[{Inset["m=5",{85,40},BaseStyle->Directive[Large,Italic]]}],PlotRange->{10,85},Frame->True,FrameLabel->{"t","r(t)"},BaseStyle->{Large,FontFamily->"Times",Italic},LabelStyle->Directive[Black,Large]]
Export["rvstbh.pdf",rvstbh,ImageResolution->1000,ImageSize->Scaled[2]]

Clear[m,q];
m=2;q=0.02;
ff=(r^2-2 m r-q r^4 /3);
Solve[ff==0,r]//N
pl1=Plot[ff,{r,0,10},PlotRange->All,Frame->True,PlotStyle->{Red,Dashed}];
Clear[m,q];
m=2;q=0.0;
ff=(r^2-2 m r-q r^4 /3);
Solve[ff==0,r]//N
pl2=Plot[ff,{r,0,10},PlotRange->All,Frame->True,PlotStyle->{Blue}];
Clear[m,q];
m=0;q=0.05;
ff=(r^2-2 m r-q r^4 /3);
Solve[ff==0,r]//N
pl3=Plot[ff,{r,0,10},PlotRange->All,Frame->True,PlotStyle->{Black,Dotted,Thick}];
frvsr=Show[pl1,pl2,pl3,
Graphics[{Thick,Orange,Dashed,Line[{{4.719457358797734,0.04776041092172534},{4.719457358797734,-22.182839278382062`}}]}],
Graphics[{Thick,Orange,Dashed,Line[{{9.20813798538092,0.04776041092172889},{9.20813798538092,-22.182839278382055`}}]}],Graphics[{Inset["m=2,Λ=0.02",{9,6},BaseStyle->Directive[Large,Italic]]}],Graphics[{Inset["m=2,Λ=0.0",{8,20},BaseStyle->Directive[Large,Italic]]}],Graphics[{Inset["m=0,Λ=0.05",{2,10},
BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, 1])",{4.5,-10},
BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, 2])",{9,-10},
BaseStyle->Directive[Large,Italic]]}],PlotRange->{-20,20},Frame->True,FrameLabel->{"r","\!\(\*SuperscriptBox[\(r\), \(\(2\)\(\\ \)\)]\)f(r)"},BaseStyle->{Large,FontFamily->"Times",Italic},LabelStyle->Directive[Black,Large]]
Export["frvsr.pdf",frvsr,ImageResolution->1000,ImageSize->Scaled[2]]

Clear[m,q];
m=2;q=0.02;
ee=(9r^2/2-8 m r-4 q r^4 /3);
Solve[ee==0,r]//N
pl1=Plot[ee,{r,0,12},PlotRange->All,Frame->True,PlotStyle->{Red,Dashed}];
Clear[m,q];
m=2;q=0.0;
ee=(9r^2/2-8 m r-4 q r^4 /3);
Solve[ee==0,r]//N
pl2=Plot[ee,{r,0,12},PlotRange->All,Frame->True,PlotStyle->{Blue}];
Clear[m,q];
m=0;q=0.05;
ee=(9r^2/2-8 m r-4 q r^4 /3);
Solve[ee==0,r]//N
pl3=Plot[ee,{r,0,12},PlotRange->All,Frame->True,PlotStyle->{Black,Dotted,Thick}];
envsr0=Show[pl1,pl2,pl3,Graphics[{Thick,Orange,Dashed,Line[{{5.780228136200256,76.22552335711194},{5.780228136200256,-58.19473809774257}}]}],
Graphics[{Thick,Orange,Dashed,Line[{{8.124460043941761,50.938543479466006},{8.124460043941761,-58.194738097742615}}]}],
Graphics[{Inset["m=2,Λ=0.02",{10,55},BaseStyle->Directive[Large,Italic]]}],Graphics[{Inset["m=0,Λ=0.05",{4,72},BaseStyle->Directive[Large,Italic]]}],Graphics[{Inset["m=2,Λ=0.0",{8,100},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, 0  crit])=(Sqrt[(27/(16  Λ))])",{4.5,-30},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, 0  crit])",{7.8,-30},BaseStyle->Directive[Large,Italic]]}],PlotRange->{-50,100},Frame->True,FrameLabel->{"(Subscript[r, 0])","Ε/4π"},BaseStyle->{Large,FontFamily->"Times",Italic},LabelStyle->Directive[Black,Large]]
Export["envsr0.pdf",envsr0,ImageResolution->1000,ImageSize->Scaled[2]]

Clear[f,qq,m,r,tfsol]
m=0.0;
ll=0.2;
imax=200;
tsol=Solve[x^2 - 2 m x-(ll/3) x^4==0,x]//Chop;
rmin=tsol[[3,1,2]];
rmax=tsol[[4,1,2]];
(* rmin=0
rmax=400 *)
dx=(rmax-rmin)/imax;
r[i_]:=i dx+rmin;
fp[i_]:=(f[i]-f[i-1])/dx;
e[i_]:=(r[i]^2 - 2 m r[i]-(ll/3) r[i]^4)fp[i]^2+r[i]^2(f[i]^2-1)^2 /2;
f[0]=-1;
f[imax]=1;
etot=dx  Sum[e[i],{i,1,imax}];
r0crit=Sqrt[(27/(16 ll))]
r0=r0crit+0.1;
ft[x_]:=Tanh[15(x-r0)];
ftab=Table[{f[i],ft[r[i]]},{i,1,imax-1}];
sol1=FindMinimum[etot,ftab,MaxIterations->1000000,AccuracyGoal->6];
etot /. sol1[[2]];
tfsol=Table[{i dx+rmin,f[i]/. sol1[[2]]},{i,0,imax}];
pl1=Plot[ft[r],{r,rmin,rmax},PlotStyle->{Dashed,Blue},Frame->True];
pl2=ListPlot[tfsol,Joined->True,PlotRange->All,Frame->True,FrameLabel->{r,Φ(r)},PlotStyle->{Thick,Blue}];
enminexp1=Show[pl1,pl2,
Graphics[{Thick,Orange,Dashed,Line[{{r0crit,1.1},{r0crit,-1.1}}]}],
Graphics[{Thick,Blue,Arrow[{{3.0254378003997098`,0.22974236844612195`},{3.8545388518030097`,0.22974236844612195`}}]}],
Graphics[{Inset["(Subscript[r, 0  crit])",{2.8,0.5},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["m=0, Λ=0.2",{1.5,0.9},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, 0])  > (Subscript[r, 0  crit])",{1.5,0.7},BaseStyle->Directive[Large,Italic]]}],
PlotRange->{-1.1,1.1},Frame->True,FrameLabel->{"r","Φ(r)"},BaseStyle->{Large,FontFamily->"Times",Italic},LabelStyle->Directive[Black,Large]]
Export["enminexp1.pdf",enminexp1,ImageResolution->1000,ImageSize->Scaled[2]]

Clear[m,q];
m=1;q=0.001;
ee=(9r^2/2-8 m r-4 q r^4 /3);
eemax=Solve[D[ee,r]==0,r][[3,1,2]]//N;
Clear[f,qq,m,r,tfsol]
m=0.0;
ll=0.2;
imax=200;
tsol=Solve[x^2 - 2 m x-(ll/3) x^4==0,x]//Chop;
rmin=tsol[[3,1,2]];
rmax=tsol[[4,1,2]];
(* rmin=0
rmax=400 *)
dx=(rmax-rmin)/imax;
r[i_]:=i dx+rmin;
fp[i_]:=(f[i]-f[i-1])/dx;
e[i_]:=(r[i]^2 - 2 m r[i]-(ll/3) r[i]^4)fp[i]^2+r[i]^2(f[i]^2-1)^2 /2;
f[0]=-1;
f[imax]=1;
etot=dx  Sum[e[i],{i,1,imax}];
r0crit=Sqrt[(27/(16 ll))];
r0=r0crit-0.1;
ft[x_]:=Tanh[15(x-r0)];
ftab=Table[{f[i],ft[r[i]]},{i,1,imax-1}];
sol1=FindMinimum[etot,ftab,MaxIterations->1000000,AccuracyGoal->6];
etot /. sol1[[2]];
tfsol=Table[{i dx+rmin,f[i]/. sol1[[2]]},{i,0,imax}];
pl1=Plot[ft[r],{r,rmin,rmax},PlotStyle->{Dashed,Red},Frame->True];
pl2=ListPlot[tfsol,Joined->True,PlotRange->All,Frame->True,FrameLabel->{r,Φ(r)},PlotStyle->{Thick,Red}];
enmincol1=Show[pl1,pl2,
Graphics[{Thick,Orange,Dashed,Line[{{r0crit,1.1},{r0crit,-1.1}}]}],
Graphics[{Thick,Red,Arrow[{{2.8108769438673735`,0.22454466616582414`},{0.03128685526273012,0.22454466616582414`}}]}],
Graphics[{Inset["(Subscript[r, 0  crit])",{3.05,0.5},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["m=0, Λ=0.2",{1.5,0.9},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, 0])  < (Subscript[r, 0  crit])",{1.5,0.7},BaseStyle->Directive[Large,Italic]]}],
PlotRange->{-1.1,1.1},Frame->True,FrameLabel->{"r","Φ(r)"},BaseStyle->{Large,FontFamily->"Times",Italic},LabelStyle->Directive[Black,Large]]
Export["enmincol1.pdf",enmincol1,ImageResolution->1000,ImageSize->Scaled[2]]

Clear[v,m,f,g,gamma,h,h1];
VsG[t_,x_]=(1+Cos[Pi*f[t,x]])/Pi^2;
Vphi[t_,x_]=(f[t,x]^2-1)^2/2;
V[t_,x_]=Vphi[t,x];
dV[t_,x_]=D[Vphi[t,x],f[t,x]];
dd=1-2m/r - (qq/3) r^2;
m=1.;
qq=0.001;
pde={D[f[t,r],t] ==g[t,r],r^2 D[g[t,r],t]/(1-2m/r - (qq/3) r^2)== D[r^2 (1-2m/r - (qq/3) r^2) D[f[t,r],r],r]-0.5 dV[t,r] r^2};
(* parameters for initial conditions and boundary conditions *)
tsol=Solve[x^2 - 2 m x-(qq/3) x^4==0,x]//Chop;
rmin=tsol[[3,1,2]];
rmax=tsol[[4,1,2]];
ee=(9r^2/2-8 m r-4 qq r^4 /3);
r0crit=Solve[D[ee,r]==0,r][[3,1,2]]//N
r0=r0crit+4;
tmax=300; (* time for which evolution is run. *)
(* function to be used to specify initial conditions *)
h[r_]=Tanh[(r-r0)];
bc={f[0,r]==h[r],
g[0,r]==0,f[t,rmin]==-1,g[t,rmin]==0,f[t,rmax]==1,g[t,rmax]==0};
(* Now solve pde using NDSolve. *)
solution1=NDSolve[{pde,bc},{f,g},{r,rmin,rmax},{t,0,tmax},StartingStepSize->{Automatic,rmax/30},PrecisionGoal->2];
fsol1[t_,r_]:=f[t,r] /. solution1;
pl1=Plot[fsol1[0,r],{r,rmin,rmax},PlotRange->{-1.2,1.2},PlotStyle->{Dashed,Blue},Frame->True];
pl2=Plot[fsol1[140,r],{r,rmin,rmax},PlotRange->{-1.2,1.2},PlotStyle->{Thick,Blue},Frame->True];
pdeexp=Show[pl1,pl2,
Graphics[{Thick,Orange,Dashed,Line[{{r0crit,1.1},{r0crit,-1.1}}]}],
Graphics[{Thick,Blue,Arrow[{{45.08550879902812,0.28471155605625387`},{48.2431964664803,0.28471155605625387`}}]}],
Graphics[{Inset["(Subscript[r, crit])",{39,0.5},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["m=1, Λ=0.001",{30,0.9},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, 0])  > (Subscript[r, crit])",{30,0.7},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Thick,Pink,Dashed,Line[{{rmax,1.1},{rmax,-1.1}}]}],
Graphics[{Thick,Pink,Dashed,Line[{{rmin,1.1},{rmin,-1.1}}]}],
Graphics[{Inset["(Subscript[r, min])",{rmin+2,0.5},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, max])",{rmax+2,0.5},BaseStyle->Directive[Large,Italic]]}],
PlotRange->{{-2,rmax+4},{-1.1,1.1}},Frame->True,FrameLabel->{"r","Φ(r)"},BaseStyle->{Large,FontFamily->"Times",Italic},LabelStyle->Directive[Black,Large]]
Export["pdeexp.pdf",pdeexp,ImageResolution->1000,ImageSize->Scaled[2]]

Clear[v,m,f,g,gamma,h,h1];
VsG[t_,x_]=(1+Cos[Pi*f[t,x]])/Pi^2;
Vphi[t_,x_]=(f[t,x]^2-1)^2/2;
V[t_,x_]=Vphi[t,x];
dV[t_,x_]=D[Vphi[t,x],f[t,x]];
dd=1-2m/r - (qq/3) r^2;
m=1.;
qq=0.001;
pde={D[f[t,r],t] ==g[t,r],r^2 D[g[t,r],t]/(1-2m/r - (qq/3) r^2)== D[r^2 (1-2m/r - (qq/3) r^2) D[f[t,r],r],r]-0.5 dV[t,r] r^2};
(* parameters for initial conditions and boundary conditions *)
tsol=Solve[x^2 - 2 m x-(qq/3) x^4==0,x]//Chop;
rmin=tsol[[3,1,2]];
rmax=tsol[[4,1,2]];
ee=(9r^2/2-8 m r-4 qq r^4 /3);
r0crit=Solve[D[ee,r]==0,r][[3,1,2]]//N;
r0=r0crit-3;
tmax=300; (* time for which evolution is run. *)
(* function to be used to specify initial conditions *)
h[r_]=Tanh[(r-r0)];
bc={f[0,r]==h[r],
g[0,r]==0,f[t,rmin]==-1,g[t,rmin]==0,f[t,rmax]==1,g[t,rmax]==0};
(* Now solve pde using NDSolve. *)
solution2=NDSolve[{pde,bc},{f,g},{r,rmin,rmax},{t,0,tmax},StartingStepSize->{Automatic,rmax/30},PrecisionGoal->2];
fsol2[t_,r_]:=f[t,r] /. solution2;
pl1=Plot[fsol2[0,r],{r,rmin,rmax},PlotRange->{-1.2,1.2},PlotStyle->{Dashed,Red},Frame->True];
pl2=Plot[fsol2[60,r],{r,rmin,rmax},PlotRange->{-1.2,1.2},PlotStyle->{Thick,Red},Frame->True];
pdecol=Show[pl1,pl2,
Graphics[{Thick,Orange,Dashed,Line[{{r0crit,1.1},{r0crit,-1.1}}]}],
Graphics[{Thick,Red,Arrow[{{37.76935889205098,0.24761183008672516`},{21.844177706670074`,0.24761183008672516`}}]}],
Graphics[{Inset["(Subscript[r, crit])",{43,0.5},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["m=1, Λ=0.001",{13,0.9},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, 0])  < (Subscript[r, crit])",{13,0.7},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Thick,Pink,Dashed,Line[{{rmax,1.1},{rmax,-1.1}}]}],
Graphics[{Thick,Pink,Dashed,Line[{{rmin,1.1},{rmin,-1.1}}]}],
Graphics[{Inset["(Subscript[r, min])",{rmin+2,0.5},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, max])",{rmax+2,0.5},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["t=0",{r0crit-6,-0.5},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["t=60",{18.5,-0.5},BaseStyle->Directive[Large,Italic]]}],
PlotRange->{{-2,rmax+4},{-1.1,1.1}},Frame->True,FrameLabel->{"r","Φ(r)"},BaseStyle->{Large,FontFamily->"Times",Italic},LabelStyle->Directive[Black,Large]]
Export["pdecol.pdf",pdecol,ImageResolution->1000,ImageSize->Scaled[2]]

rdisk=0.5;xdisk=0;ydisk=5;
mondraw=Show[Graphics[{Orange,Disk[{xdisk,ydisk},rdisk]}],
Graphics[{Thick,Blue,Arrow[{{xdisk,ydisk+rdisk},{xdisk,ydisk+rdisk+0.5}}]}],
Graphics[{Thick,Blue,Arrow[{{xdisk+rdisk,ydisk},{xdisk+rdisk+0.5,ydisk}}]}],
Graphics[{Thick,Blue,Arrow[{{xdisk,ydisk-rdisk},{xdisk,ydisk-rdisk-0.5}}]}],
Graphics[{Thick,Blue,Arrow[{{xdisk-rdisk,ydisk},{xdisk-rdisk-0.5,ydisk}}]}],
Graphics[{Thick,Orange,Dashed,Line[{{0,0},{xdisk+rdisk,ydisk}}]}],
Graphics[{Thick,Black,Dashed,Line[{{xdisk,ydisk},{xdisk+rdisk,ydisk}}]}],
Graphics[{Thick,Black,Dashed,Line[{{0.2566,2.586},{0.007683,2.586}}]}],
Graphics[{Thick,Black,Dashed,Line[{{0,0},{xdisk,ydisk}}]}],
Graphics[{PointSize[Large],Red,Point[{xdisk,ydisk}]}],
Graphics[{Inset["Δr",{0.3,5.2},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["Δθ",{0.15,2.7},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, 0])",{-0.2,3.5},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["Black Hole",{0.7,0.2},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["Monopole",{0.7,5.5},BaseStyle->Directive[Large,Italic]]}],
Graphics[{PointSize[Large],Black,Point[{0,0}]}],
BaseStyle->{Large,FontFamily->"Times",Italic},
Frame->False,Axes->False,PlotRange->{{-xdisk-rdisk-2,xdisk+rdisk+2},{-1,ydisk+rdisk+1}}]
Export["mondraw.pdf",mondraw,ImageResolution->1000,ImageSize->Scaled[2]]

rdisk1=10;xdisk1=0;ydisk1=0;
rdisk2=9;xdisk2=0;ydisk2=0;
rcirc1=1;xcirc1=0;ycirc1=0;
rcirc2=12;xcirc2=0;ycirc2=0;
sphwalldraw=Show[Graphics[{Orange,Disk[{xdisk1,ydisk1},rdisk1]}],
Graphics[{White,Disk[{xdisk2,ydisk2},rdisk2]}],
Graphics[{Dashed,Thick,Circle[{xcirc1,ycirc1},rcirc1]}],
Graphics[{Dashed,Thick,Circle[{xcirc2,ycirc2},rcirc2]}],
Graphics[{PointSize[Large],Black,Point[{xdisk1,ydisk1}]}],
Graphics[{Thick,Black,Dashed,Line[{{xdisk1,ydisk1},{rdisk2+0.5,0}}]}],
Graphics[{Thick,Black,Dashed,Line[{{5.6,7.034},{6.296,7.789}}]}],
Graphics[{Inset["Φ=-1",{-5.5,0},BaseStyle->Directive[Medium,Italic]]}],
Graphics[{Inset["Φ=+1",{-10.7,0},BaseStyle->Directive[Medium,Italic]]}],
Graphics[{Inset["Δr",{5.5,8},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, 1])",{0,-1.5},BaseStyle->Directive[Large,Italic,Bold]]}],
Graphics[{Inset["(Subscript[r, 2])",{0,11.5},BaseStyle->Directive[Large,Italic,Bold]]}],
Graphics[{Inset["Spherical Domain Wall",{0,8},BaseStyle->Directive[Medium,Italic,Bold]]}],
Graphics[{Inset["Black Hole",{0,1.2},BaseStyle->Directive[Medium,Italic,Bold]]}],
Graphics[{Inset["(Subscript[r, 0])",{5,0.7},BaseStyle->Directive[Large,Italic]]}],BaseStyle->{Large,FontFamily->"Times",Italic}]
Export["sphwalldraw.pdf",sphwalldraw,ImageResolution->1000,ImageSize->Scaled[2]]

rdisk1=1;xdisk1=10;ydisk1=0;
rdisk2=1;xdisk2=-10;ydisk2=0;
loopdraw=Show[Graphics[{Orange,Disk[{xdisk1,ydisk1},rdisk1]}],
Graphics[{Orange,Disk[{xdisk2,ydisk2},rdisk2]}],
Graphics[{Thick,Blue,Arrow[{{xdisk1,ydisk1+rdisk1},{xdisk1,ydisk1+rdisk1+1.5}}]}],
Graphics[{Thick,Blue,Arrow[{{xdisk1+rdisk1,ydisk1},{xdisk1+rdisk1+1.5,ydisk1}}]}],
Graphics[{Thick,Blue,Arrow[{{xdisk1,ydisk1-rdisk1},{xdisk1,ydisk1-rdisk1-1.5}}]}],
Graphics[{Thick,Blue,Arrow[{{xdisk1-rdisk1,ydisk1},{xdisk1-rdisk1-1.5,ydisk1}}]}],
Graphics[{Thick,Blue,Arrow[{{xdisk2,ydisk2+rdisk2},{xdisk2,ydisk2+rdisk2+1.5}}]}],
Graphics[{Thick,Blue,Arrow[{{xdisk2+rdisk2,ydisk2},{xdisk2+rdisk2+1.5,ydisk2}}]}],
Graphics[{Thick,Blue,Arrow[{{xdisk2,ydisk2-rdisk2},{xdisk2,ydisk2-rdisk2-1.5}}]}],
Graphics[{Thick,Blue,Arrow[{{xdisk2-rdisk2,ydisk2},{xdisk2-rdisk2-1.5,ydisk2}}]}],
Graphics[{Thick,Black,Dashed,Line[{{xdisk1,ydisk1},{0,0}}]}],
Graphics[{Thick,Black,Dashed,Line[{{6.99,-0.6689},{6.99,-0.03934}}]}],
Graphics[{Thick,Orange,Dashed,Line[{{0,0},{xdisk1,ydisk1-rdisk1}}]}],
Graphics[{Thick,Black,Dashed,Line[{{xdisk1,ydisk1},{xdisk1,ydisk1+rdisk1}}]}],
Graphics[{Inset["(Subscript[r, 0])",{5,1},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["Δr",{xdisk1+rdisk1,ydisk1+rdisk1},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["Δθ",{7.672,-0.3016},BaseStyle->Directive[Medium,Italic]]}],
Graphics[{Inset["Loop Cross Section",{xdisk2+2,ydisk2+rdisk2+0.5},BaseStyle->Directive[Medium,Italic]]}],
Graphics[{PointSize[Large],Black,Point[{0,0}]}],
Graphics[{Inset["Black Hole",{0,0.5},BaseStyle->Directive[Medium,Italic]]}],
BaseStyle->{Large,FontFamily->"Times",Italic},
Frame->False,Axes->False,PlotRange->{{xdisk2-3,xdisk1+3},{-5,5}}]
Export["loopdraw.pdf",loopdraw,ImageResolution->1000,ImageSize->Scaled[2]]

Clear[f,qq,m,r,tfsol]
m=0.0;
ll=0.2;
imax=200;
tsol=Solve[x^2 - 2 m x-(ll/3) x^4==0,x]//Chop;
rmin=tsol[[3,1,2]];
rmax=tsol[[4,1,2]]+0.1;
(* rmin=0
rmax=400 *)
dx=(rmax-rmin)/imax;
r[i_]:=i dx+rmin;
fp[i_]:=(f[i]-f[i-1])/dx;
e[i_]:=(r[i]^2 - 2 m r[i]-(ll/3) r[i]^4)fp[i]^2+r[i]^2(f[i]^2-1)^2 /2;
f[0]=-1;
f[imax]=1;
etot=dx  Sum[e[i],{i,1,imax}];
r0crit=Sqrt[(27/(16 ll))];
r0=r0crit+0.1;
ft[x_]:=Tanh[15(x-r0)];
ftab=Table[{f[i],ft[r[i]]},{i,1,imax-1}];
sol1=FindMinimum[etot,ftab,MaxIterations->1000000,AccuracyGoal->6];
etot /. sol1[[2]];
tfsol=Table[{i dx+rmin,f[i]/. sol1[[2]]},{i,0,imax}];
pl1=Plot[ft[r],{r,rmin,rmax},PlotStyle->{Dashed,Blue},Frame->True];
pl2=ListPlot[tfsol,Joined->True,PlotRange->All,Frame->True,FrameLabel->{r,Φ(r)},PlotStyle->{Thick,Blue}];
enminexp2=Show[pl1,pl2,
Graphics[{Thick,Orange,Dashed,Line[{{r0crit,20},{r0crit,-20}}]}],
Graphics[{Thick,Blue,Arrow[{{3.0254378003997098`,0.22974236844612195`},{3.8545388518030097`,0.22974236844612195`}}]}],
Graphics[{Inset["(Subscript[r, crit])",{2.8,10},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["m=0, Λ=0.2",{1.5,17},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, 0])  > (Subscript[r, crit])",{1.5,15},BaseStyle->Directive[Large,Italic]]}],
PlotRange->{-20,20},Frame->True,FrameLabel->{"r","Φ(r)"},BaseStyle->{Large,FontFamily->"Times",Italic},LabelStyle->Directive[Black,Large]]
Export["enminexp2.pdf",enminexp2,ImageResolution->1000,ImageSize->Scaled[2]]

Clear[f,qq,m,r,tfsol]
m=0.0;
ll=0.2;
imax=200;
tsol=Solve[x^2 - 2 m x-(ll/3) x^4==0,x]//Chop;
rmin=tsol[[3,1,2]];
rmax=tsol[[4,1,2]]+0.1;
(* rmin=0
rmax=400 *)
dx=(rmax-rmin)/imax;
r[i_]:=i dx+rmin;
fp[i_]:=(f[i]-f[i-1])/dx;
e[i_]:=(r[i]^2 - 2 m r[i]-(ll/3) r[i]^4)fp[i]^2+r[i]^2(f[i]^2-1)^2 /2;
f[0]=-1;
f[imax]=1;
etot=dx  Sum[e[i],{i,1,imax}];
r0crit=Sqrt[(27/(16 ll))];
r0=r0crit-0.1;
ft[x_]:=Tanh[15(x-r0)];
ftab=Table[{f[i],ft[r[i]]},{i,1,imax-1}];
sol1=FindMinimum[etot,ftab,MaxIterations->1000000,AccuracyGoal->6];
etot /. sol1[[2]];
tfsol=Table[{i dx+rmin,f[i]/. sol1[[2]]},{i,0,imax}];
pl1=Plot[ft[r],{r,rmin,rmax},PlotStyle->{Dashed,Red},Frame->True];
pl2=ListPlot[tfsol,Joined->True,PlotRange->All,Frame->True,FrameLabel->{r,Φ(r)},PlotStyle->{Thick,Red}];
enmincol2=Show[pl1,pl2,
Graphics[{Thick,Orange,Dashed,Line[{{r0crit,20},{r0crit,-20}}]}],
Graphics[{Thick,Red,Arrow[{{2.8108769438673735`,0.22454466616582414`},{0.03128685526273012,0.22454466616582414`}}]}],
Graphics[{Inset["(Subscript[r, crit])",{3.05,10},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["m=0, Λ=0.2",{1.5,15},BaseStyle->Directive[Large,Italic]]}],
Graphics[{Inset["(Subscript[r, 0])  < (Subscript[r, crit])",{1.5,10},BaseStyle->Directive[Large,Italic]]}],
PlotRange->{-20,20},Frame->True,FrameLabel->{"r","Φ(r)"},BaseStyle->{Large,FontFamily->"Times",Italic},LabelStyle->Directive[Black,Large]]
Export["enmincol2.pdf",enmincol2,ImageResolution->1000,ImageSize->Scaled[2]]