Deleting multiple elements of lists which follow no specific pattern

A MaxFilter does a pretty good job as your data is mostly decreasing:

MaxFilter[data, 5] // ListPlot

However this slightly changes the phase of the curve by 5 points. If you use a MovingMap instead, the right aligned window will avoid this problem, but it will sacrifice five points at the start of your data if you can tolerate that:

Show[
 ListPlot[MovingMap[Max, data, 10]],
 ListPlot[data, PlotStyle -> {PointSize[Small], Red}]
 ]

You can use this method here. Play with parameter xScale for adjustment.

 xScale = 30.;
    xy = Transpose[{N[Range[Length[data]]]*(xScale/Length[data]), data}];
    start = {-xScale, First[data]};
    finish = {2*xScale, Last[data]};
    graph = NearestNeighborGraph[Join[{start}, xy, {finish}], 25];
    graph = SetProperty[graph, 
       EdgeWeight -> 
        Apply[SquaredEuclideanDistance, EdgeList[graph], {1}]];
    path = FindShortestPath[graph, start, finish][[2 ;; -2]];
    ListLinePlot[path, PlotRange -> MinMax[data], 
     Prolog -> {Gray, Point[xy]}, PlotStyle -> Red, ImageSize -> 600]

An approach quite similar to @flinty's answer is to use the image processing filter "Dilation":

ListPlot[{data, Dilation[data, 5][[5 ;; All]]}]

The Dilation rides over the top of the data and the indexing ([[5 ;; All]]) removes the shift of the data.