Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Помощь студентам


Ответ
 
Опции темы Опции просмотра
Старый 13.04.2014, 19:02   #1 (permalink)
mp_12332
Новичок
 
Регистрация: 13.04.2014
Сообщений: 9
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
Exclamation Помощь с программой. Фортран и Паскаль

нужна помощь с программой, не хочет работать
+нужно перевести программу на паскаль
могу скинуть условие если нужно
Код:
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
mp_12332 вне форума   Ответить с цитированием

Старый 13.04.2014, 19:02
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Пока люди думают, что вам ответить вы можете ознакомиться с подобными темами

Нужна помощь с программой расчета колебаний струны
Помогите пожалуйста с программой на строки. Паскаль

Старый 13.04.2014, 19:05   #2 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Цитата:
Сообщение от mp_12332 Посмотреть сообщение
могу скинуть условие если нужно
Очень желательно!
Vladimir_S вне форума   Ответить с цитированием
Старый 13.04.2014, 19:11   #3 (permalink)
mp_12332
Новичок
 
Регистрация: 13.04.2014
Сообщений: 9
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

не могу определить где у меня ошибка, программа компилируется, запускается и ничего не происходит, просто пустое окно программы
Миниатюры
nedheioio-13.04.2014-18-07-56-.jpg  
mp_12332 вне форума   Ответить с цитированием
Старый 13.04.2014, 19:27   #4 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Ну, по отладке фортрановской программы я - пас, а вот с Паскалем помогу. Как я понимаю, для каждого из значений "c" нужно:
1. Найти корень x0 уравнения F(x,c)=0
2. Методом прямоугольников сосчитать интеграл F(x)dx в пределах от x0 до b
В связи с этим вопрос: как (каким методом) Вы ищете корень? Что-то понять не могу.
Vladimir_S вне форума   Ответить с цитированием
Старый 13.04.2014, 19:36   #5 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

А, кажется понял - методом хорд (секущих)?
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Старый 13.04.2014, 19:46   #6 (permalink)
mp_12332
Новичок
 
Регистрация: 13.04.2014
Сообщений: 9
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Цитата:
Сообщение от Vladimir_S Посмотреть сообщение
А, кажется понял - методом хорд (секущих)?
да, именно им
mp_12332 вне форума   Ответить с цитированием
Старый 13.04.2014, 21:00   #7 (permalink)
Vladimir_S
Специалист
 
Регистрация: 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.
Vladimir_S вне форума   Ответить с цитированием
Старый 13.04.2014, 21:23   #8 (permalink)
mp_12332
Новичок
 
Регистрация: 13.04.2014
Сообщений: 9
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Цитата:
Сообщение от Vladimir_S Посмотреть сообщение
А ошибка Ваша - в некорректной постановке условия выхода из цикла в подпрограмме поиска корня.
Проблема в том, что эту п/п нам дал преподаватель
mp_12332 вне форума   Ответить с цитированием
Старый 13.04.2014, 21:36   #9 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Цитата:
Сообщение от mp_12332 Посмотреть сообщение
Проблема в том, что эту п/п нам дал преподаватель
Гнать! В три шеи!! Без выходного пособия!!!
Vladimir_S вне форума   Ответить с цитированием
Старый 13.04.2014, 21:52   #10 (permalink)
mp_12332
Новичок
 
Регистрация: 13.04.2014
Сообщений: 9
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Цитата:
Сообщение от Vladimir_S Посмотреть сообщение
Гнать! В три шеи!! Без выходного пособия!!!
Хотелось бы, спасибо за помощь
mp_12332 вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 13:42.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.