var f: array [1..10,1..10] of integer;
var q: array [1..10] of integer;
    n,m,i,j,l,k,p,v,pr,buf: integer;
    fal:boolean;
begin
Writeln ('Введите количество строк матрицы (<=10)');
Readln (n);
Writeln ('Введите количество столбцов матрицы (<=10)');
Readln (m);
Writeln('Введите значения элементов матрицы');
for i:=1 to n do
for j:=1 to m do
 begin
   write('F[',i,',',j,'] -> ');
   read(f[i,j]);
 end;
Writeln ('Введите количество элементов массива (<=10)');
Readln(l);
Writeln ('Введите значения элементов массива');
For i:=1 to l do
 begin
  write('Q[',i,'] -> ');
  Readln(q[i]);
 end;
Writeln('Исходная матрица');
for i:=1 to n do
 begin
  for j:=1 to m do
  write(f[i,j]:4);
  writeln;
 end;
Writeln('Исходный массив');
For i:=1 to l do
Write(q[i]:4);
writeln;
for j:=1 to m do
 begin
  pr:=1;
  for i:=1 to n do
  pr:=pr*f[i,j];
  fal:=false;
  v:=1;
  While (v<=n)and not fal do
  If pr=q[v] then fal:=true
  else v:=v+1;
  if fal then
   begin
    for k:=1 to m-1 do
    for p:=k+1 to m do
    if f[k,j]>f[p,j] then
      begin
        buf:=f[k,j];
        f[k,j]:=f[p,j];
        f[p,j]:=buf;
       end;
     end;
 end;
Writeln('Матрица после сортировки по возрастанию');
for i:=1 to n do
 begin
  for j:=1 to m do
  write(f[i,j]:4);
  writeln;
 end;
end.