program massiv1;
uses crt;
label inp1, inp2; {объявление меток для возврата при неправильном вводе параметров}
var n,k,i,j: integer;
    p: real;
    a: array[1..10,1..10] of real;
    f: text;
begin
{инициализация генератора псевдослучайных чисел}
randomize;
{очистка текстового экрана}
clrscr;
{ввод размерности массива}
inp1: writeln('Введите размерность массива в диапазоне [1:10]');
readln(n);
if (n<1) or (n>10) then goto inp1;
{выбор источника значений массива}
inp2: writeln('Выберите способ заполнения массива (1 - из файла, 2 - вручную, 3 - псеводслучайные значения)');
readln(k);
case k of
{заполнение из текстового файла}
1:begin
   writeln('Идет заполнение массива значениями из файла c:\in.txt');
   {работа с указанным файлом}
   assign(f,'c:\in.txt');
   reset(f);
   i:=1;
   while not eof(f) do {проверка конца файла}
   begin
     j:=1;
     while j<=n do {заполнение по столбцам}
     begin
       read(f,a[i,j]);
       j:=j+1;
     end;
     i:=i+1;
   end;
   close(f);
   end;  {1}
{заполнение массива вручную}
2: begin
   for i:=1 to n do
   for j:=1 to n do
   begin
   writeln('Введите [',i,':',j,'] элемент массива');
   read(a[i,j]);
   end;
   end; {2}
{заполнение массива псевдослучайными значениями из диапазона [0;10]}
3: begin
   for i:=1 to n do
   for j:=1 to n do
   begin
   a[i,j]:=random*10;
   end;
   end; {3}
else goto inp2;
end; {case}
writeln('Массив заполнен значениями.');
{вывод массива на экран}
writeln;
for i:=1 to n do begin
for j:=1 to n do
begin
write(a[i,j],'  ');
end; writeln; end;
{вычисление количества столбцов, произведение элементов в которых меньше 5}
k:=0;
for i:=1 to n do
begin
p:=1;
for j:=1 to n do
begin
p:=p*a[i,j];
end;
if p<5 then k:=k+1;
end;
{вывод результатов на экран и в файл out.txt}
writeln('В массиве количество столбцов, произведение элементов которых меньше 5, равно ',k);
writeln('Результат работы программы сохранен в файл c:\out.txt');
assign(f,'c:\out.txt');
rewrite(f);
for i:=1 to n do
begin
 for j:=1 to n do write(f,a[i,j]:4:6,' ');
 writeln(f,'');
end; {i}
writeln(f,'В массиве количество столбцов, произведение элементов которых меньше 5, равно ',k);
close(f);
readln(i);
end.

10.1 
2.11 
3.12
2.1 
2.3 
1.1
3.2 
2.1 
0.2

10.100000 2.110000 3.120000 
2.100000 2.300000 1.100000 
3.200000 2.100000 0.200000 
В массиве количество столбцов, произведение элементов которых меньше 5, равно 1

program massiv2;
uses crt;
label inp1;
var n,k,i,j: integer;
    max, sum, b: real;
    a: array[1..1000] of real;
begin
randomize;
clrscr;
{ввод размерности массива}
writeln('Введите размерность массива:');
readln(n);
{выбор источника значений массива}
inp1: writeln('Выберите способ заполнения массива (1 - вручную, 2 - псевдослучайные значения)');
readln(k);
case k of
{заполнение массива вручную}
1: begin
   for i:=1 to n do
   begin
   writeln('Введите [',i,'] элемент массива');
   read(a[i]);
   end;
   end; {1}
{заполнение массива псевдослучайными значениями}
2: begin
   for i:=1 to n do
   begin
   a[i]:=random*10; {генерация значений элементов массива}
   if trunc(random*2)=1 then a[i]:=a[i]*(-1); {генерация отрицательных значений}
   end;
   end; {2}
else goto inp1;
end; {case}
writeln('Массив заполнен значениями:');
{вывод массива на экран}
writeln;
for i:=1 to n do
begin
writeln(a[i]);
end; 
writeln;
{поиск максимального по модулю элемента массива}
max:=a[1]; 
j:=1; {j - порядковый номер мах по модулю элемента}
for i:=2 to n do
begin
if abs(a[i])>=abs(max) then begin max:=a[i]; j:=i; end;
end;
writeln('Максимальный по модулю элемент с порядковым номером ',j,' равен ',max);
{вычисление суммы элементов между первым и вторым положительными элементами массива}
sum:=0; 
j:=1;
for i:=1 to n do
begin
if (a[i]>0) and (j=1) then
          begin
           while a[i+1]<=0 do begin
           i:=i+1;
           sum:=sum+a[i]; end;
           j:=j+1;
          end;
end;
writeln('Сумма элементов между первым и вторым положительным элементом равна ',sum);
{перемещение всех 0 в конец массива}
writeln('Отсортированный массив: ');
for i:=1 to n do
begin
if a[i]=0 then
          begin
           j:=i;
           while j<=n do begin
           b:=a[j+1];
           a[j+1]:=0;
           a[j]:=b;
           j:=j+1;
           end; {while}
          end; {if}
end;
{вывод на экран полученного массива}
for i:=1 to n do writeln(a[i]);
readln(i);
end.