Евгений

Не моё. Случайно наткнулся.

uses crt;
const max=10;
type mas=array[1..max] of real;{массив}
mtr=array[1..max] of mas;{матрица}
proc=procedure(n:byte;b,c:mas;var t:mas);{процедурный тип}
{опишем две функции}
function f1(x:real):real;
begin
f1:=sin(x)
end;
function f2(x:real):real;
begin
f2:=cos(x)
end;
{$F+}
{опишем процедуру для использования параметром в другой процедуре}
procedure newmas(n:byte;b,c:mas;var t:mas);
var m,i:byte;
begin
m:=0;
for i:=1 to n do
if (f1(b[i])>0)and(f2(c[i])>f1(b[i])) then
begin
m:=m+1;
t[m]:=b[i]+c[i]
end;
if m<n then
for i:=m+1 to n do
t[i]:=0;
end;
{$F-}
{основная процедура}
procedure newmtr(a:mtr;n:byte;newmasroc;var e:mtr);
var i:byte;
begin
for i:=1 to n div 2 do
newmas(n,a[2*i-1],a[2*i],e[i])
end;
var a,e:mtr;
n,i,j:byte;
begin
clrscr;
randomize;
repeat
write('Размер матрицы А четное число до ',max,' n=');
readln(n);
until (n in [2..max])and(n mod 2=0);
{создадим матрицу А по столбцам}
for j:=1 to n do
for i:=1 to n do
a[j,i]:=random;
{выведем ее построчно}
writeln('Матрица А:');
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j]:6:2);
writeln
end;
{получим новую матрицу}
newmtr(a,n,newmas,e);
{выведемее построчно}
writeln('Матрица E:');
for i:=1 to n div 2 do
begin
for j:=1 to n do
write(e[i,j]:5:2);
writeln
end;
readln
end.