Ответ:

Procedure DivideALine(Line:String);

Var

 I:Integer;

 W:String;

Begin

  If Line[Length(Line)]<>' '

  Then

     Line:=Line+' ';

  W:=' ';

  For I:=1 To Length(Line) Do

     If Line[I]<>' '

     Then

        W:=W+Line[I]

     Else

       Begin

          WriteLn(W);

          W:='';

       End;

End;

const

 nn = 25; // максимум слов

var

 a: array[1..nn] of string[20];

procedure Parser(s: string; var k: integer);

var  

 i,n: integer;

 w: string;

begin  

 w := '';

 k := 0;

 n := length(s);

 for i := 1 to n do

   if s[i] <> ' ' then w := w + s[i]

   else

     if length(w) > 0 then

     begin

       k := k + 1;

       a[k] := w;

       w := '';

     end;

 if length(w) > 0 then

 begin

   k := k + 1;

   a[k] := w;

 end;

end;

var

 s: string[254];

 i, k: integer;

begin

 Readln(s);

 Parser(s, k);

 for i := 1 to k do

   if Pos('ар', a[i]) > 0 then

     write(a[i], ' ');

end.

Программа уровня Турбо Паскаль