Получить матрицу по правилу

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