Блок - схема

var i,j,nT,nD,k,s,A,D,T:integer;
  Y: array[1..10] of integer;     {massiv reshenii funkcii Y}
  R:real;
  l:text;
 
function STEPEN(s,k:integer):integer;    {funkcija, vozvodit S v K-ju stepen'}
var i,p:integer;
begin
  p:=s;
  i:=1;                                  {i- s4et4ik}
  while i<k do                           {poka i<k vozvodim v stepen'}
    begin
      p:=p*s;
      i:=i+1;                            {kajdii cikl +1 poka ne stanet i>k}
    end;
  STEPEN:=p;                             {rezultat funkcii}
end;
 
begin
writeln('Vvedite zna4enie koefficienta A');
readln(a);                                   {vvod koefficienta A}
for i:=1 to 10 do
  begin
    y[i]:=a*sqr(i)-4*i+6;                    {reshaem funkciju i zapisivaem v massiv}
  end;
 
writeln('Reshenija funkcii y=',a,'n^2-4n+6');
D:=Y[1];                                     {Na4alnie MAX i MIN zna4enij, 4tobi potom sravnivat' s drugimi zna4enijami}
T:=Y[1];
for i:=1 to 10 do
  begin
    if y[i]>T then                           {nahodim MAX zna4enie}
              begin
              T:=Y[i];
              nT:=i;                         {nomer MAX zna4enija v cikle(na vsiakii slu4ai)}
              end;
    if y[i]<D then                           {nahodim MIN zha4enie}
              begin
              D:=Y[i];
              nD:=i;                         {nomer MIN zna4enija}
              end;
    writeln(i,' ',y[i]);                     {vivodim na ekran vse zna4enija funkcii}
end;
 
Writeln('MAX= ',T,'   MIN= ',D);
 
R:=1;                       {'R' prisvaivaem 1, t.k. dalshe idet umnojenie}
if 3*D<T then               {vipolniaetsia uslovie dlia R}
  begin
    for k:=1 to 7 do
      begin
        s:=y[k]-1;          {4islitel'}
        R:=R*STEPEN(s,k)/y[k];    {obrashaemsia k visheopisanoi funkcii, zadavaja ei parametri S,K}
      end;
  Writeln('R= ',R);               {vivod R na ekran}
  end
          else     {esli uslovie ne vipolniaetsia, to}
  begin
    R:=0;     {R prisvaivaem 0, t.k. dalshe budet summirovanie}
    for k:=1 to 10 do
      begin
        s:=y[k]-A;    {4islitel'}
        R:=R+STEPEN(s,k)/STEPEN(y[k],k);  {opiat' funkcija}
      end;
  Writeln('R= ',R);
  end;
 
  assign(l,'c:\otvet.txt');    {otkrivaem fail v ukazanom meste s ukazanim nazvaniem i rashireniem}
  rewrite(l);                  {otkrivaem fail dlia zapisi}
  for i:=1 to 10 do
    begin
      writeln(l,i,' ',y[i]);   {zapisivaem v fail zna4enija funkcii}
 
    end;
 
close(l);   {zakrivaem otkritii logi4eskii fail}
readln
end.