{Programa para calculo de raizes de polinomios pelo met.Birge-Vieta}
{   com refinamento  }
program BIRGEVRF(printer);
uses printer;
var
   I,N,NINT,J,NRAIZES  :integer;
   XO,XI,Y,TOL,ERRO   :real;
   NOMEFUN  :string[30];
   A,B,C,AINIC : array [0..10] of real;
   RAIZES : array [1..10] of real;
begin
  repeat {Pede grau e tolerancia , exigindo que caia dentro da faixa}
    writeln(' Forneca o grau N do polinomio , tal que 0<N<11 ',
    'e a tolerancia ');
    readln(N,TOL);NRAIZES := N;
  until ( N > 0 ) and ( N < 11 ) and (TOL > 0.0);
  writeln(' Forneca os coeficientes do polinomio ');
  write(Lst,' Coeficientes da equacao -> ');
  writeln(Lst,' ');
  for I := N downto 0 do
    begin
        read(A[I]); AINIC[I] := A[I];
        write(Lst,'  ',A[I]:6:2)
    end;
  writeln(' Forneca a aproximacao inicial ');
  writeln(Lst,' ');
  readln(XO);
{ Calculo de P(XO) e Plinha(XO) }
 repeat  { calculo de nova raiz }
  NINT := 0;
  B[N] := A[N]; C[N] := A[N];
  repeat
     for I := N - 1 downto 0 do
       begin
         B[I] := A[I] + B[I+1]*XO;
         C[I] := B[I] + C[I+1]*XO
       end;
     XI := XO - B[0]/C[1];
     ERRO := abs(XI - XO);
     Inc(NINT);
     writeln(Lst,' XO =',XO:8:5,' XI =',XI:8:5,' ERRO =',ERRO:8:5,
     ' YO =',B[0]:8:5,' Ylinha[0] =',C[1]:8:3);
     XO := XI;
  until (ERRO < TOL) or (NINT > 20);
  if NINT > 20 then
         begin  writeln(Lst,' nao convergiu com ',NINT,' iteracoes ');
           N := 1
         end
               else
         begin  writeln(Lst,' Raiz encontrada = ',XI:8:5);
                writeln(Lst,'  ');
           RAIZES[N] := XI
         end;
  writeln(' tecle <enter> para calcular nova raiz ou recomecar ');
  N := N - 1;
  for I := N downto 0 do A[I] := B[I+1];{Coloca em A os coef. de B}
 until N = 0; { Volta para calcular nova raiz}
 { Inicio do refinamento das raizes }
 if NINT <= 20 then
 begin
 for I := 1 to NRAIZES do
  begin
      XO := RAIZES[I];
      B[NRAIZES] := AINIC[NRAIZES]; C[NRAIZES] := AINIC[NRAIZES];
    repeat
      for J := NRAIZES-1 downto 0 do
        begin  B[J] := AINIC[J] + B[J+1]*XO;
               C[J] := B[J] + C[J+1]*XO
        end;
      XI := XO - B[0] / C[1];
      ERRO := abs(XI-XO);
      XO := XI;
    until ERRO < TOL;
    RAIZES[I] := XI;
  end;
 { Fim do refinamento das raizes }
 writeln(Lst,' Raizes refinadas ');
 for I := 1 to NRAIZES do  writeln(Lst,'   ',RAIZES[I]:8:5);
 writeln(Lst,' ')
 end
 end.