Unnamed

program szek;
var v:Array[1..100] of Integer;
sz,dbsz,db,n:Integer;
nev:Array[1..100] of String;
kor:Array[1..100] of Integer;

procedure kiir(k:Byte);
var z,y:Byte;
begin
 inc(db);
  for z:=1 to k do
   begin
   for y:=1 to n do
    if y=v[z] then Write(y,' ');
   end;

   if db mod 20=0 then begin
                      WriteLn;
                     end;
  WriteLn;
end;

function jo(k:Byte):Boolean;
var ok:Boolean;
x:Integer;
begin
 ok:=True;
 for x:=1 to k-1 do
  if v[x]=v[k] then ok:=false;
  for x:=1 to k-1 do
  begin
   if(v[x]=v[x+1]+1)or(v[x]=v[x+1]-1) then ok:=False
    else
     if x>1 then if (v[x]=v[x-1]+1) or (v[x]=v[x-1]-1) then ok:=false;
   if (kor[v[x]]>kor[v[x]+1]+kor[v[x]]*1/5) or (kor[v[x]]>kor[v[x]-1]+kor[v[x]]*1/5) then ok:=false;
  end;
 jo:=ok;
end;

procedure back(i:Byte);
var j:Byte;
 begin
  for j:=1 to n do
   begin
    v[i]:=j;
    if jo(i) then
     if i>=dbsz then kiir(i)
     else back(i+1);
   end;
 end;
begin
WriteLN('Kerem az emberek szamat:');
ReadLn(n);
WriteLn('Kerem a szekek szamat:');
ReadLn(dbsz);
{for sz:=1 to n do
 begin
  Write('Kerem az ',sz,'. ember nevet:');
  ReadLn(nev[sz]);
  Write('Kerem az ',sz,'. ember korat:');

  ReadLn(kor[sz]);
 end;
 }
db:=0;
back(1);
If db=0 then WriteLn('Nincs megoldas') else WriteLn('Megoldasok szama:',db);
ReadLn;
end.