Определение наименьшего общего кратного двух натуральных чисел

program del;
uses crt;
var x, y, nod1: integer;
    nok: real;
 
function NOD(x,y: integer):integer;
var z,i,k: integer;
begin
 if (x>y) then k:=y
 else if (x<y) then k:=x
 else k:=0;
 
 if (k<>0) then
 begin
  for i:=1 to k do
  begin
   if (x mod i=0)and(y mod i=0) then z:=i;
  end;
 end
 else z:=k;
 
 NOD:=z;
end;
 
Begin
 write('X = '); readln(x);
 write('Y = '); readln(y);
 
 nod1:=NOD(x,y);
 
 writeln('NOD = ',nod1);
 
 nok:=(x*y)/nod1;
 
 writeln('NOK = ',nok);
End.

if (x>y) then k:=y
 else if (x<y) then k:=x

uses wincrt;
var
  a,b,c,y : real;
  k : byte;
begin
  write('a,b,c :'); readln(a,b,c);
 
  k := trunc(a*a + b*b + c*c) div 10;
 
  case k of
    1,7 : y := (4*(a+b))/ c + sin(a/b)/cos(a/b);
    2..4: y := abs( exp(1)*a + b*b );
       5: y := sin(a - pi/2) - 3
    else
        y := (a - pi) / 25*b - a/c;
  end;
   writeln('y = ',y:0:3);
end.

uses wincrt;
var
  x : array[1..50] of integer;
 
 i,n,
 k,k_ : byte;
 
begin
  write('razmer : '); readln(n);
  writeln('mas : ');
  for i:=1 to  n do
    read(x[i]);
 
  writeln;
  for i:=1 to n do
        if x[i] = 0
           then
              inc(k)
           else
              if k > 2
                 then
                    begin
                       writeln('aga');
                       k_ := 1;
                       break;
                    end
                 else
                    k := 0;
 
   if k_ = 0
      then
         writeln('ne');
end.

Program one;
uses crt;
Var a,b,s:real;
Begin
ClrScr;
Writeln('Введите a');
Readln(a);
Writeln('Введите b');
Readln(b);
a:=trunc(a) mod 10;
b:=trunc(frac(b)*10);
S:=a+b;
Writeln('Сумма равна',s:2:0);
end.

uses wincrt;
function fac(x:byte):longint;
var
  i : byte;
  n : longint;
begin
  n := 1;
  for i:=2 to x do
     n := n * i;
  fac := n;
end;
 
VAR
 a,s,e : real;
     n : byte;
begin
 write('e = '); readln(e);
 a := 1;
 
 while abs(a) > e do
    begin
       n := n + 1;
       a := sqr(fac(n))/exp( exp(ln(n) * 2*n) * ln(2) );
       s := s + a;
    end;
 
 writeln('s : ',s:0:4);
end.

uses wincrt;
var
  i : byte;
  q : real;
begin
  for i:=1 to 15 do
     q := sqrt(2 + sqrt(q));
 
  writeln('Q = ',q:0:4);
end.

uses wincrt;
var
    l,k : byte;
  kp,ls,s : longint;
begin
  kp := 1;
   for k:=1 to 30 do
     kp := kp * (k+5);
   for l:=1 to 10 do
     ls := ls + sqr(l);
   ls := ls + k;
 s := ls * kp;
 writeln('resutat : ',s);
end.

uses wincrt;
var
  a,b,c,d : array[1..10,1..10] of real;
  z : array[1..20] of real;
  i,j,m,n : byte;
  min, max : real;
  k,i_,j_:byte;
