How to speed up code in ParallelDo loops?

I have a piece of code that I'm trying to run in a ParallelDo over 32 kernels. Using a normal Do loop in a kernel Mathematica takes about 6 minutes to do the calculation, however, in the ParallelDo loop across 32 kernels it takes just over a minute. Surely it should be much quicker than this (about 11 seconds)?! Here is the code:

LaunchKernels[2*$ProcessorCount -$KernelCount];
dk = 1;

ParallelEvaluate[
g = 2*10^-1;
ϕ = 1;
m = 1;
f = 7;
lattsize = 50;
p[P_, α_, β_] := {P*Sin[α]*Cos[β], P*Sin[α]*Sin[β], P*Cos[α]};
q[Q_, a_] := {Q*Sin[a], 0, Q*Cos[a]};
k[X_] := {0, 0, X};
X = Interpolation[Table[{i, i}, {i, 0, lattsize, 10^-3}]];
ω[x_] := Sqrt[x.x + m^2];
(*x:=p,y:=q,z:=k,s:=k+(-)p+(-)q*)
A1[x_, y_, z_, s_] := (1 + (g*ϕ^2)/(8*ω[x]^2))*ω[x] +
(1 + (g*ϕ^2)/(8*ω[y]^2))*ω[y] + (1 + (g*ϕ^2)/(8*ω[z]^2))*ω[z] +
(1 + (g*ϕ^2)/(8*ω[s]^2))*ω[s];

minA1={};

maxA1={};

];

ParallelDo[
solA1 = NSolve[A1[p[P, α, β], q[Q, a], k[X[i]], k[X[i]] - p[P, α, β] - q[Q, a]] == f, Q, Method -> {Automatic, "SymbolicProcessing" -> 0}];
If[solA1 != {},

solA1 = Select[Q /. solA1, Positive];
AppendTo[minA1, {{P, i, α, β, a}, Min[solA1] /. Infinity -> Null}];
AppendTo[maxA1, {{P, i, α, β, a}, Max[solA1] /. -Infinity -> Null}];,

AppendTo[minA1, {{P, i, α, β, a}, Null}];
AppendTo[maxA1, {{P, i, α, β, a}, Null}]
],
{P, 0, 5, dk}, {i, 0, 10, dk}, {α, 0, 3, dk}, {β, 0, 6, dk}, {a, 0, 3, dk},
Method -> "CoarsestGrained"(*Automatic*)
]

I can't see anything I've done wrong, but I am fairly new to Mathematica, so any help would be much appreciated.

• Comments are not for extended discussion; this conversation has been moved to chat. – Mr.Wizard Feb 24 '17 at 21:57