Вывести в алфавитном порядке слова текста, в которых повторяется первая буква — Pascal(Паскаль)

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.