const
  maxn          =101;
  maxm          =11;
var
  L,S           :array[1..maxn]of longint;
  mark          :array[1..maxn]of shortint;
  Lm,A          :array[1..maxm]of longint;
  ans           :array[1..maxm,0..maxn]of longint;
  M,N,i,j,num   :integer;

procedure swap(var x,y:longint);
var
  sw:longint;
begin
  sw:=x;x:=y;y:=sw;
end;

procedure writedata;
var
  k,i,j:integer;
begin
  for i:=1 to M do
  begin
    writeln(ans[i,0]);
    for j:=1 to ans[i,0] do
      write(L[ans[i,j]],' ');
    writeln;
  end;
end;

procedure solve;
var
  i,j:integer;
begin
  if num=m then
  begin
    writedata;
    halt;
  end;

  for i:=1 to m do
    if a[i]<Lm[i] then
      for j:=1 to n do
        if mark[j]=0 then
        begin
          mark[j]:=i;a[i]:=a[i]+L[j];
          inc(ans[i,0]);ans[i,ans[i,0]]:=j;
          if Lm[i]>=a[i] then
          begin
            if Lm[i]=a[i] then inc(num);
            solve;
            if Lm[i]=a[i] then inc(num);
          end;
          mark[j]:=0;a[i]:=a[i]-L[j];
          ans[i,ans[i,0]]:=0;dec(ans[i,0]);
        end;
end;

begin
{  assign(input,'A.in');reset(input);{!!!!!!!}}

  read(n,m);
  for i:=1 to n do begin read(l[i]);s[i]:=i; end;
  for i:=1 to m do read(Lm[i]);

  for i:=1 to n do
    for j:=i+1 to n do
      if l[i]<l[j] then
      begin
        swap(l[i],l[j]);
        swap(s[i],s[j]);
      end;
  solve;
end.

I wrote a new program but it got TLE can you help me to get AC.
this is my program:

const
  maxn          =100;
  maxm          =10;
var
  a,l,lm        :array[1..maxn]of longint;
  ans           :array[1..maxm,0..maxn]of integer;
  i,j,n,m,k,sw  :longint;

procedure swap(var x,y:longint);
begin
  sw:=x;x:=y;y:=sw;
end;

procedure writedata;
begin
  for i:=1 to m do
  begin
    writeln(ans[i,0]);
    for j:=1 to ans[i,0] do
      write(l[ans[i,j]],' ');
    writeln;
  end;
  halt;
end;

procedure solve(k:integer);
var
  i,j:integer;
begin
  if k=n+1 then
    writedata;

  for i:=1 to m do
  begin
    if lm[i]>=a[i]+l[k] then
    begin
      inc(ans[i,0]);ans[i,ans[i,0]]:=k;inc(a[i],l[k]);
      solve(k+1);
      ans[i,ans[i,0]]:=0;dec(ans[i,0]);dec(a[i],l[k]);
    end;
  end;
end;

begin
  readln(n,m);
  for i:=1 to n do read(l[i]);
  for i:=1 to m do read(lm[i]);
  for i:=1 to n do
    for j:=i+1 to n do
      if l[i]<l[j] then
        swap(l[i],l[j]);

  solve(1);
end.