Правила форума
Внимание!
я нашёл метод методе Лобачевского-Греффе (ну эт практически одно и тоже), но эта прога на каком-то другом языке(фортран вродеб), и там ничего не понятно.
program MLG
implicit none
double precision, dimension(0:4) ::a1,b2,eps,summa
double precision, dimension(0:8) ::b1
double precision, dimension(1:4) ::y,lg,dx
double precision, dimension(1:3) ::b3
double precision koef,v,sumcmplx,prcmplx,e1,e2, epsilon
double complex deskr
double complex, dimension(1:4) ::x
logical, dimension(0:4) ::mask
logical, dimension(1:4) ::flags
logical flag
integer i,k,m
! задание начальных значений
epsilon = 1e-3
print *,\'vvedite koeffitsienty mnogochlena\', \' \'
read *, a1 !чтение данных
!открытие файла для записи данных
open (3, file=\'res2.txt\', status=\'replace\')
write (3,10) a1
10 format (t3,\'коэффициенты исходного многочлена\',5(2x,es15.7))
write (3,11) epsilon
11 format (t3,\'ограничение точности \',es15.7)
y = 0.0
mask = .true.
b1 = 0.0
b1(0:4) = a1
flag = .true.
k=0
!операция квадрирования корней
do while (flag)
k = k + 1 !считаем номер итерации
write (3,1) k
1 format (t60,\'итерация No \',t75,i2)
b2 = b1(0:4)*b1(0:4)
summa = (/(2*s(i),i=0,4)/)
write (3,2) summa
2 format (t3,\'удвоенная сумма\',5(2x,es15.7))
print *,\' \'
b2 = (/(b2(i)+2*s(i),i=0,4)/) !вычисление коэффициентов
write (3,3) b2
3 format (t3,\'коэффициенты \',5(2x,es15.7))
mask = mask .and. (b2 > 0) !определение действительных
корней
eps = 0.0
where (mask) eps = abs(b2/(b1(0:4)*b1(0:4))-1)
flag = maxval(eps)
>epsilon !ограничение точности
if (.not. flag) then
k = k-1
do i=1,4
if (.not. mask(i)) then
e1 = abs(b2(i-1) - b1(i-1)*b1(i-1))
e2 = abs(b2(i+1) - b1(i+1)*b1(i+1))
koef = 1/exp((k+1)*LOG(2.0))
dx(i) = koef*(e1/(b1(i-1)*b1(i-1))+e2/(b1(i+1)*b1(i+1)))
else
e1 = abs(b2(i-1) - b1(i-1)*b1(i-1))
e2 = abs(b2(i) - b1(i)*b1(i))
koef = 1/exp((k+1)*LOG(2.0))
dx(i) = koef*(e1/(b1(i-1)*b1(i-1))+e2/(b1(i)*b1(i)))
end if
end do
else
b1(0:4) = b2 !запоминаем значение коэффициентов на текущей итерации
end if
write (3,4)
4 format (t3,\' \')
end do
!определение номеров комплексных корней
do i=1,4
if (.not. mask(i)) m=i
end do
mask(m+1) = .false.
dx(m+1) = dx(m)
!вычисление корней в уравнении Q(y) = 0
do i=1,4
if (mask(i)) y(i) = b1(i)/b1(i-1)
end do
!вычисление действительных корней
koef = 1/exp(k*LOG(2.0))
where (mask(1:4)) lg = exp(koef*log(y))
!определение знака действительных корней
flags = .false.
do i=1,4
if (mask(i)) then
v = polinom(lg(i))/polinom(-1.0*lg(i))
flags(i) = (v > 1.0)
end if
end do
where (flags) lg = -1.0*lg
x = lg
!составляем уравнение для нахождения комплексных корней
sumcmplx = -a1(1)/a1(0)
do i=1,4
if (mask(i)) then
sumcmplx = sumcmplx - x(i)
end if
end do
v = -1.0
prcmplx = extent_int(v,4)*a1(4)/a1(0)
do i=1,4
if (mask(i)) then
prcmplx = prcmplx/x(i)
end if
end do
b3(1) = 1.0
b3(2) = -1.0*sumcmplx
b3(3) = prcmplx
!нахождение комплексных корней
v = b3(2)*b3(2)-4*b3(1)*b3(3)
deskr = dcmplx(-1.0*b3(2),sqrt(abs(v)))/(2*b3(1))
x(m) = deskr
x(m+1) = CONJG(x(m))
!вывод результата
write (3,5)
5 format (t3,\'-------------------------------------\')
write (3,6)
6 format (t3,\'полученый результат\')
do i=1,4
write (3,7) x(i)
7 format (t20,2(es15.8,3x))
write (3,8)
8 format (t3,\'\')
end do
write (3,9) dx
9 format (t3,\'относительная погрешность корней \',4(es15.8,2x))
print *,\'vse vychisleniya vypolneny uspeshno\', \' \', \'rezultat sohranen
v faile res2.txt\'
close (3, status=\'keep\')
contains
real(8) function s(a)
integer a,j
real(8) sum
sum = 0.0
do j=1,a
if (mod(j,2) == 0) then
sum = sum + b1(a-j)*b1(a+j)
else
sum = sum - b1(a-j)*b1(a+j)
end if
end do
s=sum
end function s
real(8) function polinom(xp)
real(8) xp,p,xs
integer j,l
p = 0.0
do j=0,4
p = p+ extent_int(xp,j)*a1(4-j)
end do
polinom = p
end function polinom
real(8) function extent_int(num,ext)
real(8) num
integer ext,l
real(8) w
w=1.0
do l=1,ext
w = w*num
end do
extent_int = w
end function extent_int
end program MLG
кто разбераеться переделайте под паскаль ПЛЗ.
ЗЫ если есть на С++, то тож пойдет
Сообщение отредактировано: So Slow -
