Решить уравнение - Free Pascal (837)

Формулировка задачи:

Здравствуйте!) Помогите пожалуйста, очень нужна ваша помощь в решении задачи... Задача:" Решить уравнение ax²+bx+c=0 a - произведение вектора Т(к), b - произведение элементов целочисленного вектора D(L) с - произведение элементов целочисленного вектора R(n).". Я нашла на вашем форуме решение.. но преподаватель говорит оно не верное, и "как минимум странное") Помогите пожалуйста, буду очень благодарна..

Вот решение, на которое ругался преподаватель...

uses crt;
function arcctg(x,e:real;var i:integer):real;{вычисление функции через разложение в ряд}
var s,si,t:real;
begin
s:=0;
t:=-x;{первый член ряда}
si:=-x;
i:=1;
while abs(s-si)>e do
begin
s:=si;
i:=i+1;
{рекуррентное соотношение An=-A(n-1)/x^2}
t:=-exp(ln(1))*(i+1)*exp(ln(x)*2*i+1);
si:=si+t/(2*i+1);{член ряда= An/(2*i+1)}
end;
arcctg:=pi/2+s;{значение функции}
end;
procedure Shapka(xn,xk,dx,e:real);{рисование шапки}
begin
writeln(' Таблица табулирования функции arctg(x)');{заголовок}
writeln('на интервале ',xn:0:2,' ',xk:0:2,' с шагом ',dx:0:2,' с точностью ',e:0:8);
writeln('----------------------------');
writeln('| x | arcctg(x) | Китр.|');
writeln('----------------------------');
end;
var xn,xk,e,dx,f:real;
i,k:integer;
begin
clrscr;
repeat
write('Введите конец интервала |xk|<=1 xk=');
readln(xk);
until xk<=1;
repeat
write('Начало интервала xn<',xk:0:2,' xn=');
readln(xn);
until xn<xk;
repeat
write('Введите точность в интервале (0,1) e=');
readln(e);
until(e>0)and(e<1);
repeat
write('Введите шаг табуляции, положительное число меньше ',xk-xn:0:2,' dx=');
readln(dx);
until (dx<xk-xn)and(dx>0);
write('Press Enter...');
readln;
clrscr;
Shapka(xn,xk,dx,e);
k:=0;
while xn<=xk do
begin
f:=arcctg(xn,e,i);
writeln('|',xn:6:2,' |',f:10:6,' |',i:4,' |');
k:=k+1;
if k mod 18=0 then{если вывели 18 строк, делаем задержку. Если много значений, не войдет на экран}
begin
write('Press Enter...');
readln;
clrscr;
Shapka(xn,xk,dx,e);
end;
xn:=xn+dx;
end;
writeln('----------------------------');
write('Press Enter...');
readln
end.

Решение задачи: «Решить уравнение»

textual
                            Листинг программы 
                        

                            uses crt;
const max=5;
type vec=array[1..max] of integer;
procedure vector(var a:vec;n:byte;var p:integer;c:char);
var i:byte;
begin
writeln('Вектор ',c);
repeat
write('Размер вектора от 1 до ',max,'=');
readln(n);
until n in [1..max];
p:=1;
for i:=1 to n do
 begin
  a[i]:=1+random(5);
  write(a[i]:3);
  p:=p*a[i];
 end;
writeln;
writeln('Произведение=',p);
end;
var t,d,r:vec;
    a,b,c,k,l,n:integer;
    ds,x1,x2:real;
begin
clrscr;
randomize;
vector(t,k,a,'T');
vector(d,l,b,'D');
vector(r,n,c,'R');
ds:=b*b-4*a*c;
if ds<0 then writeln('Действительных корней нет!')
else if ds=0 then
   begin
    x1:=-b/(2*a);
    writeln('x1=x2=',x1:0:2);
   end
else
  begin
   x1:=(-b-sqrt(ds))/(2*a);
   x2:=(-b+sqrt(ds))/(2*a);
   writeln('x1=',x1:0:2,'   x2=',x2:0:2);
  end;
readln
end.
                        