|
Главная | Правила | Регистрация | Дневники | Справка | Пользователи | Календарь | Поиск | Сообщения за день | Все разделы прочитаны |
|
Опции темы | Опции просмотра |
13.04.2014, 19:02 | #1 (permalink) |
Новичок
Регистрация: 13.04.2014
Сообщений: 9
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Помощь с программой. Фортран и Паскаль
+нужно перевести программу на паскаль могу скинуть условие если нужно Код:
External F integer c real s,F,A,B,fint,E common /z/c E=0.001 B=1.3 do c=1,5,1 A=cor(F,0,1,E) !a=c*0.2 S=fint(F,A,B,E) write(*,10)S 10 format(x,'площадь равна=',F6.2) pause enddo END Real function F(x) real x common /z/c F=x**3+c*x-c end real function fint(f,a,b,eps) external f real x,a,b,eps,sp,ss,h,d,f integer n n=100 sp=0. 11 ss=0. h=(b-a)/n x=a do x=a,b,h ss=ss+f(x)*h end do d=abs(sp-ss) sp=ss n=2*n if (d>=eps) goto 11 fint=ss end real function COR(f,a,b,e) external F real x,e,f,xl,xp,u,v,d integer a,b logical P xl=a xp=b U=f(xl) v=f(xp) p=.false. do while(abs(xl-xp)>e.and..not.p) x=xp-v*(xl-xp)/(u-v) d=f(x) if((u*d)>0)then xl=x u=d else if((u*d)<0)then xp=x v=d else p=.true. endif endif enddo cor=x return end |
13.04.2014, 19:02 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Пока люди думают, что вам ответить вы можете ознакомиться с подобными темами Нужна помощь с программой расчета колебаний струны Помогите пожалуйста с программой на строки. Паскаль |
13.04.2014, 19:27 | #4 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Ну, по отладке фортрановской программы я - пас, а вот с Паскалем помогу. Как я понимаю, для каждого из значений "c" нужно:
1. Найти корень x0 уравнения F(x,c)=0 2. Методом прямоугольников сосчитать интеграл F(x)dx в пределах от x0 до b В связи с этим вопрос: как (каким методом) Вы ищете корень? Что-то понять не могу. |
13.04.2014, 19:36 | #5 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
А, кажется понял - методом хорд (секущих)?
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
13.04.2014, 21:00 | #7 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Так, ну получите. Программа полностью отлажена.
А ошибка Ваша - в некорректной постановке условия выхода из цикла в подпрограмме поиска корня. Разность xl-xp вовсе не обязана уменьшаться. Нужно сравнивать предыдущее значение найденного корня с последующим, и когда разность между ними станет меньше меры точности, то прерывать цикл. Код:
Const a=0; b=1.3; e=0.001; Var c,Sq:Array[1..5] of real; i:integer; function F(x,c:real):real; begin F:=x*x*x+c*x-c; end; function Fint(x0,c:real):real; var x,h,ss,sp,d:real; n,i:integer; begin n:=100; sp:=0; Repeat ss:=0; h:=(b-x0)/n; x:=x0; for i:=1 to n do begin x:=x+h; ss:=ss+F(x,c)*h; end; d:=abs(sp-ss); sp:=ss; n:=2*n; Until d<=e; Fint:=ss; end; function COR(c:real):real; var x_old,x_new,dif,xl,xp,U,V,D:real; p:boolean; begin xl:=a; xp:=b; dif:=b-a; U:=F(xl,c); V:=F(xp,c); p:=false; while (dif>e) and not(p) do begin x_new:=xp-V*(xl-xp)/(U-V); D:=F(x_new,c); if U*D>0 then begin xl:=x_new; U:=D; end else if U*D<0 then begin xp:=x_new; V:=D; end else p:=true; dif:=abs(x_old-x_new); x_old:=x_new; end; COR:=x_new; end; Begin for i:=1 to 5 do begin c[i]:=i; Sq[i]:=Fint(Cor(c[i]),c[i]); writeln('c = ',c[i]:3:1,' x0 = ',Cor(c[i]):0:5,' Square = ',Sq[i]:0:5); end; Readln End. |
13.04.2014, 21:52 | #10 (permalink) |
Новичок
Регистрация: 13.04.2014
Сообщений: 9
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
Опции темы | |
Опции просмотра | |
|
|