How to make the ProgressIndicator for ParallelDo more efficient

Question

I am trying to keep track of a calculation for visualization purposes ( I want to show to the user that calculation is in progress) . For that I use ProgressIndicator. However inside the paralleldo keeping track of the variable for the indicator makes the calculation much slower with respect to no-indicator. I wrote a "toy code" that mimics what I am doing. In this toy-code I am simply multiplying two arrays over and over again. Is there a way to make d run only in the main kernel and I simply multiply the with number of kernels, this will give me a rough idea.

myDummyF[nd_, np_] := Module[{mat, mat2, aI},

ns = 200;
mat = SetAccuracy[RandomReal[{-100, 100}, ns], nd];
             mat2 = SetAccuracy[RandomReal[{-200, 200}, ns], nd];
d = 0;
aI = ConstantArray[0, np];
SetSharedVariable[aI, d];

Time = AbsoluteTiming[
 If[nd <= 16,
  Monitor[Do[
    If[iC == 2, Print["Do Loop"]];
    aI[[iC]] = SetAccuracy[mat.(mat2/iC^0.5), nd], {iC, np}], 
   ProgressIndicator[Dynamic[iC/np]]],
  Monitor[ParallelDo[d++;
    If[iC == 2, Print[" ParallelDo Loop"]];
    aI[[iC]] = SetAccuracy[mat.(mat2/iC^0.5), nd];
    , {iC, np}],
   ProgressIndicator[Dynamic[d/np]]]]];

  Print["Do loop time = ", Time[[1]], ", np = ", np, ", nd = ", nd];
  aInum = Apply[Plus, (aI/np)];
  Print["Total = ", aInum];
  Return[aInum]];
  np = 1000;
  nd = 30;
  myDummyF[nd, np];

For do loop (not the parallel one) there is not performance issue. I know the that the performance hit coming from the overhead of carrying d. Is there another way of doing this? I don't need to keep track exactly just an idea would be fine.

Below is the same code without process indicator:

myDummyF[nd_, np_] := Module[{mat, mat2, aI},

ns = 200;
mat = SetAccuracy[RandomReal[{-100, 100}, ns], nd];

mat2 = SetAccuracy[RandomReal[{-200, 200}, ns], nd];

aI = ConstantArray[0, np];
SetSharedVariable[aI];
Time = AbsoluteTiming[
 If[nd <= 16,
  Do[
   If[iC == 2, Print["---------------------"]];
   If[iC == 2, Print["Do Loop", " nd= ", nd, " np= ", np]];
   aI[[iC]] = SetAccuracy[mat.(mat2/iC^0.5), nd], {iC, np}],
  ParallelDo[
   If[iC == 2, Print["---------------------"]];
   If[iC == 2, 
    Print[" ParallelDo Loop", " nd= ", nd, " np= ", np]];
   aI[[iC]] = SetAccuracy[mat.(mat2/iC^0.5), nd], {iC, np}]]];
  Print["Do loop time = ", Time[[1]]];
  aInum = Apply[Plus, (aI/np)];
  Print["Total = ", aInum];
  Print["---------------------"];
  Return[aInum]];
  np = 1000;
  nd = 30;
  myDummyF[nd, np];

Answer 1

I didn't want to bother about handling nd <= 16 as an extra condition and made some additional changes that increase the performance.

np = 1000;
nd = 30;

First the function without a ProgressIndicator as a reference:

dummyFKnoPI[nd_, np_] := Module[{mat, mat2, aI, ns = 200, time, aInum},
   mat = SetAccuracy[RandomReal[{-100, 100}, ns], nd];
   mat2 = SetAccuracy[RandomReal[{-200, 200}, ns], nd];
   aI = ConstantArray[0, np];

   time = AbsoluteTiming[
     Print[" Parallel Loop"];
     aI = ParallelTable[
       SetAccuracy[mat.(mat2/iC^0.5), nd],
       {iC, np}];
     ];
   Print["Loop time = ", time[[1]], ", np = ", np, ", nd = ", nd];
   aInum = Apply[Plus, (aI/np)];
   Print["Total = ", aInum];
   aInum];

dummyFKnoPI[nd, np*100];

 Parallel Loop
Loop time = 4.30922, np = 100000, nd = 30
Total = -392.25069339023950901292892012862

Now the function with a ProgressIndicator, but minimal inter kernel communication overload:

dummyFK[nd_, np_] := Module[{mat, mat2, aI, ns = 200, d = 0, dl, time, aInum},
   mat = SetAccuracy[RandomReal[{-100, 100}, ns], nd];
   mat2 = SetAccuracy[RandomReal[{-200, 200}, ns], nd];
   aI = ConstantArray[0, np];

   SetSharedVariable[d];
   ParallelEvaluate[dl = 0];

   time = AbsoluteTiming[
     Print[" Parallel Loop"];
     Monitor[
      aI = ParallelTable[
         If[Mod[dl++, 1000] == 0, d += 1000]; 
         SetAccuracy[mat.(mat2/iC^0.5), nd],
         {iC, np}];,
      ProgressIndicator[d/np]
      ]
     ];
   Print["Loop time = ", time[[1]], ", np = ", np, ", nd = ", nd];
   aInum = Apply[Plus, (aI/np)];
   Print["Total = ", aInum];
   aInum];

dummyFK[nd, np*100];

 Parallel Loop
Loop time = 4.5777, np = 100000, nd = 30
Total = -457.35153371159704445886973189772

When using d++ instead of If[Mod[dl++, 1000] == 0, d += 1000] the Loop time is 309.525.