IPB
ЛогинПароль:

> Внимание!

1. Пользуйтесь тегами кода. - [code] ... [/code]
2. Точно указывайте язык, название и версию компилятора (интерпретатора).
3. Название темы должно быть информативным.
В описании темы указываем язык!!!

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

> Метод Лобачевского, хелп курсач!
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 21
Пол: Мужской
Реальное имя: Stas

Репутация: -  0  +


у кого-нибуть есть метод Лобачевского нахождения корней многочлена?

я нашёл метод методе Лобачевского-Греффе (ну эт практически одно и тоже), но эта прога на каком-то другом языке(фортран вродеб), и там ничего не понятно.


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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 6.12.2021 19:32
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name