(( дано целое число n> 1, найти наибольшее целое число k при котором выполняется неравенство 3к

Program while_4; var N: integer; begin readln(N); while N mod 3 = 0 do N := N div 3; // пока остаток от деления на 3 равен нулю, делим на 3. writeln(N = 1); // Выведет True или False end.

Const
 names:array[1..7] of string=('пн','вт','ср','чт','пт','сб','вс');
var k,i,n0,np,nw,year,dw:integer;
begin
k:=0;
n0:=6; //01.01.2000 - суббота
for i:=2000 to 2100 do
 begin
  if (i mod 400=0)or(i mod 4=0)and(i mod 100<>0)
   then begin year:=366; dw:=31+29+31+3; end
   else begin year:=365; dw:=31+28+31+3; end;
  np:=(255+n0-1) mod 7+1;
  nw:=(dw+n0-1) mod 7+1;
  n0:=(year+n0-1) mod 7+1;
  if np=nw then 
   begin writeln(i,' - ',names[np]); k:=k+1; end;
 end;
writeln('k = ',k);
end.

Результат:
2000 - вт
2004 - вс
2008 - пт
...
2092 - пт
2096 - ср
k = 25

PS. Високосные годы, однако )

// PascalABC.NET 3.2, сборка 1399 от 08.03.2017
// Внимание! Если программа не работает, обновите версию!

begin
  var s:=ReadReal('Площадь решета равна');
  var a:=ReadArrReal('Введите диаметры клубней:',10);
  var d:=sqrt(4*s/pi);
  var b:=a.Where(x->x<d);
  var n:=b.Count;
  if n>0 then begin
    Write('Пройдут клубни диаметром '); b.Print;
    Writeln(' - всего ',n,' шт.')
    end
  else Writeln('Ни один клубень не пройдет')
end.

Пример
Площадь решета равна 45
Введите диаметры клубней: 8.6 7.1 9 10.2 6.4 5 6 8.2 6.6 7
Пройдут клубни диаметром 7.1 6.4 5 6 6.6 7 - всего 6 шт.