
MATHEMATICA

w = {2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607}; Do[w[[n]] = 2^w[[n]]  1, {n, 1, Length[w]}]; c = 0; a = {}; Do[k = 24 n + 7; If[PrimeQ[k], c = c + 1; If[MemberQ[w, k], AppendTo[a, c]]], {n, 1, 10000000}]; a
With[{mps=2^#1&/@MersennePrimeExponent[Range[20]]}, Position[ Select[ 24*Range[0, 10^8]+7, PrimeQ], _?(MemberQ[mps, #]&)]]//Flatten (* Requires Mathematica version 10 or later *) (* Harvey P. Dale, Aug 20 2019 *)
