Написать модифицированный вариант алгоритма Евклида

function NOD (x,y:longint):longint;
begin
if x<>0 then Nod:=Nod(x mod y,x)
else Nod:=y;
end;
 
var
a,b,c,d:longint;
begin
readln(a,b,c,d);
writeln('NOD (',a,',',b,',',c,',',d,') = ',NOD(a,NOD(b,NOD(c,d))));
 
readln
end.

uses crt;
const max=20;
      e=0.1;{0.0001}
type matr=array[1..max,1..max] of extended;
procedure Vvod(var mt:matr;var x:byte);{создание исходной матрицы}
var i,j:byte;
begin
repeat
write('Введите размер матрицы до ',max,' =');
readln(x);
until x in [1..20];
for i:=1 to x do
for j:=1 to x do
mt[i,j]:=random;
end;
procedure Vyvod(var mt:matr;x:byte;c:string);{вывод матриц на экран}
var i,j:byte;
begin
writeln(c);
for i:=1 to x do
 begin
  for j:=1 to x do
  write(mt[i,j]:8:5);
  writeln;
 end;
end;
 
procedure UmnMt(m1,m2:matr;var m3:matr;x:byte);{умножение матриц}
var k,j,i:byte;
begin
for k:=1 to x do
for j:=1 to x do
   begin
     m3[k,j]:=0;
     for i:=1 to x do
     m3[k,j]:=m3[k,j]+m1[k,i]*m2[i,j];
   end;
end;
 
procedure Razn(m1,m2:matr;var m3:matr;x:byte);{разность матриц}
var i,j:byte;
begin
for i:=1 to x do
for j:=1 to x do
m3[i,j]:=m1[i,j]-m2[i,j];
end;
 
function Prov(mt:matr;x:byte):boolean;{проверка достигнутой точности}
var i,j:byte;
begin
Prov:=true;
for i:=1 to x do
for j:=1 to x do
if abs(mt[i,j])>=e then
 begin
  Prov:=false;
  break;
 end;
end;
var a,b,an,r:matr;
    n,i,j:byte;
begin
clrscr;
Vvod(a,n);
Vyvod(a,n,'Исходная матрица:');
randomize;
b:=a;{запомним исходную матрицу}
repeat
UmnMt(a,b,an,n);{умножаем}
Razn(an,a,r,n);{смотрим матрицу разности}
if Prov(r,n) then break{если точность достигнута, выходим из цикла}
else a:=an;{иначе умножаем новую маирицу}
until Prov(r,n);
Vyvod(a,n,'Матрица A(n-1):');{выводим предпоследнюю}
Vyvod(an,n,'Матрица An:');{выводим последнюю}
Vyvod(r,n,'Достигнутая точность:');{матрица последних разностей}
readln
end.

uses crt;
const max=20;
      e=0.0001;
type matr=array[1..max,1..max] of extended;
procedure Vvod(var mt:matr;var x:byte);{создание исходной матрицы}
var i,j:byte;
begin
repeat
write('Введите размер матрицы до ',max,' =');
readln(x);
until x in [1..20];
for i:=1 to x do
for j:=1 to x do
mt[i,j]:=random;
end;
procedure Vyvod(var mt:matr;x:byte;c:string);{вывод матриц на экран}
var i,j:byte;
begin
writeln(c);
for i:=1 to x do
 begin
  for j:=1 to x do
  write(abs(mt[i,j]):11:7);
  writeln;
 end;
end;
 
procedure UmnMt(m1,m2:matr;var m3:matr;x:byte);{умножение элементов матриц}
var i,j:byte;
begin
for i:=1 to x do
for j:=1 to x do
m3[i,j]:=m1[i,j]*m2[i,j];
end;
 
procedure Razn(m1,m2:matr;var m3:matr;x:byte);{разность матриц}
var i,j:byte;
begin
for i:=1 to x do
for j:=1 to x do
m3[i,j]:=m1[i,j]-m2[i,j];
end;
 
function Prov(mt:matr;x:byte):boolean;{проверка достигнутой точности}
var i,j:byte;
begin
Prov:=true;
for i:=1 to x do
for j:=1 to x do
if abs(mt[i,j])>=e then
 begin
  Prov:=false;
  break;
 end;
end;
var a,b,an,r:matr;
    n,i,j:byte;
begin
clrscr;
Vvod(a,n);
Vyvod(a,n,'Исходная матрица:');
randomize;
b:=a;{запомним исходную матрицу}
repeat
UmnMt(a,b,an,n);{перемножаем элементы}
Razn(an,a,r,n);{смотрим матрицу разности}
if Prov(r,n) then break{если точность достигнута, выходим из цикла}
else a:=an;{иначе умножаем новую матрицу}
until Prov(r,n);
Vyvod(a,n,'Матрица A(n-1):');{выводим предпоследнюю}
Vyvod(an,n,'Матрица An:');{выводим последнюю}
Vyvod(r,n,'Достигнутая точность:');{матрица последних разностей}
readln
end.

const n=2;
label exit;
var
a    : array[1..n, 1..n] of longint;
i,k  : integer;
m    : real;
iff  : boolean;
begin
exit:
writeln('Enter the array, one by one, pressing ENTER: ');
iff:=false;
for i:=1 to n do begin
for k:=1 to n do begin
readln(a[i,k]);
if (a[i,k]=1) or (a[i,k]<1) then begin writeln('The array cant consist of 1! (Press ENTER)'); readln; goto exit; end;
end;
end;
writeln('Enter the number to stop: ');
readln(m);
repeat
iff:=true;
for i:=1 to n do begin
for k:=1 to n do begin
if sqr(a[i,k])-a[i,k]<m then iff:=false;
a[i,k]:=sqr(a[i,k]);
end;
end;
until iff=true;
for i:=1 to n do begin
for k:=1 to n do begin
if k=n then begin write(a[i,k]); writeln; end
       else begin
       if a[i,k]<10 then write(a[i,k],'     ');
       if (a[i,k]<100) and (a[i,k]>=10) then write(a[i,k],'    ');
       if (a[i,k]>=100) and (a[i,k]<1000) then write(a[i,k],'   ');
       if (a[i,k]>=1000) and (a[i,k]<10000) then write(a[i,k],'  ');             {}{}{}{}{}{}
       if (a[i,k]>10000) and (a[i,k]<100000) then write(a[i,k],' ');
            end;
end;
end;
readln;
end.