Spreading colors in ListDensityPlot

I would simply use ListPlot with a PlotStyle that is defined as a function of your third column:

ListPlot[List /@ data[[All, {1, 2}]], 
 PlotStyle -> ({PointSize[0.01], ColorData["Rainbow"][#1]} & /@ 
    Rescale[data[[All, 3]], {1.5, 4}]), 
 PlotRange -> {{-1, 1}, {-1, 1}}, AspectRatio -> 1, Frame -> True, 
 Axes -> None]

To add the color legend you could use the solution provided here that in your case would look like:

Clear[colorbar]
colorbar[{min_, max_}, colorFunction_: Automatic, divs_: 150] := 
 DensityPlot[y, {x, 0, 0.1}, {y, min, max}, AspectRatio -> 10, 
  PlotRangePadding -> 0, PlotPoints -> {2, divs}, MaxRecursion -> 0, 
  FrameTicks -> {None, Automatic, None, None}, 
  ColorFunction -> colorFunction]

With[{opts = {ImageSize -> {Automatic, 300}, ImagePadding -> 20}, 
  cf = "Rainbow"}, 
 Row[{ListPlot[List /@ data[[All, {1, 2}]], 
    PlotStyle -> ({PointSize[0.01], ColorData["Rainbow"][#1]} & /@ 
       Rescale[data[[All, 3]], {1.5, 4}]), 
    PlotRange -> {{-1, 1}, {-1, 1}}, AspectRatio -> 1, Frame -> True, 
    Axes -> None, FrameTicks -> True, opts], 
   Show[colorbar[{1.5, 4}, cf], opts]}]]

With some additional options you can change the default font and add a label to the color legend:

Clear[colorbar]
colorbar[{min_, max_}, colorFunction_: Automatic, divs_: 150] := 
 DensityPlot[y, {x, 0, 0.1}, {y, min, max}, AspectRatio -> 10, 
  PlotRangePadding -> 0, PlotPoints -> {2, divs}, MaxRecursion -> 0, 
  Frame -> True, FrameLabel -> {{None, "log10(Tesc)"}, {None, None}}, 
  LabelStyle -> Directive[FontFamily -> "Helvetica", 14, Bold], 
  FrameTicks -> {{None, All}, {None, None}}, 
  FrameTicksStyle -> Directive[FontFamily -> "Helvetica", 10, Plain], 
  ColorFunction -> colorFunction]

With[{opts = {ImageSize -> {Automatic, 300}}, cf = "Rainbow"}, 
 Row[{ListPlot[List /@ data[[All, {1, 2}]], 
    PlotStyle -> ({PointSize[0.01], ColorData[cf][#1]} & /@ 
       Rescale[data[[All, 3]], {1.5, 4}]), 
    PlotRange -> {{-1, 1}, {-1, 1}}, AspectRatio -> 1, Frame -> True, 
    Axes -> None, FrameTicks -> True, 
    LabelStyle -> Directive[FontFamily -> "Helvetica", 10], 
    ImagePadding -> {{40, 10}, {20, 20}}, opts], 
   Show[colorbar[{1.5, 4}, cf], ImagePadding -> {{10, 40}, {20, 20}}, 
    opts]}]]

Last additions:

Clear[colorbar]
colorbar[{min_, max_}, colorFunction_: Automatic, divs_: 150] := 
 DensityPlot[y, {x, 0, 0.1}, {y, min, max}, AspectRatio -> 10, 
  PlotRangePadding -> 0, PlotPoints -> {2, divs}, MaxRecursion -> 0, 
  Frame -> True, 
  FrameLabel -> {{None, 
     "log10(\!\(\*SubscriptBox[\(T\), \(esc\)]\))"}, {None, None}}, 
  LabelStyle -> Directive[FontFamily -> "Helvetica", 15], 
  FrameTicks -> {{None, All}, {None, None}}, 
  FrameTicksStyle -> Directive[FontFamily -> "Helvetica", 15, Plain], 
  ColorFunction -> colorFunction]

ω1 = 0.4;
ω2 = 0.4;
ϵ = 1;
V[x_, y_] := 
  1/2*(ω1^2*x^2 + ω2^2*y^2) - ϵ*x^2*y^2;
xmin = 1;

fig = ContourPlot[
   Evaluate[V[x, y]], {x, -xmin, xmin}, {y, -xmin, xmin}, 
   Contours -> 10, ContourStyle -> {{Gray, Thickness[0.003]}}, 
   AspectRatio -> 1, ContourShading -> False, 
   PlotRange -> {{-1, 1}, {-1, 1}}];

With[{opts = {ImageSize -> {Automatic, 500}}, cf = "Rainbow"}, Row[{
   Show[
    ListPlot[List /@ data[[All, {1, 2}]], 
     PlotStyle -> ({PointSize[0.0045], ColorData[cf][#1]} & /@ 
        Rescale[data[[All, 2]], {1.5, 5}]), 
     PlotRange -> {{-1, 1}, {-1, 1}}, AspectRatio -> 1, Frame -> True,
      AspectRatio -> 1, RotateLabel -> False, Axes -> None, 
     FrameTicks -> True, FrameLabel -> {"x", "y"}, 
     LabelStyle -> Directive[FontFamily -> "Helvetica", 17], 
     ImagePadding -> {{60, 20}, {60, 20}}, opts],
    fig],
   Show[colorbar[{1.5, 5}, cf], ImagePadding -> {{20, 60}, {60, 20}}, 
    opts]}]]

Part of the original question referred to a density plot. To incorporate that element into the solution this version includes Opacity to allow the density of areas with close or overlapping points to be assessed. Such an effect can be observed in the two upper quadrant clusters.

densityHeatMap[data, opacity->0.5, Frame->True, FrameLabel->{"", "", "", "log10(Tesc)"}]

An additional benefit is that it gives some insight into areas where points of some particular some value might be obscured by overlapping, perhaps densely, points of different values. This effect is observable in the tips of the four main clusters where some high value points can be overlapped by lower value ones.

Clear@densityHeatMap;
Options[densityHeatMap] = {opacity -> 0.25, shiftRatio -> 1.05, 
   colorFunction -> ColorData["Rainbow"], pointSize -> 0.005,
   numHues -> 10, legend -> True, Frame -> True, 
   FrameTicks -> {Automatic, Automatic, Automatic, None}, 
   FrameLabel -> {"", "", "", ""}};
densityHeatMap[data_, opts : OptionsPattern[]] := 
 Module[{hues, shift, lLbls, lLocs, lSize, minX, maxX, minY, maxY, minZ, maxZ, lgnd,
   cf = OptionValue@colorFunction, op = OptionValue@opacity, 
   ps = OptionValue@pointSize, sr = OptionValue@shiftRatio, 
   nh = OptionValue@numHues},
  {{minX, maxX}, {minY, maxY}, {minZ, maxZ}} = {Min@#, Max@#} & /@ (data\[Transpose]);
  shift = {maxX sr, 0}; lLbls = FindDivisions[{minZ, maxZ}, nh] // N;
  hues = Range[0, 1, 1/(Length@lLbls - 1)] // N;

  lLocs = {0, #} & /@ 
    Range[Sequence @@ {minY, 
       maxY}, (Subtract @@ {maxY, minY})/(Length@lLbls - 1)];
  lSize = Subtract @@ lLocs[[{-1, 1}, 2]]/(Length@lLbls);

  lgnd = Graphics@
    MapThread[{cf[#1], Opacity@op, 
       Rectangle @@ {#3 + shift, #3 + {lSize, lSize} + shift},
       Darker@Gray, 
       Text[ToString@#2, #3 + {0.2, lSize/2} + shift]} &, {hues, 
      lLbls, lLocs}];

  Show[Graphics[{cf[#3], PointSize@ps, Opacity@op, 
       Point[{#1, #2}]} & @@@ 
     Transpose[{data[[All, 1]], data[[All, 2]], 
       Rescale@data[[All, 3]]}]], lgnd, 
   Sequence @@ FilterRules[{opts}, Options@Graphics]]  
  ]

A more concise skeletal version is given below.

d = Import["/tmp/Esc_data.out", "Table"];

With[{s=Max@d[[All,3]]},Show[Graphics[{1-Hue[#3/s],Point[{#1, #2}]}& @@@ d], Frame->True]]

You can insert a PointSize directive if you want to adjust the size of the points.

This is anything but fast, but here's how you do it with BubbleChart:

data = Import["C:\\Temp\\Esc_data.out", "Table"];
range = {Min@#, Max@#} &@data[[All, 3]];

plot =  BubbleChart[data, PlotRange -> {{-1, 1}, {-1, 1}}, ImageSize -> 300, 
   ChartElementFunction -> ({
       EdgeForm@None, 
       Hue[Rescale[Last@#2, range, {.6, 0.}]],
       Disk[Most@#2, .02]
     } &)];

legend = Grid[Table[{Graphics[{Hue[i], Rectangle[]}, ImageSize -> 25], 
              Rescale[i, {0, .6}, Reverse@range]},
       {i, 0, .6, .6/8}], Spacings -> {.3, 0}, Alignment -> Left];

Row@{plot, Labeled[legend, "legend\ntitle", Top]}