In[]:=
Clear[Q,α,q,ω,criticalpress,criticalrh,criticaltemp]​​Q=0.2;​​α=0.2;​​q=0.1;​​ω=-
1
3
;​​criticalrh=Last[Flatten[r/.NSolve[-
4+3ω
r
+12
2+3ω
r
α+12
3ω
r
2
α
+6
2
Q
3ω
r
(
2
r
+2α)-162qrα
2
ω
(1+ω)-9q
3
r
ω(2+5ω+3
2
ω
)0&&r>0,]]];​​crittemp=
-1-3ω
r
(-2
2
Q
3ω
r
+
2+3ω
r
-2
3ω
r
α+9qrω+9qr
2
ω
)
2π(
2
r
+6α)
;​​press=Simplify-
-4-3ω+3(1+ω)
r
(
2
r
+2α)-T+
4+3ω-3(1+ω)
r
4πα
-
2+3ω-3(1+ω)
r
4π
2
r
+2α
2
r
-
4+3ω-3(1+ω)
r
4πα
2
r
+2α
2
r
-
3ω-3(1+ω)
r

2
Q
+α
4π
2
r
+2α
2
r
+
3q
1-3(1+ω)
r
ω
2π
2
r
+2α
2
r
2
2
r
;​​criticaltemp=crittemp/.rcriticalrh;​​criticalpress=press/.{rcriticalrh,Tcriticaltemp};​​G[r_,P_]:=
-1-3ω
r
(
3ω
r
(-8Pπ
6
r
+21
2
r
α+12
2
α
+3
2
Q
(3
2
r
+4α)+
4
r
(3+32Pπα))-6q(4rα+
3
r
(2+3ω))+12α(
2
Q
3ω
r
-
2+3ω
r
-8Pπ
4+3ω
r
+
3ω
r
α-6qrω)Log[r])
12(
2
r
+2α)
;​​GminPlot=-1;​​GmaxPlot=1;​​contours1={-1,-0.3,-0.1,G[criticalrh,1.4criticalpress],G[criticalrh,criticalpress],G[criticalrh,0.4criticalpress],1};​​contour=ContourPlot[G[r,P],{r,0,10},{P,0,2criticalpress},Contourscontours1,ContourShadingAutomatic,ContourStyle{Black,Magenta,Green},PlotLegendsBarLegend[{"TemperatureMap",{GminPlot,GmaxPlot}},LegendLabelPlaced["G",Top]],FrameLabel{"\!\(\*SubscriptBox[\(r\), \(+\)]\)","P"},ColorFunctionFunction[{z},ColorData["TemperatureMap"][Rescale[z,{GminPlot,GmaxPlot}]]],ColorFunctionScalingTrue,PlotRange{GminPlot,GmaxPlot},ClippingStyleAutomatic,Epilog{Text["P < Pc",{2,0.5criticalpress},BackgroundWhite],Text["P = Pc",{2,criticalpress},BackgroundWhite],Text["P > Pc",{2,1.5criticalpress},BackgroundWhite]}]
Out[]=
G