OFFSET
1,1
MATHEMATICA
q=9; lst={}; Do[p0=Prime[n+0]; p1=Prime[n+1]; p2=Prime[n+2]; p3=Prime[n+3]; p4=Prime[n+4]; If[PrimeQ[p0+p1+p2]&&PrimeQ[p2+p3+p4], AppendTo[lst, p2]], {n, q!}]; a2=lst; lst={}; Do[p0=Prime[n+0]; p1=Prime[n+1]; p2=Prime[n+2]; p3=Prime[n+3]; p4=Prime[n+4]; p5=Prime[n+5]; p6=Prime[n+6]; p7=Prime[n+7]; p8=Prime[n+8]; If[PrimeQ[p0+p1+p2+p3+p4]&&PrimeQ[p4+p5+p6+p7+p8], AppendTo[lst, p4]], {n, q!}]; a4=lst; lst={}; Do[p0=Prime[n+0]; p1=Prime[n+1]; p2=Prime[n+2]; p3=Prime[n+3]; p4=Prime[n+4]; p5=Prime[n+5]; p6=Prime[n+6]; p7=Prime[n+7]; p8=Prime[n+8]; p9=Prime[n+9]; p10=Prime[n+10]; p11=Prime[n+11]; p12=Prime[n+12]; If[PrimeQ[p0+p1+p2+p3+p4+p5+p6]&&PrimeQ[p6+p7+p8+p9+p10+p11+p12], AppendTo[lst, p6]], {n, q!}]; a6=lst; Intersection[a2, a4, a6]
cpQ[n_]:=Module[{a=Total/@Table[Take[n, {i, 7}], {i, 1, 5, 2}], b=Total/@ Table[ Take[ n, {7, j}], {j, 9, 13, 2}]}, AllTrue[Flatten[{a, b}], PrimeQ]]; Select[Partition[ Prime[ Range[ 360000]], 13, 1], cpQ][[All, 7]] (* The program uses the AllTrue function from Mathematica version 10 *) (* Harvey P. Dale, Jan 01 2019 *)
CROSSREFS
KEYWORD
nonn
AUTHOR
Vladimir Joseph Stephan Orlovsky, Feb 15 2009
EXTENSIONS
More terms from Harvey P. Dale, Jan 01 2019
STATUS
approved