Вывести в алфавитном порядке слова текста, в которых повторяется первая буква

program PascalGuru;
uses crt;
label 1,2;
var s,zs,zp,gl,slovo,l:string;
    i,j,p,n,nn:integer;
    m:array [1..80] of string;
    b:boolean;
    
procedure exchange(var a,b:string);
var c:string;
begin
c:=a; a:=b; b:=c; end;
{------------------------------------------}
 
 
begin
write('Stroka: '); readln(s);
 
zp:='!?*,.'; {все знаки препинания}
zs:='бвгжздйлмнр';
gl:='аоуыэяеёюи';
 {начало разбиения предложения на слова}
 p:=pos(' ',s);
 i:=0;
        repeat
        inc(i);
        slovo:=copy(s,1,p-1);
        if pos(slovo[length(slovo)],zp)<>0 then delete(slovo,length(slovo),1);
        m[i]:=slovo;
        delete(s,1,p);
        p:=pos(' ',s);
        until p=0;
        n:=i+1;
        m[n]:=s;  {массив со словами}
 {--конец разбиения предложения на слова}
 
{************сортировка по алфавиту****************************  }
nn:=n;
repeat
b:=false;
for j:=1 to nn-1 do                  BEGIN
i:=1;
l:=m[j];
s:=m[j+1];
While (I<=5)and(l[i]=s[i]) do inc(i);
If i>5 then writeln('the same')
 else
    if ord(l[i])>ord(s[i]) then begin exchange(m[j+1],m[j]); b:=true; end;
                                  END;
dec(nn);
until not b;
{*************************************************************    }
writeln;
writeln('*Slova teksta, v kotoryh povtoryaetsya pervaya bukva:');
for i:=1 to n do {проход по массиву слов строки}
    begin
    s:=m[i];
    b:=false;
    for j:=2 to length(s) do
     if s[1]=s[j] then b:=true;
    if b then  writeln(s);{выводим}
    end;
 
 
{--------------------------------------------------------------------}
writeln;
writeln('*Ostalinye slova (obnovlennye) teksta:');
for i:=1 to n do {проход по массиву слов строки}
    begin
    s:=m[i];
    b:=false;
    for j:=2 to length(s) do
     if s[1]=s[j] then b:=true;
    
     if not b then
        begin
        {удаляем}
        1:
        for j:=1 to length(s) do
        if pos(s[j],zs)<>0 then begin delete(s,j,1); goto 1;  end;
        {дублируем}
        j:=1;
        repeat
        if pos(s[j],gl)<>0 then
           begin
           insert(s[j],s,j);
           inc(j,2);
           end else inc(j);
        until j>length(s);
        
        writeln(s);{выводим обновлённый}
        end;
    end;
    
 
readln;
end.