begin
  write('razmer A : ');readln(m,n);
  writeln('matrica A:');
  for i:=1 to m do
    begin
      for j:=1 to n do
        begin
          a[i,j] := (i+j)*(sin(i)/cos(i));
          write(a[i,j]:0:0,' ');
        end;
      writeln;
    end;
 k := m;
 
 repeat
   for j:=1 to n do
    begin
      min := a[1,j];
       i_ := 1;
       j_ := j;
      for i:=1 to k do
        if min > a[i,j]
          then
             begin
                min := a[i,j];
                 i_ := i;
                 j_ := j;
             end;
    a[i_,j_] := a[k,j];
      a[k,j] := min;
      b[k,j] := min;
    end;
 
    k := k - 1;
 until k < 1;
 
 writeln;
 writeln('matrica B:');
 for i:=1 to m do
   begin
     for J:=1 to n do
       write(b[i,j]:0:0,' ');
     writeln;
   end;
 writeln; writeln('matrica C :');
 for i:=1 to 6 do
   for j:=i to 6 do
       c[i,j] := 1;
 
 for I:=1 to 6 do
   begin
     for J:=1 to 6 do
       write(c[i,j]:0:0,' ');
     writeln;
   end;
 
 
   for i:=1 to m do
   for K:=1 to n do
   for j:=1 to n do
    d[i,k]:=d[i,k]+b[i,j]*c[j,k];
 
    gotoxy(37,2); write('matrica D:');
    for i:=1 to m do
      for j:=1 to n do
           begin
             gotoxy(30 + 4*j,i+2);
             write(d[i,j]:0:0);
           end;
 
  max := a[1,1];
  i_ := 1;
    for i:=1 to m do
      for j:=1 to n do
         if max < a[i,j]
            then
               begin
                   max := a[i,j];
                    i_ := i;
               end;
 
   for j:=1 to n do
      z[j] := a[i_,j];
 
   gotoxy(30,10); write('stroka s max el. dlya A :');
   for i:=1 to n do
      begin
        gotoxy(30+3*i,11);
        write(z[i]:0:0);
      end;
 
  end.

uses crt;
const n=6;
var a,b,c,d,e:array[1..n,1..n] of real;
    i,j,k:byte;
    x:real;
begin
clrscr;
{создание матрицы А}
writeln('Матрица А:');
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    a[i,j]:=(i+j)*cos(i)/sin(i);
    write(a[i,j]:7:2);
   end;
  writeln;
 end;
writeln;
{создание матрицы В-сортировка столбцов}
b:=a;
for j:=1 to n do
for i:=1 to n-1 do
for k:=i+1 to n do
if b[i,j]<b[k,j] then
 begin
  x:=b[i,j];
  b[i,j]:=b[k,j];
  b[k,j]:=x;
 end;
writeln('Матрица В:');
for i:=1 to n do
 begin
  for j:=1 to n do
  write(b[i,j]:7:2);
  writeln;
 end;
writeln;
{создание матрицы С}
writeln('Матрица С:');
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    if j>=i then c[i,j]:=1
    else c[i,j]:=0;
    write(c[i,j]:7:2);
   end;
  writeln;
 end;
write('Нажмите Enter');
readln;
{Матрица D=B*C}
for k:=1 to n do
for j:=1 to n do
   begin
     d[k,j]:=0;
     for i:=1 to n do
     d[k,j]:=d[k,j]+b[k,i]*c[i,j];
   end;
writeln('Матрица D=B*C:');
for i:=1 to n do
 begin
  for j:=1 to n do
  write(d[i,j]:7:2);
  writeln;
 end;
{матрица Е}
for i:=1 to 2 do
for j:=1 to 4 do
 begin
  e[i,j]:=d[i,j+2];{сдвиг верхних блоков 2,3 влево}
  e[n-i+1,n-j+1]:=d[n-i+1,n-j-1];{сдвиг нижних блоков 7,8 вправо}
 end;
for i:=3 to n do
for j:=1 to 2 do
 begin
  e[i,j]:=d[i-2,j];{сдвиг левых блоков 1,4 вниз}
  e[n-i+1,n-j+1]:=d[n-i+3,n-j+1];{сдвиг правых блоков 6,9 вверх}
 end;
for i:=3 to 4 do
for j:=3 to 4 do
e[i,j]:=d[i,j];
writeln('Матрица E:');
for i:=1 to n do
 begin
  for j:=1 to n do
  write(e[i,j]:7:2);{центральный блок 5 на месте}
  writeln;
 end;
readln
end.