3D Contour Plot - parts with gradients less and more than zero

Question

I'm trying to plot sections of the 3D Contours, with gradient less than zero, and more than zero and equal to zero.

It manages to solve for the derivative, but when I apply the conditions deriv2 < 0 or deriv2 > 0 it gives the error:

deriv2 < 0 must be a boolean condition

C1 = 10^(-1);
C2 = 0.1*C1;
R = 50;
Tb = 0.1;
Geb = 5.;
Z0 = 50;
L[Te_] := 1. + 1.*(Te - 0.1);
Zlcr[Te_, w_] := (1/R + 1/(I*L[Te]*w) + I*C1*w)^-1;
Zload[Te_, w_] := -I*w*C2 + Zlcr[Te, w];
Γ[Te_, w_] := (Zload[Te, w] - Z0)/(Zload[Te, w] + Z0);
y[Te_, w_] := (Abs[Γ[Te, w]])^2;
DeltaPlocal = 10.^-5;
eq2 = (1 -   y[Te, w]) Pprobe  ==  (Te - Tb) Geb
ContourPlot3D[ 
 Evaluate[eq2], {w, 2.5, 2.8}, {Te, 0, 0.5}, {Pprobe, 0, 5}    ]

deriv2 = Derivative[1, 0][Te][w, Pprobe] /. 
   First[  Solve[    D[eq2 /. Te ->   Te[w, Pprobe], w],  
     Derivative[1, 0][Te][w, Pprobe]  ]  ]  /. Te[w, Pprobe] ->  Te

Positive2 = 
 ContourPlot3D[
  Evaluate[eq2], {w, 2.5, 2.8}, {Pprobe, 0, 5}, {Te, 0, 0.5}, 
  RegionFunction ->  Function[{w, Pprobe, Te}, deriv2 > 0], Mesh -> False, 
  ContourStyle -> Blue, MaxRecursion -> 5]

Negative2 = 
 ContourPlot3D[
  Evaluate[eq2], {w, 2.5, 2.8}, {Pprobe, 0, 5}, {Te, 0, 0.5}, 
  RegionFunction ->  Function[{w, Pprobe, Te}, deriv2 < 0], Mesh -> False, 
  ContourStyle -> Red, MaxRecursion -> 5]

zero2 = ContourPlot3D[
  Evaluate[eq2], {w, 2.5, 2.8}, {Pprobe, 0, 5}, {Te, 0, 0.5}, 
  RegionFunction ->  Function[{w, Pprobe, Te}, deriv2 = 0], Mesh -> False, 
  ContourStyle -> Green, MaxRecursion -> 5]

Answer 1

Rationalize all of the definitions and equations so that there are no numerical artifacts resulting from the initial presence of the imaginary factors.

C1 = 1/10;
C2 = C1/10;
R = 50;
Tb = 1/10;
Geb = 5;
Z0 = 50;
L[Te_] = Te + 9/10;
Zlcr[Te_, w_] = (1/R + 1/(I*L[Te]*w) + I*C1*w)^-1;
Zload[Te_, w_] = -I*w*C2 + Zlcr[Te, w];
Γ[Te_, w_] = (Zload[Te, w] - Z0)/(Zload[Te, w] + Z0);
y[Te_, w_] = (Abs[Γ[Te, w]])^2;
DeltaPlocal = 10^-5;

Since you are interested in real values of {w, Te, Pprobe} use ComplexExpand to get rid of Abs in eq2. Abs causes problems with derivatives. For example,

D[Abs[x], x]

Derivative1[Abs][x]

eq2 = (1 - y[Te, w]) Pprobe == (Te - Tb) Geb //
   ComplexExpand[#, TargetFunctions -> {Re, Im}] & //
  Simplify

1/2 + (100000000 Pprobe (9 + 10 Te)^2 w^2)/(6250000000000 + 250000 (-4467779 - 4928200 Te + 40000 Te^2) w^2 + (50629005081 + 112508950180 Te + 62505000100 Te^2) w^4 + 25 (9 + 10 Te)^2 w^6) == 5 Te

cp3D = ContourPlot3D[Evaluate[eq2],
   {w, 25/10, 28/10}, {Pprobe, 0, 5}, {Te, 0, 1/2},
   AxesLabel -> (Style[#, 14, Bold] & /@ {w, Pprobe, Te})];

deriv2 = Derivative[1, 0][Te][w, Pprobe] /.
      First[Solve[D[eq2 /. Te -> Te[w, Pprobe], w],
        Derivative[1, 0][Te][w, Pprobe]]] /.
     Te[w, Pprobe] -> Te // 
    N[#, 30] & // Simplify;

Positive2 = ContourPlot3D[Evaluate[eq2],
   {w, 25/10, 28/10}, {Pprobe, 0, 5}, {Te, 0, 1/2},
   RegionFunction ->
    Function[{w, Pprobe, Te}, deriv2 > 0],
   WorkingPrecision -> 20,
   Mesh -> False,
   ContourStyle -> Blue,
   AxesLabel ->
    (Style[#, 14, Bold] & /@ {w, Pprobe, Te})];

Negative2 = ContourPlot3D[Evaluate[eq2],
   {w, 25/10, 28/10}, {Pprobe, 0, 5}, {Te, 0, 1/2},
   RegionFunction ->
    Function[{w, Pprobe, Te}, deriv2 < 0],
   WorkingPrecision -> 20,
   Mesh -> False,
   ContourStyle -> Red,
   AxesLabel ->
    (Style[#, 14, Bold] & /@ {w, Pprobe, Te})];

zero2 appears to be an arbitrarily small region so I have skipped over it.

GraphicsRow[{cp3D, Show[Positive2, Negative2,
   AxesLabel ->
    (Style[#, 14, Bold] & /@ {w, Pprobe, Te})]},
 ImageSize -> 600]