NewMathema Mfied

Block[{$MaxExtraPrecision = 10000}, epsloc = {}; emptwob = {};
 For[v = 2, v < 106,
  v++ For[j = 4, j < 5, j++,
    For[h = 1, h < j - 1, h++,
     If[h == (j - 1)/2, Continue,
      For[f = 1, f < v + 1, f++,
       g = Floor[(1/
            2*(((2*h*(j^(v) - 1)/(j - 1)) + 1/2)^(1/f) + 1/2))];
       d = g + Sqrt[g^2 - 1]; If[d > j, x = (d^f + (1/d^f))/2;
        y = h*(j^v - 1)/(j - 1);
        If[x == y, kappaa = Log[j, d]; z = 1;
         q = Denominator[Convergents[kappaa, z][[z]]];
         If[6*10^(15) < q,
          epslo = Abs[-Log[j, (2*h)/(j - 1)]*q -
              Round[-Log[j, (2*h)/(j - 1)]*q]] -
            10^(15)*Abs[kappaa*q - Round[kappaa*q]];
          If[epslo > 0, AppendTo[epsloc, epslo]; AppendTo[emptwob, q],
            While[epslo <= 0, z++;
            q = Denominator[Convergents[kappaa, z][[z]]];
            epslo =
             Abs[-Log[j, (2*h)/(j - 1)]*q -
                Round[-Log[j, (2*h)/(j - 1)]*q]] -
              10^(15)*Abs[kappaa*q - Round[kappaa*q]]];
           AppendTo[epsloc, epslo]; AppendTo[emptwob, q]],
          While[q <= 6*10^(15), z++;
           q = Denominator[Convergents[kappaa, z][[z]]]      ];

          epslo = Abs[-Log[j, (2*h)/(j - 1)]*q -
              Round[-Log[j, (2*h)/(j - 1)]*q]] -
            10^(15)*Abs[kappaa*q - Round[kappaa*q]];
          If[epslo > 0, AppendTo[epsloc, epslo]; AppendTo[emptwob, q],
            While[epslo <= 0, z++;
            q = Denominator[Convergents[kappaa, z][[z]]];
            epslo =
             Abs[-Log[j, (2*h)/(j - 1)]*q -
                Round[-Log[j, (2*h)/(j - 1)]*q]] -
              10^(15)*Abs[kappaa*q - Round[kappaa*q]]];
           AppendTo[epsloc, epslo]; AppendTo[emptwob, q]]      ],
         Continue], Continue]]]]]]; Print[Max[emptwob]];
 Print[Min[epsloc]]]