Let us Trace
how messages from parallel kernels are handled in the main kernel:
Flatten[Trace[ParallelTable[Message[General::munfl, $KernelID], {1}],
LinkRead | MessagePacket | TextPacket] /.
seq : {_HoldForm, _} :> Rule @@ seq] // Column

We see that the subkernel first returns MessagePacket[General, "munfl"]
which isn't printed, then it returns
TextPacket["General::munfl: 4 is too small to represent as a normalized machine number; precision may be lost."]
which is passed to Parallel`Protected`PacketHandler
along with the corresponding KernelObject
, from which it extracts the $KernelID
and passes it as a part of CellLabel
to CellPrint
. This is how the original message from the subkernel appears in the evaluation Notebook.
Hence we can intercept the message printing by overloading either Parallel`Protected`PacketHandler
or CellPrint
. I tried to work with the first without success, but overloading of CellPrint
works:
Unprotect[CellPrint];
CellPrint[Cell[s_String, "Print", CellLabel -> label_String, ShowCellLabel -> True]] :=
Block[{$inCP = True,
mname = First[StringCases[s, RegularExpression["^(\\w+::\\w+):"] :> "$1", 1], False]},
If[! AssociationQ[$SubkernelMessages], $SubkernelMessages = <||>];
If[! NumericQ[$SubkernelMessagesLimit], $SubkernelMessagesLimit = 3];
If[KeyExistsQ[$SubkernelMessages, mname],
++$SubkernelMessages[mname], $SubkernelMessages[mname] = 1];
If[$SubkernelMessages[mname] <= $SubkernelMessagesLimit,
CellPrint[Cell[s, "Print", CellLabel -> label, ShowCellLabel -> True]]]; /;
StringQ[mname]] /;
Not[TrueQ[$inCP]] && StringMatchQ[label, RegularExpression["\\(kernel \\d+\\)"]];
Protect[CellPrint];
After evaluating the above we can use ParallelTable
as follows:
$SubkernelMessages =.;
$SubkernelMessagesLimit = 2;
ParallelTable[Message[General::munfl, $KernelID], {100}];

Note that $SubkernelMessages
is kept during the whole main kernel session, not per evaluation as $MessageList
. Hence it should be purged manually before every input where you call a Parallel*
function (as I do in the above example) if you wish to mimic the default behavior of Message
. However, it is not difficult to automate this too:
Unprotect[CellPrint];
CellPrint[Cell[s_String, "Print", CellLabel -> label_String, ShowCellLabel -> True]] :=
Block[{$inCP = True,
mname = First[StringCases[s, RegularExpression["^(\\w+::\\w+):"] :> "$1", 1], False]},
If[Not[AssociationQ[$SubkernelMessages]] || $SubkernelMessages["$Line"] =!= $Line,
$SubkernelMessages = <|"$Line" -> $Line|>];
If[! NumericQ[$SubkernelMessagesLimit], $SubkernelMessagesLimit = 3];
If[KeyExistsQ[$SubkernelMessages, mname],
++$SubkernelMessages[mname], $SubkernelMessages[mname] = 1];
If[$SubkernelMessages[mname] <= $SubkernelMessagesLimit,
CellPrint[Cell[s, "Print", CellLabel -> label, ShowCellLabel -> True]]]; /;
StringQ[mname]] /;
Not[TrueQ[$inCP]] && StringMatchQ[label, RegularExpression["\\(kernel \\d+\\)"]];
Protect[CellPrint];
With this definition $SubkernelMessagesLimit
will limit the number of printed messages from the subkernels for every input $Line
of the main kernel:
$SubkernelMessagesLimit = 1;
ParallelTable[Message[General::munfl, $KernelID]; $KernelID, {20}]
ParallelTable[Message[General::munfl, $KernelID]; $KernelID, {20}]

As a bonus. If you evaluate (related)
ParallelEvaluate[SetOptions[$Output, PageWidth -> Infinity]];
then the messages from the parallel kernels will be printed without the compulsory linebreaks:
$SubkernelMessages =.;
ParallelTable[Message[General::munfl, $KernelID], {100}];

Additionally, you can get a nicer appearance with automating word-wrapping if you change the inner CellPrint
part of the above custom definitions to the following:
CellPrint[Cell[BoxData@s, "Message", CellLabel -> label, ShowCellLabel -> True]]
Here is the result:

Also, you can get the statistics of the Message
s generated in the subkernels:
$SubkernelMessages
<|"General::munfl" -> 36, "General::stop" -> 12|>
Quiet[Check[{0^0, 0^0},"ERROR",Power::indet]]
suppresses the message, but returns "ERROR" sinceCheck
is insideQuiet
- this might be a way to generate one message for the whole calculation. $\endgroup$Mathematica | Preferences ... | Advanced | Open Option Inspector | Global Preferences | Global Options | Message Options | "MaxMessageCount"
set value to1
or whatever value you desire. $\endgroup$