Помощь с программой. Фортран и Паскаль

[mp_12332]

Помощь с программой. Фортран и Паскаль

нужна помощь с программой, не хочет работать
+нужно перевести программу на паскаль
могу скинуть условие если нужно

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

 

[Vladimir_S]

могу скинуть условие если нужно

Очень желательно!

 

[mp_12332]

не могу определить где у меня ошибка, программа компилируется, запускается и ничего не происходит, просто пустое окно программы

 

[Vladimir_S]

Ну, по отладке фортрановской программы я - пас, а вот с Паскалем помогу. Как я понимаю, для каждого из значений "c" нужно:
1. Найти корень x0 уравнения F(x,c)=0
2. Методом прямоугольников сосчитать интеграл F(x)dx в пределах от x0 до b
В связи с этим вопрос: как (каким методом) Вы ищете корень? Что-то понять не могу.

 

[Vladimir_S]

А, кажется понял - методом хорд (секущих)?

 

[mp_12332]

А, кажется понял - методом хорд (секущих)?

да, именно им

 

[Vladimir_S]

Так, ну получите. Программа полностью отлажена.
А ошибка Ваша - в некорректной постановке условия выхода из цикла в подпрограмме поиска корня. Разность 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.

 

[mp_12332]

А ошибка Ваша - в некорректной постановке условия выхода из цикла в подпрограмме поиска корня.

Проблема в том, что эту п/п нам дал преподаватель

 

[Vladimir_S]

Проблема в том, что эту п/п нам дал преподаватель

Гнать! В три шеи!! Без выходного пособия!!!

 

[mp_12332]

Гнать! В три шеи!! Без выходного пособия!!!

Хотелось бы, спасибо за помощь

 

[mp_12332]

Так, а что мне необходимо исправить в фортрановской программе, чтобы она заработала?

 

[Vladimir_S]

Так, а что мне необходимо исправить в фортрановской программе, чтобы она заработала?

Попробуйте так:
1. В п/п COR вместо x ввести real x1, x2, dif.
2. В начале п/п присвоить x1=a, dif=a.
3. вместо
do while(abs(xl-xp)>e.and..not.p)
записать
do while(dif>e.and..not.p)
4. вместо
x=xp-v*(xl-xp)/(u-v)
записать
x2=xp-v*(xl-xp)/(u-v)
5. Далее вместо
d=f(x)
xl=x
xp=x
записать
d=f(x2)
xl=x2
xp=x2
6. В конце цикла while добавить
dif=abs(x2-x1)
x1=x2
7. Вместо
cor=x
поставить
cor=x2

Как-то так. Попробуйте.

 

[mp_12332]

нет, не работает, все так же пустое окно, на клавиши ноль реакции

 

[mp_12332]

так должно получиться?

real function COR(f,a,b,e)
external F
real x1,x2,e,f,xl,xp,u,v,d,dif,a,b
logical P
xl=a
xp=b
U=f(xl)
v=f(xp)
x1=a
p=.false.
do while(abs(xl-xp)>e.and..not.p)
x2=xp-v*(xl-xp)/(u-v)
d=f(x2)
if((u*d)>0)then
 xl=x2
 u=d
 else
  if((u*d)<0)then
  xp=x2
  v=d
  else
  p=.true.
  endif
endif
dif=abs(x2-x1)
 x1=x2
enddo
cor=x2
return
end

 

[Vladimir_S]

так должно получиться?

Нет. Вы не поменяли условие цикла do while.
Совет: не пытайтесь отлаживать сразу всю программу. Научите ее вначале правильно находить корень уравнения. Всё остальное временно отключите. Найденный корень выведите на экран.

 

[mp_12332]

а теперь корень всегда получается равен 0

real function COR(f,a,b,e)
external F
real x1,x2,e,f,xl,xp,u,v,d,dif,a,b
logical P
xl=a
xp=b
U=f(xl)
v=f(xp)
x1=a
p=.false.
dif=a
do while(dif>e.and..not.p)
x2=xp-v*(xl-xp)/(u-v)
d=f(x2)
if((u*d)>0)then
 xl=x2
 u=d
 else
  if((u*d)<0)then
  xp=x2
  v=d
  else
  p=.true.
  endif
endif
dif=abs(x2-x1)
 x1=x2
enddo
cor=x2
return
end

 

[Vladimir_S]

а теперь корень всегда получается равен 0

Уважаемый mp_12332, к сожалению, я не обладаю ни достаточными знаниями Фортрана, ни даже Фортран-транслятором, а потому провести за Вас полную отладку программы не могу. Так что Вы уж сами. С моей точки зрения, подпрограммы у Вас в #16 и у меня в #7 полностью идентичны. Ниже я привожу результат работы моей Паскаль-программы. Колонки соответствуют параметру-корню-интегралу. Что касается Ваших "нулей", то единственное, что могу предположить - ошибка в операции вывода на экран (что-то не то выводите). Проверяйте.

 

[Anna)]

Помогите, пожалуйста, не могу разобрать 2 задачи в программе Паскаль

Третья и пятая задача. Вообще...

[mod2]Прежде всего - у нас не принято цепляться к чужим темам, создавайте свои. На первый раз я сделал это за Вас: http://www.tehnari.ru/f41/t95832/

Модератор[/mod2]